source: LMDZ4/trunk/libf/dyn3d/dynetat0.F @ 2281

Last change on this file since 2281 was 1421, checked in by jghattas, 14 years ago
  • Fixed problems with pseudo-vapor tracers.
  • Removed variable nseuil. The transport with convection can be desactivated with the variable conv_flg instead of nseuil.
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 10.8 KB
RevLine 
[524]1!
[1403]2! $Id $
[524]3!
[1146]4      SUBROUTINE dynetat0(fichnom,vcov,ucov,
[524]5     .                    teta,q,masse,ps,phis,time)
[1146]6
7      USE infotrac
[524]8      IMPLICIT NONE
9
10c=======================================================================
11c
12c   Auteur:  P. Le Van / L.Fairhead
13c   -------
14c
15c   objet:
16c   ------
17c
18c   Lecture de l'etat initial
19c
20c=======================================================================
21c-----------------------------------------------------------------------
22c   Declarations:
23c   -------------
24
25#include "dimensions.h"
26#include "paramet.h"
27#include "temps.h"
28#include "comconst.h"
29#include "comvert.h"
30#include "comgeom.h"
31#include "ener.h"
32#include "netcdf.inc"
33#include "description.h"
34#include "serre.h"
35#include "logic.h"
[1403]36#include "iniprint.h"
[524]37
38c   Arguments:
39c   ----------
40
41      CHARACTER*(*) fichnom
42      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm)
[1146]43      REAL q(ip1jmp1,llm,nqtot),masse(ip1jmp1,llm)
[524]44      REAL ps(ip1jmp1),phis(ip1jmp1)
45
46      REAL time
47
48c   Variables
49c
50      INTEGER length,iq
51      PARAMETER (length = 100)
52      REAL tab_cntrl(length) ! tableau des parametres du run
53      INTEGER ierr, nid, nvarid
54
55c-----------------------------------------------------------------------
56
57c  Ouverture NetCDF du fichier etat initial
58
59      ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
60      IF (ierr.NE.NF_NOERR) THEN
[1403]61        write(lunout,*)'dynetat0: Pb d''ouverture du fichier start.nc'
62        write(lunout,*)' ierr = ', ierr
[524]63        CALL ABORT
64      ENDIF
65
66c
67      ierr = NF_INQ_VARID (nid, "controle", nvarid)
68      IF (ierr .NE. NF_NOERR) THEN
[1403]69         write(lunout,*)"dynetat0: Le champ <controle> est absent"
[524]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
[1403]78         write(lunout,*)"dynetat0: Lecture echoue pour <controle>"
[524]79         CALL abort
80      ENDIF
81
82      im         = tab_cntrl(1)
83      jm         = tab_cntrl(2)
84      lllm       = tab_cntrl(3)
85      day_ref    = tab_cntrl(4)
86      annee_ref  = tab_cntrl(5)
87      rad        = tab_cntrl(6)
88      omeg       = tab_cntrl(7)
89      g          = tab_cntrl(8)
90      cpp        = tab_cntrl(9)
91      kappa      = tab_cntrl(10)
92      daysec     = tab_cntrl(11)
93      dtvr       = tab_cntrl(12)
94      etot0      = tab_cntrl(13)
95      ptot0      = tab_cntrl(14)
96      ztot0      = tab_cntrl(15)
97      stot0      = tab_cntrl(16)
98      ang0       = tab_cntrl(17)
99      pa         = tab_cntrl(18)
100      preff      = tab_cntrl(19)
101c
102      clon       = tab_cntrl(20)
103      clat       = tab_cntrl(21)
104      grossismx  = tab_cntrl(22)
105      grossismy  = tab_cntrl(23)
106c
107      IF ( tab_cntrl(24).EQ.1. )  THEN
108        fxyhypb  = . TRUE .
[541]109c        dzoomx   = tab_cntrl(25)
110c        dzoomy   = tab_cntrl(26)
111c        taux     = tab_cntrl(28)
112c        tauy     = tab_cntrl(29)
[524]113      ELSE
114        fxyhypb = . FALSE .
115        ysinus  = . FALSE .
116        IF( tab_cntrl(27).EQ.1. ) ysinus = . TRUE.
117      ENDIF
118
119      day_ini = tab_cntrl(30)
120      itau_dyn = tab_cntrl(31)
121c   .................................................................
122c
123c
[1403]124      write(lunout,*)'dynetat0: rad,omeg,g,cpp,kappa',
125     &               rad,omeg,g,cpp,kappa
[524]126
127      IF(   im.ne.iim           )  THEN
128          PRINT 1,im,iim
129          STOP
130      ELSE  IF( jm.ne.jjm       )  THEN
131          PRINT 2,jm,jjm
132          STOP
133      ELSE  IF( lllm.ne.llm     )  THEN
134          PRINT 3,lllm,llm
135          STOP
136      ENDIF
137
138      ierr = NF_INQ_VARID (nid, "rlonu", nvarid)
139      IF (ierr .NE. NF_NOERR) THEN
[1403]140         write(lunout,*)"dynetat0: Le champ <rlonu> est absent"
[524]141         CALL abort
142      ENDIF
143#ifdef NC_DOUBLE
144      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonu)
145#else
146      ierr = NF_GET_VAR_REAL(nid, nvarid, rlonu)
147#endif
148      IF (ierr .NE. NF_NOERR) THEN
[1403]149         write(lunout,*)"dynetat0: Lecture echouee pour <rlonu>"
[524]150         CALL abort
151      ENDIF
152
153      ierr = NF_INQ_VARID (nid, "rlatu", nvarid)
154      IF (ierr .NE. NF_NOERR) THEN
[1403]155         write(lunout,*)"dynetat0: Le champ <rlatu> est absent"
[524]156         CALL abort
157      ENDIF
158#ifdef NC_DOUBLE
159      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatu)
160#else
161      ierr = NF_GET_VAR_REAL(nid, nvarid, rlatu)
162#endif
163      IF (ierr .NE. NF_NOERR) THEN
[1403]164         write(lunout,*)"dynetat0: Lecture echouee pour <rlatu>"
[524]165         CALL abort
166      ENDIF
167
168      ierr = NF_INQ_VARID (nid, "rlonv", nvarid)
169      IF (ierr .NE. NF_NOERR) THEN
[1403]170         write(lunout,*)"dynetat0: Le champ <rlonv> est absent"
[524]171         CALL abort
172      ENDIF
173#ifdef NC_DOUBLE
174      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonv)
175#else
176      ierr = NF_GET_VAR_REAL(nid, nvarid, rlonv)
177#endif
178      IF (ierr .NE. NF_NOERR) THEN
[1403]179         write(lunout,*)"dynetat0: Lecture echouee pour <rlonv>"
[524]180         CALL abort
181      ENDIF
182
183      ierr = NF_INQ_VARID (nid, "rlatv", nvarid)
184      IF (ierr .NE. NF_NOERR) THEN
[1403]185         write(lunout,*)"dynetat0: Le champ <rlatv> est absent"
[524]186         CALL abort
187      ENDIF
188#ifdef NC_DOUBLE
189      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatv)
190#else
191      ierr = NF_GET_VAR_REAL(nid, nvarid, rlatv)
192#endif
193      IF (ierr .NE. NF_NOERR) THEN
[1403]194         write(lunout,*)"dynetat0: Lecture echouee pour rlatv"
[524]195         CALL abort
196      ENDIF
197
198      ierr = NF_INQ_VARID (nid, "cu", nvarid)
199      IF (ierr .NE. NF_NOERR) THEN
[1403]200         write(lunout,*)"dynetat0: Le champ <cu> est absent"
[524]201         CALL abort
202      ENDIF
203#ifdef NC_DOUBLE
204      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, cu)
205#else
206      ierr = NF_GET_VAR_REAL(nid, nvarid, cu)
207#endif
208      IF (ierr .NE. NF_NOERR) THEN
[1403]209         write(lunout,*)"dynetat0: Lecture echouee pour <cu>"
[524]210         CALL abort
211      ENDIF
212
213      ierr = NF_INQ_VARID (nid, "cv", nvarid)
214      IF (ierr .NE. NF_NOERR) THEN
[1403]215         write(lunout,*)"dynetat0: Le champ <cv> est absent"
[524]216         CALL abort
217      ENDIF
218#ifdef NC_DOUBLE
219      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, cv)
220#else
221      ierr = NF_GET_VAR_REAL(nid, nvarid, cv)
222#endif
223      IF (ierr .NE. NF_NOERR) THEN
[1403]224         write(lunout,*)"dynetat0: Lecture echouee pour <cv>"
[524]225         CALL abort
226      ENDIF
227
228      ierr = NF_INQ_VARID (nid, "aire", nvarid)
229      IF (ierr .NE. NF_NOERR) THEN
[1403]230         write(lunout,*)"dynetat0: Le champ <aire> est absent"
[524]231         CALL abort
232      ENDIF
233#ifdef NC_DOUBLE
234      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, aire)
235#else
236      ierr = NF_GET_VAR_REAL(nid, nvarid, aire)
237#endif
238      IF (ierr .NE. NF_NOERR) THEN
[1403]239         write(lunout,*)"dynetat0: Lecture echouee pour <aire>"
[524]240         CALL abort
241      ENDIF
242
243      ierr = NF_INQ_VARID (nid, "phisinit", nvarid)
244      IF (ierr .NE. NF_NOERR) THEN
[1403]245         write(lunout,*)"dynetat0: Le champ <phisinit> est absent"
[524]246         CALL abort
247      ENDIF
248#ifdef NC_DOUBLE
249      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, phis)
250#else
251      ierr = NF_GET_VAR_REAL(nid, nvarid, phis)
252#endif
253      IF (ierr .NE. NF_NOERR) THEN
[1403]254         write(lunout,*)"dynetat0: Lecture echouee pour <phisinit>"
[524]255         CALL abort
256      ENDIF
257
258      ierr = NF_INQ_VARID (nid, "temps", nvarid)
259      IF (ierr .NE. NF_NOERR) THEN
[1403]260         write(lunout,*)"dynetat0: Le champ <temps> est absent"
[524]261         CALL abort
262      ENDIF
263#ifdef NC_DOUBLE
264      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, time)
265#else
266      ierr = NF_GET_VAR_REAL(nid, nvarid, time)
267#endif
268      IF (ierr .NE. NF_NOERR) THEN
[1403]269         write(lunout,*)"dynetat0: Lecture echouee <temps>"
[524]270         CALL abort
271      ENDIF
272
273      ierr = NF_INQ_VARID (nid, "ucov", nvarid)
274      IF (ierr .NE. NF_NOERR) THEN
[1403]275         write(lunout,*)"dynetat0: Le champ <ucov> est absent"
[524]276         CALL abort
277      ENDIF
278#ifdef NC_DOUBLE
279      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, ucov)
280#else
281      ierr = NF_GET_VAR_REAL(nid, nvarid, ucov)
282#endif
283      IF (ierr .NE. NF_NOERR) THEN
[1403]284         write(lunout,*)"dynetat0: Lecture echouee pour <ucov>"
[524]285         CALL abort
286      ENDIF
287 
288      ierr = NF_INQ_VARID (nid, "vcov", nvarid)
289      IF (ierr .NE. NF_NOERR) THEN
[1403]290         write(lunout,*)"dynetat0: Le champ <vcov> est absent"
[524]291         CALL abort
292      ENDIF
293#ifdef NC_DOUBLE
294      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, vcov)
295#else
296      ierr = NF_GET_VAR_REAL(nid, nvarid, vcov)
297#endif
298      IF (ierr .NE. NF_NOERR) THEN
[1403]299         write(lunout,*)"dynetat0: Lecture echouee pour <vcov>"
[524]300         CALL abort
301      ENDIF
302
303      ierr = NF_INQ_VARID (nid, "teta", nvarid)
304      IF (ierr .NE. NF_NOERR) THEN
[1403]305         write(lunout,*)"dynetat0: Le champ <teta> est absent"
[524]306         CALL abort
307      ENDIF
308#ifdef NC_DOUBLE
309      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, teta)
310#else
311      ierr = NF_GET_VAR_REAL(nid, nvarid, teta)
312#endif
313      IF (ierr .NE. NF_NOERR) THEN
[1403]314         write(lunout,*)"dynetat0: Lecture echouee pour <teta>"
[524]315         CALL abort
316      ENDIF
317
318
[1146]319      IF(nqtot.GE.1) THEN
320      DO iq=1,nqtot
[524]321        ierr =  NF_INQ_VARID (nid, tname(iq), nvarid)
322        IF (ierr .NE. NF_NOERR) THEN
[1421]323           write(lunout,*)"dynetat0: Le traceur <"//trim(tname(iq))//
[1403]324     &                    "> est absent"
325           write(lunout,*)"          Il est donc initialise a zero"
[524]326           q(:,:,iq)=0.
327        ELSE
328#ifdef NC_DOUBLE
329          ierr = NF_GET_VAR_DOUBLE(nid, nvarid, q(1,1,iq))
330#else
331          ierr = NF_GET_VAR_REAL(nid, nvarid, q(1,1,iq))
332#endif
333          IF (ierr .NE. NF_NOERR) THEN
[1403]334            write(lunout,*)"dynetat0: Lecture echouee pour "//tname(iq)
335            CALL abort
[524]336          ENDIF
337        ENDIF
338      ENDDO
339      ENDIF
340
341      ierr = NF_INQ_VARID (nid, "masse", nvarid)
342      IF (ierr .NE. NF_NOERR) THEN
[1403]343         write(lunout,*)"dynetat0: Le champ <masse> est absent"
[524]344         CALL abort
345      ENDIF
346#ifdef NC_DOUBLE
347      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, masse)
348#else
349      ierr = NF_GET_VAR_REAL(nid, nvarid, masse)
350#endif
351      IF (ierr .NE. NF_NOERR) THEN
[1403]352         write(lunout,*)"dynetat0: Lecture echouee pour <masse>"
[524]353         CALL abort
354      ENDIF
355
356      ierr = NF_INQ_VARID (nid, "ps", nvarid)
357      IF (ierr .NE. NF_NOERR) THEN
[1403]358         write(lunout,*)"dynetat0: Le champ <ps> est absent"
[524]359         CALL abort
360      ENDIF
361#ifdef NC_DOUBLE
362      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, ps)
363#else
364      ierr = NF_GET_VAR_REAL(nid, nvarid, ps)
365#endif
366      IF (ierr .NE. NF_NOERR) THEN
[1403]367         write(lunout,*)"dynetat0: Lecture echouee pour <ps>"
[524]368         CALL abort
369      ENDIF
370
371      ierr = NF_CLOSE(nid)
372
373       day_ini=day_ini+INT(time)
374       time=time-INT(time)
375
376  1   FORMAT(//10x,'la valeur de im =',i4,2x,'lue sur le fichier de dem
377     *arrage est differente de la valeur parametree iim =',i4//)
378   2  FORMAT(//10x,'la valeur de jm =',i4,2x,'lue sur le fichier de dem
379     *arrage est differente de la valeur parametree jjm =',i4//)
380   3  FORMAT(//10x,'la valeur de lmax =',i4,2x,'lue sur le fichier dema
381     *rrage est differente de la valeur parametree llm =',i4//)
382   4  FORMAT(//10x,'la valeur de dtrv =',i4,2x,'lue sur le fichier dema
383     *rrage est differente de la valeur  dtinteg =',i4//)
384
385      RETURN
386      END
Note: See TracBrowser for help on using the repository browser.