source: trunk/LMDZ.TITAN/libf/phytitan/phyetat0.F @ 201

Last change on this file since 201 was 175, checked in by slebonnois, 14 years ago

S.LEBONNOIS:

  • Revision majeure de la physique Titan => ajout des nuages version 10 bins (Jeremie Burgalat) Cette version reste a tester mais avec clouds=0, on reste sur l'ancienne.
  • Quelques ajouts dans la doc.
File size: 10.2 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,
[175]9     .           fder,radsol,resch4,
[3]10     .           tabcntr0,
11     .           t_ancien,ancien_ok)
12c======================================================================
13c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
14c Objet: Lecture de l'etat initial pour la physique
15c======================================================================
[102]16      use dimphy
17      IMPLICIT none
[3]18#include "dimensions.h"
19#include "netcdf.inc"
20#include "dimsoil.h"
21#include "clesphys.h"
22#include "temps.h"
23c======================================================================
24      CHARACTER*(*) fichnom
25      REAL dtime
26      INTEGER radpas,chimpas
[175]27      REAL rlat(klon), rlon(klon)   ! in degrees
[3]28      REAL tsol(klon)
29      REAL tsoil(klon,nsoilmx)
30      REAL albe(klon)
31cIM BEG alblw
32      REAL alblw(klon)
33cIM END alblw
34      REAL radsol(klon)
35      REAL sollw(klon)
36      real solsw(klon)
37      real fder(klon)
38
39      REAL t_ancien(klon,klev)
40      LOGICAL ancien_ok
41
[175]42      REAL resch4(klon)
43      INTEGER ig0
44
[3]45      REAL xmin, xmax
46c
47      INTEGER nid, nvarid
48      INTEGER ierr, i, nsrf, isoil
49      INTEGER length
50      PARAMETER (length=100)
51      REAL tab_cntrl(length), tabcntr0(length)
52      CHARACTER*2 str2
53c
54c Ouvrir le fichier contenant l'etat initial:
55c
56      print*,'fichnom',fichnom
57      ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
58      IF (ierr.NE.NF_NOERR) THEN
59        write(6,*)' Pb d''ouverture du fichier '//fichnom
60        write(6,*)' ierr = ', ierr
61        CALL ABORT
62      ENDIF
63c
64c Lecture des parametres de controle:
65c
66      ierr = NF_INQ_VARID (nid, "controle", nvarid)
67      IF (ierr.NE.NF_NOERR) THEN
68         PRINT*, 'phyetat0: Le champ <controle> est absent'
69         CALL abort
70      ENDIF
71#ifdef NC_DOUBLE
72      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl)
73#else
74      ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
75#endif
76      IF (ierr.NE.NF_NOERR) THEN
77         PRINT*, 'phyetat0: Lecture echouee pour <controle>'
78         CALL abort
79      ELSE
80c
81         DO i = 1, length
82           tabcntr0( i ) = tab_cntrl( i )
83         ENDDO
84c
85
86         dtime        = tab_cntrl(1)
87         radpas       = tab_cntrl(2)
88         chimpas      = tab_cntrl(3)
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      ancien_ok = .TRUE.
317c
318      ierr = NF_INQ_VARID (nid, "TANCIEN", nvarid)
319      IF (ierr.NE.NF_NOERR) THEN
320         PRINT*, "phyetat0: Le champ <TANCIEN> est absent"
321         PRINT*, "Depart legerement fausse. Mais je continue"
322         ancien_ok = .FALSE.
323      ELSE
324#ifdef NC_DOUBLE
325         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, t_ancien)
326#else
327         ierr = NF_GET_VAR_REAL(nid, nvarid, t_ancien)
328#endif
329         IF (ierr.NE.NF_NOERR) THEN
330            PRINT*, "phyetat0: Lecture echouee pour <TANCIEN>"
331            CALL abort
332         ENDIF
333      ENDIF
[175]334c     Par defaut on cree 2 bandes de methane au pole Nord et au pole Sud
335c     (entre 75 et 85 degres de latitude) de 2 metres.
336c     Les poles sont sec !
337      resch4(1) = 0.    ! pole nord = 1 point
338      DO ig0=2,klon
339          if ((rlat(ig0).ge.75..and.rlat(ig0).le.85.).or.
340     &        (rlat(ig0).ge.-85.and.rlat(ig0).le.-75.)) then
341            resch4(ig0) = 2.
342          else
343            resch4(ig0) = 0.
344          endif
345      ENDDO
346      resch4(klon) = 0.   ! pole sud = 1 point
347
348      ierr = NF_INQ_VARID (nid, "RESCH4", nvarid)
349      IF (ierr.NE.NF_NOERR) THEN
350         PRINT*, "phyetat0: Le champ <RESCH4> est absent"
351         PRINT*, "Pas de reservoir de methane mais je continue..."
352         PRINT*, "Pour info, je met 2 metres de methane sur 2 bandes"
353         PRINT*, "comprises entre 75 et 85 degres de latitude dans  "
354         PRINT*, "chaque hemisphere."
355      ELSE
356#ifdef NC_DOUBLE
357         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, resch4)
358#else
359         ierr = NF_GET_VAR_REAL(nid, nvarid,resch4)
360#endif
361         IF (ierr.NE.NF_NOERR) THEN
362            PRINT*, "phyetat0: Lecture echouee pour <reservoir>"
363            CALL abort
364         ENDIF
365      ENDIF
[3]366c
367c Fermer le fichier:
368c
369      ierr = NF_CLOSE(nid)
370c
371      RETURN
372      END
Note: See TracBrowser for help on using the repository browser.