source: trunk/libf/phytitan/phyetat0.F @ 110

Last change on this file since 110 was 102, checked in by slebonnois, 14 years ago

SL : corrections et modifications dans phytitan correspondant a celles
faites apres compilation Venus. Titan pas encore compile.
File size: 9.0 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,
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======================================================================
16      use dimphy
17      IMPLICIT none
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
27      REAL rlat(klon), rlon(klon)
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
42      REAL xmin, xmax
43c
44      INTEGER nid, nvarid
45      INTEGER ierr, i, nsrf, isoil
46      INTEGER length
47      PARAMETER (length=100)
48      REAL tab_cntrl(length), tabcntr0(length)
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)
86
87      ENDIF
88
89      itau_phy = tab_cntrl(15)
90
91c
92c Lecture des latitudes (coordonnees):
93c
94      ierr = NF_INQ_VARID (nid, "latitude", nvarid)
95      IF (ierr.NE.NF_NOERR) THEN
96         PRINT*, 'phyetat0: Le champ <latitude> est absent'
97         CALL abort
98      ENDIF
99#ifdef NC_DOUBLE
100      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlat)
101#else
102      ierr = NF_GET_VAR_REAL(nid, nvarid, rlat)
103#endif
104      IF (ierr.NE.NF_NOERR) THEN
105         PRINT*, 'phyetat0: Lecture echouee pour <latitude>'
106         CALL abort
107      ENDIF
108c
109c Lecture des longitudes (coordonnees):
110c
111      ierr = NF_INQ_VARID (nid, "longitude", nvarid)
112      IF (ierr.NE.NF_NOERR) THEN
113         PRINT*, 'phyetat0: Le champ <longitude> est absent'
114         CALL abort
115      ENDIF
116#ifdef NC_DOUBLE
117      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlon)
118#else
119      ierr = NF_GET_VAR_REAL(nid, nvarid, rlon)
120#endif
121      IF (ierr.NE.NF_NOERR) THEN
122         PRINT*, 'phyetat0: Lecture echouee pour <latitude>'
123         CALL abort
124      ENDIF
125C
126c Lecture des temperatures du sol:
127c
128      ierr = NF_INQ_VARID (nid, "TS", nvarid)
129      IF (ierr.NE.NF_NOERR) THEN
130         PRINT*, 'phyetat0: Le champ <TS> est absent'
131         PRINT*, "phyetat0: Lecture echouee pour <TS>"
132         CALL abort
133      ELSE
134         PRINT*, 'phyetat0: Le champ <TS> est present'
135#ifdef NC_DOUBLE
136         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsol(1))
137#else
138         ierr = NF_GET_VAR_REAL(nid, nvarid, tsol(1))
139#endif
140         IF (ierr.NE.NF_NOERR) THEN
141            PRINT*, "phyetat0: Lecture echouee pour <TS>"
142            CALL abort
143         ENDIF
144         xmin = 1.0E+20
145         xmax = -1.0E+20
146         DO i = 1, klon
147            xmin = MIN(tsol(i),xmin)
148            xmax = MAX(tsol(i),xmax)
149         ENDDO
150         PRINT*,'Temperature du sol <TS>', xmin, xmax
151      ENDIF
152c
153c Lecture des temperatures du sol profond:
154c
155      DO isoil=1, nsoilmx
156      IF (isoil.GT.99) THEN
157         PRINT*, "Trop de couches"
158         CALL abort
159      ENDIF
160      WRITE(str2,'(i2.2)') isoil
161      ierr = NF_INQ_VARID (nid, 'Tsoil'//str2, nvarid)
162      IF (ierr.NE.NF_NOERR) THEN
163         PRINT*, "phyetat0: Le champ <Tsoil"//str2//"> est absent"
164         PRINT*, "          Il prend donc la valeur de surface"
165         DO i=1, klon
166             tsoil(i,isoil)=tsol(i)
167         ENDDO
168      ELSE
169#ifdef NC_DOUBLE
170         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsoil(1,isoil))
171#else
172         ierr = NF_GET_VAR_REAL(nid, nvarid, tsoil(1,isoil))
173#endif
174         IF (ierr.NE.NF_NOERR) THEN
175            PRINT*, "Lecture echouee pour <Tsoil"//str2//">"
176            CALL abort
177         ENDIF
178      ENDIF
179      ENDDO
180c
181c Lecture de albedo au sol:
182c
183      ierr = NF_INQ_VARID (nid, "ALBE", nvarid)
184      IF (ierr.NE.NF_NOERR) THEN
185         PRINT*, 'phyetat0: Le champ <ALBE> est absent'
186         PRINT*, "phyetat0: Lecture echouee pour <ALBE>"
187         CALL abort
188      ELSE
189         PRINT*, 'phyetat0: Le champ <ALBE> est present'
190#ifdef NC_DOUBLE
191         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, albe(1))
192#else
193         ierr = NF_GET_VAR_REAL(nid, nvarid, albe(1))
194#endif
195         IF (ierr.NE.NF_NOERR) THEN
196            PRINT*, "phyetat0: Lecture echouee pour <ALBE>"
197            CALL abort
198         ENDIF
199         xmin = 1.0E+20
200         xmax = -1.0E+20
201         DO i = 1, klon
202            xmin = MIN(albe(i),xmin)
203            xmax = MAX(albe(i),xmax)
204         ENDDO
205         PRINT*,'Albedo du sol <ALBE>', xmin, xmax
206      ENDIF
207
208c
209c Lecture rayonnement solaire au sol:
210c
211      ierr = NF_INQ_VARID (nid, "solsw", nvarid)
212      IF (ierr.NE.NF_NOERR) THEN
213         PRINT*, 'phyetat0: Le champ <solsw> est absent'
214         PRINT*, 'mis a zero'
215         solsw = 0.
216      ELSE
217#ifdef NC_DOUBLE
218        ierr = NF_GET_VAR_DOUBLE(nid, nvarid, solsw)
219#else
220        ierr = NF_GET_VAR_REAL(nid, nvarid, solsw)
221#endif
222        IF (ierr.NE.NF_NOERR) THEN
223          PRINT*, 'phyetat0: Lecture echouee pour <solsw>'
224          CALL abort
225        ENDIF
226      ENDIF
227      xmin = 1.0E+20
228      xmax = -1.0E+20
229      DO i = 1, klon
230         xmin = MIN(solsw(i),xmin)
231         xmax = MAX(solsw(i),xmax)
232      ENDDO
233      PRINT*,'Rayonnement solaire au sol solsw:', xmin, xmax
234c
235c Lecture rayonnement IF au sol:
236c
237      ierr = NF_INQ_VARID (nid, "sollw", nvarid)
238      IF (ierr.NE.NF_NOERR) THEN
239         PRINT*, 'phyetat0: Le champ <sollw> est absent'
240         PRINT*, 'mis a zero'
241         sollw = 0.
242      ELSE
243#ifdef NC_DOUBLE
244        ierr = NF_GET_VAR_DOUBLE(nid, nvarid, sollw)
245#else
246        ierr = NF_GET_VAR_REAL(nid, nvarid, sollw)
247#endif
248        IF (ierr.NE.NF_NOERR) THEN
249          PRINT*, 'phyetat0: Lecture echouee pour <sollw>'
250          CALL abort
251        ENDIF
252      ENDIF
253      xmin = 1.0E+20
254      xmax = -1.0E+20
255      DO i = 1, klon
256         xmin = MIN(sollw(i),xmin)
257         xmax = MAX(sollw(i),xmax)
258      ENDDO
259      PRINT*,'Rayonnement IF au sol sollw:', xmin, xmax
260
261c
262c Lecture derive des flux:
263c
264      ierr = NF_INQ_VARID (nid, "fder", nvarid)
265      IF (ierr.NE.NF_NOERR) THEN
266         PRINT*, 'phyetat0: Le champ <fder> est absent'
267         PRINT*, 'mis a zero'
268         fder = 0.
269      ELSE
270#ifdef NC_DOUBLE
271        ierr = NF_GET_VAR_DOUBLE(nid, nvarid, fder)
272#else
273        ierr = NF_GET_VAR_REAL(nid, nvarid, fder)
274#endif
275        IF (ierr.NE.NF_NOERR) THEN
276          PRINT*, 'phyetat0: Lecture echouee pour <fder>'
277          CALL abort
278        ENDIF
279      ENDIF
280      xmin = 1.0E+20
281      xmax = -1.0E+20
282      DO i = 1, klon
283         xmin = MIN(fder(i),xmin)
284         xmax = MAX(fder(i),xmax)
285      ENDDO
286      PRINT*,'Derive des flux fder:', xmin, xmax
287
288c
289c Lecture du rayonnement net au sol:
290c
291      ierr = NF_INQ_VARID (nid, "RADS", nvarid)
292      IF (ierr.NE.NF_NOERR) THEN
293         PRINT*, 'phyetat0: Le champ <RADS> est absent'
294         CALL abort
295      ENDIF
296#ifdef NC_DOUBLE
297      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, radsol)
298#else
299      ierr = NF_GET_VAR_REAL(nid, nvarid, radsol)
300#endif
301      IF (ierr.NE.NF_NOERR) THEN
302         PRINT*, 'phyetat0: Lecture echouee pour <RADS>'
303         CALL abort
304      ENDIF
305      xmin = 1.0E+20
306      xmax = -1.0E+20
307      DO i = 1, klon
308         xmin = MIN(radsol(i),xmin)
309         xmax = MAX(radsol(i),xmax)
310      ENDDO
311      PRINT*,'Rayonnement net au sol radsol:', xmin, xmax
312c
313      ancien_ok = .TRUE.
314c
315      ierr = NF_INQ_VARID (nid, "TANCIEN", nvarid)
316      IF (ierr.NE.NF_NOERR) THEN
317         PRINT*, "phyetat0: Le champ <TANCIEN> est absent"
318         PRINT*, "Depart legerement fausse. Mais je continue"
319         ancien_ok = .FALSE.
320      ELSE
321#ifdef NC_DOUBLE
322         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, t_ancien)
323#else
324         ierr = NF_GET_VAR_REAL(nid, nvarid, t_ancien)
325#endif
326         IF (ierr.NE.NF_NOERR) THEN
327            PRINT*, "phyetat0: Lecture echouee pour <TANCIEN>"
328            CALL abort
329         ENDIF
330      ENDIF
331c
332c Fermer le fichier:
333c
334      ierr = NF_CLOSE(nid)
335c
336      RETURN
337      END
Note: See TracBrowser for help on using the repository browser.