source: trunk/libf/phyvenus/phyetat0.F @ 100

Last change on this file since 100 was 97, checked in by slebonnois, 14 years ago

Serie de modifs SL pour homogeneisation des phytitan et phyvenus
Ca touche aussi aux liens phy/dyn (surtout a propos de clesphy0),
a verifier avec les autres, donc...
File size: 13.7 KB
RevLine 
[3]1!
2! $Header: /home/cvsroot/LMDZ4/libf/phylmd/phyetat0.F,v 1.2 2004/06/22 11:45:33 lmdzadmin Exp $
3!
4c
5c
6      SUBROUTINE phyetat0 (fichnom,dtime,
7     .            rlat,rlon, tsol,tsoil,
8     .           albe, solsw, sollw,
[97]9     .           fder,radsol,
[3]10     .    zmea, zstd, zsig, zgam, zthe, zpic, zval, 
11     .           tabcntr0,
12     .           t_ancien,ancien_ok)
13      IMPLICIT none
14c======================================================================
15c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
16c Objet: Lecture de l'etat initial pour la physique
17c======================================================================
18#include "dimensions.h"
19#include "dimphy.h"
20#include "netcdf.inc"
21#include "dimsoil.h"
22#include "clesphys.h"
23#include "temps.h"
24c======================================================================
25      CHARACTER*(*) fichnom
26      REAL dtime
27      INTEGER radpas
28      REAL rlat(klon), rlon(klon)
29      REAL tsol(klon)
30      REAL tsoil(klon,nsoilmx)
31      REAL albe(klon)
32cIM BEG alblw
33      REAL alblw(klon)
34cIM END alblw
35      REAL radsol(klon)
36      REAL sollw(klon)
37      real solsw(klon)
38      real fder(klon)
39      REAL zmea(klon), zstd(klon)
40      REAL zsig(klon), zgam(klon), zthe(klon)
41      REAL zpic(klon), zval(klon)
42
43      REAL t_ancien(klon,klev)
44      LOGICAL ancien_ok
45
46      REAL xmin, xmax
47c
48      INTEGER nid, nvarid
49      INTEGER ierr, i, nsrf, isoil
50      INTEGER length
51      PARAMETER (length=100)
52      REAL tab_cntrl(length), tabcntr0(length)
53      CHARACTER*2 str2
54c
55c Ouvrir le fichier contenant l'etat initial:
56c
57      print*,'fichnom',fichnom
58      ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
59      IF (ierr.NE.NF_NOERR) THEN
60        write(6,*)' Pb d''ouverture du fichier '//fichnom
61        write(6,*)' ierr = ', ierr
62        CALL ABORT
63      ENDIF
64c
65c Lecture des parametres de controle:
66c
67      ierr = NF_INQ_VARID (nid, "controle", nvarid)
68      IF (ierr.NE.NF_NOERR) THEN
69         PRINT*, 'phyetat0: Le champ <controle> est absent'
70         CALL abort
71      ENDIF
72#ifdef NC_DOUBLE
73      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl)
74#else
75      ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
76#endif
77      IF (ierr.NE.NF_NOERR) THEN
78         PRINT*, 'phyetat0: Lecture echouee pour <controle>'
79         CALL abort
80      ELSE
81c
82         DO i = 1, length
83           tabcntr0( i ) = tab_cntrl( i )
84         ENDDO
85c
86
87         dtime        = tab_cntrl(1)
88         radpas       = tab_cntrl(2)
89
90      ENDIF
91
92      itau_phy = tab_cntrl(15)
93
94c
95c Lecture des latitudes (coordonnees):
96c
97      ierr = NF_INQ_VARID (nid, "latitude", nvarid)
98      IF (ierr.NE.NF_NOERR) THEN
99         PRINT*, 'phyetat0: Le champ <latitude> est absent'
100         CALL abort
101      ENDIF
102#ifdef NC_DOUBLE
103      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlat)
104#else
105      ierr = NF_GET_VAR_REAL(nid, nvarid, rlat)
106#endif
107      IF (ierr.NE.NF_NOERR) THEN
108         PRINT*, 'phyetat0: Lecture echouee pour <latitude>'
109         CALL abort
110      ENDIF
111c
112c Lecture des longitudes (coordonnees):
113c
114      ierr = NF_INQ_VARID (nid, "longitude", nvarid)
115      IF (ierr.NE.NF_NOERR) THEN
116         PRINT*, 'phyetat0: Le champ <longitude> est absent'
117         CALL abort
118      ENDIF
119#ifdef NC_DOUBLE
120      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlon)
121#else
122      ierr = NF_GET_VAR_REAL(nid, nvarid, rlon)
123#endif
124      IF (ierr.NE.NF_NOERR) THEN
125         PRINT*, 'phyetat0: Lecture echouee pour <latitude>'
126         CALL abort
127      ENDIF
128C
129c Lecture des temperatures du sol:
130c
131      ierr = NF_INQ_VARID (nid, "TS", nvarid)
132      IF (ierr.NE.NF_NOERR) THEN
133         PRINT*, 'phyetat0: Le champ <TS> est absent'
134         PRINT*, "phyetat0: Lecture echouee pour <TS>"
135         CALL abort
136      ELSE
137         PRINT*, 'phyetat0: Le champ <TS> est present'
138#ifdef NC_DOUBLE
139         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsol(1))
140#else
141         ierr = NF_GET_VAR_REAL(nid, nvarid, tsol(1))
142#endif
143         IF (ierr.NE.NF_NOERR) THEN
144            PRINT*, "phyetat0: Lecture echouee pour <TS>"
145            CALL abort
146         ENDIF
147         xmin = 1.0E+20
148         xmax = -1.0E+20
149         DO i = 1, klon
150            xmin = MIN(tsol(i),xmin)
151            xmax = MAX(tsol(i),xmax)
152         ENDDO
153         PRINT*,'Temperature du sol <TS>', xmin, xmax
154      ENDIF
155c
156c Lecture des temperatures du sol profond:
157c
158      DO isoil=1, nsoilmx
159      IF (isoil.GT.99) THEN
160         PRINT*, "Trop de couches"
161         CALL abort
162      ENDIF
163      WRITE(str2,'(i2.2)') isoil
164      ierr = NF_INQ_VARID (nid, 'Tsoil'//str2, nvarid)
165      IF (ierr.NE.NF_NOERR) THEN
166         PRINT*, "phyetat0: Le champ <Tsoil"//str2//"> est absent"
167         PRINT*, "          Il prend donc la valeur de surface"
168         DO i=1, klon
169             tsoil(i,isoil)=tsol(i)
170         ENDDO
171      ELSE
172#ifdef NC_DOUBLE
173         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsoil(1,isoil))
174#else
175         ierr = NF_GET_VAR_REAL(nid, nvarid, tsoil(1,isoil))
176#endif
177         IF (ierr.NE.NF_NOERR) THEN
178            PRINT*, "Lecture echouee pour <Tsoil"//str2//">"
179            CALL abort
180         ENDIF
181      ENDIF
182      ENDDO
183c
184c Lecture de albedo au sol:
185c
186      ierr = NF_INQ_VARID (nid, "ALBE", nvarid)
187      IF (ierr.NE.NF_NOERR) THEN
188         PRINT*, 'phyetat0: Le champ <ALBE> est absent'
189         PRINT*, "phyetat0: Lecture echouee pour <ALBE>"
190         CALL abort
191      ELSE
192         PRINT*, 'phyetat0: Le champ <ALBE> est present'
193#ifdef NC_DOUBLE
194         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, albe(1))
195#else
196         ierr = NF_GET_VAR_REAL(nid, nvarid, albe(1))
197#endif
198         IF (ierr.NE.NF_NOERR) THEN
199            PRINT*, "phyetat0: Lecture echouee pour <ALBE>"
200            CALL abort
201         ENDIF
202         xmin = 1.0E+20
203         xmax = -1.0E+20
204         DO i = 1, klon
205            xmin = MIN(albe(i),xmin)
206            xmax = MAX(albe(i),xmax)
207         ENDDO
208         PRINT*,'Albedo du sol <ALBE>', xmin, xmax
209      ENDIF
210
211c
212c Lecture rayonnement solaire au sol:
213c
214      ierr = NF_INQ_VARID (nid, "solsw", nvarid)
215      IF (ierr.NE.NF_NOERR) THEN
216         PRINT*, 'phyetat0: Le champ <solsw> est absent'
217         PRINT*, 'mis a zero'
218         solsw = 0.
219      ELSE
220#ifdef NC_DOUBLE
221        ierr = NF_GET_VAR_DOUBLE(nid, nvarid, solsw)
222#else
223        ierr = NF_GET_VAR_REAL(nid, nvarid, solsw)
224#endif
225        IF (ierr.NE.NF_NOERR) THEN
226          PRINT*, 'phyetat0: Lecture echouee pour <solsw>'
227          CALL abort
228        ENDIF
229      ENDIF
230      xmin = 1.0E+20
231      xmax = -1.0E+20
232      DO i = 1, klon
233         xmin = MIN(solsw(i),xmin)
234         xmax = MAX(solsw(i),xmax)
235      ENDDO
236      PRINT*,'Rayonnement solaire au sol solsw:', xmin, xmax
237c
238c Lecture rayonnement IF au sol:
239c
240      ierr = NF_INQ_VARID (nid, "sollw", nvarid)
241      IF (ierr.NE.NF_NOERR) THEN
242         PRINT*, 'phyetat0: Le champ <sollw> est absent'
243         PRINT*, 'mis a zero'
244         sollw = 0.
245      ELSE
246#ifdef NC_DOUBLE
247        ierr = NF_GET_VAR_DOUBLE(nid, nvarid, sollw)
248#else
249        ierr = NF_GET_VAR_REAL(nid, nvarid, sollw)
250#endif
251        IF (ierr.NE.NF_NOERR) THEN
252          PRINT*, 'phyetat0: Lecture echouee pour <sollw>'
253          CALL abort
254        ENDIF
255      ENDIF
256      xmin = 1.0E+20
257      xmax = -1.0E+20
258      DO i = 1, klon
259         xmin = MIN(sollw(i),xmin)
260         xmax = MAX(sollw(i),xmax)
261      ENDDO
262      PRINT*,'Rayonnement IF au sol sollw:', xmin, xmax
263
264c
265c Lecture derive des flux:
266c
267      ierr = NF_INQ_VARID (nid, "fder", nvarid)
268      IF (ierr.NE.NF_NOERR) THEN
269         PRINT*, 'phyetat0: Le champ <fder> est absent'
270         PRINT*, 'mis a zero'
271         fder = 0.
272      ELSE
273#ifdef NC_DOUBLE
274        ierr = NF_GET_VAR_DOUBLE(nid, nvarid, fder)
275#else
276        ierr = NF_GET_VAR_REAL(nid, nvarid, fder)
277#endif
278        IF (ierr.NE.NF_NOERR) THEN
279          PRINT*, 'phyetat0: Lecture echouee pour <fder>'
280          CALL abort
281        ENDIF
282      ENDIF
283      xmin = 1.0E+20
284      xmax = -1.0E+20
285      DO i = 1, klon
286         xmin = MIN(fder(i),xmin)
287         xmax = MAX(fder(i),xmax)
288      ENDDO
289      PRINT*,'Derive des flux fder:', xmin, xmax
290
291c
292c Lecture du rayonnement net au sol:
293c
294      ierr = NF_INQ_VARID (nid, "RADS", nvarid)
295      IF (ierr.NE.NF_NOERR) THEN
296         PRINT*, 'phyetat0: Le champ <RADS> est absent'
297         CALL abort
298      ENDIF
299#ifdef NC_DOUBLE
300      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, radsol)
301#else
302      ierr = NF_GET_VAR_REAL(nid, nvarid, radsol)
303#endif
304      IF (ierr.NE.NF_NOERR) THEN
305         PRINT*, 'phyetat0: Lecture echouee pour <RADS>'
306         CALL abort
307      ENDIF
308      xmin = 1.0E+20
309      xmax = -1.0E+20
310      DO i = 1, klon
311         xmin = MIN(radsol(i),xmin)
312         xmax = MAX(radsol(i),xmax)
313      ENDDO
314      PRINT*,'Rayonnement net au sol radsol:', xmin, xmax
315c
316
317c
318c Lecture de l'orographie sous-maille si ok_orodr:
319c
320      if(ok_orodr) then
321     
322      ierr = NF_INQ_VARID (nid, "ZMEA", nvarid)
323      IF (ierr.NE.NF_NOERR) THEN
324         PRINT*, 'phyetat0: Le champ <ZMEA> est absent'
325         CALL abort
326      ENDIF
327#ifdef NC_DOUBLE
328      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zmea)
329#else
330      ierr = NF_GET_VAR_REAL(nid, nvarid, zmea)
331#endif
332      IF (ierr.NE.NF_NOERR) THEN
333         PRINT*, 'phyetat0: Lecture echouee pour <ZMEA>'
334         CALL abort
335      ENDIF
336      xmin = 1.0E+20
337      xmax = -1.0E+20
338      DO i = 1, klon
339         xmin = MIN(zmea(i),xmin)
340         xmax = MAX(zmea(i),xmax)
341      ENDDO
342      PRINT*,'OROGRAPHIE SOUS-MAILLE zmea:', xmin, xmax
343c
344c
345      ierr = NF_INQ_VARID (nid, "ZSTD", nvarid)
346      IF (ierr.NE.NF_NOERR) THEN
347         PRINT*, 'phyetat0: Le champ <ZSTD> est absent'
348         CALL abort
349      ENDIF
350#ifdef NC_DOUBLE
351      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zstd)
352#else
353      ierr = NF_GET_VAR_REAL(nid, nvarid, zstd)
354#endif
355      IF (ierr.NE.NF_NOERR) THEN
356         PRINT*, 'phyetat0: Lecture echouee pour <ZSTD>'
357         CALL abort
358      ENDIF
359      xmin = 1.0E+20
360      xmax = -1.0E+20
361      DO i = 1, klon
362         xmin = MIN(zstd(i),xmin)
363         xmax = MAX(zstd(i),xmax)
364      ENDDO
365      PRINT*,'OROGRAPHIE SOUS-MAILLE zstd:', xmin, xmax
366c
367c
368      ierr = NF_INQ_VARID (nid, "ZSIG", nvarid)
369      IF (ierr.NE.NF_NOERR) THEN
370         PRINT*, 'phyetat0: Le champ <ZSIG> est absent'
371         CALL abort
372      ENDIF
373#ifdef NC_DOUBLE
374      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zsig)
375#else
376      ierr = NF_GET_VAR_REAL(nid, nvarid, zsig)
377#endif
378      IF (ierr.NE.NF_NOERR) THEN
379         PRINT*, 'phyetat0: Lecture echouee pour <ZSIG>'
380         CALL abort
381      ENDIF
382      xmin = 1.0E+20
383      xmax = -1.0E+20
384      DO i = 1, klon
385         xmin = MIN(zsig(i),xmin)
386         xmax = MAX(zsig(i),xmax)
387      ENDDO
388      PRINT*,'OROGRAPHIE SOUS-MAILLE zsig:', xmin, xmax
389c
390c
391      ierr = NF_INQ_VARID (nid, "ZGAM", nvarid)
392      IF (ierr.NE.NF_NOERR) THEN
393         PRINT*, 'phyetat0: Le champ <ZGAM> est absent'
394         CALL abort
395      ENDIF
396#ifdef NC_DOUBLE
397      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zgam)
398#else
399      ierr = NF_GET_VAR_REAL(nid, nvarid, zgam)
400#endif
401      IF (ierr.NE.NF_NOERR) THEN
402         PRINT*, 'phyetat0: Lecture echouee pour <ZGAM>'
403         CALL abort
404      ENDIF
405      xmin = 1.0E+20
406      xmax = -1.0E+20
407      DO i = 1, klon
408         xmin = MIN(zgam(i),xmin)
409         xmax = MAX(zgam(i),xmax)
410      ENDDO
411      PRINT*,'OROGRAPHIE SOUS-MAILLE zgam:', xmin, xmax
412c
413c
414      ierr = NF_INQ_VARID (nid, "ZTHE", nvarid)
415      IF (ierr.NE.NF_NOERR) THEN
416         PRINT*, 'phyetat0: Le champ <ZTHE> est absent'
417         CALL abort
418      ENDIF
419#ifdef NC_DOUBLE
420      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zthe)
421#else
422      ierr = NF_GET_VAR_REAL(nid, nvarid, zthe)
423#endif
424      IF (ierr.NE.NF_NOERR) THEN
425         PRINT*, 'phyetat0: Lecture echouee pour <ZTHE>'
426         CALL abort
427      ENDIF
428      xmin = 1.0E+20
429      xmax = -1.0E+20
430      DO i = 1, klon
431         xmin = MIN(zthe(i),xmin)
432         xmax = MAX(zthe(i),xmax)
433      ENDDO
434      PRINT*,'OROGRAPHIE SOUS-MAILLE zthe:', xmin, xmax
435c
436c
437      ierr = NF_INQ_VARID (nid, "ZPIC", nvarid)
438      IF (ierr.NE.NF_NOERR) THEN
439         PRINT*, 'phyetat0: Le champ <ZPIC> est absent'
440         CALL abort
441      ENDIF
442#ifdef NC_DOUBLE
443      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zpic)
444#else
445      ierr = NF_GET_VAR_REAL(nid, nvarid, zpic)
446#endif
447      IF (ierr.NE.NF_NOERR) THEN
448         PRINT*, 'phyetat0: Lecture echouee pour <ZPIC>'
449         CALL abort
450      ENDIF
451      xmin = 1.0E+20
452      xmax = -1.0E+20
453      DO i = 1, klon
454         xmin = MIN(zpic(i),xmin)
455         xmax = MAX(zpic(i),xmax)
456      ENDDO
457      PRINT*,'OROGRAPHIE SOUS-MAILLE zpic:', xmin, xmax
458c
459      ierr = NF_INQ_VARID (nid, "ZVAL", nvarid)
460      IF (ierr.NE.NF_NOERR) THEN
461         PRINT*, 'phyetat0: Le champ <ZVAL> est absent'
462         CALL abort
463      ENDIF
464#ifdef NC_DOUBLE
465      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zval)
466#else
467      ierr = NF_GET_VAR_REAL(nid, nvarid, zval)
468#endif
469      IF (ierr.NE.NF_NOERR) THEN
470         PRINT*, 'phyetat0: Lecture echouee pour <ZVAL>'
471         CALL abort
472      ENDIF
473      xmin = 1.0E+20
474      xmax = -1.0E+20
475      DO i = 1, klon
476         xmin = MIN(zval(i),xmin)
477         xmax = MAX(zval(i),xmax)
478      ENDDO
479      PRINT*,'OROGRAPHIE SOUS-MAILLE zval:', xmin, xmax
480
481      else
482         zmea = 0.
483         zstd = 0.
484         zsig = 0.
485         zgam = 0.
486         zthe = 0.
487         zpic = 0.
488         zval = 0.
489
490      endif   ! fin test sur ok_orodr
491
492c
493c Lecture de TANCIEN:
494c
495      ancien_ok = .TRUE.
496c
497      ierr = NF_INQ_VARID (nid, "TANCIEN", nvarid)
498      IF (ierr.NE.NF_NOERR) THEN
499         PRINT*, "phyetat0: Le champ <TANCIEN> est absent"
500         PRINT*, "Depart legerement fausse. Mais je continue"
501         ancien_ok = .FALSE.
502      ELSE
503#ifdef NC_DOUBLE
504         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, t_ancien)
505#else
506         ierr = NF_GET_VAR_REAL(nid, nvarid, t_ancien)
507#endif
508         IF (ierr.NE.NF_NOERR) THEN
509            PRINT*, "phyetat0: Lecture echouee pour <TANCIEN>"
510            CALL abort
511         ENDIF
512      ENDIF
513c
514c Fermer le fichier:
515c
516      ierr = NF_CLOSE(nid)
517c
518      RETURN
519      END
Note: See TracBrowser for help on using the repository browser.