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

Last change on this file since 902 was 815, checked in by slebonnois, 13 years ago

SL: petites modifs Titan et Venus pour tableau controle dans la physique ; pour Titan, petits details lies a raz_date ; modif chemin ioipsl sur gnome ; + elimination d'un warning etrange dans gcm.F
File size: 10.8 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
[815]6      SUBROUTINE phyetat0 (fichnom,
[3]7     .            rlat,rlon, tsol,tsoil,
8     .           albe, solsw, sollw,
[175]9     .           fder,radsol,resch4,
[3]10     .           t_ancien,ancien_ok)
11c======================================================================
12c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
13c Objet: Lecture de l'etat initial pour la physique
14c======================================================================
[102]15      use dimphy
[814]16      use control_mod
[102]17      IMPLICIT none
[3]18#include "dimensions.h"
19#include "netcdf.inc"
20#include "dimsoil.h"
21#include "clesphys.h"
[815]22#include "tabcontrol.h"
[3]23#include "temps.h"
24c======================================================================
25      CHARACTER*(*) fichnom
[175]26      REAL rlat(klon), rlon(klon)   ! in degrees
[3]27      REAL tsol(klon)
28      REAL tsoil(klon,nsoilmx)
29      REAL albe(klon)
30cIM BEG alblw
31      REAL alblw(klon)
32cIM END alblw
33      REAL radsol(klon)
34      REAL sollw(klon)
35      real solsw(klon)
36      real fder(klon)
37
38      REAL t_ancien(klon,klev)
39      LOGICAL ancien_ok
40
[175]41      REAL resch4(klon)
42      INTEGER ig0
43
[3]44      REAL xmin, xmax
45c
46      INTEGER nid, nvarid
47      INTEGER ierr, i, nsrf, isoil
[815]48      REAL tab_cntrl(length)
[3]49      CHARACTER*2 str2
50c
51c Ouvrir le fichier contenant l'etat initial:
52c
53      print*,'fichnom',fichnom
54      ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
55      IF (ierr.NE.NF_NOERR) THEN
56        write(6,*)' Pb d''ouverture du fichier '//fichnom
57        write(6,*)' ierr = ', ierr
58        CALL ABORT
59      ENDIF
60c
61c Lecture des parametres de controle:
62c
63      ierr = NF_INQ_VARID (nid, "controle", nvarid)
64      IF (ierr.NE.NF_NOERR) THEN
65         PRINT*, 'phyetat0: Le champ <controle> est absent'
66         CALL abort
67      ENDIF
68#ifdef NC_DOUBLE
69      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl)
70#else
71      ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
72#endif
73      IF (ierr.NE.NF_NOERR) THEN
74         PRINT*, 'phyetat0: Lecture echouee pour <controle>'
75         CALL abort
76      ELSE
77c
78         DO i = 1, length
79           tabcntr0( i ) = tab_cntrl( i )
80         ENDDO
81c
82
83         dtime        = tab_cntrl(1)
84         radpas       = tab_cntrl(2)
85         chimpas      = tab_cntrl(3)
[815]86         lsinit       = tab_cntrl(17)
[3]87
88      ENDIF
89
90      itau_phy = tab_cntrl(15)
91
[808]92c Attention si raz_date est active :
[815]93c il faut remettre a zero itau_phy apres phyetat0
94c et verifier que lsinit est proche de 0.
[808]95      IF (raz_date.eq.1) THEN
96        itau_phy=0
[815]97        if ((lsinit.gt.3.).and.(lsinit.lt.357.)) then
98          PRINT*, 'phyetat0: raz_date=1 and ls different from 0.'
99          PRINT*, 'When raz_date=1, we reset the initial date'
100          PRINT*, 'to spring equinox, Ls=0., so the start files'
101          PRINT*, 'should be within a couple of degrees from Ls=0.'
102          PRINT*, 'or the circulation will be too far from equilibrium'
103          CALL abort
104        endif
[808]105      ENDIF
106
[3]107c
108c Lecture des latitudes (coordonnees):
109c
110      ierr = NF_INQ_VARID (nid, "latitude", nvarid)
111      IF (ierr.NE.NF_NOERR) THEN
112         PRINT*, 'phyetat0: Le champ <latitude> est absent'
113         CALL abort
114      ENDIF
115#ifdef NC_DOUBLE
116      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlat)
117#else
118      ierr = NF_GET_VAR_REAL(nid, nvarid, rlat)
119#endif
120      IF (ierr.NE.NF_NOERR) THEN
121         PRINT*, 'phyetat0: Lecture echouee pour <latitude>'
122         CALL abort
123      ENDIF
124c
125c Lecture des longitudes (coordonnees):
126c
127      ierr = NF_INQ_VARID (nid, "longitude", nvarid)
128      IF (ierr.NE.NF_NOERR) THEN
129         PRINT*, 'phyetat0: Le champ <longitude> est absent'
130         CALL abort
131      ENDIF
132#ifdef NC_DOUBLE
133      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlon)
134#else
135      ierr = NF_GET_VAR_REAL(nid, nvarid, rlon)
136#endif
137      IF (ierr.NE.NF_NOERR) THEN
138         PRINT*, 'phyetat0: Lecture echouee pour <latitude>'
139         CALL abort
140      ENDIF
141C
142c Lecture des temperatures du sol:
143c
144      ierr = NF_INQ_VARID (nid, "TS", nvarid)
145      IF (ierr.NE.NF_NOERR) THEN
146         PRINT*, 'phyetat0: Le champ <TS> est absent'
147         PRINT*, "phyetat0: Lecture echouee pour <TS>"
148         CALL abort
149      ELSE
150         PRINT*, 'phyetat0: Le champ <TS> est present'
151#ifdef NC_DOUBLE
152         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsol(1))
153#else
154         ierr = NF_GET_VAR_REAL(nid, nvarid, tsol(1))
155#endif
156         IF (ierr.NE.NF_NOERR) THEN
157            PRINT*, "phyetat0: Lecture echouee pour <TS>"
158            CALL abort
159         ENDIF
160         xmin = 1.0E+20
161         xmax = -1.0E+20
162         DO i = 1, klon
163            xmin = MIN(tsol(i),xmin)
164            xmax = MAX(tsol(i),xmax)
165         ENDDO
166         PRINT*,'Temperature du sol <TS>', xmin, xmax
167      ENDIF
168c
169c Lecture des temperatures du sol profond:
170c
171      DO isoil=1, nsoilmx
172      IF (isoil.GT.99) THEN
173         PRINT*, "Trop de couches"
174         CALL abort
175      ENDIF
176      WRITE(str2,'(i2.2)') isoil
177      ierr = NF_INQ_VARID (nid, 'Tsoil'//str2, nvarid)
178      IF (ierr.NE.NF_NOERR) THEN
179         PRINT*, "phyetat0: Le champ <Tsoil"//str2//"> est absent"
180         PRINT*, "          Il prend donc la valeur de surface"
181         DO i=1, klon
182             tsoil(i,isoil)=tsol(i)
183         ENDDO
184      ELSE
185#ifdef NC_DOUBLE
186         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsoil(1,isoil))
187#else
188         ierr = NF_GET_VAR_REAL(nid, nvarid, tsoil(1,isoil))
189#endif
190         IF (ierr.NE.NF_NOERR) THEN
191            PRINT*, "Lecture echouee pour <Tsoil"//str2//">"
192            CALL abort
193         ENDIF
194      ENDIF
195      ENDDO
196c
197c Lecture de albedo au sol:
198c
199      ierr = NF_INQ_VARID (nid, "ALBE", nvarid)
200      IF (ierr.NE.NF_NOERR) THEN
201         PRINT*, 'phyetat0: Le champ <ALBE> est absent'
202         PRINT*, "phyetat0: Lecture echouee pour <ALBE>"
203         CALL abort
204      ELSE
205         PRINT*, 'phyetat0: Le champ <ALBE> est present'
206#ifdef NC_DOUBLE
207         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, albe(1))
208#else
209         ierr = NF_GET_VAR_REAL(nid, nvarid, albe(1))
210#endif
211         IF (ierr.NE.NF_NOERR) THEN
212            PRINT*, "phyetat0: Lecture echouee pour <ALBE>"
213            CALL abort
214         ENDIF
215         xmin = 1.0E+20
216         xmax = -1.0E+20
217         DO i = 1, klon
218            xmin = MIN(albe(i),xmin)
219            xmax = MAX(albe(i),xmax)
220         ENDDO
221         PRINT*,'Albedo du sol <ALBE>', xmin, xmax
222      ENDIF
223
224c
225c Lecture rayonnement solaire au sol:
226c
227      ierr = NF_INQ_VARID (nid, "solsw", nvarid)
228      IF (ierr.NE.NF_NOERR) THEN
229         PRINT*, 'phyetat0: Le champ <solsw> est absent'
230         PRINT*, 'mis a zero'
231         solsw = 0.
232      ELSE
233#ifdef NC_DOUBLE
234        ierr = NF_GET_VAR_DOUBLE(nid, nvarid, solsw)
235#else
236        ierr = NF_GET_VAR_REAL(nid, nvarid, solsw)
237#endif
238        IF (ierr.NE.NF_NOERR) THEN
239          PRINT*, 'phyetat0: Lecture echouee pour <solsw>'
240          CALL abort
241        ENDIF
242      ENDIF
243      xmin = 1.0E+20
244      xmax = -1.0E+20
245      DO i = 1, klon
246         xmin = MIN(solsw(i),xmin)
247         xmax = MAX(solsw(i),xmax)
248      ENDDO
249      PRINT*,'Rayonnement solaire au sol solsw:', xmin, xmax
250c
251c Lecture rayonnement IF au sol:
252c
253      ierr = NF_INQ_VARID (nid, "sollw", nvarid)
254      IF (ierr.NE.NF_NOERR) THEN
255         PRINT*, 'phyetat0: Le champ <sollw> est absent'
256         PRINT*, 'mis a zero'
257         sollw = 0.
258      ELSE
259#ifdef NC_DOUBLE
260        ierr = NF_GET_VAR_DOUBLE(nid, nvarid, sollw)
261#else
262        ierr = NF_GET_VAR_REAL(nid, nvarid, sollw)
263#endif
264        IF (ierr.NE.NF_NOERR) THEN
265          PRINT*, 'phyetat0: Lecture echouee pour <sollw>'
266          CALL abort
267        ENDIF
268      ENDIF
269      xmin = 1.0E+20
270      xmax = -1.0E+20
271      DO i = 1, klon
272         xmin = MIN(sollw(i),xmin)
273         xmax = MAX(sollw(i),xmax)
274      ENDDO
275      PRINT*,'Rayonnement IF au sol sollw:', xmin, xmax
276
277c
278c Lecture derive des flux:
279c
280      ierr = NF_INQ_VARID (nid, "fder", nvarid)
281      IF (ierr.NE.NF_NOERR) THEN
282         PRINT*, 'phyetat0: Le champ <fder> est absent'
283         PRINT*, 'mis a zero'
284         fder = 0.
285      ELSE
286#ifdef NC_DOUBLE
287        ierr = NF_GET_VAR_DOUBLE(nid, nvarid, fder)
288#else
289        ierr = NF_GET_VAR_REAL(nid, nvarid, fder)
290#endif
291        IF (ierr.NE.NF_NOERR) THEN
292          PRINT*, 'phyetat0: Lecture echouee pour <fder>'
293          CALL abort
294        ENDIF
295      ENDIF
296      xmin = 1.0E+20
297      xmax = -1.0E+20
298      DO i = 1, klon
299         xmin = MIN(fder(i),xmin)
300         xmax = MAX(fder(i),xmax)
301      ENDDO
302      PRINT*,'Derive des flux fder:', xmin, xmax
303
304c
305c Lecture du rayonnement net au sol:
306c
307      ierr = NF_INQ_VARID (nid, "RADS", nvarid)
308      IF (ierr.NE.NF_NOERR) THEN
309         PRINT*, 'phyetat0: Le champ <RADS> est absent'
310         CALL abort
311      ENDIF
312#ifdef NC_DOUBLE
313      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, radsol)
314#else
315      ierr = NF_GET_VAR_REAL(nid, nvarid, radsol)
316#endif
317      IF (ierr.NE.NF_NOERR) THEN
318         PRINT*, 'phyetat0: Lecture echouee pour <RADS>'
319         CALL abort
320      ENDIF
321      xmin = 1.0E+20
322      xmax = -1.0E+20
323      DO i = 1, klon
324         xmin = MIN(radsol(i),xmin)
325         xmax = MAX(radsol(i),xmax)
326      ENDDO
327      PRINT*,'Rayonnement net au sol radsol:', xmin, xmax
328c
329      ancien_ok = .TRUE.
330c
331      ierr = NF_INQ_VARID (nid, "TANCIEN", nvarid)
332      IF (ierr.NE.NF_NOERR) THEN
333         PRINT*, "phyetat0: Le champ <TANCIEN> est absent"
334         PRINT*, "Depart legerement fausse. Mais je continue"
335         ancien_ok = .FALSE.
336      ELSE
337#ifdef NC_DOUBLE
338         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, t_ancien)
339#else
340         ierr = NF_GET_VAR_REAL(nid, nvarid, t_ancien)
341#endif
342         IF (ierr.NE.NF_NOERR) THEN
343            PRINT*, "phyetat0: Lecture echouee pour <TANCIEN>"
344            CALL abort
345         ENDIF
346      ENDIF
[175]347c     Par defaut on cree 2 bandes de methane au pole Nord et au pole Sud
348c     (entre 75 et 85 degres de latitude) de 2 metres.
349c     Les poles sont sec !
350      resch4(1) = 0.    ! pole nord = 1 point
351      DO ig0=2,klon
352          if ((rlat(ig0).ge.75..and.rlat(ig0).le.85.).or.
353     &        (rlat(ig0).ge.-85.and.rlat(ig0).le.-75.)) then
354            resch4(ig0) = 2.
355          else
356            resch4(ig0) = 0.
357          endif
358      ENDDO
359      resch4(klon) = 0.   ! pole sud = 1 point
360
361      ierr = NF_INQ_VARID (nid, "RESCH4", nvarid)
362      IF (ierr.NE.NF_NOERR) THEN
363         PRINT*, "phyetat0: Le champ <RESCH4> est absent"
364         PRINT*, "Pas de reservoir de methane mais je continue..."
365         PRINT*, "Pour info, je met 2 metres de methane sur 2 bandes"
366         PRINT*, "comprises entre 75 et 85 degres de latitude dans  "
367         PRINT*, "chaque hemisphere."
368      ELSE
369#ifdef NC_DOUBLE
370         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, resch4)
371#else
372         ierr = NF_GET_VAR_REAL(nid, nvarid,resch4)
373#endif
374         IF (ierr.NE.NF_NOERR) THEN
375            PRINT*, "phyetat0: Lecture echouee pour <reservoir>"
376            CALL abort
377         ENDIF
378      ENDIF
[3]379c
380c Fermer le fichier:
381c
382      ierr = NF_CLOSE(nid)
383c
384      RETURN
385      END
Note: See TracBrowser for help on using the repository browser.