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

Last change on this file since 127 was 101, checked in by slebonnois, 14 years ago

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