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

Last change on this file since 4 was 3, checked in by slebonnois, 15 years ago

Creation de repertoires:

  • chantiers : pour communiquer sur nos projets de modifs
  • documentation : pour stocker les docs

Ajout de:

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