Context Navigation

phyetat0.F @ 900

Last change on this file since 900 was 888, checked in by Laurent Fairhead, 17 years ago
Modifications sur l'albedo JG LF
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 47.5 KB

Line
1	!
2	! $Header$
3	!
4	c
5	c
6	SUBROUTINE phyetat0 (fichnom,dtime,co2_ppm_etat0,solaire_etat0,
7	. rlat_p, rlon_p, pctsrf_p, tsol_p,
8	. ocean_in, ok_veget_in,
9	. alb1_p, alb2_p,
10	. rain_fall_p, snow_fall_p,solsw_p, sollw_p,
11	. radsol_p,clesphy0,
12	. zmea_p,zstd_p,zsig_p,zgam_p,zthe_p,zpic_p,zval_p,
13	. rugsrel_p,tabcntr0,
14	. t_ancien_p,q_ancien_p,ancien_ok_p, rnebcon_p, ratqs_p,
15	. clwcon_p,pbl_tke_p)
16
17	USE dimphy
18	USE mod_grid_phy_lmdz
19	USE mod_phys_lmdz_para
20	USE iophy
21	USE ocean_slab_mod, ONLY : ocean_slab_init
22	USE ocean_cpl_mod, ONLY : ocean_cpl_init
23	USE ocean_forced_mod, ONLY : ocean_forced_init
24	USE fonte_neige_mod, ONLY : fonte_neige_init
25	USE pbl_surface_mod, ONLY : pbl_surface_init
26	USE surface_data, ONLY : ocean, ok_veget
27
28	IMPLICIT none
29	c======================================================================
30	c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
31	c Objet: Lecture de l'etat initial pour la physique
32	c======================================================================
33	#include "dimensions.h"
34	#include "netcdf.inc"
35	#include "indicesol.h"
36	#include "dimsoil.h"
37	#include "clesphys.h"
38	#include "temps.h"
39	#include "thermcell.h"
40	#include "compbl.h"
41	c======================================================================
42	CHARACTER() fichnom
43	REAL dtime
44	INTEGER radpas
45	REAL rlat_p(klon), rlon_p(klon)
46	REAL co2_ppm_etat0
47	REAL solaire_etat0
48	REAL tsol_p(klon,nbsrf)
49	REAL pbl_tke_p(klon,klev,nbsrf)
50	REAL tsoil_p(klon,nsoilmx,nbsrf)
51	REAL tslab_p(klon), seaice_p(klon)
52	REAL qsurf_p(klon,nbsrf)
53	REAL qsol_p(klon)
54	REAL snow_p(klon,nbsrf)
55	REAL alb1_p(klon,nbsrf) ! albedo in visible SW interval
56	REAL alb2_p(klon,nbsrf) ! albedo in near IR interval
57	REAL evap_p(klon,nbsrf)
58	REAL radsol_p(klon)
59	REAL rain_fall_p(klon)
60	REAL snow_fall_p(klon)
61	REAL sollw_p(klon)
62	real solsw_p(klon)
63	real fder_p(klon)
64	REAL frugs_p(klon,nbsrf)
65	REAL agesno_p(klon,nbsrf)
66	REAL zmea_p(klon)
67	REAL zstd_p(klon)
68	REAL zsig_p(klon)
69	REAL zgam_p(klon)
70	REAL zthe_p(klon)
71	REAL zpic_p(klon)
72	REAL zval_p(klon)
73	REAL rugsrel_p(klon)
74	REAL pctsrf_p(klon, nbsrf)
75	REAL run_off_lic_0_p(klon)
76
77	REAL t_ancien_p(klon,klev), q_ancien_p(klon,klev)
78	real rnebcon_p(klon,klev),clwcon_p(klon,klev)
79	real ratqs_p(klon,klev)
80	LOGICAL,SAVE :: ancien_ok
81	LOGICAL :: ancien_ok_p
82
83	REAL zmasq_glo(klon_glo)
84	REAL rlat(klon_glo), rlon(klon_glo)
85	REAL tsol(klon_glo,nbsrf)
86	REAL pbl_tke(klon_glo,klev,nbsrf)
87	REAL tsoil(klon_glo,nsoilmx,nbsrf)
88	cIM "slab" ocean
89	REAL tslab(klon_glo), seaice(klon_glo)
90	REAL qsurf(klon_glo,nbsrf)
91	REAL qsol(klon_glo)
92	REAL snow(klon_glo,nbsrf)
93	REAL alb1(klon_glo,nbsrf)
94	REAL alb2(klon_glo,nbsrf)
95	REAL evap(klon_glo,nbsrf)
96	REAL radsol(klon_glo)
97	REAL rain_fall(klon_glo)
98	REAL snow_fall(klon_glo)
99	REAL sollw(klon_glo)
100	real solsw(klon_glo)
101	real fder(klon_glo)
102	REAL frugs(klon_glo,nbsrf)
103	REAL agesno(klon_glo,nbsrf)
104	REAL zmea(klon_glo)
105	REAL zstd(klon_glo)
106	REAL zsig(klon_glo)
107	REAL zgam(klon_glo)
108	REAL zthe(klon_glo)
109	REAL zpic(klon_glo)
110	REAL zval(klon_glo)
111	REAL rugsrel(klon_glo)
112	REAL pctsrf(klon_glo, nbsrf)
113	REAL fractint(klon_glo)
114	REAL run_off_lic_0(klon_glo)
115	REAL t_ancien(klon_glo,klev)
116	REAL q_ancien(klon_glo,klev)
117	real rnebcon(klon_glo,klev)
118	real clwcon(klon_glo,klev)
119	real ratqs(klon_glo,klev)
120
121	CHARACTER*6 ocean_in
122	LOGICAL ok_veget_in
123
124	INTEGER longcles
125	PARAMETER ( longcles = 20 )
126	REAL clesphy0( longcles )
127	c
128	REAL xmin, xmax
129	c
130	INTEGER nid, nvarid
131	INTEGER ierr, i, nsrf, isoil ,k
132	INTEGER length
133	PARAMETER (length=100)
134	REAL tab_cntrl(length), tabcntr0(length)
135	REAL,SAVE :: tab_cntrl_omp(length)
136	CHARACTER*7 str7
137	CHARACTER*2 str2
138
139	c FH1D
140	c real iolat(jjm+1)
141	real iolat(jjm+1-1/iim)
142	c
143	c Ouvrir le fichier contenant l'etat initial:
144	c
145
146	c$OMP MASTER
147	print *,'MASTER -x , omp_rank=',omp_rank
148	c$OMP END MASTER
149
150	c$OMP MASTER
151	IF (is_mpi_root) THEN
152	print*,'fichnom ',fichnom
153	ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
154	IF (ierr.NE.NF_NOERR) THEN
155	write(6,*)' Pb d''ouverture du fichier '//fichnom
156	write(6,*)' ierr = ', ierr
157	CALL ABORT
158	ENDIF
159	ENDIF
160	c$OMP END MASTER
161	c
162	c Lecture des parametres de controle:
163	c
164	c$OMP MASTER
165	IF (is_mpi_root) THEN
166
167	ierr = NF_INQ_VARID (nid, "controle", nvarid)
168	IF (ierr.NE.NF_NOERR) THEN
169	PRINT*, 'phyetat0: Le champ <controle> est absent'
170	CALL abort
171	ENDIF
172	#ifdef NC_DOUBLE
173	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl)
174	#else
175	ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
176	#endif
177	IF (ierr.NE.NF_NOERR) THEN
178	PRINT*, 'phyetat0: Lecture echouee pour <controle>'
179	CALL abort
180	ENDIF
181	ENDIF
182
183	c$OMP END MASTER
184
185	CALL bcast(tab_cntrl)
186
187	c
188
189	DO i = 1, length
190	tabcntr0( i ) = tab_cntrl( i )
191	ENDDO
192	c
193	cycle_diurne = .FALSE.
194	soil_model = .FALSE.
195	new_oliq = .FALSE.
196	ok_orodr = .FALSE.
197	ok_orolf = .FALSE.
198	ok_limitvrai = .FALSE.
199
200
201	IF( clesphy0(1).NE.tab_cntrl( 5 ) ) THEN
202	tab_cntrl( 5 ) = clesphy0(1)
203	ENDIF
204
205	IF( clesphy0(2).NE.tab_cntrl( 6 ) ) THEN
206	tab_cntrl( 6 ) = clesphy0(2)
207	ENDIF
208
209	IF( clesphy0(3).NE.tab_cntrl( 7 ) ) THEN
210	tab_cntrl( 7 ) = clesphy0(3)
211	ENDIF
212
213	IF( clesphy0(4).NE.tab_cntrl( 8 ) ) THEN
214	tab_cntrl( 8 ) = clesphy0(4)
215	ENDIF
216
217	IF( clesphy0(5).NE.tab_cntrl( 9 ) ) THEN
218	tab_cntrl( 9 ) = clesphy0( 5 )
219	ENDIF
220
221	IF( clesphy0(6).NE.tab_cntrl( 10 ) ) THEN
222	tab_cntrl( 10 ) = clesphy0( 6 )
223	ENDIF
224
225	IF( clesphy0(7).NE.tab_cntrl( 11 ) ) THEN
226	tab_cntrl( 11 ) = clesphy0( 7 )
227	ENDIF
228
229	IF( clesphy0(8).NE.tab_cntrl( 12 ) ) THEN
230	tab_cntrl( 12 ) = clesphy0( 8 )
231	ENDIF
232
233
234	dtime = tab_cntrl(1)
235	radpas = tab_cntrl(2)
236	co2_ppm_etat0 = tab_cntrl(3)
237	solaire_etat0 = tab_cntrl(4)
238	iflag_con = tab_cntrl(5)
239	nbapp_rad = tab_cntrl(6)
240
241
242	cycle_diurne = .FALSE.
243	soil_model = .FALSE.
244	new_oliq = .FALSE.
245	ok_orodr = .FALSE.
246	ok_orolf = .FALSE.
247	ok_limitvrai = .FALSE.
248
249	IF( tab_cntrl( 7) .EQ. 1. ) cycle_diurne = .TRUE.
250	IF( tab_cntrl( 8) .EQ. 1. ) soil_model = .TRUE.
251	IF( tab_cntrl( 9) .EQ. 1. ) new_oliq = .TRUE.
252	IF( tab_cntrl(10) .EQ. 1. ) ok_orodr = .TRUE.
253	IF( tab_cntrl(11) .EQ. 1. ) ok_orolf = .TRUE.
254	IF( tab_cntrl(12) .EQ. 1. ) ok_limitvrai = .TRUE.
255
256
257	itau_phy = tab_cntrl(15)
258
259	c
260	c Lecture des latitudes (coordonnees):
261	c
262	c$OMP MASTER
263	IF (is_mpi_root) THEN
264
265	ierr = NF_INQ_VARID (nid, "latitude", nvarid)
266	IF (ierr.NE.NF_NOERR) THEN
267	PRINT*, 'phyetat0: Le champ <latitude> est absent'
268	CALL abort
269	ENDIF
270	#ifdef NC_DOUBLE
271	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlat)
272	#else
273	ierr = NF_GET_VAR_REAL(nid, nvarid, rlat)
274	#endif
275	IF (ierr.NE.NF_NOERR) THEN
276	PRINT*, 'phyetat0: Lecture echouee pour <latitude>'
277	CALL abort
278	ENDIF
279
280	c
281	c Lecture des longitudes (coordonnees):
282	c
283	ierr = NF_INQ_VARID (nid, "longitude", nvarid)
284	IF (ierr.NE.NF_NOERR) THEN
285	PRINT*, 'phyetat0: Le champ <longitude> est absent'
286	CALL abort
287	ENDIF
288	#ifdef NC_DOUBLE
289	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlon)
290	#else
291	ierr = NF_GET_VAR_REAL(nid, nvarid, rlon)
292	#endif
293	IF (ierr.NE.NF_NOERR) THEN
294	PRINT*, 'phyetat0: Lecture echouee pour <latitude>'
295	CALL abort
296	ENDIF
297	C
298	C
299	C Lecture du masque terre mer
300	C
301
302	ierr = NF_INQ_VARID (nid, "masque", nvarid)
303	IF (ierr .EQ. NF_NOERR) THEN
304	#ifdef NC_DOUBLE
305	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zmasq_glo)
306	#else
307	ierr = NF_GET_VAR_REAL(nid, nvarid, zmasq_glo)
308	#endif
309	IF (ierr.NE.NF_NOERR) THEN
310	PRINT*, 'phyetat0: Lecture echouee pour <masque>'
311	CALL abort
312	ENDIF
313	else
314	PRINT*, 'phyetat0: Le champ <masque> est absent'
315	PRINT*, 'fichier startphy non compatible avec phyetat0'
316	C CALL abort
317	ENDIF
318
319
320	C Lecture des fractions pour chaque sous-surface
321	C
322	C initialisation des sous-surfaces
323	C
324	pctsrf = 0.
325	C
326	C fraction de terre
327	C
328
329	ierr = NF_INQ_VARID (nid, "FTER", nvarid)
330	IF (ierr .EQ. NF_NOERR) THEN
331	#ifdef NC_DOUBLE
332	ierr = NF_GET_VAR_DOUBLE(nid, nvarid,
333	. pctsrf(1 : klon_glo,is_ter))
334	#else
335	ierr = NF_GET_VAR_REAL(nid, nvarid,
336	. pctsrf(1 : klon_glo,is_ter))
337	#endif
338	IF (ierr.NE.NF_NOERR) THEN
339	PRINT*, 'phyetat0: Lecture echouee pour <FTER>'
340	CALL abort
341	ENDIF
342	else
343	PRINT*, 'phyetat0: Le champ <FTER> est absent'
344	c@$$ CALL abort
345	ENDIF
346
347	C
348	C fraction de glace de terre
349	C
350	ierr = NF_INQ_VARID (nid, "FLIC", nvarid)
351	IF (ierr .EQ. NF_NOERR) THEN
352	#ifdef NC_DOUBLE
353	ierr = NF_GET_VAR_DOUBLE(nid, nvarid,
354	. pctsrf(1 : klon_glo,is_lic))
355	#else
356	ierr = NF_GET_VAR_REAL(nid, nvarid,
357	. pctsrf(1 : klon_glo,is_lic))
358	#endif
359	IF (ierr.NE.NF_NOERR) THEN
360	PRINT*, 'phyetat0: Lecture echouee pour <FLIC>'
361	CALL abort
362	ENDIF
363	else
364	PRINT*, 'phyetat0: Le champ <FLIC> est absent'
365	c@$$ CALL abort
366	ENDIF
367	C
368	C fraction d'ocean
369	C
370	ierr = NF_INQ_VARID (nid, "FOCE", nvarid)
371	IF (ierr .EQ. NF_NOERR) THEN
372	#ifdef NC_DOUBLE
373	ierr = NF_GET_VAR_DOUBLE(nid, nvarid,
374	. pctsrf(1 : klon_glo,is_oce))
375	#else
376	ierr = NF_GET_VAR_REAL(nid, nvarid,
377	. pctsrf(1 : klon_glo,is_oce))
378	#endif
379	IF (ierr.NE.NF_NOERR) THEN
380	PRINT*, 'phyetat0: Lecture echouee pour <FOCE>'
381	CALL abort
382	ENDIF
383	else
384	PRINT*, 'phyetat0: Le champ <FOCE> est absent'
385	c@$$ CALL abort
386	ENDIF
387
388	C
389	C fraction glace de mer
390	C
391	ierr = NF_INQ_VARID (nid, "FSIC", nvarid)
392	IF (ierr .EQ. NF_NOERR) THEN
393	#ifdef NC_DOUBLE
394	ierr = NF_GET_VAR_DOUBLE(nid, nvarid,
395	. pctsrf(1 : klon_glo,is_sic))
396	#else
397	ierr = NF_GET_VAR_REAL(nid, nvarid,
398	. pctsrf(1 : klon_glo, is_sic))
399	#endif
400	IF (ierr.NE.NF_NOERR) THEN
401	PRINT*, 'phyetat0: Lecture echouee pour <FSIC>'
402	CALL abort
403	ENDIF
404	else
405	PRINT*, 'phyetat0: Le champ <FSIC> est absent'
406	c@$$ CALL abort
407	ENDIF
408
409	C
410	C Verification de l'adequation entre le masque et les sous-surfaces
411	C
412	fractint( 1 : klon_glo) = pctsrf(1 : klon_glo, is_ter)
413	$ + pctsrf(1 : klon_glo, is_lic)
414	DO i = 1 , klon_glo
415	IF ( abs(fractint(i) - zmasq_glo(i) ) .GT. EPSFRA ) THEN
416	WRITE(,) 'phyetat0: attention fraction terre pas ',
417	$ 'coherente ', i, zmasq_glo(i), pctsrf(i, is_ter)
418	$ ,pctsrf(i, is_lic)
419	ENDIF
420	END DO
421	fractint (1 : klon_glo) = pctsrf(1 : klon_glo, is_oce)
422	$ + pctsrf(1 : klon_glo, is_sic)
423	DO i = 1 , klon_glo
424	IF ( abs( fractint(i) - (1. - zmasq_glo(i))) .GT. EPSFRA ) THEN
425	WRITE(,) 'phyetat0 attention fraction ocean pas ',
426	$ 'coherente ', i, zmasq_glo(i) , pctsrf(i, is_oce)
427	$ ,pctsrf(i, is_sic)
428	ENDIF
429	END DO
430
431	C
432	c Lecture des temperatures du sol:
433	c
434
435	ierr = NF_INQ_VARID (nid, "TS", nvarid)
436	IF (ierr.NE.NF_NOERR) THEN
437	PRINT*, 'phyetat0: Le champ <TS> est absent'
438	PRINT, ' Mais je vais essayer de lire TS*'
439	DO nsrf = 1, nbsrf
440	IF (nsrf.GT.99) THEN
441	PRINT*, "Trop de sous-mailles"
442	CALL abort
443	ENDIF
444	WRITE(str2,'(i2.2)') nsrf
445	ierr = NF_INQ_VARID (nid, "TS"//str2, nvarid)
446	IF (ierr.NE.NF_NOERR) THEN
447	PRINT*, "phyetat0: Le champ <TS"//str2//"> est absent"
448	CALL abort
449	ENDIF
450	#ifdef NC_DOUBLE
451	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsol(1,nsrf))
452	#else
453	ierr = NF_GET_VAR_REAL(nid, nvarid, tsol(1,nsrf))
454	#endif
455	IF (ierr.NE.NF_NOERR) THEN
456	PRINT*, "phyetat0: Lecture echouee pour <TS"//str2//">"
457	CALL abort
458	ENDIF
459
460	xmin = 1.0E+20
461	xmax = -1.0E+20
462	DO i = 1, klon_glo
463	xmin = MIN(tsol(i,nsrf),xmin)
464	xmax = MAX(tsol(i,nsrf),xmax)
465	ENDDO
466	PRINT,'Temperature du sol TS*:', nsrf, xmin, xmax
467	ENDDO
468	ELSE
469	PRINT*, 'phyetat0: Le champ <TS> est present'
470	PRINT, ' J ignore donc les autres temperatures TS*'
471	#ifdef NC_DOUBLE
472	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsol(1,1))
473	#else
474	ierr = NF_GET_VAR_REAL(nid, nvarid, tsol(1,1))
475	#endif
476	IF (ierr.NE.NF_NOERR) THEN
477	PRINT*, "phyetat0: Lecture echouee pour <TS>"
478	CALL abort
479	ENDIF
480	xmin = 1.0E+20
481	xmax = -1.0E+20
482	DO i = 1, klon_glo
483	xmin = MIN(tsol(i,1),xmin)
484	xmax = MAX(tsol(i,1),xmax)
485	ENDDO
486	PRINT*,'Temperature du sol <TS>', xmin, xmax
487	DO nsrf = 2, nbsrf
488	DO i = 1, klon_glo
489	tsol(i,nsrf) = tsol(i,1)
490	ENDDO
491	ENDDO
492	ENDIF
493
494	c
495	c Lecture des temperatures du sol profond:
496	c
497	DO nsrf = 1, nbsrf
498	DO isoil=1, nsoilmx
499	IF (isoil.GT.99 .AND. nsrf.GT.99) THEN
500	PRINT*, "Trop de couches ou sous-mailles"
501	CALL abort
502	ENDIF
503	WRITE(str7,'(i2.2,"srf",i2.2)') isoil, nsrf
504	ierr = NF_INQ_VARID (nid, 'Tsoil'//str7, nvarid)
505	IF (ierr.NE.NF_NOERR) THEN
506	PRINT*, "phyetat0: Le champ <Tsoil"//str7//"> est absent"
507	PRINT*, " Il prend donc la valeur de surface"
508	DO i=1, klon_glo
509	tsoil(i,isoil,nsrf)=tsol(i,nsrf)
510	ENDDO
511	ELSE
512	#ifdef NC_DOUBLE
513	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsoil(1,isoil,nsrf))
514	#else
515	ierr = NF_GET_VAR_REAL(nid, nvarid, tsoil(1,isoil,nsrf))
516	#endif
517	IF (ierr.NE.NF_NOERR) THEN
518	PRINT*, "Lecture echouee pour <Tsoil"//str7//">"
519	CALL abort
520	ENDIF
521	ENDIF
522	ENDDO
523	ENDDO
524	c
525	cIM "slab" ocean
526	c
527	c Lecture de tslab (pour slab ocean seulement):
528	c
529	IF (ocean_in .eq. 'slab ') then
530	ierr = NF_INQ_VARID (nid, "TSLAB", nvarid)
531	IF (ierr.NE.NF_NOERR) THEN
532	PRINT*, "phyetat0: Le champ <TSLAB> est absent"
533	CALL abort
534	ENDIF
535	#ifdef NC_DOUBLE
536	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tslab)
537	#else
538	ierr = NF_GET_VAR_REAL(nid, nvarid, tslab)
539	#endif
540	IF (ierr.NE.NF_NOERR) THEN
541	PRINT*, "phyetat0: Lecture echouee pour <TSLAB>"
542	CALL abort
543	ENDIF
544	xmin = 1.0E+20
545	xmax = -1.0E+20
546	DO i = 1, klon_glo
547	xmin = MIN(tslab(i),xmin)
548	xmax = MAX(tslab(i),xmax)
549	ENDDO
550	PRINT*,'Min, Max tslab (utilise si OCEAN=slab )', xmin, xmax
551	c
552	c Lecture de seaice (pour slab ocean seulement):
553	c
554	ierr = NF_INQ_VARID (nid, "SEAICE", nvarid)
555	IF (ierr.NE.NF_NOERR) THEN
556	PRINT*, "phyetat0: Le champ <SEAICE> est absent"
557	CALL abort
558	ENDIF
559	#ifdef NC_DOUBLE
560	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, seaice)
561	#else
562	ierr = NF_GET_VAR_REAL(nid, nvarid, seaice)
563	#endif
564	IF (ierr.NE.NF_NOERR) THEN
565	PRINT*, "phyetat0: Lecture echouee pour <SEAICE>"
566	CALL abort
567	ENDIF
568	xmin = 1.0E+20
569	xmax = -1.0E+20
570	DO i = 1, klon_glo
571	xmin = MIN(seaice(i),xmin)
572	xmax = MAX(seaice(i),xmax)
573	ENDDO
574	PRINT*,'Masse de la glace de mer (utilise si OCEAN=slab)',
575	$ xmin, xmax
576	ELSE
577	tslab = 0.
578	seaice = 0.
579	ENDIF
580	c
581	c Lecture de l'humidite de l'air juste au dessus du sol:
582	c
583	ierr = NF_INQ_VARID (nid, "QS", nvarid)
584	IF (ierr.NE.NF_NOERR) THEN
585	PRINT*, 'phyetat0: Le champ <QS> est absent'
586	PRINT, ' Mais je vais essayer de lire QS*'
587	DO nsrf = 1, nbsrf
588	IF (nsrf.GT.99) THEN
589	PRINT*, "Trop de sous-mailles"
590	CALL abort
591	ENDIF
592	WRITE(str2,'(i2.2)') nsrf
593	ierr = NF_INQ_VARID (nid, "QS"//str2, nvarid)
594	IF (ierr.NE.NF_NOERR) THEN
595	PRINT*, "phyetat0: Le champ <QS"//str2//"> est absent"
596	CALL abort
597	ENDIF
598	#ifdef NC_DOUBLE
599	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, qsurf(1,nsrf))
600	#else
601	ierr = NF_GET_VAR_REAL(nid, nvarid, qsurf(1,nsrf))
602	#endif
603	IF (ierr.NE.NF_NOERR) THEN
604	PRINT*, "phyetat0: Lecture echouee pour <QS"//str2//">"
605	CALL abort
606	ENDIF
607	xmin = 1.0E+20
608	xmax = -1.0E+20
609	DO i = 1, klon_glo
610	xmin = MIN(qsurf(i,nsrf),xmin)
611	xmax = MAX(qsurf(i,nsrf),xmax)
612	ENDDO
613	PRINT,'Humidite pres du sol QS*:', nsrf, xmin, xmax
614	ENDDO
615	ELSE
616	PRINT*, 'phyetat0: Le champ <QS> est present'
617	PRINT, ' J ignore donc les autres humidites QS*'
618	#ifdef NC_DOUBLE
619	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, qsurf(1,1))
620	#else
621	ierr = NF_GET_VAR_REAL(nid, nvarid, qsurf(1,1))
622	#endif
623	IF (ierr.NE.NF_NOERR) THEN
624	PRINT*, "phyetat0: Lecture echouee pour <QS>"
625	CALL abort
626	ENDIF
627	xmin = 1.0E+20
628	xmax = -1.0E+20
629	DO i = 1, klon_glo
630	xmin = MIN(qsurf(i,1),xmin)
631	xmax = MAX(qsurf(i,1),xmax)
632	ENDDO
633	PRINT*,'Humidite pres du sol <QS>', xmin, xmax
634	DO nsrf = 2, nbsrf
635	DO i = 1, klon_glo
636	qsurf(i,nsrf) = qsurf(i,1)
637	ENDDO
638	ENDDO
639	ENDIF
640	C
641	C Eau dans le sol (pour le modele de sol "bucket")
642	C
643	ierr = NF_INQ_VARID (nid, "QSOL", nvarid)
644	IF (ierr .EQ. NF_NOERR) THEN
645	#ifdef NC_DOUBLE
646	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, qsol)
647	#else
648	ierr = NF_GET_VAR_REAL(nid, nvarid, qsol)
649	#endif
650	IF (ierr.NE.NF_NOERR) THEN
651	PRINT*, 'phyetat0: Lecture echouee pour <QSOL>'
652	CALL abort
653	ENDIF
654	else
655	PRINT*, 'phyetat0: Le champ <QSOL> est absent'
656	PRINT*, ' Valeur par defaut nulle'
657	qsol(:)=0.
658	c@$$ CALL abort
659	ENDIF
660	xmin = 1.0E+20
661	xmax = -1.0E+20
662	DO i = 1, klon_glo
663	xmin = MIN(qsol(i),xmin)
664	xmax = MAX(qsol(i),xmax)
665	ENDDO
666	PRINT*,'Eau dans le sol (mm) <QSOL>', xmin, xmax
667	c
668	c Lecture de neige au sol:
669	c
670	ierr = NF_INQ_VARID (nid, "SNOW", nvarid)
671	IF (ierr.NE.NF_NOERR) THEN
672	PRINT*, 'phyetat0: Le champ <SNOW> est absent'
673	PRINT, ' Mais je vais essayer de lire SNOW*'
674	DO nsrf = 1, nbsrf
675	IF (nsrf.GT.99) THEN
676	PRINT*, "Trop de sous-mailles"
677	CALL abort
678	ENDIF
679	WRITE(str2,'(i2.2)') nsrf
680	ierr = NF_INQ_VARID (nid, "SNOW"//str2, nvarid)
681	IF (ierr.NE.NF_NOERR) THEN
682	PRINT*, "phyetat0: Le champ <SNOW"//str2//"> est absent"
683	CALL abort
684	ENDIF
685	#ifdef NC_DOUBLE
686	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, snow(1,nsrf))
687	#else
688	ierr = NF_GET_VAR_REAL(nid, nvarid, snow(1,nsrf))
689	#endif
690	IF (ierr.NE.NF_NOERR) THEN
691	PRINT*, "phyetat0: Lecture echouee pour <SNOW"//str2//">"
692	CALL abort
693	ENDIF
694	xmin = 1.0E+20
695	xmax = -1.0E+20
696	DO i = 1, klon_glo
697	xmin = MIN(snow(i,nsrf),xmin)
698	xmax = MAX(snow(i,nsrf),xmax)
699	ENDDO
700	PRINT,'Neige du sol SNOW*:', nsrf, xmin, xmax
701	ENDDO
702	ELSE
703	PRINT*, 'phyetat0: Le champ <SNOW> est present'
704	PRINT, ' J ignore donc les autres neiges SNOW*'
705	#ifdef NC_DOUBLE
706	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, snow(1,1))
707	#else
708	ierr = NF_GET_VAR_REAL(nid, nvarid, snow(1,1))
709	#endif
710	IF (ierr.NE.NF_NOERR) THEN
711	PRINT*, "phyetat0: Lecture echouee pour <SNOW>"
712	CALL abort
713	ENDIF
714	xmin = 1.0E+20
715	xmax = -1.0E+20
716	DO i = 1, klon_glo
717	xmin = MIN(snow(i,1),xmin)
718	xmax = MAX(snow(i,1),xmax)
719	ENDDO
720	PRINT*,'Neige du sol <SNOW>', xmin, xmax
721	DO nsrf = 2, nbsrf
722	DO i = 1, klon_glo
723	snow(i,nsrf) = snow(i,1)
724	ENDDO
725	ENDDO
726	ENDIF
727	c
728	c Lecture de albedo de l'interval visible au sol:
729	c
730	ierr = NF_INQ_VARID (nid, "ALBE", nvarid)
731	IF (ierr.NE.NF_NOERR) THEN
732	PRINT*, 'phyetat0: Le champ <ALBE> est absent'
733	PRINT, ' Mais je vais essayer de lire ALBE*'
734	DO nsrf = 1, nbsrf
735	IF (nsrf.GT.99) THEN
736	PRINT*, "Trop de sous-mailles"
737	CALL abort
738	ENDIF
739	WRITE(str2,'(i2.2)') nsrf
740	ierr = NF_INQ_VARID (nid, "ALBE"//str2, nvarid)
741	IF (ierr.NE.NF_NOERR) THEN
742	PRINT*, "phyetat0: Le champ <ALBE"//str2//"> est absent"
743	CALL abort
744	ENDIF
745	#ifdef NC_DOUBLE
746	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, alb1(1,nsrf))
747	#else
748	ierr = NF_GET_VAR_REAL(nid, nvarid, alb1(1,nsrf))
749	#endif
750	IF (ierr.NE.NF_NOERR) THEN
751	PRINT*, "phyetat0: Lecture echouee pour <ALBE"//str2//">"
752	CALL abort
753	ENDIF
754	xmin = 1.0E+20
755	xmax = -1.0E+20
756	DO i = 1, klon_glo
757	xmin = MIN(alb1(i,nsrf),xmin)
758	xmax = MAX(alb1(i,nsrf),xmax)
759	ENDDO
760	PRINT,'Albedo du sol ALBE*:', nsrf, xmin, xmax
761	ENDDO
762	ELSE
763	PRINT*, 'phyetat0: Le champ <ALBE> est present'
764	PRINT, ' J ignore donc les autres ALBE*'
765	#ifdef NC_DOUBLE
766	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, alb1(1,1))
767	#else
768	ierr = NF_GET_VAR_REAL(nid, nvarid, alb1(1,1))
769	#endif
770	IF (ierr.NE.NF_NOERR) THEN
771	PRINT*, "phyetat0: Lecture echouee pour <ALBE>"
772	CALL abort
773	ENDIF
774	xmin = 1.0E+20
775	xmax = -1.0E+20
776	DO i = 1, klon_glo
777	xmin = MIN(alb1(i,1),xmin)
778	xmax = MAX(alb1(i,1),xmax)
779	ENDDO
780	PRINT*,'Neige du sol <ALBE>', xmin, xmax
781	DO nsrf = 2, nbsrf
782	DO i = 1, klon_glo
783	alb1(i,nsrf) = alb1(i,1)
784	ENDDO
785	ENDDO
786	ENDIF
787
788	c
789	c Lecture de albedo au sol dans l'interval proche infra-rouge:
790	c
791	ierr = NF_INQ_VARID (nid, "ALBLW", nvarid)
792	IF (ierr.NE.NF_NOERR) THEN
793	PRINT*, 'phyetat0: Le champ <ALBLW> est absent'
794	c PRINT, ' Mais je vais essayer de lire ALBLW*'
795	PRINT, ' Mais je vais prendre ALBE*'
796	DO nsrf = 1, nbsrf
797	DO i = 1, klon_glo
798	alb2(i,nsrf) = alb1(i,nsrf)
799	ENDDO
800	ENDDO
801	ELSE
802	PRINT*, 'phyetat0: Le champ <ALBLW> est present'
803	PRINT, ' J ignore donc les autres ALBLW*'
804	#ifdef NC_DOUBLE
805	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, alb2(1,1))
806	#else
807	ierr = NF_GET_VAR_REAL(nid, nvarid, alb2(1,1))
808	#endif
809	IF (ierr.NE.NF_NOERR) THEN
810	PRINT*, "phyetat0: Lecture echouee pour <ALBLW>"
811	CALL abort
812	ENDIF
813	xmin = 1.0E+20
814	xmax = -1.0E+20
815	DO i = 1, klon_glo
816	xmin = MIN(alb2(i,1),xmin)
817	xmax = MAX(alb2(i,1),xmax)
818	ENDDO
819	PRINT*,'Neige du sol <ALBLW>', xmin, xmax
820	DO nsrf = 2, nbsrf
821	DO i = 1, klon_glo
822	alb2(i,nsrf) = alb2(i,1)
823	ENDDO
824	ENDDO
825	ENDIF
826	c
827	c Lecture de evaporation:
828	c
829	ierr = NF_INQ_VARID (nid, "EVAP", nvarid)
830	IF (ierr.NE.NF_NOERR) THEN
831	PRINT*, 'phyetat0: Le champ <EVAP> est absent'
832	PRINT, ' Mais je vais essayer de lire EVAP*'
833	DO nsrf = 1, nbsrf
834	IF (nsrf.GT.99) THEN
835	PRINT*, "Trop de sous-mailles"
836	CALL abort
837	ENDIF
838	WRITE(str2,'(i2.2)') nsrf
839	ierr = NF_INQ_VARID (nid, "EVAP"//str2, nvarid)
840	IF (ierr.NE.NF_NOERR) THEN
841	PRINT*, "phyetat0: Le champ <EVAP"//str2//"> est absent"
842	CALL abort
843	ENDIF
844	#ifdef NC_DOUBLE
845	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, evap(1,nsrf))
846	#else
847	ierr = NF_GET_VAR_REAL(nid, nvarid, evap(1,nsrf))
848	#endif
849	IF (ierr.NE.NF_NOERR) THEN
850	PRINT*, "phyetat0: Lecture echouee pour <EVAP"//str2//">"
851	CALL abort
852	ENDIF
853	xmin = 1.0E+20
854	xmax = -1.0E+20
855	DO i = 1, klon_glo
856	xmin = MIN(evap(i,nsrf),xmin)
857	xmax = MAX(evap(i,nsrf),xmax)
858	ENDDO
859	PRINT,'evap du sol EVAP*:', nsrf, xmin, xmax
860	ENDDO
861	ELSE
862	PRINT*, 'phyetat0: Le champ <EVAP> est present'
863	PRINT, ' J ignore donc les autres EVAP*'
864	#ifdef NC_DOUBLE
865	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, evap(1,1))
866	#else
867	ierr = NF_GET_VAR_REAL(nid, nvarid, evap(1,1))
868	#endif
869	IF (ierr.NE.NF_NOERR) THEN
870	PRINT*, "phyetat0: Lecture echouee pour <EVAP>"
871	CALL abort
872	ENDIF
873	xmin = 1.0E+20
874	xmax = -1.0E+20
875	DO i = 1, klon_glo
876	xmin = MIN(evap(i,1),xmin)
877	xmax = MAX(evap(i,1),xmax)
878	ENDDO
879	PRINT*,'Evap du sol <EVAP>', xmin, xmax
880	DO nsrf = 2, nbsrf
881	DO i = 1, klon_glo
882	evap(i,nsrf) = evap(i,1)
883	ENDDO
884	ENDDO
885	ENDIF
886	c
887	c Lecture precipitation liquide:
888	c
889	ierr = NF_INQ_VARID (nid, "rain_f", nvarid)
890	IF (ierr.NE.NF_NOERR) THEN
891	PRINT*, 'phyetat0: Le champ <rain_f> est absent'
892	CALL abort
893	ENDIF
894	#ifdef NC_DOUBLE
895	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rain_fall)
896	#else
897	ierr = NF_GET_VAR_REAL(nid, nvarid, rain_fall)
898	#endif
899	IF (ierr.NE.NF_NOERR) THEN
900	PRINT*, 'phyetat0: Lecture echouee pour <rain_f>'
901	CALL abort
902	ENDIF
903	xmin = 1.0E+20
904	xmax = -1.0E+20
905	DO i = 1, klon_glo
906	xmin = MIN(rain_fall(i),xmin)
907	xmax = MAX(rain_fall(i),xmax)
908	ENDDO
909	PRINT*,'Precipitation liquide rain_f:', xmin, xmax
910	c
911	c Lecture precipitation solide:
912	c
913	ierr = NF_INQ_VARID (nid, "snow_f", nvarid)
914	IF (ierr.NE.NF_NOERR) THEN
915	PRINT*, 'phyetat0: Le champ <snow_f> est absent'
916	CALL abort
917	ENDIF
918	#ifdef NC_DOUBLE
919	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, snow_fall)
920	#else
921	ierr = NF_GET_VAR_REAL(nid, nvarid, snow_fall)
922	#endif
923	IF (ierr.NE.NF_NOERR) THEN
924	PRINT*, 'phyetat0: Lecture echouee pour <snow_f>'
925	CALL abort
926	ENDIF
927	xmin = 1.0E+20
928	xmax = -1.0E+20
929	DO i = 1, klon_glo
930	xmin = MIN(snow_fall(i),xmin)
931	xmax = MAX(snow_fall(i),xmax)
932	ENDDO
933	PRINT*,'Precipitation solide snow_f:', xmin, xmax
934	c
935	c Lecture rayonnement solaire au sol:
936	c
937	ierr = NF_INQ_VARID (nid, "solsw", nvarid)
938	IF (ierr.NE.NF_NOERR) THEN
939	PRINT*, 'phyetat0: Le champ <solsw> est absent'
940	PRINT*, 'mis a zero'
941	solsw = 0.
942	ELSE
943	#ifdef NC_DOUBLE
944	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, solsw)
945	#else
946	ierr = NF_GET_VAR_REAL(nid, nvarid, solsw)
947	#endif
948	IF (ierr.NE.NF_NOERR) THEN
949	PRINT*, 'phyetat0: Lecture echouee pour <solsw>'
950	CALL abort
951	ENDIF
952	ENDIF
953	xmin = 1.0E+20
954	xmax = -1.0E+20
955	DO i = 1, klon_glo
956	xmin = MIN(solsw(i),xmin)
957	xmax = MAX(solsw(i),xmax)
958	ENDDO
959	PRINT*,'Rayonnement solaire au sol solsw:', xmin, xmax
960	c
961	c Lecture rayonnement IF au sol:
962	c
963	ierr = NF_INQ_VARID (nid, "sollw", nvarid)
964	IF (ierr.NE.NF_NOERR) THEN
965	PRINT*, 'phyetat0: Le champ <sollw> est absent'
966	PRINT*, 'mis a zero'
967	sollw = 0.
968	ELSE
969	#ifdef NC_DOUBLE
970	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, sollw)
971	#else
972	ierr = NF_GET_VAR_REAL(nid, nvarid, sollw)
973	#endif
974	IF (ierr.NE.NF_NOERR) THEN
975	PRINT*, 'phyetat0: Lecture echouee pour <sollw>'
976	CALL abort
977	ENDIF
978	ENDIF
979	xmin = 1.0E+20
980	xmax = -1.0E+20
981	DO i = 1, klon_glo
982	xmin = MIN(sollw(i),xmin)
983	xmax = MAX(sollw(i),xmax)
984	ENDDO
985	PRINT*,'Rayonnement IF au sol sollw:', xmin, xmax
986
987	ENDIF ! is_mpi_root
988	c$OMP END MASTER
989
990
991	c$OMP MASTER
992	IF (is_mpi_root) THEN
993	c
994	c Lecture derive des flux:
995	c
996	ierr = NF_INQ_VARID (nid, "fder", nvarid)
997	IF (ierr.NE.NF_NOERR) THEN
998	PRINT*, 'phyetat0: Le champ <fder> est absent'
999	PRINT*, 'mis a zero'
1000	fder = 0.
1001	ELSE
1002	#ifdef NC_DOUBLE
1003	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, fder)
1004	#else
1005	ierr = NF_GET_VAR_REAL(nid, nvarid, fder)
1006	#endif
1007	IF (ierr.NE.NF_NOERR) THEN
1008	PRINT*, 'phyetat0: Lecture echouee pour <fder>'
1009	CALL abort
1010	ENDIF
1011	ENDIF
1012	xmin = 1.0E+20
1013	xmax = -1.0E+20
1014	DO i = 1, klon_glo
1015	xmin = MIN(fder(i),xmin)
1016	xmax = MAX(fder(i),xmax)
1017	ENDDO
1018	PRINT*,'Derive des flux fder:', xmin, xmax
1019
1020	c
1021	c Lecture du rayonnement net au sol:
1022	c
1023	ierr = NF_INQ_VARID (nid, "RADS", nvarid)
1024	IF (ierr.NE.NF_NOERR) THEN
1025	PRINT*, 'phyetat0: Le champ <RADS> est absent'
1026	CALL abort
1027	ENDIF
1028	#ifdef NC_DOUBLE
1029	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, radsol)
1030	#else
1031	ierr = NF_GET_VAR_REAL(nid, nvarid, radsol)
1032	#endif
1033	IF (ierr.NE.NF_NOERR) THEN
1034	PRINT*, 'phyetat0: Lecture echouee pour <RADS>'
1035	CALL abort
1036	ENDIF
1037	xmin = 1.0E+20
1038	xmax = -1.0E+20
1039	DO i = 1, klon_glo
1040	xmin = MIN(radsol(i),xmin)
1041	xmax = MAX(radsol(i),xmax)
1042	ENDDO
1043	PRINT*,'Rayonnement net au sol radsol:', xmin, xmax
1044	c
1045	c Lecture de la longueur de rugosite
1046	c
1047	c
1048	ierr = NF_INQ_VARID (nid, "RUG", nvarid)
1049	IF (ierr.NE.NF_NOERR) THEN
1050	PRINT*, 'phyetat0: Le champ <RUG> est absent'
1051	PRINT, ' Mais je vais essayer de lire RUG*'
1052	DO nsrf = 1, nbsrf
1053	IF (nsrf.GT.99) THEN
1054	PRINT*, "Trop de sous-mailles"
1055	CALL abort
1056	ENDIF
1057	WRITE(str2,'(i2.2)') nsrf
1058	ierr = NF_INQ_VARID (nid, "RUG"//str2, nvarid)
1059	IF (ierr.NE.NF_NOERR) THEN
1060	PRINT*, "phyetat0: Le champ <RUG"//str2//"> est absent"
1061	CALL abort
1062	ENDIF
1063	#ifdef NC_DOUBLE
1064	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, frugs(1,nsrf))
1065	#else
1066	ierr = NF_GET_VAR_REAL(nid, nvarid, frugs(1,nsrf))
1067	#endif
1068	IF (ierr.NE.NF_NOERR) THEN
1069	PRINT*, "phyetat0: Lecture echouee pour <RUG"//str2//">"
1070	CALL abort
1071	ENDIF
1072	xmin = 1.0E+20
1073	xmax = -1.0E+20
1074	DO i = 1, klon_glo
1075	xmin = MIN(frugs(i,nsrf),xmin)
1076	xmax = MAX(frugs(i,nsrf),xmax)
1077	ENDDO
1078	PRINT,'rugosite du sol RUG*:', nsrf, xmin, xmax
1079	ENDDO
1080	ELSE
1081	PRINT*, 'phyetat0: Le champ <RUG> est present'
1082	PRINT, ' J ignore donc les autres RUG*'
1083	#ifdef NC_DOUBLE
1084	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, frugs(1,1))
1085	#else
1086	ierr = NF_GET_VAR_REAL(nid, nvarid, frugs(1,1))
1087	#endif
1088	IF (ierr.NE.NF_NOERR) THEN
1089	PRINT*, "phyetat0: Lecture echouee pour <RUG>"
1090	CALL abort
1091	ENDIF
1092	xmin = 1.0E+20
1093	xmax = -1.0E+20
1094	DO i = 1, klon_glo
1095	xmin = MIN(frugs(i,1),xmin)
1096	xmax = MAX(frugs(i,1),xmax)
1097	ENDDO
1098	PRINT*,'rugosite <RUG>', xmin, xmax
1099	DO nsrf = 2, nbsrf
1100	DO i = 1, klon_glo
1101	frugs(i,nsrf) = frugs(i,1)
1102	ENDDO
1103	ENDDO
1104	ENDIF
1105
1106	c
1107	c Lecture de l'age de la neige:
1108	c
1109	ierr = NF_INQ_VARID (nid, "AGESNO", nvarid)
1110	IF (ierr.NE.NF_NOERR) THEN
1111	PRINT*, 'phyetat0: Le champ <AGESNO> est absent'
1112	PRINT, ' Mais je vais essayer de lire AGESNO*'
1113	DO nsrf = 1, nbsrf
1114	IF (nsrf.GT.99) THEN
1115	PRINT*, "Trop de sous-mailles"
1116	CALL abort
1117	ENDIF
1118	WRITE(str2,'(i2.2)') nsrf
1119	ierr = NF_INQ_VARID (nid, "AGESNO"//str2, nvarid)
1120	IF (ierr.NE.NF_NOERR) THEN
1121	PRINT*, "phyetat0: Le champ <AGESNO"//str2//"> est absent"
1122	agesno = 50.0
1123	ENDIF
1124	#ifdef NC_DOUBLE
1125	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, agesno(1,nsrf))
1126	#else
1127	ierr = NF_GET_VAR_REAL(nid, nvarid, agesno(1,nsrf))
1128	#endif
1129	IF (ierr.NE.NF_NOERR) THEN
1130	PRINT*, "phyetat0: Lecture echouee pour <AGESNO"//str2//">"
1131	CALL abort
1132	ENDIF
1133	xmin = 1.0E+20
1134	xmax = -1.0E+20
1135	DO i = 1, klon_glo
1136	xmin = MIN(agesno(i,nsrf),xmin)
1137	xmax = MAX(agesno(i,nsrf),xmax)
1138	ENDDO
1139	PRINT,'Age de la neige AGESNO*:', nsrf, xmin, xmax
1140	ENDDO
1141	ELSE
1142	PRINT*, 'phyetat0: Le champ <AGESNO> est present'
1143	PRINT, ' J ignore donc les autres AGESNO*'
1144	#ifdef NC_DOUBLE
1145	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, agesno(1,1))
1146	#else
1147	ierr = NF_GET_VAR_REAL(nid, nvarid, agesno(1,1))
1148	#endif
1149	IF (ierr.NE.NF_NOERR) THEN
1150	PRINT*, "phyetat0: Lecture echouee pour <AGESNO>"
1151	CALL abort
1152	ENDIF
1153	xmin = 1.0E+20
1154	xmax = -1.0E+20
1155	DO i = 1, klon_glo
1156	xmin = MIN(agesno(i,1),xmin)
1157	xmax = MAX(agesno(i,1),xmax)
1158	ENDDO
1159	PRINT*,'Age de la neige <AGESNO>', xmin, xmax
1160	DO nsrf = 2, nbsrf
1161	DO i = 1, klon_glo
1162	agesno(i,nsrf) = agesno(i,1)
1163	ENDDO
1164	ENDDO
1165	ENDIF
1166
1167	c
1168	ierr = NF_INQ_VARID (nid, "ZMEA", nvarid)
1169	IF (ierr.NE.NF_NOERR) THEN
1170	PRINT*, 'phyetat0: Le champ <ZMEA> est absent'
1171	CALL abort
1172	ENDIF
1173	#ifdef NC_DOUBLE
1174	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zmea)
1175	#else
1176	ierr = NF_GET_VAR_REAL(nid, nvarid, zmea)
1177	#endif
1178	IF (ierr.NE.NF_NOERR) THEN
1179	PRINT*, 'phyetat0: Lecture echouee pour <ZMEA>'
1180	CALL abort
1181	ENDIF
1182	xmin = 1.0E+20
1183	xmax = -1.0E+20
1184	DO i = 1, klon_glo
1185	xmin = MIN(zmea(i),xmin)
1186	xmax = MAX(zmea(i),xmax)
1187	ENDDO
1188	PRINT*,'OROGRAPHIE SOUS-MAILLE zmea:', xmin, xmax
1189	c
1190	c
1191	ierr = NF_INQ_VARID (nid, "ZSTD", nvarid)
1192	IF (ierr.NE.NF_NOERR) THEN
1193	PRINT*, 'phyetat0: Le champ <ZSTD> est absent'
1194	CALL abort
1195	ENDIF
1196	#ifdef NC_DOUBLE
1197	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zstd)
1198	#else
1199	ierr = NF_GET_VAR_REAL(nid, nvarid, zstd)
1200	#endif
1201	IF (ierr.NE.NF_NOERR) THEN
1202	PRINT*, 'phyetat0: Lecture echouee pour <ZSTD>'
1203	CALL abort
1204	ENDIF
1205	xmin = 1.0E+20
1206	xmax = -1.0E+20
1207	DO i = 1, klon_glo
1208	xmin = MIN(zstd(i),xmin)
1209	xmax = MAX(zstd(i),xmax)
1210	ENDDO
1211	PRINT*,'OROGRAPHIE SOUS-MAILLE zstd:', xmin, xmax
1212	c
1213	c
1214	ierr = NF_INQ_VARID (nid, "ZSIG", nvarid)
1215	IF (ierr.NE.NF_NOERR) THEN
1216	PRINT*, 'phyetat0: Le champ <ZSIG> est absent'
1217	CALL abort
1218	ENDIF
1219	#ifdef NC_DOUBLE
1220	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zsig)
1221	#else
1222	ierr = NF_GET_VAR_REAL(nid, nvarid, zsig)
1223	#endif
1224	IF (ierr.NE.NF_NOERR) THEN
1225	PRINT*, 'phyetat0: Lecture echouee pour <ZSIG>'
1226	CALL abort
1227	ENDIF
1228	xmin = 1.0E+20
1229	xmax = -1.0E+20
1230	DO i = 1, klon_glo
1231	xmin = MIN(zsig(i),xmin)
1232	xmax = MAX(zsig(i),xmax)
1233	ENDDO
1234	PRINT*,'OROGRAPHIE SOUS-MAILLE zsig:', xmin, xmax
1235	c
1236	c
1237	ierr = NF_INQ_VARID (nid, "ZGAM", nvarid)
1238	IF (ierr.NE.NF_NOERR) THEN
1239	PRINT*, 'phyetat0: Le champ <ZGAM> est absent'
1240	CALL abort
1241	ENDIF
1242	#ifdef NC_DOUBLE
1243	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zgam)
1244	#else
1245	ierr = NF_GET_VAR_REAL(nid, nvarid, zgam)
1246	#endif
1247	IF (ierr.NE.NF_NOERR) THEN
1248	PRINT*, 'phyetat0: Lecture echouee pour <ZGAM>'
1249	CALL abort
1250	ENDIF
1251	xmin = 1.0E+20
1252	xmax = -1.0E+20
1253	DO i = 1, klon_glo
1254	xmin = MIN(zgam(i),xmin)
1255	xmax = MAX(zgam(i),xmax)
1256	ENDDO
1257	PRINT*,'OROGRAPHIE SOUS-MAILLE zgam:', xmin, xmax
1258	c
1259	c
1260	ierr = NF_INQ_VARID (nid, "ZTHE", nvarid)
1261	IF (ierr.NE.NF_NOERR) THEN
1262	PRINT*, 'phyetat0: Le champ <ZTHE> est absent'
1263	CALL abort
1264	ENDIF
1265	#ifdef NC_DOUBLE
1266	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zthe)
1267	#else
1268	ierr = NF_GET_VAR_REAL(nid, nvarid, zthe)
1269	#endif
1270	IF (ierr.NE.NF_NOERR) THEN
1271	PRINT*, 'phyetat0: Lecture echouee pour <ZTHE>'
1272	CALL abort
1273	ENDIF
1274	xmin = 1.0E+20
1275	xmax = -1.0E+20
1276	DO i = 1, klon_glo
1277	xmin = MIN(zthe(i),xmin)
1278	xmax = MAX(zthe(i),xmax)
1279	ENDDO
1280	PRINT*,'OROGRAPHIE SOUS-MAILLE zthe:', xmin, xmax
1281	c
1282	c
1283	ierr = NF_INQ_VARID (nid, "ZPIC", nvarid)
1284	IF (ierr.NE.NF_NOERR) THEN
1285	PRINT*, 'phyetat0: Le champ <ZPIC> est absent'
1286	CALL abort
1287	ENDIF
1288	#ifdef NC_DOUBLE
1289	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zpic)
1290	#else
1291	ierr = NF_GET_VAR_REAL(nid, nvarid, zpic)
1292	#endif
1293	IF (ierr.NE.NF_NOERR) THEN
1294	PRINT*, 'phyetat0: Lecture echouee pour <ZPIC>'
1295	CALL abort
1296	ENDIF
1297	xmin = 1.0E+20
1298	xmax = -1.0E+20
1299	DO i = 1, klon_glo
1300	xmin = MIN(zpic(i),xmin)
1301	xmax = MAX(zpic(i),xmax)
1302	ENDDO
1303	PRINT*,'OROGRAPHIE SOUS-MAILLE zpic:', xmin, xmax
1304	c
1305	ierr = NF_INQ_VARID (nid, "ZVAL", nvarid)
1306	IF (ierr.NE.NF_NOERR) THEN
1307	PRINT*, 'phyetat0: Le champ <ZVAL> est absent'
1308	CALL abort
1309	ENDIF
1310	#ifdef NC_DOUBLE
1311	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zval)
1312	#else
1313	ierr = NF_GET_VAR_REAL(nid, nvarid, zval)
1314	#endif
1315	IF (ierr.NE.NF_NOERR) THEN
1316	PRINT*, 'phyetat0: Lecture echouee pour <ZVAL>'
1317	CALL abort
1318	ENDIF
1319	xmin = 1.0E+20
1320	xmax = -1.0E+20
1321	DO i = 1, klon_glo
1322	xmin = MIN(zval(i),xmin)
1323	xmax = MAX(zval(i),xmax)
1324	ENDDO
1325	PRINT*,'OROGRAPHIE SOUS-MAILLE zval:', xmin, xmax
1326	c
1327	c
1328	ierr = NF_INQ_VARID (nid, "RUGSREL", nvarid)
1329	IF (ierr.NE.NF_NOERR) THEN
1330	PRINT*, 'phyetat0: Le champ <RUGSREL> est absent'
1331	CALL abort
1332	ENDIF
1333	#ifdef NC_DOUBLE
1334	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rugsrel)
1335	#else
1336	ierr = NF_GET_VAR_REAL(nid, nvarid, rugsrel)
1337	#endif
1338	IF (ierr.NE.NF_NOERR) THEN
1339	PRINT*, 'phyetat0: Lecture echouee pour <RUGSREL>'
1340	CALL abort
1341	ENDIF
1342	xmin = 1.0E+20
1343	xmax = -1.0E+20
1344	DO i = 1, klon_glo
1345	xmin = MIN(rugsrel(i),xmin)
1346	xmax = MAX(rugsrel(i),xmax)
1347	ENDDO
1348	PRINT*,'Rugosite relief (ecart-type) rugsrel:', xmin, xmax
1349	c
1350	c
1351	ancien_ok = .TRUE.
1352	c
1353	ierr = NF_INQ_VARID (nid, "TANCIEN", nvarid)
1354	IF (ierr.NE.NF_NOERR) THEN
1355	PRINT*, "phyetat0: Le champ <TANCIEN> est absent"
1356	PRINT*, "Depart legerement fausse. Mais je continue"
1357	ancien_ok = .FALSE.
1358	ELSE
1359	#ifdef NC_DOUBLE
1360	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, t_ancien)
1361	#else
1362	ierr = NF_GET_VAR_REAL(nid, nvarid, t_ancien)
1363	#endif
1364	IF (ierr.NE.NF_NOERR) THEN
1365	PRINT*, "phyetat0: Lecture echouee pour <TANCIEN>"
1366	CALL abort
1367	ENDIF
1368	ENDIF
1369	c
1370	ierr = NF_INQ_VARID (nid, "QANCIEN", nvarid)
1371	IF (ierr.NE.NF_NOERR) THEN
1372	PRINT*, "phyetat0: Le champ <QANCIEN> est absent"
1373	PRINT*, "Depart legerement fausse. Mais je continue"
1374	ancien_ok = .FALSE.
1375	ELSE
1376	#ifdef NC_DOUBLE
1377	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, q_ancien)
1378	#else
1379	ierr = NF_GET_VAR_REAL(nid, nvarid, q_ancien)
1380	#endif
1381	IF (ierr.NE.NF_NOERR) THEN
1382	PRINT*, "phyetat0: Lecture echouee pour <QANCIEN>"
1383	CALL abort
1384	ENDIF
1385	ENDIF
1386	c
1387	clwcon=0.
1388	ierr = NF_INQ_VARID (nid, "CLWCON", nvarid)
1389	IF (ierr.NE.NF_NOERR) THEN
1390	PRINT*, "phyetat0: Le champ CLWCON est absent"
1391	PRINT*, "Depart legerement fausse. Mais je continue"
1392	clwcon = 0.
1393	ELSE
1394	#ifdef NC_DOUBLE
1395	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, clwcon)
1396	#else
1397	ierr = NF_GET_VAR_REAL(nid, nvarid, clwcon)
1398	#endif
1399	IF (ierr.NE.NF_NOERR) THEN
1400	PRINT*, "phyetat0: Lecture echouee pour <CLWCON>"
1401	CALL abort
1402	ENDIF
1403	ENDIF
1404	xmin = 1.0E+20
1405	xmax = -1.0E+20
1406	xmin = MINval(clwcon)
1407	xmax = MAXval(clwcon)
1408	PRINT*,'Eau liquide convective (ecart-type) clwcon:', xmin, xmax
1409	c
1410	rnebcon=0.
1411	ierr = NF_INQ_VARID (nid, "RNEBCON", nvarid)
1412	IF (ierr.NE.NF_NOERR) THEN
1413	PRINT*, "phyetat0: Le champ RNEBCON est absent"
1414	PRINT*, "Depart legerement fausse. Mais je continue"
1415	rnebcon = 0.
1416	ELSE
1417	#ifdef NC_DOUBLE
1418	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rnebcon)
1419	#else
1420	ierr = NF_GET_VAR_REAL(nid, nvarid, rnebcon)
1421	#endif
1422	IF (ierr.NE.NF_NOERR) THEN
1423	PRINT*, "phyetat0: Lecture echouee pour <RNEBCON>"
1424	CALL abort
1425	ENDIF
1426	ENDIF
1427	xmin = 1.0E+20
1428	xmax = -1.0E+20
1429	xmin = MINval(rnebcon)
1430	xmax = MAXval(rnebcon)
1431	PRINT*,'Nebulosite convective (ecart-type) rnebcon:', xmin, xmax
1432
1433	c
1434	ierr = NF_INQ_VARID (nid, "QANCIEN", nvarid)
1435	IF (ierr.NE.NF_NOERR) THEN
1436	PRINT*, "phyetat0: Le champ <QANCIEN> est absent"
1437	PRINT*, "Depart legerement fausse. Mais je continue"
1438	ancien_ok = .FALSE.
1439	ELSE
1440	#ifdef NC_DOUBLE
1441	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, q_ancien)
1442	#else
1443	ierr = NF_GET_VAR_REAL(nid, nvarid, q_ancien)
1444	#endif
1445	IF (ierr.NE.NF_NOERR) THEN
1446	PRINT*, "phyetat0: Lecture echouee pour <QANCIEN>"
1447	CALL abort
1448	ENDIF
1449	ENDIF
1450	c
1451	c Lecture ratqs
1452	c
1453	ratqs=0.
1454	ierr = NF_INQ_VARID (nid, "RATQS", nvarid)
1455	IF (ierr.NE.NF_NOERR) THEN
1456	PRINT*, "phyetat0: Le champ <RATQS> est absent"
1457	PRINT*, "Depart legerement fausse. Mais je continue"
1458	ratqs = 0.
1459	ELSE
1460	#ifdef NC_DOUBLE
1461	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, ratqs)
1462	#else
1463	ierr = NF_GET_VAR_REAL(nid, nvarid, ratqs)
1464	#endif
1465	IF (ierr.NE.NF_NOERR) THEN
1466	PRINT*, "phyetat0: Lecture echouee pour <RATQS>"
1467	CALL abort
1468	ENDIF
1469	ENDIF
1470	xmin = 1.0E+20
1471	xmax = -1.0E+20
1472	xmin = MINval(ratqs)
1473	xmax = MAXval(ratqs)
1474	PRINT*,'(ecart-type) ratqs:', xmin, xmax
1475	c
1476	c Lecture run_off_lic_0
1477	c
1478	ierr = NF_INQ_VARID (nid, "RUNOFFLIC0", nvarid)
1479	IF (ierr.NE.NF_NOERR) THEN
1480	PRINT*, "phyetat0: Le champ <RUNOFFLIC0> est absent"
1481	PRINT*, "Depart legerement fausse. Mais je continue"
1482	run_off_lic_0 = 0.
1483	ELSE
1484	#ifdef NC_DOUBLE
1485	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, run_off_lic_0)
1486	#else
1487	ierr = NF_GET_VAR_REAL(nid, nvarid, run_off_lic_0)
1488	#endif
1489	IF (ierr.NE.NF_NOERR) THEN
1490	PRINT*, "phyetat0: Lecture echouee pour <RUNOFFLIC0>"
1491	CALL abort
1492	ENDIF
1493	ENDIF
1494	xmin = 1.0E+20
1495	xmax = -1.0E+20
1496	xmin = MINval(run_off_lic_0)
1497	xmax = MAXval(run_off_lic_0)
1498	PRINT*,'(ecart-type) run_off_lic_0:', xmin, xmax
1499
1500
1501	c Lecture de l'energie cinetique turbulente
1502	c
1503
1504	IF (iflag_pbl>1) then
1505	PRINT*, 'phyetat0: Le champ <TKE> est absent'
1506	PRINT, ' Mais je vais essayer de lire TKE*'
1507	DO nsrf = 1, nbsrf
1508	IF (nsrf.GT.99) THEN
1509	PRINT*, "Trop de sous-mailles"
1510	CALL abort
1511	ENDIF
1512	WRITE(str2,'(i2.2)') nsrf
1513	ierr = NF_INQ_VARID (nid, "TKE"//str2, nvarid)
1514	IF (ierr.NE.NF_NOERR) THEN
1515	PRINT*, "WARNING phyetat0: <TKE"//str2//"> est absent"
1516	pbl_tke(:,:,nsrf)=1.e-8
1517	ELSE
1518	#ifdef NC_DOUBLE
1519	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, pbl_tke(1,1,nsrf))
1520	#else
1521	ierr = NF_GET_VAR_REAL(nid, nvarid, pbl_tke(1,1,nsrf))
1522	#endif
1523	IF (ierr.NE.NF_NOERR) THEN
1524	PRINT*, "WARNING phyetat0: echec lect <TKE"//str2//">"
1525	CALL abort
1526	ENDIF
1527	ENDIF
1528
1529	xmin = 1.0E+20
1530	xmax = -1.0E+20
1531	DO k = 1, klev
1532	DO i = 1, klon_glo
1533	xmin = MIN(pbl_tke(i,k,nsrf),xmin)
1534	xmax = MAX(pbl_tke(i,k,nsrf),xmax)
1535	ENDDO
1536	ENDDO
1537	PRINT,'Temperature du sol TKE*:', nsrf, xmin, xmax
1538	ENDDO
1539	ENDIF
1540
1541	c
1542	c Fermer le fichier:
1543	c
1544	ierr = NF_CLOSE(nid)
1545	ENDIF ! is_mpi_root
1546	c
1547	c$OMP END MASTER
1548
1549	c$OMP MASTER
1550	cym en attendant mieux
1551	iolat(1)=rlat(1)
1552
1553	!FH1D
1554	!iolat(jjm+1)=rlat(klon_glo)
1555	iolat(jjm+1-1/iim)=rlat(klon_glo)
1556	if (iim.gt.1) then
1557	do i=2,jjm
1558	iolat(i)=rlat(2+(i-2)*iim)
1559	enddo
1560	endif
1561
1562	CALL bcast_mpi(iolat)
1563	CALL bcast_mpi(rlon)
1564
1565	!FH1D
1566	! call init_iophy(iolat,rlon(2:iim+1))
1567	call init_iophy(iolat,rlon(2-1/iim:iim+1-1/iim))
1568
1569	c$OMP END MASTER
1570
1571	call Scatter( rlat,rlat_p)
1572	call Scatter( rlon,rlon_p)
1573	call Scatter( tsol,tsol_p)
1574	IF (iflag_pbl>1) then
1575	call Scatter( pbl_tke,pbl_tke_p)
1576	endif
1577	call Scatter( tsoil,tsoil_p)
1578	call Scatter( tslab,tslab_p)
1579	call Scatter( seaice,seaice_p)
1580	call Scatter( qsurf,qsurf_p)
1581	call Scatter( qsol,qsol_p)
1582	call Scatter( snow,snow_p)
1583	call Scatter( alb1,alb1_p)
1584	call Scatter( alb2,alb2_p)
1585	call Scatter( evap,evap_p)
1586	call Scatter( radsol,radsol_p)
1587	call Scatter( rain_fall,rain_fall_p)
1588	call Scatter( snow_fall,snow_fall_p)
1589	call Scatter( sollw,sollw_p)
1590	call Scatter( solsw,solsw_p)
1591	call Scatter( fder,fder_p)
1592	call Scatter( frugs,frugs_p)
1593	call Scatter( agesno,agesno_p)
1594	call Scatter( zmea,zmea_p)
1595	call Scatter( zstd,zstd_p)
1596	call Scatter( zsig,zsig_p)
1597	call Scatter( zgam,zgam_p)
1598	call Scatter( zthe,zthe_p)
1599	call Scatter( zpic,zpic_p)
1600	call Scatter( zval,zval_p)
1601	call Scatter( rugsrel,rugsrel_p)
1602	call Scatter( pctsrf,pctsrf_p)
1603	call Scatter( run_off_lic_0,run_off_lic_0_p)
1604	call Scatter( t_ancien,t_ancien_p)
1605	call Scatter( q_ancien,q_ancien_p)
1606	call Scatter( rnebcon,rnebcon_p)
1607	call Scatter( clwcon,clwcon_p)
1608	call Scatter( ratqs,ratqs_p)
1609	call Scatter( zmasq_glo,zmasq)
1610
1611	c
1612	c Initilalize variables in module surface_data
1613	c
1614	ok_veget = ok_veget_in
1615	ocean = ocean_in
1616	c
1617	c Initialize module pbl_surface_mod
1618	c
1619	CALL pbl_surface_init(qsol_p, fder_p, snow_p, qsurf_p,
1620	$ evap_p, frugs_p, agesno_p, tsoil_p)
1621
1622	c Initialize ocean module according to ocean type
1623	IF ( ocean == 'slab' ) THEN
1624	c initilalize module ocean_slab_init
1625	CALL ocean_slab_init(dtime, tslab_p, seaice_p, pctsrf_p)
1626	ELSEIF ( ocean == 'couple' ) THEN
1627	c initilalize module ocean_cpl_init
1628	CALL ocean_cpl_init(dtime, rlon_p, rlat_p)
1629	ELSE
1630	c initilalize module ocean_forced_init
1631	CALL ocean_forced_init
1632	ENDIF
1633	c
1634	c Initilialize module fonte_neige_mod
1635	c
1636	CALL fonte_neige_init(run_off_lic_0_p)
1637
1638
1639	RETURN
1640	END

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format