Context Navigation

phyetat0.F @ 880

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

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

Download in other formats:

Original Format