Context Navigation

phyetat0.F @ 1074

Last change on this file since 1074 was 956, checked in by lmdzadmin, 16 years ago

Nettoyage du controle des parametres physiques. FH

Les parametres cycle_diurne, soil_model, new_oliq, ok_orodr, ok_orolf, ok_limitvrai, nbapp_rad et iflag_con
sont maintenant geres par la physique uniquement.
ecritphy est elimine.
dimphy.F90 et clesphys.h ne sont plus utilises par le code dynamique.
Le test academique obtenu en compilant avec
makegcm -p nophys gcm
fonctionne. FH
IM

Property svn:eol-style set to native
Property svn:keywords set to Author Date Id Revision

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

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

Download in other formats:

Original Format