Context Navigation

phyetat0.F @ 123

Last change on this file since 123 was 123, checked in by lmdzadmin, 24 years ago
Pb d'affichage min/max albedo
Property svn:eol-style set to `native` Property svn:executable set to ``* Property svn:keywords set to `Author Date Id Revision`
File size: 32.3 KB

Line
1	SUBROUTINE phyetat0 (fichnom,dtime,co2_ppm,solaire,
2	. rlat,rlon, pctsrf, tsol,tsoil,deltat,qsol,snow,
3	. albe, evap, rain_fall, snow_fall, solsw, sollw,
4	. radsol,frugs,agesno,clesphy0,
5	. zmea,zstd,zsig,zgam,zthe,zpic,zval,rugsrel,tabcntr0,
6	. t_ancien,q_ancien,ancien_ok)
7	IMPLICIT none
8	c======================================================================
9	c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
10	c Objet: Lecture de l'etat initial pour la physique
11	c======================================================================
12	#include "dimensions.h"
13	#include "dimphy.h"
14	#include "netcdf.inc"
15	#include "indicesol.h"
16	#include "dimsoil.h"
17	#include "clesphys.h"
18	c======================================================================
19	CHARACTER() fichnom
20	REAL dtime
21	INTEGER radpas
22	REAL rlat(klon), rlon(klon)
23	REAL co2_ppm
24	REAL solaire
25	REAL tsol(klon,nbsrf)
26	REAL tsoil(klon,nsoilmx,nbsrf)
27	REAL deltat(klon)
28	REAL qsol(klon,nbsrf)
29	REAL snow(klon,nbsrf)
30	REAL albe(klon,nbsrf)
31	REAL evap(klon,nbsrf)
32	REAL radsol(klon)
33	REAL rain_fall(klon)
34	REAL snow_fall(klon)
35	REAL sollw(klon)
36	real solsw(klon)
37	REAL frugs(klon,nbsrf)
38	REAL agesno(klon)
39	REAL zmea(klon)
40	REAL zstd(klon)
41	REAL zsig(klon)
42	REAL zgam(klon)
43	REAL zthe(klon)
44	REAL zpic(klon)
45	REAL zval(klon)
46	REAL rugsrel(klon)
47	REAL pctsrf(klon, nbsrf)
48	REAL fractint(klon)
49
50	REAL t_ancien(klon,klev), q_ancien(klon,klev)
51	LOGICAL ancien_ok
52
53	INTEGER longcles
54	PARAMETER ( longcles = 20 )
55	REAL clesphy0( longcles )
56	c
57	REAL xmin, xmax
58	c
59	INTEGER nid, nvarid
60	INTEGER ierr, i, nsrf, isoil
61	INTEGER length
62	PARAMETER (length=100)
63	REAL tab_cntrl(length), tabcntr0(length)
64	CHARACTER*7 str7
65	CHARACTER*2 str2
66	c
67	c Ouvrir le fichier contenant l'etat initial:
68	c
69	print*,'fichnom',fichnom
70	ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
71	IF (ierr.NE.NF_NOERR) THEN
72	write(6,*)' Pb d''ouverture du fichier '//fichnom
73	write(6,*)' ierr = ', ierr
74	CALL ABORT
75	ENDIF
76	c
77	c Lecture des parametres de controle:
78	c
79	ierr = NF_INQ_VARID (nid, "controle", nvarid)
80	IF (ierr.NE.NF_NOERR) THEN
81	PRINT*, 'phyetat0: Le champ <controle> est absent'
82	CALL abort
83	ENDIF
84	#ifdef NC_DOUBLE
85	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl)
86	#else
87	ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
88	#endif
89	IF (ierr.NE.NF_NOERR) THEN
90	PRINT*, 'phyetat0: Lecture echouee pour <controle>'
91	CALL abort
92	ELSE
93	c
94	DO i = 1, length
95	tabcntr0( i ) = tab_cntrl( i )
96	ENDDO
97	c
98	cycle_diurne = .FALSE.
99	soil_model = .FALSE.
100	new_oliq = .FALSE.
101	ok_orodr = .FALSE.
102	ok_orolf = .FALSE.
103	ok_limitvrai = .FALSE.
104
105
106	IF( clesphy0(1).NE.tab_cntrl( 5 ) ) THEN
107	tab_cntrl( 5 ) = clesphy0(1)
108	ENDIF
109
110	IF( clesphy0(2).NE.tab_cntrl( 6 ) ) THEN
111	tab_cntrl( 6 ) = clesphy0(2)
112	ENDIF
113
114	IF( clesphy0(3).NE.tab_cntrl( 7 ) ) THEN
115	tab_cntrl( 7 ) = clesphy0(3)
116	ENDIF
117
118	IF( clesphy0(4).NE.tab_cntrl( 8 ) ) THEN
119	tab_cntrl( 8 ) = clesphy0(4)
120	ENDIF
121
122	IF( clesphy0(5).NE.tab_cntrl( 9 ) ) THEN
123	tab_cntrl( 9 ) = clesphy0( 5 )
124	ENDIF
125
126	IF( clesphy0(6).NE.tab_cntrl( 10 ) ) THEN
127	tab_cntrl( 10 ) = clesphy0( 6 )
128	ENDIF
129
130	IF( clesphy0(7).NE.tab_cntrl( 11 ) ) THEN
131	tab_cntrl( 11 ) = clesphy0( 7 )
132	ENDIF
133
134	IF( clesphy0(8).NE.tab_cntrl( 12 ) ) THEN
135	tab_cntrl( 12 ) = clesphy0( 8 )
136	ENDIF
137
138
139	dtime = tab_cntrl(1)
140	radpas = tab_cntrl(2)
141	co2_ppm = tab_cntrl(3)
142	solaire = tab_cntrl(4)
143	iflag_con = tab_cntrl(5)
144	nbapp_rad = tab_cntrl(6)
145
146
147	cycle_diurne = .FALSE.
148	soil_model = .FALSE.
149	new_oliq = .FALSE.
150	ok_orodr = .FALSE.
151	ok_orolf = .FALSE.
152	ok_limitvrai = .FALSE.
153
154	IF( tab_cntrl( 7) .EQ. 1. ) cycle_diurne = .TRUE.
155	IF( tab_cntrl( 8) .EQ. 1. ) soil_model = .TRUE.
156	IF( tab_cntrl( 9) .EQ. 1. ) new_oliq = .TRUE.
157	IF( tab_cntrl(10) .EQ. 1. ) ok_orodr = .TRUE.
158	IF( tab_cntrl(11) .EQ. 1. ) ok_orolf = .TRUE.
159	IF( tab_cntrl(12) .EQ. 1. ) ok_limitvrai = .TRUE.
160
161	ENDIF
162	c
163	c Lecture des latitudes (coordonnees):
164	c
165	ierr = NF_INQ_VARID (nid, "latitude", nvarid)
166	IF (ierr.NE.NF_NOERR) THEN
167	PRINT*, 'phyetat0: Le champ <latitude> est absent'
168	CALL abort
169	ENDIF
170	#ifdef NC_DOUBLE
171	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlat)
172	#else
173	ierr = NF_GET_VAR_REAL(nid, nvarid, rlat)
174	#endif
175	IF (ierr.NE.NF_NOERR) THEN
176	PRINT*, 'phyetat0: Lecture echouee pour <latitude>'
177	CALL abort
178	ENDIF
179	c
180	c Lecture des longitudes (coordonnees):
181	c
182	ierr = NF_INQ_VARID (nid, "longitude", nvarid)
183	IF (ierr.NE.NF_NOERR) THEN
184	PRINT*, 'phyetat0: Le champ <longitude> est absent'
185	CALL abort
186	ENDIF
187	#ifdef NC_DOUBLE
188	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlon)
189	#else
190	ierr = NF_GET_VAR_REAL(nid, nvarid, rlon)
191	#endif
192	IF (ierr.NE.NF_NOERR) THEN
193	PRINT*, 'phyetat0: Lecture echouee pour <latitude>'
194	CALL abort
195	ENDIF
196	C
197	C
198	C Lecture du masque terre mer
199	C
200	ierr = NF_INQ_VARID (nid, "masque", nvarid)
201	IF (ierr .EQ. NF_NOERR) THEN
202	#ifdef NC_DOUBLE
203	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zmasq)
204	#else
205	ierr = NF_GET_VAR_REAL(nid, nvarid, zmasq)
206	#endif
207	IF (ierr.NE.NF_NOERR) THEN
208	PRINT*, 'phyetat0: Lecture echouee pour <masque>'
209	CALL abort
210	ENDIF
211	else
212	PRINT*, 'phyetat0: Le champ <masque> est absent'
213	PRINT*, 'fichier startphy non compatible avec phyetat0'
214	C CALL abort
215	ENDIF
216	C Lecture des fractions pour chaque sous-surface
217	C
218	C initialisation des sous-surfaces
219	C
220	pctsrf = 0.
221	C
222	C fraction de terre
223	C
224	ierr = NF_INQ_VARID (nid, "FTER", nvarid)
225	IF (ierr .EQ. NF_NOERR) THEN
226	#ifdef NC_DOUBLE
227	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, pctsrf(1 : klon,is_ter))
228	#else
229	ierr = NF_GET_VAR_REAL(nid, nvarid, pctsrf(1 : klon,is_ter))
230	#endif
231	IF (ierr.NE.NF_NOERR) THEN
232	PRINT*, 'phyetat0: Lecture echouee pour <FTER>'
233	CALL abort
234	ENDIF
235	else
236	PRINT*, 'phyetat0: Le champ <FTER> est absent'
237	c$$$ CALL abort
238	ENDIF
239	C
240	C fraction de glace de terre
241	C
242	ierr = NF_INQ_VARID (nid, "FLIC", nvarid)
243	IF (ierr .EQ. NF_NOERR) THEN
244	#ifdef NC_DOUBLE
245	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, pctsrf(1 : klon,is_lic))
246	#else
247	ierr = NF_GET_VAR_REAL(nid, nvarid, pctsrf(1 : klon,is_lic))
248	#endif
249	IF (ierr.NE.NF_NOERR) THEN
250	PRINT*, 'phyetat0: Lecture echouee pour <FLIC>'
251	CALL abort
252	ENDIF
253	else
254	PRINT*, 'phyetat0: Le champ <FLIC> est absent'
255	c$$$ CALL abort
256	ENDIF
257	C
258	C fraction d'ocean
259	C
260	ierr = NF_INQ_VARID (nid, "FOCE", nvarid)
261	IF (ierr .EQ. NF_NOERR) THEN
262	#ifdef NC_DOUBLE
263	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, pctsrf(1 : klon,is_oce))
264	#else
265	ierr = NF_GET_VAR_REAL(nid, nvarid, pctsrf(1 : klon,is_oce))
266	#endif
267	IF (ierr.NE.NF_NOERR) THEN
268	PRINT*, 'phyetat0: Lecture echouee pour <FOCE>'
269	CALL abort
270	ENDIF
271	else
272	PRINT*, 'phyetat0: Le champ <FOCE> est absent'
273	c$$$ CALL abort
274	ENDIF
275	C
276	C fraction glace de mer
277	C
278	ierr = NF_INQ_VARID (nid, "FSIC", nvarid)
279	IF (ierr .EQ. NF_NOERR) THEN
280	#ifdef NC_DOUBLE
281	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, pctsrf(1 : klon,is_sic))
282	#else
283	ierr = NF_GET_VAR_REAL(nid, nvarid, pctsrf(1 : klon, is_sic))
284	#endif
285	IF (ierr.NE.NF_NOERR) THEN
286	PRINT*, 'phyetat0: Lecture echouee pour <FSIC>'
287	CALL abort
288	ENDIF
289	else
290	PRINT*, 'phyetat0: Le champ <FSIC> est absent'
291	c$$$ CALL abort
292	ENDIF
293	C
294	C Verification de l'adequation entre le masque et les sous-surfaces
295	C
296	fractint( 1 : klon) = pctsrf(1 : klon, is_ter)
297	$ + pctsrf(1 : klon, is_lic)
298	DO i = 1 , klon
299	IF ( abs(fractint(i) - zmasq(i) ) .GT. EPSFRA ) THEN
300	WRITE(,) 'phyetat0: attention fraction terre pas ',
301	$ 'coherente ', i, zmasq(i), pctsrf(i, is_ter)
302	$ ,pctsrf(i, is_lic)
303	ENDIF
304	END DO
305	fractint (1 : klon) = pctsrf(1 : klon, is_oce)
306	$ + pctsrf(1 : klon, is_sic)
307	DO i = 1 , klon
308	IF ( abs( fractint(i) - (1. - zmasq(i))) .GT. EPSFRA ) THEN
309	WRITE(,) 'phyetat0 attention fraction ocean pas ',
310	$ 'coherente ', i, zmasq(i) , pctsrf(i, is_oce)
311	$ ,pctsrf(i, is_sic)
312	ENDIF
313	END DO
314	C
315	c Lecture des temperatures du sol:
316	c
317	ierr = NF_INQ_VARID (nid, "TS", nvarid)
318	IF (ierr.NE.NF_NOERR) THEN
319	PRINT*, 'phyetat0: Le champ <TS> est absent'
320	PRINT, ' Mais je vais essayer de lire TS*'
321	DO nsrf = 1, nbsrf
322	IF (nsrf.GT.99) THEN
323	PRINT*, "Trop de sous-mailles"
324	CALL abort
325	ENDIF
326	WRITE(str2,'(i2.2)') nsrf
327	ierr = NF_INQ_VARID (nid, "TS"//str2, nvarid)
328	IF (ierr.NE.NF_NOERR) THEN
329	PRINT*, "phyetat0: Le champ <TS"//str2//"> est absent"
330	CALL abort
331	ENDIF
332	#ifdef NC_DOUBLE
333	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsol(1,nsrf))
334	#else
335	ierr = NF_GET_VAR_REAL(nid, nvarid, tsol(1,nsrf))
336	#endif
337	IF (ierr.NE.NF_NOERR) THEN
338	PRINT*, "phyetat0: Lecture echouee pour <TS"//str2//">"
339	CALL abort
340	ENDIF
341	xmin = 1.0E+20
342	xmax = -1.0E+20
343	DO i = 1, klon
344	xmin = MIN(tsol(i,nsrf),xmin)
345	xmax = MAX(tsol(i,nsrf),xmax)
346	ENDDO
347	PRINT,'Temperature du sol TS*:', nsrf, xmin, xmax
348	ENDDO
349	ELSE
350	PRINT*, 'phyetat0: Le champ <TS> est present'
351	PRINT, ' J ignore donc les autres temperatures TS*'
352	#ifdef NC_DOUBLE
353	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsol(1,1))
354	#else
355	ierr = NF_GET_VAR_REAL(nid, nvarid, tsol(1,1))
356	#endif
357	IF (ierr.NE.NF_NOERR) THEN
358	PRINT*, "phyetat0: Lecture echouee pour <TS>"
359	CALL abort
360	ENDIF
361	xmin = 1.0E+20
362	xmax = -1.0E+20
363	DO i = 1, klon
364	xmin = MIN(tsol(i,1),xmin)
365	xmax = MAX(tsol(i,1),xmax)
366	ENDDO
367	PRINT*,'Temperature du sol <TS>', xmin, xmax
368	DO nsrf = 2, nbsrf
369	DO i = 1, klon
370	tsol(i,nsrf) = tsol(i,1)
371	ENDDO
372	ENDDO
373	ENDIF
374	c
375	c Lecture des temperatures du sol profond:
376	c
377	DO nsrf = 1, nbsrf
378	DO isoil=1, nsoilmx
379	IF (isoil.GT.99 .AND. nsrf.GT.99) THEN
380	PRINT*, "Trop de couches ou sous-mailles"
381	CALL abort
382	ENDIF
383	WRITE(str7,'(i2.2,"srf",i2.2)') isoil, nsrf
384	ierr = NF_INQ_VARID (nid, 'Tsoil'//str7, nvarid)
385	IF (ierr.NE.NF_NOERR) THEN
386	PRINT*, "phyetat0: Le champ <Tsoil"//str7//"> est absent"
387	PRINT*, " Il prend donc la valeur de surface"
388	DO i=1, klon
389	tsoil(i,isoil,nsrf)=tsol(i,nsrf)
390	ENDDO
391	ELSE
392	#ifdef NC_DOUBLE
393	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsoil(1,isoil,nsrf))
394	#else
395	ierr = NF_GET_VAR_REAL(nid, nvarid, tsoil(1,isoil,nsrf))
396	#endif
397	IF (ierr.NE.NF_NOERR) THEN
398	PRINT*, "Lecture echouee pour <Tsoil"//str7//">"
399	CALL abort
400	ENDIF
401	ENDIF
402	ENDDO
403	ENDDO
404	c
405	c Lecture de deltat (pour slab ocean seulement):
406	c
407	ierr = NF_INQ_VARID (nid, "DELTAT", nvarid)
408	IF (ierr.NE.NF_NOERR) THEN
409	PRINT*, "phyetat0: Le champ <DELTAT> est absent"
410	CALL abort
411	ENDIF
412	#ifdef NC_DOUBLE
413	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, deltat)
414	#else
415	ierr = NF_GET_VAR_REAL(nid, nvarid, deltat)
416	#endif
417	IF (ierr.NE.NF_NOERR) THEN
418	PRINT*, "phyetat0: Lecture echouee pour <DELTAT>"
419	CALL abort
420	ENDIF
421	xmin = 1.0E+20
422	xmax = -1.0E+20
423	DO i = 1, klon
424	xmin = MIN(deltat(i),xmin)
425	xmax = MAX(deltat(i),xmax)
426	ENDDO
427	PRINT*,'Ecart de la SST deltat:', xmin, xmax
428	c
429	c Lecture de l'humidite du sol:
430	c
431	ierr = NF_INQ_VARID (nid, "QS", nvarid)
432	IF (ierr.NE.NF_NOERR) THEN
433	PRINT*, 'phyetat0: Le champ <QS> est absent'
434	PRINT, ' Mais je vais essayer de lire QS*'
435	DO nsrf = 1, nbsrf
436	IF (nsrf.GT.99) THEN
437	PRINT*, "Trop de sous-mailles"
438	CALL abort
439	ENDIF
440	WRITE(str2,'(i2.2)') nsrf
441	ierr = NF_INQ_VARID (nid, "QS"//str2, nvarid)
442	IF (ierr.NE.NF_NOERR) THEN
443	PRINT*, "phyetat0: Le champ <QS"//str2//"> est absent"
444	CALL abort
445	ENDIF
446	#ifdef NC_DOUBLE
447	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, qsol(1,nsrf))
448	#else
449	ierr = NF_GET_VAR_REAL(nid, nvarid, qsol(1,nsrf))
450	#endif
451	IF (ierr.NE.NF_NOERR) THEN
452	PRINT*, "phyetat0: Lecture echouee pour <QS"//str2//">"
453	CALL abort
454	ENDIF
455	xmin = 1.0E+20
456	xmax = -1.0E+20
457	DO i = 1, klon
458	xmin = MIN(qsol(i,nsrf),xmin)
459	xmax = MAX(qsol(i,nsrf),xmax)
460	ENDDO
461	PRINT,'Humidite du sol QS*:', nsrf, xmin, xmax
462	ENDDO
463	ELSE
464	PRINT*, 'phyetat0: Le champ <QS> est present'
465	PRINT, ' J ignore donc les autres humidites QS*'
466	#ifdef NC_DOUBLE
467	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, qsol(1,1))
468	#else
469	ierr = NF_GET_VAR_REAL(nid, nvarid, qsol(1,1))
470	#endif
471	IF (ierr.NE.NF_NOERR) THEN
472	PRINT*, "phyetat0: Lecture echouee pour <QS>"
473	CALL abort
474	ENDIF
475	xmin = 1.0E+20
476	xmax = -1.0E+20
477	DO i = 1, klon
478	xmin = MIN(qsol(i,1),xmin)
479	xmax = MAX(qsol(i,1),xmax)
480	ENDDO
481	PRINT*,'Humidite du sol <QS>', xmin, xmax
482	DO nsrf = 2, nbsrf
483	DO i = 1, klon
484	qsol(i,nsrf) = qsol(i,1)
485	ENDDO
486	ENDDO
487	ENDIF
488	c
489	c Lecture de neige au sol:
490	c
491	ierr = NF_INQ_VARID (nid, "SNOW", nvarid)
492	IF (ierr.NE.NF_NOERR) THEN
493	PRINT*, 'phyetat0: Le champ <SNOW> est absent'
494	PRINT, ' Mais je vais essayer de lire SNOW*'
495	DO nsrf = 1, nbsrf
496	IF (nsrf.GT.99) THEN
497	PRINT*, "Trop de sous-mailles"
498	CALL abort
499	ENDIF
500	WRITE(str2,'(i2.2)') nsrf
501	ierr = NF_INQ_VARID (nid, "SNOW"//str2, nvarid)
502	IF (ierr.NE.NF_NOERR) THEN
503	PRINT*, "phyetat0: Le champ <SNOW"//str2//"> est absent"
504	CALL abort
505	ENDIF
506	#ifdef NC_DOUBLE
507	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, snow(1,nsrf))
508	#else
509	ierr = NF_GET_VAR_REAL(nid, nvarid, snow(1,nsrf))
510	#endif
511	IF (ierr.NE.NF_NOERR) THEN
512	PRINT*, "phyetat0: Lecture echouee pour <SNOW"//str2//">"
513	CALL abort
514	ENDIF
515	xmin = 1.0E+20
516	xmax = -1.0E+20
517	DO i = 1, klon
518	xmin = MIN(snow(i,nsrf),xmin)
519	xmax = MAX(snow(i,nsrf),xmax)
520	ENDDO
521	PRINT,'Neige du sol SNOW*:', nsrf, xmin, xmax
522	ENDDO
523	ELSE
524	PRINT*, 'phyetat0: Le champ <SNOW> est present'
525	PRINT, ' J ignore donc les autres neiges SNOW*'
526	#ifdef NC_DOUBLE
527	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, snow(1,1))
528	#else
529	ierr = NF_GET_VAR_REAL(nid, nvarid, snow(1,1))
530	#endif
531	IF (ierr.NE.NF_NOERR) THEN
532	PRINT*, "phyetat0: Lecture echouee pour <SNOW>"
533	CALL abort
534	ENDIF
535	xmin = 1.0E+20
536	xmax = -1.0E+20
537	DO i = 1, klon
538	xmin = MIN(snow(i,1),xmin)
539	xmax = MAX(snow(i,1),xmax)
540	ENDDO
541	PRINT*,'Neige du sol <SNOW>', xmin, xmax
542	DO nsrf = 2, nbsrf
543	DO i = 1, klon
544	snow(i,nsrf) = snow(i,1)
545	ENDDO
546	ENDDO
547	ENDIF
548	c
549	c Lecture de albedo au sol:
550	c
551	ierr = NF_INQ_VARID (nid, "ALBE", nvarid)
552	IF (ierr.NE.NF_NOERR) THEN
553	PRINT*, 'phyetat0: Le champ <ALBE> est absent'
554	PRINT, ' Mais je vais essayer de lire ALBE*'
555	DO nsrf = 1, nbsrf
556	IF (nsrf.GT.99) THEN
557	PRINT*, "Trop de sous-mailles"
558	CALL abort
559	ENDIF
560	WRITE(str2,'(i2.2)') nsrf
561	ierr = NF_INQ_VARID (nid, "ALBE"//str2, nvarid)
562	IF (ierr.NE.NF_NOERR) THEN
563	PRINT*, "phyetat0: Le champ <ALBE"//str2//"> est absent"
564	CALL abort
565	ENDIF
566	#ifdef NC_DOUBLE
567	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, albe(1,nsrf))
568	#else
569	ierr = NF_GET_VAR_REAL(nid, nvarid, albe(1,nsrf))
570	#endif
571	IF (ierr.NE.NF_NOERR) THEN
572	PRINT*, "phyetat0: Lecture echouee pour <ALBE"//str2//">"
573	CALL abort
574	ENDIF
575	xmin = 1.0E+20
576	xmax = -1.0E+20
577	DO i = 1, klon
578	xmin = MIN(albe(i,nsrf),xmin)
579	xmax = MAX(albe(i,nsrf),xmax)
580	ENDDO
581	PRINT,'Albedo du sol ALBE*:', nsrf, xmin, xmax
582	ENDDO
583	ELSE
584	PRINT*, 'phyetat0: Le champ <ALBE> est present'
585	PRINT, ' J ignore donc les autres ALBE*'
586	#ifdef NC_DOUBLE
587	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, albe(1,1))
588	#else
589	ierr = NF_GET_VAR_REAL(nid, nvarid, albe(1,1))
590	#endif
591	IF (ierr.NE.NF_NOERR) THEN
592	PRINT*, "phyetat0: Lecture echouee pour <ALBE>"
593	CALL abort
594	ENDIF
595	xmin = 1.0E+20
596	xmax = -1.0E+20
597	DO i = 1, klon
598	xmin = MIN(albe(i,1),xmin)
599	xmax = MAX(albe(i,1),xmax)
600	ENDDO
601	PRINT*,'Neige du sol <ALBE>', xmin, xmax
602	DO nsrf = 2, nbsrf
603	DO i = 1, klon
604	albe(i,nsrf) = albe(i,1)
605	ENDDO
606	ENDDO
607	ENDIF
608
609	c
610	c Lecture de evaporation:
611	c
612	ierr = NF_INQ_VARID (nid, "EVAP", nvarid)
613	IF (ierr.NE.NF_NOERR) THEN
614	PRINT*, 'phyetat0: Le champ <EVAP> est absent'
615	PRINT, ' Mais je vais essayer de lire EVAP*'
616	DO nsrf = 1, nbsrf
617	IF (nsrf.GT.99) THEN
618	PRINT*, "Trop de sous-mailles"
619	CALL abort
620	ENDIF
621	WRITE(str2,'(i2.2)') nsrf
622	ierr = NF_INQ_VARID (nid, "EVAP"//str2, nvarid)
623	IF (ierr.NE.NF_NOERR) THEN
624	PRINT*, "phyetat0: Le champ <EVAP"//str2//"> est absent"
625	CALL abort
626	ENDIF
627	#ifdef NC_DOUBLE
628	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, evap(1,nsrf))
629	#else
630	ierr = NF_GET_VAR_REAL(nid, nvarid, evap(1,nsrf))
631	#endif
632	IF (ierr.NE.NF_NOERR) THEN
633	PRINT*, "phyetat0: Lecture echouee pour <EVAP"//str2//">"
634	CALL abort
635	ENDIF
636	xmin = 1.0E+20
637	xmax = -1.0E+20
638	DO i = 1, klon
639	xmin = MIN(evap(i,nsrf),xmin)
640	xmax = MAX(evap(i,nsrf),xmax)
641	ENDDO
642	PRINT,'evap du sol EVAP*:', nsrf, xmin, xmax
643	ENDDO
644	ELSE
645	PRINT*, 'phyetat0: Le champ <EVAP> est present'
646	PRINT, ' J ignore donc les autres EVAP*'
647	#ifdef NC_DOUBLE
648	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, evap(1,1))
649	#else
650	ierr = NF_GET_VAR_REAL(nid, nvarid, evap(1,1))
651	#endif
652	IF (ierr.NE.NF_NOERR) THEN
653	PRINT*, "phyetat0: Lecture echouee pour <EVAP>"
654	CALL abort
655	ENDIF
656	xmin = 1.0E+20
657	xmax = -1.0E+20
658	DO i = 1, klon
659	xmin = MIN(evap(i,1),xmin)
660	xmax = MAX(evap(i,1),xmax)
661	ENDDO
662	PRINT*,'Evap du sol <EVAP>', xmin, xmax
663	DO nsrf = 2, nbsrf
664	DO i = 1, klon
665	evap(i,nsrf) = evap(i,1)
666	ENDDO
667	ENDDO
668	ENDIF
669	c
670	c Lecture precipitation liquide:
671	c
672	ierr = NF_INQ_VARID (nid, "rain_f", nvarid)
673	IF (ierr.NE.NF_NOERR) THEN
674	PRINT*, 'phyetat0: Le champ <rain_f> est absent'
675	CALL abort
676	ENDIF
677	#ifdef NC_DOUBLE
678	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rain_fall)
679	#else
680	ierr = NF_GET_VAR_REAL(nid, nvarid, rain_fall)
681	#endif
682	IF (ierr.NE.NF_NOERR) THEN
683	PRINT*, 'phyetat0: Lecture echouee pour <rain_f>'
684	CALL abort
685	ENDIF
686	xmin = 1.0E+20
687	xmax = -1.0E+20
688	DO i = 1, klon
689	xmin = MIN(rain_fall(i),xmin)
690	xmax = MAX(rain_fall(i),xmax)
691	ENDDO
692	PRINT*,'Precipitation liquide rain_f:', xmin, xmax
693	c
694	c Lecture precipitation solide:
695	c
696	ierr = NF_INQ_VARID (nid, "snow_f", nvarid)
697	IF (ierr.NE.NF_NOERR) THEN
698	PRINT*, 'phyetat0: Le champ <snow_f> est absent'
699	CALL abort
700	ENDIF
701	#ifdef NC_DOUBLE
702	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, snow_fall)
703	#else
704	ierr = NF_GET_VAR_REAL(nid, nvarid, snow_fall)
705	#endif
706	IF (ierr.NE.NF_NOERR) THEN
707	PRINT*, 'phyetat0: Lecture echouee pour <snow_f>'
708	CALL abort
709	ENDIF
710	xmin = 1.0E+20
711	xmax = -1.0E+20
712	DO i = 1, klon
713	xmin = MIN(snow_fall(i),xmin)
714	xmax = MAX(snow_fall(i),xmax)
715	ENDDO
716	PRINT*,'Precipitation solide snow_f:', xmin, xmax
717	c
718	c Lecture rayonnement solaire au sol:
719	c
720	ierr = NF_INQ_VARID (nid, "solsw", nvarid)
721	IF (ierr.NE.NF_NOERR) THEN
722	PRINT*, 'phyetat0: Le champ <solsw> est absent'
723	PRINT*, 'mis a zero'
724	solsw = 0.
725	ELSE
726	#ifdef NC_DOUBLE
727	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, solsw)
728	#else
729	ierr = NF_GET_VAR_REAL(nid, nvarid, solsw)
730	#endif
731	IF (ierr.NE.NF_NOERR) THEN
732	PRINT*, 'phyetat0: Lecture echouee pour <solsw>'
733	CALL abort
734	ENDIF
735	ENDIF
736	xmin = 1.0E+20
737	xmax = -1.0E+20
738	DO i = 1, klon
739	xmin = MIN(solsw(i),xmin)
740	xmax = MAX(solsw(i),xmax)
741	ENDDO
742	PRINT*,'Rayonnement solaire au sol solsw:', xmin, xmax
743	c
744	c Lecture rayonnement IF au sol:
745	c
746	ierr = NF_INQ_VARID (nid, "sollw", nvarid)
747	IF (ierr.NE.NF_NOERR) THEN
748	PRINT*, 'phyetat0: Le champ <sollw> est absent'
749	PRINT*, 'mis a zero'
750	sollw = 0.
751	ELSE
752	#ifdef NC_DOUBLE
753	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, sollw)
754	#else
755	ierr = NF_GET_VAR_REAL(nid, nvarid, sollw)
756	#endif
757	IF (ierr.NE.NF_NOERR) THEN
758	PRINT*, 'phyetat0: Lecture echouee pour <sollw>'
759	CALL abort
760	ENDIF
761	ENDIF
762	xmin = 1.0E+20
763	xmax = -1.0E+20
764	DO i = 1, klon
765	xmin = MIN(sollw(i),xmin)
766	xmax = MAX(sollw(i),xmax)
767	ENDDO
768	PRINT*,'Rayonnement IF au sol sollw:', xmin, xmax
769
770	c
771	c Lecture du rayonnement net au sol:
772	c
773	ierr = NF_INQ_VARID (nid, "RADS", nvarid)
774	IF (ierr.NE.NF_NOERR) THEN
775	PRINT*, 'phyetat0: Le champ <RADS> est absent'
776	CALL abort
777	ENDIF
778	#ifdef NC_DOUBLE
779	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, radsol)
780	#else
781	ierr = NF_GET_VAR_REAL(nid, nvarid, radsol)
782	#endif
783	IF (ierr.NE.NF_NOERR) THEN
784	PRINT*, 'phyetat0: Lecture echouee pour <RADS>'
785	CALL abort
786	ENDIF
787	xmin = 1.0E+20
788	xmax = -1.0E+20
789	DO i = 1, klon
790	xmin = MIN(radsol(i),xmin)
791	xmax = MAX(radsol(i),xmax)
792	ENDDO
793	PRINT*,'Rayonnement net au sol radsol:', xmin, xmax
794	c
795	c Lecture de la longueur de rugosite
796	c
797	c
798	ierr = NF_INQ_VARID (nid, "RUG", nvarid)
799	IF (ierr.NE.NF_NOERR) THEN
800	PRINT*, 'phyetat0: Le champ <RUG> est absent'
801	PRINT, ' Mais je vais essayer de lire RUG*'
802	DO nsrf = 1, nbsrf
803	IF (nsrf.GT.99) THEN
804	PRINT*, "Trop de sous-mailles"
805	CALL abort
806	ENDIF
807	WRITE(str2,'(i2.2)') nsrf
808	ierr = NF_INQ_VARID (nid, "RUG"//str2, nvarid)
809	IF (ierr.NE.NF_NOERR) THEN
810	PRINT*, "phyetat0: Le champ <RUG"//str2//"> est absent"
811	CALL abort
812	ENDIF
813	#ifdef NC_DOUBLE
814	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, frugs(1,nsrf))
815	#else
816	ierr = NF_GET_VAR_REAL(nid, nvarid, frugs(1,nsrf))
817	#endif
818	IF (ierr.NE.NF_NOERR) THEN
819	PRINT*, "phyetat0: Lecture echouee pour <RUG"//str2//">"
820	CALL abort
821	ENDIF
822	xmin = 1.0E+20
823	xmax = -1.0E+20
824	DO i = 1, klon
825	xmin = MIN(frugs(i,nsrf),xmin)
826	xmax = MAX(frugs(i,nsrf),xmax)
827	ENDDO
828	PRINT,'evap du sol RUG*:', nsrf, xmin, xmax
829	ENDDO
830	ELSE
831	PRINT*, 'phyetat0: Le champ <RUG> est present'
832	PRINT, ' J ignore donc les autres RUG*'
833	#ifdef NC_DOUBLE
834	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, frugs(1,1))
835	#else
836	ierr = NF_GET_VAR_REAL(nid, nvarid, frugs(1,1))
837	#endif
838	IF (ierr.NE.NF_NOERR) THEN
839	PRINT*, "phyetat0: Lecture echouee pour <RUG>"
840	CALL abort
841	ENDIF
842	xmin = 1.0E+20
843	xmax = -1.0E+20
844	DO i = 1, klon
845	xmin = MIN(frugs(i,1),xmin)
846	xmax = MAX(frugs(i,1),xmax)
847	ENDDO
848	PRINT*,'Neige du sol <RUG>', xmin, xmax
849	DO nsrf = 2, nbsrf
850	DO i = 1, klon
851	frugs(i,nsrf) = frugs(i,1)
852	ENDDO
853	ENDDO
854	ENDIF
855
856	c
857	c Lecture de l'age de la neige:
858	c
859	ierr = NF_INQ_VARID (nid, "AGESNO", nvarid)
860	IF (ierr.NE.NF_NOERR) THEN
861	PRINT*, 'phyetat0: Le champ <AGESNO> est absent'
862	PRINT*, " Valeur par default: 50"
863	DO i = 1, klon
864	agesno(i) = 50.0
865	ENDDO
866	ELSE
867	#ifdef NC_DOUBLE
868	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, agesno)
869	#else
870	ierr = NF_GET_VAR_REAL(nid, nvarid, agesno)
871	#endif
872	IF (ierr.NE.NF_NOERR) THEN
873	PRINT*, 'phyetat0: Lecture echouee pour <AGESNO>'
874	CALL abort
875	ENDIF
876	xmin = 1.0E+20
877	xmax = -1.0E+20
878	DO i = 1, klon
879	xmin = MIN(agesno(i),xmin)
880	xmax = MAX(agesno(i),xmax)
881	ENDDO
882	PRINT*,'Age de la neige agesno:', xmin, xmax
883	ENDIF
884	c
885	c
886	ierr = NF_INQ_VARID (nid, "ZMEA", nvarid)
887	IF (ierr.NE.NF_NOERR) THEN
888	PRINT*, 'phyetat0: Le champ <ZMEA> est absent'
889	CALL abort
890	ENDIF
891	#ifdef NC_DOUBLE
892	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zmea)
893	#else
894	ierr = NF_GET_VAR_REAL(nid, nvarid, zmea)
895	#endif
896	IF (ierr.NE.NF_NOERR) THEN
897	PRINT*, 'phyetat0: Lecture echouee pour <ZMEA>'
898	CALL abort
899	ENDIF
900	xmin = 1.0E+20
901	xmax = -1.0E+20
902	DO i = 1, klon
903	xmin = MIN(zmea(i),xmin)
904	xmax = MAX(zmea(i),xmax)
905	ENDDO
906	PRINT*,'OROGRAPHIE SOUS-MAILLE zmea:', xmin, xmax
907	c
908	c
909	ierr = NF_INQ_VARID (nid, "ZSTD", nvarid)
910	IF (ierr.NE.NF_NOERR) THEN
911	PRINT*, 'phyetat0: Le champ <ZSTD> est absent'
912	CALL abort
913	ENDIF
914	#ifdef NC_DOUBLE
915	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zstd)
916	#else
917	ierr = NF_GET_VAR_REAL(nid, nvarid, zstd)
918	#endif
919	IF (ierr.NE.NF_NOERR) THEN
920	PRINT*, 'phyetat0: Lecture echouee pour <ZSTD>'
921	CALL abort
922	ENDIF
923	xmin = 1.0E+20
924	xmax = -1.0E+20
925	DO i = 1, klon
926	xmin = MIN(zstd(i),xmin)
927	xmax = MAX(zstd(i),xmax)
928	ENDDO
929	PRINT*,'OROGRAPHIE SOUS-MAILLE zstd:', xmin, xmax
930	c
931	c
932	ierr = NF_INQ_VARID (nid, "ZSIG", nvarid)
933	IF (ierr.NE.NF_NOERR) THEN
934	PRINT*, 'phyetat0: Le champ <ZSIG> est absent'
935	CALL abort
936	ENDIF
937	#ifdef NC_DOUBLE
938	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zsig)
939	#else
940	ierr = NF_GET_VAR_REAL(nid, nvarid, zsig)
941	#endif
942	IF (ierr.NE.NF_NOERR) THEN
943	PRINT*, 'phyetat0: Lecture echouee pour <ZSIG>'
944	CALL abort
945	ENDIF
946	xmin = 1.0E+20
947	xmax = -1.0E+20
948	DO i = 1, klon
949	xmin = MIN(zsig(i),xmin)
950	xmax = MAX(zsig(i),xmax)
951	ENDDO
952	PRINT*,'OROGRAPHIE SOUS-MAILLE zsig:', xmin, xmax
953	c
954	c
955	ierr = NF_INQ_VARID (nid, "ZGAM", nvarid)
956	IF (ierr.NE.NF_NOERR) THEN
957	PRINT*, 'phyetat0: Le champ <ZGAM> est absent'
958	CALL abort
959	ENDIF
960	#ifdef NC_DOUBLE
961	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zgam)
962	#else
963	ierr = NF_GET_VAR_REAL(nid, nvarid, zgam)
964	#endif
965	IF (ierr.NE.NF_NOERR) THEN
966	PRINT*, 'phyetat0: Lecture echouee pour <ZGAM>'
967	CALL abort
968	ENDIF
969	xmin = 1.0E+20
970	xmax = -1.0E+20
971	DO i = 1, klon
972	xmin = MIN(zgam(i),xmin)
973	xmax = MAX(zgam(i),xmax)
974	ENDDO
975	PRINT*,'OROGRAPHIE SOUS-MAILLE zgam:', xmin, xmax
976	c
977	c
978	ierr = NF_INQ_VARID (nid, "ZTHE", nvarid)
979	IF (ierr.NE.NF_NOERR) THEN
980	PRINT*, 'phyetat0: Le champ <ZTHE> est absent'
981	CALL abort
982	ENDIF
983	#ifdef NC_DOUBLE
984	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zthe)
985	#else
986	ierr = NF_GET_VAR_REAL(nid, nvarid, zthe)
987	#endif
988	IF (ierr.NE.NF_NOERR) THEN
989	PRINT*, 'phyetat0: Lecture echouee pour <ZTHE>'
990	CALL abort
991	ENDIF
992	xmin = 1.0E+20
993	xmax = -1.0E+20
994	DO i = 1, klon
995	xmin = MIN(zthe(i),xmin)
996	xmax = MAX(zthe(i),xmax)
997	ENDDO
998	PRINT*,'OROGRAPHIE SOUS-MAILLE zthe:', xmin, xmax
999	c
1000	c
1001	ierr = NF_INQ_VARID (nid, "ZPIC", nvarid)
1002	IF (ierr.NE.NF_NOERR) THEN
1003	PRINT*, 'phyetat0: Le champ <ZPIC> est absent'
1004	CALL abort
1005	ENDIF
1006	#ifdef NC_DOUBLE
1007	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zpic)
1008	#else
1009	ierr = NF_GET_VAR_REAL(nid, nvarid, zpic)
1010	#endif
1011	IF (ierr.NE.NF_NOERR) THEN
1012	PRINT*, 'phyetat0: Lecture echouee pour <ZPIC>'
1013	CALL abort
1014	ENDIF
1015	xmin = 1.0E+20
1016	xmax = -1.0E+20
1017	DO i = 1, klon
1018	xmin = MIN(zpic(i),xmin)
1019	xmax = MAX(zpic(i),xmax)
1020	ENDDO
1021	PRINT*,'OROGRAPHIE SOUS-MAILLE zpic:', xmin, xmax
1022	c
1023	ierr = NF_INQ_VARID (nid, "ZVAL", nvarid)
1024	IF (ierr.NE.NF_NOERR) THEN
1025	PRINT*, 'phyetat0: Le champ <ZVAL> est absent'
1026	CALL abort
1027	ENDIF
1028	#ifdef NC_DOUBLE
1029	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zval)
1030	#else
1031	ierr = NF_GET_VAR_REAL(nid, nvarid, zval)
1032	#endif
1033	IF (ierr.NE.NF_NOERR) THEN
1034	PRINT*, 'phyetat0: Lecture echouee pour <ZVAL>'
1035	CALL abort
1036	ENDIF
1037	xmin = 1.0E+20
1038	xmax = -1.0E+20
1039	DO i = 1, klon
1040	xmin = MIN(zval(i),xmin)
1041	xmax = MAX(zval(i),xmax)
1042	ENDDO
1043	PRINT*,'OROGRAPHIE SOUS-MAILLE zval:', xmin, xmax
1044	c
1045	c
1046	ierr = NF_INQ_VARID (nid, "RUGSREL", nvarid)
1047	IF (ierr.NE.NF_NOERR) THEN
1048	PRINT*, 'phyetat0: Le champ <RUGSREL> est absent'
1049	CALL abort
1050	ENDIF
1051	#ifdef NC_DOUBLE
1052	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rugsrel)
1053	#else
1054	ierr = NF_GET_VAR_REAL(nid, nvarid, rugsrel)
1055	#endif
1056	IF (ierr.NE.NF_NOERR) THEN
1057	PRINT*, 'phyetat0: Lecture echouee pour <RUGSREL>'
1058	CALL abort
1059	ENDIF
1060	xmin = 1.0E+20
1061	xmax = -1.0E+20
1062	DO i = 1, klon
1063	xmin = MIN(rugsrel(i),xmin)
1064	xmax = MAX(rugsrel(i),xmax)
1065	ENDDO
1066	PRINT*,'Rugosite relief (ecart-type) rugsrel:', xmin, xmax
1067	c
1068	c
1069	ancien_ok = .TRUE.
1070	c
1071	ierr = NF_INQ_VARID (nid, "TANCIEN", nvarid)
1072	IF (ierr.NE.NF_NOERR) THEN
1073	PRINT*, "phyetat0: Le champ <TANCIEN> est absent"
1074	PRINT*, "Depart legerement fausse. Mais je continue"
1075	ancien_ok = .FALSE.
1076	ELSE
1077	#ifdef NC_DOUBLE
1078	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, t_ancien)
1079	#else
1080	ierr = NF_GET_VAR_REAL(nid, nvarid, t_ancien)
1081	#endif
1082	IF (ierr.NE.NF_NOERR) THEN
1083	PRINT*, "phyetat0: Lecture echouee pour <TANCIEN>"
1084	CALL abort
1085	ENDIF
1086	ENDIF
1087	c
1088	ierr = NF_INQ_VARID (nid, "QANCIEN", nvarid)
1089	IF (ierr.NE.NF_NOERR) THEN
1090	PRINT*, "phyetat0: Le champ <QANCIEN> est absent"
1091	PRINT*, "Depart legerement fausse. Mais je continue"
1092	ancien_ok = .FALSE.
1093	ELSE
1094	#ifdef NC_DOUBLE
1095	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, q_ancien)
1096	#else
1097	ierr = NF_GET_VAR_REAL(nid, nvarid, q_ancien)
1098	#endif
1099	IF (ierr.NE.NF_NOERR) THEN
1100	PRINT*, "phyetat0: Lecture echouee pour <QANCIEN>"
1101	CALL abort
1102	ENDIF
1103	ENDIF
1104	c
1105	c Fermer le fichier:
1106	c
1107	ierr = NF_CLOSE(nid)
1108	c
1109	RETURN
1110	END

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

Download in other formats:

Original Format