Context Navigation

phyetat0.F @ 5373

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

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

Download in other formats:

Original Format