Context Navigation

phyetat0.F @ 996

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

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

Download in other formats:

Original Format