Context Navigation

phyetat0.F @ 929

Last change on this file since 929 was 927, checked in by lmdzadmin, 17 years ago
Ajout variables zmax0, f0 dans le startphy.nc FH IM
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 48.9 KB

Line
1	!
2	! $Header$
3	!
4	c
5	c
6	SUBROUTINE phyetat0 (fichnom,dtime,co2_ppm_etat0,solaire_etat0,
7	. rlat_p, rlon_p, pctsrf_p, tsol_p,
8	. ocean_in, ok_veget_in,
9	. alb1_p, alb2_p,
10	. rain_fall_p, snow_fall_p,solsw_p, sollw_p,
11	. radsol_p,clesphy0,
12	. zmea_p,zstd_p,zsig_p,zgam_p,zthe_p,zpic_p,zval_p,
13	. rugsrel_p,tabcntr0,
14	. t_ancien_p,q_ancien_p,ancien_ok_p, rnebcon_p, ratqs_p,
15	. clwcon_p,pbl_tke_p, zmax0_p, f0_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 zmax0_p(klon), f0_p(klon)
51	REAL tsoil_p(klon,nsoilmx,nbsrf)
52	REAL tslab_p(klon), seaice_p(klon)
53	REAL qsurf_p(klon,nbsrf)
54	REAL qsol_p(klon)
55	REAL snow_p(klon,nbsrf)
56	REAL alb1_p(klon,nbsrf) ! albedo in visible SW interval
57	REAL alb2_p(klon,nbsrf) ! albedo in near IR interval
58	REAL evap_p(klon,nbsrf)
59	REAL radsol_p(klon)
60	REAL rain_fall_p(klon)
61	REAL snow_fall_p(klon)
62	REAL sollw_p(klon)
63	real solsw_p(klon)
64	real fder_p(klon)
65	REAL frugs_p(klon,nbsrf)
66	REAL agesno_p(klon,nbsrf)
67	REAL zmea_p(klon)
68	REAL zstd_p(klon)
69	REAL zsig_p(klon)
70	REAL zgam_p(klon)
71	REAL zthe_p(klon)
72	REAL zpic_p(klon)
73	REAL zval_p(klon)
74	REAL rugsrel_p(klon)
75	REAL pctsrf_p(klon, nbsrf)
76	REAL run_off_lic_0_p(klon)
77
78	REAL t_ancien_p(klon,klev), q_ancien_p(klon,klev)
79	real rnebcon_p(klon,klev),clwcon_p(klon,klev)
80	real ratqs_p(klon,klev)
81	LOGICAL,SAVE :: ancien_ok
82	LOGICAL :: ancien_ok_p
83
84	REAL zmasq_glo(klon_glo)
85	REAL rlat(klon_glo), rlon(klon_glo)
86	REAL tsol(klon_glo,nbsrf)
87	REAL pbl_tke(klon_glo,klev,nbsrf)
88	REAL zmax0(klon), f0(klon)
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 alb1(klon_glo,nbsrf)
96	REAL alb2(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 de l'interval visible 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, alb1(1,nsrf))
749	#else
750	ierr = NF_GET_VAR_REAL(nid, nvarid, alb1(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(alb1(i,nsrf),xmin)
760	xmax = MAX(alb1(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, alb1(1,1))
769	#else
770	ierr = NF_GET_VAR_REAL(nid, nvarid, alb1(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(alb1(i,1),xmin)
780	xmax = MAX(alb1(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	alb1(i,nsrf) = alb1(i,1)
786	ENDDO
787	ENDDO
788	ENDIF
789
790	c
791	c Lecture de albedo au sol dans l'interval proche infra-rouge:
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	alb2(i,nsrf) = alb1(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, alb2(1,1))
808	#else
809	ierr = NF_GET_VAR_REAL(nid, nvarid, alb2(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(alb2(i,1),xmin)
819	xmax = MAX(alb2(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	alb2(i,nsrf) = alb2(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	c
1543	c zmax0
1544	ierr = NF_INQ_VARID (nid, "ZMAX0", nvarid)
1545	IF (ierr.NE.NF_NOERR) THEN
1546	PRINT*, "phyetat0: Le champ <ZMAX0> est absent"
1547	PRINT*, "Depart legerement fausse. Mais je continue"
1548	zmax0=40.
1549	ELSE
1550	#ifdef NC_DOUBLE
1551	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zmax0)
1552	#else
1553	ierr = NF_GET_VAR_REAL(nid, nvarid, zmax0)
1554	#endif
1555	IF (ierr.NE.NF_NOERR) THEN
1556	PRINT*, "phyetat0: Lecture echouee pour <ZMAX0>"
1557	CALL abort
1558	ENDIF
1559	ENDIF
1560	xmin = 1.0E+20
1561	xmax = -1.0E+20
1562	xmin = MINval(zmax0)
1563	xmax = MAXval(zmax0)
1564	PRINT*,'(ecart-type) zmax0:', xmin, xmax
1565	c
1566	c f0(ig)=1.e-5
1567	c f0
1568	ierr = NF_INQ_VARID (nid, "f0", nvarid)
1569	IF (ierr.NE.NF_NOERR) THEN
1570	PRINT*, "phyetat0: Le champ <f0> est absent"
1571	PRINT*, "Depart legerement fausse. Mais je continue"
1572	f0=1.e-5
1573	ELSE
1574	#ifdef NC_DOUBLE
1575	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, f0)
1576	#else
1577	ierr = NF_GET_VAR_REAL(nid, nvarid, f0)
1578	#endif
1579	IF (ierr.NE.NF_NOERR) THEN
1580	PRINT*, "phyetat0: Lecture echouee pour <f0>"
1581	CALL abort
1582	ENDIF
1583	ENDIF
1584	xmin = 1.0E+20
1585	xmax = -1.0E+20
1586	xmin = MINval(f0)
1587	xmax = MAXval(f0)
1588	PRINT*,'(ecart-type) f0:', xmin, xmax
1589	c
1590	c Fermer le fichier:
1591	c
1592	ierr = NF_CLOSE(nid)
1593	ENDIF ! is_mpi_root
1594	c
1595	c$OMP END MASTER
1596
1597	c$OMP MASTER
1598	cym en attendant mieux
1599	iolat(1)=rlat(1)
1600
1601	!FH1D
1602	!iolat(jjm+1)=rlat(klon_glo)
1603	iolat(jjm+1-1/iim)=rlat(klon_glo)
1604	if (iim.gt.1) then
1605	do i=2,jjm
1606	iolat(i)=rlat(2+(i-2)*iim)
1607	enddo
1608	endif
1609
1610	CALL bcast_mpi(iolat)
1611	CALL bcast_mpi(rlon)
1612
1613	!FH1D
1614	! call init_iophy(iolat,rlon(2:iim+1))
1615	call init_iophy(iolat,rlon(2-1/iim:iim+1-1/iim))
1616
1617	c$OMP END MASTER
1618
1619	call Scatter( rlat,rlat_p)
1620	call Scatter( rlon,rlon_p)
1621	call Scatter( tsol,tsol_p)
1622	IF (iflag_pbl>1) then
1623	call Scatter( pbl_tke,pbl_tke_p)
1624	endif
1625	call Scatter( zmax0,zmax0_p)
1626	call Scatter( f0,f0_p)
1627	call Scatter( tsoil,tsoil_p)
1628	call Scatter( tslab,tslab_p)
1629	call Scatter( seaice,seaice_p)
1630	call Scatter( qsurf,qsurf_p)
1631	call Scatter( qsol,qsol_p)
1632	call Scatter( snow,snow_p)
1633	call Scatter( alb1,alb1_p)
1634	call Scatter( alb2,alb2_p)
1635	call Scatter( evap,evap_p)
1636	call Scatter( radsol,radsol_p)
1637	call Scatter( rain_fall,rain_fall_p)
1638	call Scatter( snow_fall,snow_fall_p)
1639	call Scatter( sollw,sollw_p)
1640	call Scatter( solsw,solsw_p)
1641	call Scatter( fder,fder_p)
1642	call Scatter( frugs,frugs_p)
1643	call Scatter( agesno,agesno_p)
1644	call Scatter( zmea,zmea_p)
1645	call Scatter( zstd,zstd_p)
1646	call Scatter( zsig,zsig_p)
1647	call Scatter( zgam,zgam_p)
1648	call Scatter( zthe,zthe_p)
1649	call Scatter( zpic,zpic_p)
1650	call Scatter( zval,zval_p)
1651	call Scatter( rugsrel,rugsrel_p)
1652	call Scatter( pctsrf,pctsrf_p)
1653	call Scatter( run_off_lic_0,run_off_lic_0_p)
1654	call Scatter( t_ancien,t_ancien_p)
1655	call Scatter( q_ancien,q_ancien_p)
1656	call Scatter( rnebcon,rnebcon_p)
1657	call Scatter( clwcon,clwcon_p)
1658	call Scatter( ratqs,ratqs_p)
1659	call Scatter( zmasq_glo,zmasq)
1660
1661	c
1662	c Initilalize variables in module surface_data
1663	c
1664	ok_veget = ok_veget_in
1665	ocean = ocean_in
1666	c
1667	c Initialize module pbl_surface_mod
1668	c
1669	CALL pbl_surface_init(qsol_p, fder_p, snow_p, qsurf_p,
1670	$ evap_p, frugs_p, agesno_p, tsoil_p)
1671
1672	c Initialize ocean module according to ocean type
1673	IF ( ocean == 'slab' ) THEN
1674	c initilalize module ocean_slab_init
1675	CALL ocean_slab_init(dtime, tslab_p, seaice_p, pctsrf_p)
1676	ELSEIF ( ocean == 'couple' ) THEN
1677	c initilalize module ocean_cpl_init
1678	CALL ocean_cpl_init(dtime, rlon_p, rlat_p)
1679	ELSE
1680	c initilalize module ocean_forced_init
1681	CALL ocean_forced_init
1682	ENDIF
1683	c
1684	c Initilialize module fonte_neige_mod
1685	c
1686	CALL fonte_neige_init(run_off_lic_0_p)
1687
1688
1689	RETURN
1690	END

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

Download in other formats:

Original Format