Context Navigation

phyetat0.F @ 109

Last change on this file since 109 was 98, checked in by lmdzadmin, 24 years ago
Interface avec les differentes surface, version de travail.LF
Property svn:eol-style set to `native` Property svn:executable set to ``* Property svn:keywords set to `Author Date Id Revision`
File size: 31.0 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,rugmer,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 rugmer(klon)
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(snow(i,nsrf),xmin)
579	xmax = MAX(snow(i,nsrf),xmax)
580	ENDDO
581	PRINT,'Neige 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,'Neige 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*,'Neige 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 en mer:
796	c
797	ierr = NF_INQ_VARID (nid, "RUGMER", nvarid)
798	IF (ierr.NE.NF_NOERR) THEN
799	PRINT*, 'phyetat0: Le champ <RUGMER> est absent'
800	CALL abort
801	ENDIF
802	#ifdef NC_DOUBLE
803	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rugmer)
804	#else
805	ierr = NF_GET_VAR_REAL(nid, nvarid, rugmer)
806	#endif
807	IF (ierr.NE.NF_NOERR) THEN
808	PRINT*, 'phyetat0: Lecture echouee pour <RUGMER>'
809	CALL abort
810	ENDIF
811	xmin = 1.0E+20
812	xmax = -1.0E+20
813	DO i = 1, klon
814	xmin = MIN(rugmer(i),xmin)
815	xmax = MAX(rugmer(i),xmax)
816	ENDDO
817	PRINT*,'Rugosite sur la mer rugmer:', xmin, xmax
818	c
819	c Lecture de l'age de la neige:
820	c
821	ierr = NF_INQ_VARID (nid, "AGESNO", nvarid)
822	IF (ierr.NE.NF_NOERR) THEN
823	PRINT*, 'phyetat0: Le champ <AGESNO> est absent'
824	PRINT*, " Valeur par default: 50"
825	DO i = 1, klon
826	agesno(i) = 50.0
827	ENDDO
828	ELSE
829	#ifdef NC_DOUBLE
830	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, agesno)
831	#else
832	ierr = NF_GET_VAR_REAL(nid, nvarid, agesno)
833	#endif
834	IF (ierr.NE.NF_NOERR) THEN
835	PRINT*, 'phyetat0: Lecture echouee pour <AGESNO>'
836	CALL abort
837	ENDIF
838	xmin = 1.0E+20
839	xmax = -1.0E+20
840	DO i = 1, klon
841	xmin = MIN(agesno(i),xmin)
842	xmax = MAX(agesno(i),xmax)
843	ENDDO
844	PRINT*,'Age de la neige agesno:', xmin, xmax
845	ENDIF
846	c
847	c
848	ierr = NF_INQ_VARID (nid, "ZMEA", nvarid)
849	IF (ierr.NE.NF_NOERR) THEN
850	PRINT*, 'phyetat0: Le champ <ZMEA> est absent'
851	CALL abort
852	ENDIF
853	#ifdef NC_DOUBLE
854	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zmea)
855	#else
856	ierr = NF_GET_VAR_REAL(nid, nvarid, zmea)
857	#endif
858	IF (ierr.NE.NF_NOERR) THEN
859	PRINT*, 'phyetat0: Lecture echouee pour <ZMEA>'
860	CALL abort
861	ENDIF
862	xmin = 1.0E+20
863	xmax = -1.0E+20
864	DO i = 1, klon
865	xmin = MIN(zmea(i),xmin)
866	xmax = MAX(zmea(i),xmax)
867	ENDDO
868	PRINT*,'OROGRAPHIE SOUS-MAILLE zmea:', xmin, xmax
869	c
870	c
871	ierr = NF_INQ_VARID (nid, "ZSTD", nvarid)
872	IF (ierr.NE.NF_NOERR) THEN
873	PRINT*, 'phyetat0: Le champ <ZSTD> est absent'
874	CALL abort
875	ENDIF
876	#ifdef NC_DOUBLE
877	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zstd)
878	#else
879	ierr = NF_GET_VAR_REAL(nid, nvarid, zstd)
880	#endif
881	IF (ierr.NE.NF_NOERR) THEN
882	PRINT*, 'phyetat0: Lecture echouee pour <ZSTD>'
883	CALL abort
884	ENDIF
885	xmin = 1.0E+20
886	xmax = -1.0E+20
887	DO i = 1, klon
888	xmin = MIN(zstd(i),xmin)
889	xmax = MAX(zstd(i),xmax)
890	ENDDO
891	PRINT*,'OROGRAPHIE SOUS-MAILLE zstd:', xmin, xmax
892	c
893	c
894	ierr = NF_INQ_VARID (nid, "ZSIG", nvarid)
895	IF (ierr.NE.NF_NOERR) THEN
896	PRINT*, 'phyetat0: Le champ <ZSIG> est absent'
897	CALL abort
898	ENDIF
899	#ifdef NC_DOUBLE
900	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zsig)
901	#else
902	ierr = NF_GET_VAR_REAL(nid, nvarid, zsig)
903	#endif
904	IF (ierr.NE.NF_NOERR) THEN
905	PRINT*, 'phyetat0: Lecture echouee pour <ZSIG>'
906	CALL abort
907	ENDIF
908	xmin = 1.0E+20
909	xmax = -1.0E+20
910	DO i = 1, klon
911	xmin = MIN(zsig(i),xmin)
912	xmax = MAX(zsig(i),xmax)
913	ENDDO
914	PRINT*,'OROGRAPHIE SOUS-MAILLE zsig:', xmin, xmax
915	c
916	c
917	ierr = NF_INQ_VARID (nid, "ZGAM", nvarid)
918	IF (ierr.NE.NF_NOERR) THEN
919	PRINT*, 'phyetat0: Le champ <ZGAM> est absent'
920	CALL abort
921	ENDIF
922	#ifdef NC_DOUBLE
923	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zgam)
924	#else
925	ierr = NF_GET_VAR_REAL(nid, nvarid, zgam)
926	#endif
927	IF (ierr.NE.NF_NOERR) THEN
928	PRINT*, 'phyetat0: Lecture echouee pour <ZGAM>'
929	CALL abort
930	ENDIF
931	xmin = 1.0E+20
932	xmax = -1.0E+20
933	DO i = 1, klon
934	xmin = MIN(zgam(i),xmin)
935	xmax = MAX(zgam(i),xmax)
936	ENDDO
937	PRINT*,'OROGRAPHIE SOUS-MAILLE zgam:', xmin, xmax
938	c
939	c
940	ierr = NF_INQ_VARID (nid, "ZTHE", nvarid)
941	IF (ierr.NE.NF_NOERR) THEN
942	PRINT*, 'phyetat0: Le champ <ZTHE> est absent'
943	CALL abort
944	ENDIF
945	#ifdef NC_DOUBLE
946	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zthe)
947	#else
948	ierr = NF_GET_VAR_REAL(nid, nvarid, zthe)
949	#endif
950	IF (ierr.NE.NF_NOERR) THEN
951	PRINT*, 'phyetat0: Lecture echouee pour <ZTHE>'
952	CALL abort
953	ENDIF
954	xmin = 1.0E+20
955	xmax = -1.0E+20
956	DO i = 1, klon
957	xmin = MIN(zthe(i),xmin)
958	xmax = MAX(zthe(i),xmax)
959	ENDDO
960	PRINT*,'OROGRAPHIE SOUS-MAILLE zthe:', xmin, xmax
961	c
962	c
963	ierr = NF_INQ_VARID (nid, "ZPIC", nvarid)
964	IF (ierr.NE.NF_NOERR) THEN
965	PRINT*, 'phyetat0: Le champ <ZPIC> est absent'
966	CALL abort
967	ENDIF
968	#ifdef NC_DOUBLE
969	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zpic)
970	#else
971	ierr = NF_GET_VAR_REAL(nid, nvarid, zpic)
972	#endif
973	IF (ierr.NE.NF_NOERR) THEN
974	PRINT*, 'phyetat0: Lecture echouee pour <ZPIC>'
975	CALL abort
976	ENDIF
977	xmin = 1.0E+20
978	xmax = -1.0E+20
979	DO i = 1, klon
980	xmin = MIN(zpic(i),xmin)
981	xmax = MAX(zpic(i),xmax)
982	ENDDO
983	PRINT*,'OROGRAPHIE SOUS-MAILLE zpic:', xmin, xmax
984	c
985	ierr = NF_INQ_VARID (nid, "ZVAL", nvarid)
986	IF (ierr.NE.NF_NOERR) THEN
987	PRINT*, 'phyetat0: Le champ <ZVAL> est absent'
988	CALL abort
989	ENDIF
990	#ifdef NC_DOUBLE
991	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zval)
992	#else
993	ierr = NF_GET_VAR_REAL(nid, nvarid, zval)
994	#endif
995	IF (ierr.NE.NF_NOERR) THEN
996	PRINT*, 'phyetat0: Lecture echouee pour <ZVAL>'
997	CALL abort
998	ENDIF
999	xmin = 1.0E+20
1000	xmax = -1.0E+20
1001	DO i = 1, klon
1002	xmin = MIN(zval(i),xmin)
1003	xmax = MAX(zval(i),xmax)
1004	ENDDO
1005	PRINT*,'OROGRAPHIE SOUS-MAILLE zval:', xmin, xmax
1006	c
1007	c
1008	ierr = NF_INQ_VARID (nid, "RUGSREL", nvarid)
1009	IF (ierr.NE.NF_NOERR) THEN
1010	PRINT*, 'phyetat0: Le champ <RUGSREL> est absent'
1011	CALL abort
1012	ENDIF
1013	#ifdef NC_DOUBLE
1014	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rugsrel)
1015	#else
1016	ierr = NF_GET_VAR_REAL(nid, nvarid, rugsrel)
1017	#endif
1018	IF (ierr.NE.NF_NOERR) THEN
1019	PRINT*, 'phyetat0: Lecture echouee pour <RUGSREL>'
1020	CALL abort
1021	ENDIF
1022	xmin = 1.0E+20
1023	xmax = -1.0E+20
1024	DO i = 1, klon
1025	xmin = MIN(rugsrel(i),xmin)
1026	xmax = MAX(rugsrel(i),xmax)
1027	ENDDO
1028	PRINT*,'Rugosite relief (ecart-type) rugsrel:', xmin, xmax
1029	c
1030	c
1031	ancien_ok = .TRUE.
1032	c
1033	ierr = NF_INQ_VARID (nid, "TANCIEN", nvarid)
1034	IF (ierr.NE.NF_NOERR) THEN
1035	PRINT*, "phyetat0: Le champ <TANCIEN> est absent"
1036	PRINT*, "Depart legerement fausse. Mais je continue"
1037	ancien_ok = .FALSE.
1038	ELSE
1039	#ifdef NC_DOUBLE
1040	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, t_ancien)
1041	#else
1042	ierr = NF_GET_VAR_REAL(nid, nvarid, t_ancien)
1043	#endif
1044	IF (ierr.NE.NF_NOERR) THEN
1045	PRINT*, "phyetat0: Lecture echouee pour <TANCIEN>"
1046	CALL abort
1047	ENDIF
1048	ENDIF
1049	c
1050	ierr = NF_INQ_VARID (nid, "QANCIEN", nvarid)
1051	IF (ierr.NE.NF_NOERR) THEN
1052	PRINT*, "phyetat0: Le champ <QANCIEN> est absent"
1053	PRINT*, "Depart legerement fausse. Mais je continue"
1054	ancien_ok = .FALSE.
1055	ELSE
1056	#ifdef NC_DOUBLE
1057	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, q_ancien)
1058	#else
1059	ierr = NF_GET_VAR_REAL(nid, nvarid, q_ancien)
1060	#endif
1061	IF (ierr.NE.NF_NOERR) THEN
1062	PRINT*, "phyetat0: Lecture echouee pour <QANCIEN>"
1063	CALL abort
1064	ENDIF
1065	ENDIF
1066	c
1067	c Fermer le fichier:
1068	c
1069	ierr = NF_CLOSE(nid)
1070	c
1071	RETURN
1072	END

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

Download in other formats:

Original Format