source: LMDZ5/branches/AI-cosp/libf/dyn3dpar/dynetat0.F @ 5429

Last change on this file since 5429 was 1930, checked in by lguez, 11 years ago

abort, dfloat and pause are not in the Fortran standard. Replaced
abort by abort_gcm and dfloat by dble. Note: I modified dyn3dpar files
that were identical to dyn3d modified files.
  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 11.1 KB
Line 
1!
2! $Id $
3!
4      SUBROUTINE dynetat0(fichnom,vcov,ucov,
5     .                    teta,q,masse,ps,phis,time)
6
7      USE infotrac
8      use netcdf, only: nf90_get_var
9
10      use control_mod, only : planet_type
11
12      IMPLICIT NONE
13
14c=======================================================================
15c
16c   Auteur:  P. Le Van / L.Fairhead
17c   -------
18c
19c   objet:
20c   ------
21c
22c   Lecture de l'etat initial
23c
24c=======================================================================
25c-----------------------------------------------------------------------
26c   Declarations:
27c   -------------
28
29#include "dimensions.h"
30#include "paramet.h"
31#include "temps.h"
32#include "comconst.h"
33#include "comvert.h"
34#include "comgeom2.h"
35#include "ener.h"
36#include "netcdf.inc"
37#include "description.h"
38#include "serre.h"
39#include "logic.h"
40#include "iniprint.h"
41
42c   Arguments:
43c   ----------
44
45      CHARACTER*(*) fichnom
46      REAL vcov(iip1, jjm,llm),ucov(iip1, jjp1,llm),teta(iip1, jjp1,llm)
47      REAL q(iip1,jjp1,llm,nqtot),masse(iip1, jjp1,llm)
48      REAL ps(iip1, jjp1),phis(iip1, jjp1)
49
50      REAL time
51
52c   Variables
53c
54      INTEGER length,iq
55      PARAMETER (length = 100)
56      REAL tab_cntrl(length) ! tableau des parametres du run
57      INTEGER ierr, nid, nvarid
58
59      INTEGER idecal
60
61c-----------------------------------------------------------------------
62
63c  Ouverture NetCDF du fichier etat initial
64
65      ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
66      IF (ierr.NE.NF_NOERR) THEN
67        write(lunout,*)'dynetat0: Pb d''ouverture du fichier start.nc'
68        write(lunout,*)' ierr = ', ierr
69        CALL ABORT_gcm("dynetat0", "", 1)
70      ENDIF
71
72c
73      ierr = NF_INQ_VARID (nid, "controle", nvarid)
74      IF (ierr .NE. NF_NOERR) THEN
75         write(lunout,*)"dynetat0: Le champ <controle> est absent"
76         CALL ABORT_gcm("dynetat0", "", 1)
77      ENDIF
78      ierr = nf90_get_var(nid, nvarid, tab_cntrl)
79      IF (ierr .NE. NF_NOERR) THEN
80         write(lunout,*)"dynetat0: Lecture echoue pour <controle>"
81         CALL ABORT_gcm("dynetat0", "", 1)
82      ENDIF
83
84      !!! AS: idecal is a hack to be able to read planeto starts...
85      !!!     .... while keeping everything OK for LMDZ EARTH
86      if (planet_type.eq."generic") then
87          print*,'NOTE NOTE NOTE : Planeto-like start files'
88          idecal = 4
89          annee_ref  = 2000
90      else
91          print*,'NOTE NOTE NOTE : Earth-like start files'
92          idecal = 5
93          annee_ref  = tab_cntrl(5)
94      endif
95
96
97      im         = tab_cntrl(1)
98      jm         = tab_cntrl(2)
99      lllm       = tab_cntrl(3)
100      day_ref    = tab_cntrl(4)
101      rad        = tab_cntrl(idecal+1)
102      omeg       = tab_cntrl(idecal+2)
103      g          = tab_cntrl(idecal+3)
104      cpp        = tab_cntrl(idecal+4)
105      kappa      = tab_cntrl(idecal+5)
106      daysec     = tab_cntrl(idecal+6)
107      dtvr       = tab_cntrl(idecal+7)
108      etot0      = tab_cntrl(idecal+8)
109      ptot0      = tab_cntrl(idecal+9)
110      ztot0      = tab_cntrl(idecal+10)
111      stot0      = tab_cntrl(idecal+11)
112      ang0       = tab_cntrl(idecal+12)
113      pa         = tab_cntrl(idecal+13)
114      preff      = tab_cntrl(idecal+14)
115c
116      clon       = tab_cntrl(idecal+15)
117      clat       = tab_cntrl(idecal+16)
118      grossismx  = tab_cntrl(idecal+17)
119      grossismy  = tab_cntrl(idecal+18)
120c
121      IF ( tab_cntrl(idecal+19).EQ.1. )  THEN
122        fxyhypb  = . TRUE .
123c        dzoomx   = tab_cntrl(25)
124c        dzoomy   = tab_cntrl(26)
125c        taux     = tab_cntrl(28)
126c        tauy     = tab_cntrl(29)
127      ELSE
128        fxyhypb = . FALSE .
129        ysinus  = . FALSE .
130        IF( tab_cntrl(idecal+22).EQ.1. ) ysinus = . TRUE.
131      ENDIF
132
133      day_ini = tab_cntrl(30)
134      itau_dyn = tab_cntrl(31)
135      start_time = tab_cntrl(32)
136c   .................................................................
137c
138c
139      write(lunout,*)'dynetat0: rad,omeg,g,cpp,kappa',
140     &               rad,omeg,g,cpp,kappa
141
142      IF(   im.ne.iim           )  THEN
143          PRINT 1,im,iim
144          STOP
145      ELSE  IF( jm.ne.jjm       )  THEN
146          PRINT 2,jm,jjm
147          STOP
148      ELSE  IF( lllm.ne.llm     )  THEN
149          PRINT 3,lllm,llm
150          STOP
151      ENDIF
152
153      ierr = NF_INQ_VARID (nid, "rlonu", nvarid)
154      IF (ierr .NE. NF_NOERR) THEN
155         write(lunout,*)"dynetat0: Le champ <rlonu> est absent"
156         CALL ABORT_gcm("dynetat0", "", 1)
157      ENDIF
158      ierr = nf90_get_var(nid, nvarid, rlonu)
159      IF (ierr .NE. NF_NOERR) THEN
160         write(lunout,*)"dynetat0: Lecture echouee pour <rlonu>"
161         CALL ABORT_gcm("dynetat0", "", 1)
162      ENDIF
163
164      ierr = NF_INQ_VARID (nid, "rlatu", nvarid)
165      IF (ierr .NE. NF_NOERR) THEN
166         write(lunout,*)"dynetat0: Le champ <rlatu> est absent"
167         CALL ABORT_gcm("dynetat0", "", 1)
168      ENDIF
169      ierr = nf90_get_var(nid, nvarid, rlatu)
170      IF (ierr .NE. NF_NOERR) THEN
171         write(lunout,*)"dynetat0: Lecture echouee pour <rlatu>"
172         CALL ABORT_gcm("dynetat0", "", 1)
173      ENDIF
174
175      ierr = NF_INQ_VARID (nid, "rlonv", nvarid)
176      IF (ierr .NE. NF_NOERR) THEN
177         write(lunout,*)"dynetat0: Le champ <rlonv> est absent"
178         CALL ABORT_gcm("dynetat0", "", 1)
179      ENDIF
180      ierr = nf90_get_var(nid, nvarid, rlonv)
181      IF (ierr .NE. NF_NOERR) THEN
182         write(lunout,*)"dynetat0: Lecture echouee pour <rlonv>"
183         CALL ABORT_gcm("dynetat0", "", 1)
184      ENDIF
185
186      ierr = NF_INQ_VARID (nid, "rlatv", nvarid)
187      IF (ierr .NE. NF_NOERR) THEN
188         write(lunout,*)"dynetat0: Le champ <rlatv> est absent"
189         CALL ABORT_gcm("dynetat0", "", 1)
190      ENDIF
191      ierr = nf90_get_var(nid, nvarid, rlatv)
192      IF (ierr .NE. NF_NOERR) THEN
193         write(lunout,*)"dynetat0: Lecture echouee pour rlatv"
194         CALL ABORT_gcm("dynetat0", "", 1)
195      ENDIF
196
197      ierr = NF_INQ_VARID (nid, "cu", nvarid)
198      IF (ierr .NE. NF_NOERR) THEN
199         write(lunout,*)"dynetat0: Le champ <cu> est absent"
200         CALL ABORT_gcm("dynetat0", "", 1)
201      ENDIF
202      ierr = nf90_get_var(nid, nvarid, cu)
203      IF (ierr .NE. NF_NOERR) THEN
204         write(lunout,*)"dynetat0: Lecture echouee pour <cu>"
205         CALL ABORT_gcm("dynetat0", "", 1)
206      ENDIF
207
208      ierr = NF_INQ_VARID (nid, "cv", nvarid)
209      IF (ierr .NE. NF_NOERR) THEN
210         write(lunout,*)"dynetat0: Le champ <cv> est absent"
211         CALL ABORT_gcm("dynetat0", "", 1)
212      ENDIF
213      ierr = nf90_get_var(nid, nvarid, cv)
214      IF (ierr .NE. NF_NOERR) THEN
215         write(lunout,*)"dynetat0: Lecture echouee pour <cv>"
216         CALL ABORT_gcm("dynetat0", "", 1)
217      ENDIF
218
219      ierr = NF_INQ_VARID (nid, "aire", nvarid)
220      IF (ierr .NE. NF_NOERR) THEN
221         write(lunout,*)"dynetat0: Le champ <aire> est absent"
222         CALL ABORT_gcm("dynetat0", "", 1)
223      ENDIF
224      ierr = nf90_get_var(nid, nvarid, aire)
225      IF (ierr .NE. NF_NOERR) THEN
226         write(lunout,*)"dynetat0: Lecture echouee pour <aire>"
227         CALL ABORT_gcm("dynetat0", "", 1)
228      ENDIF
229
230      ierr = NF_INQ_VARID (nid, "phisinit", nvarid)
231      IF (ierr .NE. NF_NOERR) THEN
232         write(lunout,*)"dynetat0: Le champ <phisinit> est absent"
233         CALL ABORT_gcm("dynetat0", "", 1)
234      ENDIF
235      ierr = nf90_get_var(nid, nvarid, phis)
236      IF (ierr .NE. NF_NOERR) THEN
237         write(lunout,*)"dynetat0: Lecture echouee pour <phisinit>"
238         CALL ABORT_gcm("dynetat0", "", 1)
239      ENDIF
240
241      ierr = NF_INQ_VARID (nid, "temps", nvarid)
242      IF (ierr .NE. NF_NOERR) THEN
243         write(lunout,*)"dynetat0: Le champ <temps> est absent"
244         write(lunout,*)"dynetat0: J essaie <Time>"
245         ierr = NF_INQ_VARID (nid, "Time", nvarid)
246         IF (ierr .NE. NF_NOERR) THEN
247            write(lunout,*)"dynetat0: Le champ <Time> est absent"
248            CALL ABORT_gcm("dynetat0", "", 1)
249         ENDIF
250      ENDIF
251      ierr = nf90_get_var(nid, nvarid, time)
252      IF (ierr .NE. NF_NOERR) THEN
253         write(lunout,*)"dynetat0: Lecture echouee <temps>"
254         CALL ABORT_gcm("dynetat0", "", 1)
255      ENDIF
256
257      ierr = NF_INQ_VARID (nid, "ucov", nvarid)
258      IF (ierr .NE. NF_NOERR) THEN
259         write(lunout,*)"dynetat0: Le champ <ucov> est absent"
260         CALL ABORT_gcm("dynetat0", "", 1)
261      ENDIF
262      ierr = nf90_get_var(nid, nvarid, ucov)
263      IF (ierr .NE. NF_NOERR) THEN
264         write(lunout,*)"dynetat0: Lecture echouee pour <ucov>"
265         CALL ABORT_gcm("dynetat0", "", 1)
266      ENDIF
267 
268      ierr = NF_INQ_VARID (nid, "vcov", nvarid)
269      IF (ierr .NE. NF_NOERR) THEN
270         write(lunout,*)"dynetat0: Le champ <vcov> est absent"
271         CALL ABORT_gcm("dynetat0", "", 1)
272      ENDIF
273      ierr = nf90_get_var(nid, nvarid, vcov)
274      IF (ierr .NE. NF_NOERR) THEN
275         write(lunout,*)"dynetat0: Lecture echouee pour <vcov>"
276         CALL ABORT_gcm("dynetat0", "", 1)
277      ENDIF
278
279      ierr = NF_INQ_VARID (nid, "teta", nvarid)
280      IF (ierr .NE. NF_NOERR) THEN
281         write(lunout,*)"dynetat0: Le champ <teta> est absent"
282         CALL ABORT_gcm("dynetat0", "", 1)
283      ENDIF
284      ierr = nf90_get_var(nid, nvarid, teta)
285      IF (ierr .NE. NF_NOERR) THEN
286         write(lunout,*)"dynetat0: Lecture echouee pour <teta>"
287         CALL ABORT_gcm("dynetat0", "", 1)
288      ENDIF
289
290
291      IF(nqtot.GE.1) THEN
292      DO iq=1,nqtot
293        ierr =  NF_INQ_VARID (nid, tname(iq), nvarid)
294        IF (ierr .NE. NF_NOERR) THEN
295           write(lunout,*)"dynetat0: Le traceur <"//trim(tname(iq))//
296     &                    "> est absent"
297           write(lunout,*)"          Il est donc initialise a zero"
298           q(:,:,:,iq)=0.
299        ELSE
300           ierr = NF90_GET_VAR(nid, nvarid, q(:,:,:,iq))
301          IF (ierr .NE. NF_NOERR) THEN
302            write(lunout,*)"dynetat0: Lecture echouee pour "//tname(iq)
303            CALL ABORT_gcm("dynetat0", "", 1)
304          ENDIF
305        ENDIF
306      ENDDO
307      ENDIF
308
309      ierr = NF_INQ_VARID (nid, "masse", nvarid)
310      IF (ierr .NE. NF_NOERR) THEN
311         write(lunout,*)"dynetat0: Le champ <masse> est absent"
312         CALL ABORT_gcm("dynetat0", "", 1)
313      ENDIF
314      ierr = nf90_get_var(nid, nvarid, masse)
315      IF (ierr .NE. NF_NOERR) THEN
316         write(lunout,*)"dynetat0: Lecture echouee pour <masse>"
317         CALL ABORT_gcm("dynetat0", "", 1)
318      ENDIF
319
320      ierr = NF_INQ_VARID (nid, "ps", nvarid)
321      IF (ierr .NE. NF_NOERR) THEN
322         write(lunout,*)"dynetat0: Le champ <ps> est absent"
323         CALL ABORT_gcm("dynetat0", "", 1)
324      ENDIF
325      ierr = nf90_get_var(nid, nvarid, ps)
326      IF (ierr .NE. NF_NOERR) THEN
327         write(lunout,*)"dynetat0: Lecture echouee pour <ps>"
328         CALL ABORT_gcm("dynetat0", "", 1)
329      ENDIF
330
331      ierr = NF_CLOSE(nid)
332
333       day_ini=day_ini+INT(time)
334       time=time-INT(time)
335
336  1   FORMAT(//10x,'la valeur de im =',i4,2x,'lue sur le fichier de dem
337     *arrage est differente de la valeur parametree iim =',i4//)
338   2  FORMAT(//10x,'la valeur de jm =',i4,2x,'lue sur le fichier de dem
339     *arrage est differente de la valeur parametree jjm =',i4//)
340   3  FORMAT(//10x,'la valeur de lmax =',i4,2x,'lue sur le fichier dema
341     *rrage est differente de la valeur parametree llm =',i4//)
342   4  FORMAT(//10x,'la valeur de dtrv =',i4,2x,'lue sur le fichier dema
343     *rrage est differente de la valeur  dtinteg =',i4//)
344
345      RETURN
346      END
Note: See TracBrowser for help on using the repository browser.