source: trunk/libf/phytitan/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: 11.0 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,
9     .           fder,radsol,clesphy0,
10     .           tabcntr0,
11     .           t_ancien,ancien_ok)
12      IMPLICIT none
13c======================================================================
14c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
15c Objet: Lecture de l'etat initial pour la physique
16c======================================================================
17#include "dimensions.h"
18#include "dimphy.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      INTEGER        longcles
43      PARAMETER    ( longcles = 20 )
44      REAL clesphy0( longcles )
45c
46      REAL xmin, xmax
47c
48      INTEGER nid, nvarid
49      INTEGER ierr, i, nsrf, isoil
50      INTEGER length
51      PARAMETER (length=100)
52      REAL tab_cntrl(length), tabcntr0(length)
53      CHARACTER*2 str2
54c
55c Ouvrir le fichier contenant l'etat initial:
56c
57      print*,'fichnom',fichnom
58      ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
59      IF (ierr.NE.NF_NOERR) THEN
60        write(6,*)' Pb d''ouverture du fichier '//fichnom
61        write(6,*)' ierr = ', ierr
62        CALL ABORT
63      ENDIF
64c
65c Lecture des parametres de controle:
66c
67      ierr = NF_INQ_VARID (nid, "controle", nvarid)
68      IF (ierr.NE.NF_NOERR) THEN
69         PRINT*, 'phyetat0: Le champ <controle> est absent'
70         CALL abort
71      ENDIF
72#ifdef NC_DOUBLE
73      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl)
74#else
75      ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
76#endif
77      IF (ierr.NE.NF_NOERR) THEN
78         PRINT*, 'phyetat0: Lecture echouee pour <controle>'
79         CALL abort
80      ELSE
81c
82         DO i = 1, length
83           tabcntr0( i ) = tab_cntrl( i )
84         ENDDO
85c
86         cycle_diurne   = .FALSE.
87         soil_model     = .FALSE.
88         new_oliq       = .FALSE.
89         ok_orodr       = .FALSE.
90         ok_orolf       = .FALSE.
91         ok_limitvrai   = .FALSE.
92
93
94         IF( clesphy0(1).NE.tab_cntrl( 5 ) )  THEN
95             tab_cntrl( 5 ) = clesphy0(1)
96         ENDIF
97
98         IF( clesphy0(2).NE.tab_cntrl( 6 ) )  THEN
99             tab_cntrl( 6 ) = clesphy0(2)
100         ENDIF
101
102         IF( clesphy0(3).NE.tab_cntrl( 7 ) )  THEN
103             tab_cntrl( 7 ) = clesphy0(3)
104         ENDIF
105
106         IF( clesphy0(4).NE.tab_cntrl( 8 ) )  THEN
107             tab_cntrl( 8 ) = clesphy0(4)
108         ENDIF
109
110         IF( clesphy0(5).NE.tab_cntrl( 9 ) )  THEN
111             tab_cntrl( 9 ) = clesphy0( 5 )
112         ENDIF
113
114         IF( clesphy0(6).NE.tab_cntrl( 10 ) )  THEN
115             tab_cntrl( 10 ) = clesphy0( 6 )
116         ENDIF
117
118         IF( clesphy0(7).NE.tab_cntrl( 11 ) )  THEN
119             tab_cntrl( 11 ) = clesphy0( 7 )
120         ENDIF
121
122         IF( clesphy0(8).NE.tab_cntrl( 12 ) )  THEN
123             tab_cntrl( 12 ) = clesphy0( 8 )
124         ENDIF
125
126         IF( clesphy0(9).NE.tab_cntrl( 16 ) )  THEN
127             tab_cntrl( 16 ) = clesphy0( 9 )
128         ENDIF
129
130
131         dtime        = tab_cntrl(1)
132         radpas       = tab_cntrl(2)
133         chimpas      = tab_cntrl(3)
134         iflag_con    = tab_cntrl(5)
135         nbapp_rad    = tab_cntrl(6)
136         nbapp_chim   = tab_cntrl(16)
137
138
139         cycle_diurne    = .FALSE.
140         soil_model      = .FALSE.
141         new_oliq        = .FALSE.
142         ok_orodr        = .FALSE.
143         ok_orolf        = .FALSE.
144         ok_limitvrai    = .FALSE.
145
146         IF( tab_cntrl( 7) .EQ. 1. )    cycle_diurne  = .TRUE.
147         IF( tab_cntrl( 8) .EQ. 1. )       soil_model = .TRUE.
148         IF( tab_cntrl( 9) .EQ. 1. )         new_oliq = .TRUE.
149         IF( tab_cntrl(10) .EQ. 1. )         ok_orodr = .TRUE.
150         IF( tab_cntrl(11) .EQ. 1. )         ok_orolf = .TRUE.
151         IF( tab_cntrl(12) .EQ. 1. )     ok_limitvrai = .TRUE.
152
153      ENDIF
154
155      itau_phy = tab_cntrl(15)
156
157c
158c Lecture des latitudes (coordonnees):
159c
160      ierr = NF_INQ_VARID (nid, "latitude", nvarid)
161      IF (ierr.NE.NF_NOERR) THEN
162         PRINT*, 'phyetat0: Le champ <latitude> est absent'
163         CALL abort
164      ENDIF
165#ifdef NC_DOUBLE
166      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlat)
167#else
168      ierr = NF_GET_VAR_REAL(nid, nvarid, rlat)
169#endif
170      IF (ierr.NE.NF_NOERR) THEN
171         PRINT*, 'phyetat0: Lecture echouee pour <latitude>'
172         CALL abort
173      ENDIF
174c
175c Lecture des longitudes (coordonnees):
176c
177      ierr = NF_INQ_VARID (nid, "longitude", nvarid)
178      IF (ierr.NE.NF_NOERR) THEN
179         PRINT*, 'phyetat0: Le champ <longitude> est absent'
180         CALL abort
181      ENDIF
182#ifdef NC_DOUBLE
183      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlon)
184#else
185      ierr = NF_GET_VAR_REAL(nid, nvarid, rlon)
186#endif
187      IF (ierr.NE.NF_NOERR) THEN
188         PRINT*, 'phyetat0: Lecture echouee pour <latitude>'
189         CALL abort
190      ENDIF
191C
192c Lecture des temperatures du sol:
193c
194      ierr = NF_INQ_VARID (nid, "TS", nvarid)
195      IF (ierr.NE.NF_NOERR) THEN
196         PRINT*, 'phyetat0: Le champ <TS> est absent'
197         PRINT*, "phyetat0: Lecture echouee pour <TS>"
198         CALL abort
199      ELSE
200         PRINT*, 'phyetat0: Le champ <TS> est present'
201#ifdef NC_DOUBLE
202         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsol(1))
203#else
204         ierr = NF_GET_VAR_REAL(nid, nvarid, tsol(1))
205#endif
206         IF (ierr.NE.NF_NOERR) THEN
207            PRINT*, "phyetat0: Lecture echouee pour <TS>"
208            CALL abort
209         ENDIF
210         xmin = 1.0E+20
211         xmax = -1.0E+20
212         DO i = 1, klon
213            xmin = MIN(tsol(i),xmin)
214            xmax = MAX(tsol(i),xmax)
215         ENDDO
216         PRINT*,'Temperature du sol <TS>', xmin, xmax
217      ENDIF
218c
219c Lecture des temperatures du sol profond:
220c
221      DO isoil=1, nsoilmx
222      IF (isoil.GT.99) THEN
223         PRINT*, "Trop de couches"
224         CALL abort
225      ENDIF
226      WRITE(str2,'(i2.2)') isoil
227      ierr = NF_INQ_VARID (nid, 'Tsoil'//str2, nvarid)
228      IF (ierr.NE.NF_NOERR) THEN
229         PRINT*, "phyetat0: Le champ <Tsoil"//str2//"> est absent"
230         PRINT*, "          Il prend donc la valeur de surface"
231         DO i=1, klon
232             tsoil(i,isoil)=tsol(i)
233         ENDDO
234      ELSE
235#ifdef NC_DOUBLE
236         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsoil(1,isoil))
237#else
238         ierr = NF_GET_VAR_REAL(nid, nvarid, tsoil(1,isoil))
239#endif
240         IF (ierr.NE.NF_NOERR) THEN
241            PRINT*, "Lecture echouee pour <Tsoil"//str2//">"
242            CALL abort
243         ENDIF
244      ENDIF
245      ENDDO
246c
247c Lecture de albedo au sol:
248c
249      ierr = NF_INQ_VARID (nid, "ALBE", nvarid)
250      IF (ierr.NE.NF_NOERR) THEN
251         PRINT*, 'phyetat0: Le champ <ALBE> est absent'
252         PRINT*, "phyetat0: Lecture echouee pour <ALBE>"
253         CALL abort
254      ELSE
255         PRINT*, 'phyetat0: Le champ <ALBE> est present'
256#ifdef NC_DOUBLE
257         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, albe(1))
258#else
259         ierr = NF_GET_VAR_REAL(nid, nvarid, albe(1))
260#endif
261         IF (ierr.NE.NF_NOERR) THEN
262            PRINT*, "phyetat0: Lecture echouee pour <ALBE>"
263            CALL abort
264         ENDIF
265         xmin = 1.0E+20
266         xmax = -1.0E+20
267         DO i = 1, klon
268            xmin = MIN(albe(i),xmin)
269            xmax = MAX(albe(i),xmax)
270         ENDDO
271         PRINT*,'Albedo du sol <ALBE>', xmin, xmax
272      ENDIF
273
274c
275c Lecture rayonnement solaire au sol:
276c
277      ierr = NF_INQ_VARID (nid, "solsw", nvarid)
278      IF (ierr.NE.NF_NOERR) THEN
279         PRINT*, 'phyetat0: Le champ <solsw> est absent'
280         PRINT*, 'mis a zero'
281         solsw = 0.
282      ELSE
283#ifdef NC_DOUBLE
284        ierr = NF_GET_VAR_DOUBLE(nid, nvarid, solsw)
285#else
286        ierr = NF_GET_VAR_REAL(nid, nvarid, solsw)
287#endif
288        IF (ierr.NE.NF_NOERR) THEN
289          PRINT*, 'phyetat0: Lecture echouee pour <solsw>'
290          CALL abort
291        ENDIF
292      ENDIF
293      xmin = 1.0E+20
294      xmax = -1.0E+20
295      DO i = 1, klon
296         xmin = MIN(solsw(i),xmin)
297         xmax = MAX(solsw(i),xmax)
298      ENDDO
299      PRINT*,'Rayonnement solaire au sol solsw:', xmin, xmax
300c
301c Lecture rayonnement IF au sol:
302c
303      ierr = NF_INQ_VARID (nid, "sollw", nvarid)
304      IF (ierr.NE.NF_NOERR) THEN
305         PRINT*, 'phyetat0: Le champ <sollw> est absent'
306         PRINT*, 'mis a zero'
307         sollw = 0.
308      ELSE
309#ifdef NC_DOUBLE
310        ierr = NF_GET_VAR_DOUBLE(nid, nvarid, sollw)
311#else
312        ierr = NF_GET_VAR_REAL(nid, nvarid, sollw)
313#endif
314        IF (ierr.NE.NF_NOERR) THEN
315          PRINT*, 'phyetat0: Lecture echouee pour <sollw>'
316          CALL abort
317        ENDIF
318      ENDIF
319      xmin = 1.0E+20
320      xmax = -1.0E+20
321      DO i = 1, klon
322         xmin = MIN(sollw(i),xmin)
323         xmax = MAX(sollw(i),xmax)
324      ENDDO
325      PRINT*,'Rayonnement IF au sol sollw:', xmin, xmax
326
327c
328c Lecture derive des flux:
329c
330      ierr = NF_INQ_VARID (nid, "fder", nvarid)
331      IF (ierr.NE.NF_NOERR) THEN
332         PRINT*, 'phyetat0: Le champ <fder> est absent'
333         PRINT*, 'mis a zero'
334         fder = 0.
335      ELSE
336#ifdef NC_DOUBLE
337        ierr = NF_GET_VAR_DOUBLE(nid, nvarid, fder)
338#else
339        ierr = NF_GET_VAR_REAL(nid, nvarid, fder)
340#endif
341        IF (ierr.NE.NF_NOERR) THEN
342          PRINT*, 'phyetat0: Lecture echouee pour <fder>'
343          CALL abort
344        ENDIF
345      ENDIF
346      xmin = 1.0E+20
347      xmax = -1.0E+20
348      DO i = 1, klon
349         xmin = MIN(fder(i),xmin)
350         xmax = MAX(fder(i),xmax)
351      ENDDO
352      PRINT*,'Derive des flux fder:', xmin, xmax
353
354c
355c Lecture du rayonnement net au sol:
356c
357      ierr = NF_INQ_VARID (nid, "RADS", nvarid)
358      IF (ierr.NE.NF_NOERR) THEN
359         PRINT*, 'phyetat0: Le champ <RADS> est absent'
360         CALL abort
361      ENDIF
362#ifdef NC_DOUBLE
363      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, radsol)
364#else
365      ierr = NF_GET_VAR_REAL(nid, nvarid, radsol)
366#endif
367      IF (ierr.NE.NF_NOERR) THEN
368         PRINT*, 'phyetat0: Lecture echouee pour <RADS>'
369         CALL abort
370      ENDIF
371      xmin = 1.0E+20
372      xmax = -1.0E+20
373      DO i = 1, klon
374         xmin = MIN(radsol(i),xmin)
375         xmax = MAX(radsol(i),xmax)
376      ENDDO
377      PRINT*,'Rayonnement net au sol radsol:', xmin, xmax
378c
379      ancien_ok = .TRUE.
380c
381      ierr = NF_INQ_VARID (nid, "TANCIEN", nvarid)
382      IF (ierr.NE.NF_NOERR) THEN
383         PRINT*, "phyetat0: Le champ <TANCIEN> est absent"
384         PRINT*, "Depart legerement fausse. Mais je continue"
385         ancien_ok = .FALSE.
386      ELSE
387#ifdef NC_DOUBLE
388         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, t_ancien)
389#else
390         ierr = NF_GET_VAR_REAL(nid, nvarid, t_ancien)
391#endif
392         IF (ierr.NE.NF_NOERR) THEN
393            PRINT*, "phyetat0: Lecture echouee pour <TANCIEN>"
394            CALL abort
395         ENDIF
396      ENDIF
397c
398c Fermer le fichier:
399c
400      ierr = NF_CLOSE(nid)
401c
402      RETURN
403      END
Note: See TracBrowser for help on using the repository browser.