Context Navigation

phyetat0.F @ 789

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

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

Download in other formats:

Original Format