source: LMDZ5/trunk/libf/dyn3d/dynetat0.F @ 2219

Last change on this file since 2219 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
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
[1635]8      use netcdf, only: nf90_get_var
[1654]9
10      use control_mod, only : planet_type
11
[524]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"
[1635]34#include "comgeom2.h"
[524]35#include "ener.h"
36#include "netcdf.inc"
37#include "description.h"
38#include "serre.h"
39#include "logic.h"
[1403]40#include "iniprint.h"
[524]41
42c   Arguments:
43c   ----------
44
45      CHARACTER*(*) fichnom
[1635]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)
[524]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
[1654]59      INTEGER idecal
60
[524]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
[1403]67        write(lunout,*)'dynetat0: Pb d''ouverture du fichier start.nc'
68        write(lunout,*)' ierr = ', ierr
[1930]69        CALL ABORT_gcm("dynetat0", "", 1)
[524]70      ENDIF
71
72c
73      ierr = NF_INQ_VARID (nid, "controle", nvarid)
74      IF (ierr .NE. NF_NOERR) THEN
[1403]75         write(lunout,*)"dynetat0: Le champ <controle> est absent"
[1930]76         CALL ABORT_gcm("dynetat0", "", 1)
[524]77      ENDIF
[1635]78      ierr = nf90_get_var(nid, nvarid, tab_cntrl)
[524]79      IF (ierr .NE. NF_NOERR) THEN
[1403]80         write(lunout,*)"dynetat0: Lecture echoue pour <controle>"
[1930]81         CALL ABORT_gcm("dynetat0", "", 1)
[524]82      ENDIF
83
[1654]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
[524]97      im         = tab_cntrl(1)
98      jm         = tab_cntrl(2)
99      lllm       = tab_cntrl(3)
100      day_ref    = tab_cntrl(4)
[1654]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)
[524]115c
[1654]116      clon       = tab_cntrl(idecal+15)
117      clat       = tab_cntrl(idecal+16)
118      grossismx  = tab_cntrl(idecal+17)
119      grossismy  = tab_cntrl(idecal+18)
[524]120c
[1654]121      IF ( tab_cntrl(idecal+19).EQ.1. )  THEN
[524]122        fxyhypb  = . TRUE .
[541]123c        dzoomx   = tab_cntrl(25)
124c        dzoomy   = tab_cntrl(26)
125c        taux     = tab_cntrl(28)
126c        tauy     = tab_cntrl(29)
[524]127      ELSE
128        fxyhypb = . FALSE .
129        ysinus  = . FALSE .
[1654]130        IF( tab_cntrl(idecal+22).EQ.1. ) ysinus = . TRUE.
[524]131      ENDIF
132
133      day_ini = tab_cntrl(30)
134      itau_dyn = tab_cntrl(31)
[1577]135      start_time = tab_cntrl(32)
[524]136c   .................................................................
137c
138c
[1403]139      write(lunout,*)'dynetat0: rad,omeg,g,cpp,kappa',
140     &               rad,omeg,g,cpp,kappa
[524]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
[1403]155         write(lunout,*)"dynetat0: Le champ <rlonu> est absent"
[1930]156         CALL ABORT_gcm("dynetat0", "", 1)
[524]157      ENDIF
[1635]158      ierr = nf90_get_var(nid, nvarid, rlonu)
[524]159      IF (ierr .NE. NF_NOERR) THEN
[1403]160         write(lunout,*)"dynetat0: Lecture echouee pour <rlonu>"
[1930]161         CALL ABORT_gcm("dynetat0", "", 1)
[524]162      ENDIF
163
164      ierr = NF_INQ_VARID (nid, "rlatu", nvarid)
165      IF (ierr .NE. NF_NOERR) THEN
[1403]166         write(lunout,*)"dynetat0: Le champ <rlatu> est absent"
[1930]167         CALL ABORT_gcm("dynetat0", "", 1)
[524]168      ENDIF
[1635]169      ierr = nf90_get_var(nid, nvarid, rlatu)
[524]170      IF (ierr .NE. NF_NOERR) THEN
[1403]171         write(lunout,*)"dynetat0: Lecture echouee pour <rlatu>"
[1930]172         CALL ABORT_gcm("dynetat0", "", 1)
[524]173      ENDIF
174
175      ierr = NF_INQ_VARID (nid, "rlonv", nvarid)
176      IF (ierr .NE. NF_NOERR) THEN
[1403]177         write(lunout,*)"dynetat0: Le champ <rlonv> est absent"
[1930]178         CALL ABORT_gcm("dynetat0", "", 1)
[524]179      ENDIF
[1635]180      ierr = nf90_get_var(nid, nvarid, rlonv)
[524]181      IF (ierr .NE. NF_NOERR) THEN
[1403]182         write(lunout,*)"dynetat0: Lecture echouee pour <rlonv>"
[1930]183         CALL ABORT_gcm("dynetat0", "", 1)
[524]184      ENDIF
185
186      ierr = NF_INQ_VARID (nid, "rlatv", nvarid)
187      IF (ierr .NE. NF_NOERR) THEN
[1403]188         write(lunout,*)"dynetat0: Le champ <rlatv> est absent"
[1930]189         CALL ABORT_gcm("dynetat0", "", 1)
[524]190      ENDIF
[1635]191      ierr = nf90_get_var(nid, nvarid, rlatv)
[524]192      IF (ierr .NE. NF_NOERR) THEN
[1403]193         write(lunout,*)"dynetat0: Lecture echouee pour rlatv"
[1930]194         CALL ABORT_gcm("dynetat0", "", 1)
[524]195      ENDIF
196
197      ierr = NF_INQ_VARID (nid, "cu", nvarid)
198      IF (ierr .NE. NF_NOERR) THEN
[1403]199         write(lunout,*)"dynetat0: Le champ <cu> est absent"
[1930]200         CALL ABORT_gcm("dynetat0", "", 1)
[524]201      ENDIF
[1635]202      ierr = nf90_get_var(nid, nvarid, cu)
[524]203      IF (ierr .NE. NF_NOERR) THEN
[1403]204         write(lunout,*)"dynetat0: Lecture echouee pour <cu>"
[1930]205         CALL ABORT_gcm("dynetat0", "", 1)
[524]206      ENDIF
207
208      ierr = NF_INQ_VARID (nid, "cv", nvarid)
209      IF (ierr .NE. NF_NOERR) THEN
[1403]210         write(lunout,*)"dynetat0: Le champ <cv> est absent"
[1930]211         CALL ABORT_gcm("dynetat0", "", 1)
[524]212      ENDIF
[1635]213      ierr = nf90_get_var(nid, nvarid, cv)
[524]214      IF (ierr .NE. NF_NOERR) THEN
[1403]215         write(lunout,*)"dynetat0: Lecture echouee pour <cv>"
[1930]216         CALL ABORT_gcm("dynetat0", "", 1)
[524]217      ENDIF
218
219      ierr = NF_INQ_VARID (nid, "aire", nvarid)
220      IF (ierr .NE. NF_NOERR) THEN
[1403]221         write(lunout,*)"dynetat0: Le champ <aire> est absent"
[1930]222         CALL ABORT_gcm("dynetat0", "", 1)
[524]223      ENDIF
[1635]224      ierr = nf90_get_var(nid, nvarid, aire)
[524]225      IF (ierr .NE. NF_NOERR) THEN
[1403]226         write(lunout,*)"dynetat0: Lecture echouee pour <aire>"
[1930]227         CALL ABORT_gcm("dynetat0", "", 1)
[524]228      ENDIF
229
230      ierr = NF_INQ_VARID (nid, "phisinit", nvarid)
231      IF (ierr .NE. NF_NOERR) THEN
[1403]232         write(lunout,*)"dynetat0: Le champ <phisinit> est absent"
[1930]233         CALL ABORT_gcm("dynetat0", "", 1)
[524]234      ENDIF
[1635]235      ierr = nf90_get_var(nid, nvarid, phis)
[524]236      IF (ierr .NE. NF_NOERR) THEN
[1403]237         write(lunout,*)"dynetat0: Lecture echouee pour <phisinit>"
[1930]238         CALL ABORT_gcm("dynetat0", "", 1)
[524]239      ENDIF
240
241      ierr = NF_INQ_VARID (nid, "temps", nvarid)
242      IF (ierr .NE. NF_NOERR) THEN
[1403]243         write(lunout,*)"dynetat0: Le champ <temps> est absent"
[1654]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"
[1930]248            CALL ABORT_gcm("dynetat0", "", 1)
[1654]249         ENDIF
[524]250      ENDIF
[1635]251      ierr = nf90_get_var(nid, nvarid, time)
[524]252      IF (ierr .NE. NF_NOERR) THEN
[1403]253         write(lunout,*)"dynetat0: Lecture echouee <temps>"
[1930]254         CALL ABORT_gcm("dynetat0", "", 1)
[524]255      ENDIF
256
257      ierr = NF_INQ_VARID (nid, "ucov", nvarid)
258      IF (ierr .NE. NF_NOERR) THEN
[1403]259         write(lunout,*)"dynetat0: Le champ <ucov> est absent"
[1930]260         CALL ABORT_gcm("dynetat0", "", 1)
[524]261      ENDIF
[1635]262      ierr = nf90_get_var(nid, nvarid, ucov)
[524]263      IF (ierr .NE. NF_NOERR) THEN
[1403]264         write(lunout,*)"dynetat0: Lecture echouee pour <ucov>"
[1930]265         CALL ABORT_gcm("dynetat0", "", 1)
[524]266      ENDIF
267 
268      ierr = NF_INQ_VARID (nid, "vcov", nvarid)
269      IF (ierr .NE. NF_NOERR) THEN
[1403]270         write(lunout,*)"dynetat0: Le champ <vcov> est absent"
[1930]271         CALL ABORT_gcm("dynetat0", "", 1)
[524]272      ENDIF
[1635]273      ierr = nf90_get_var(nid, nvarid, vcov)
[524]274      IF (ierr .NE. NF_NOERR) THEN
[1403]275         write(lunout,*)"dynetat0: Lecture echouee pour <vcov>"
[1930]276         CALL ABORT_gcm("dynetat0", "", 1)
[524]277      ENDIF
278
279      ierr = NF_INQ_VARID (nid, "teta", nvarid)
280      IF (ierr .NE. NF_NOERR) THEN
[1403]281         write(lunout,*)"dynetat0: Le champ <teta> est absent"
[1930]282         CALL ABORT_gcm("dynetat0", "", 1)
[524]283      ENDIF
[1635]284      ierr = nf90_get_var(nid, nvarid, teta)
[524]285      IF (ierr .NE. NF_NOERR) THEN
[1403]286         write(lunout,*)"dynetat0: Lecture echouee pour <teta>"
[1930]287         CALL ABORT_gcm("dynetat0", "", 1)
[524]288      ENDIF
289
290
[1146]291      IF(nqtot.GE.1) THEN
292      DO iq=1,nqtot
[524]293        ierr =  NF_INQ_VARID (nid, tname(iq), nvarid)
294        IF (ierr .NE. NF_NOERR) THEN
[1421]295           write(lunout,*)"dynetat0: Le traceur <"//trim(tname(iq))//
[1403]296     &                    "> est absent"
297           write(lunout,*)"          Il est donc initialise a zero"
[1635]298           q(:,:,:,iq)=0.
[524]299        ELSE
[1635]300           ierr = NF90_GET_VAR(nid, nvarid, q(:,:,:,iq))
[524]301          IF (ierr .NE. NF_NOERR) THEN
[1403]302            write(lunout,*)"dynetat0: Lecture echouee pour "//tname(iq)
[1930]303            CALL ABORT_gcm("dynetat0", "", 1)
[524]304          ENDIF
305        ENDIF
306      ENDDO
307      ENDIF
308
309      ierr = NF_INQ_VARID (nid, "masse", nvarid)
310      IF (ierr .NE. NF_NOERR) THEN
[1403]311         write(lunout,*)"dynetat0: Le champ <masse> est absent"
[1930]312         CALL ABORT_gcm("dynetat0", "", 1)
[524]313      ENDIF
[1635]314      ierr = nf90_get_var(nid, nvarid, masse)
[524]315      IF (ierr .NE. NF_NOERR) THEN
[1403]316         write(lunout,*)"dynetat0: Lecture echouee pour <masse>"
[1930]317         CALL ABORT_gcm("dynetat0", "", 1)
[524]318      ENDIF
319
320      ierr = NF_INQ_VARID (nid, "ps", nvarid)
321      IF (ierr .NE. NF_NOERR) THEN
[1403]322         write(lunout,*)"dynetat0: Le champ <ps> est absent"
[1930]323         CALL ABORT_gcm("dynetat0", "", 1)
[524]324      ENDIF
[1635]325      ierr = nf90_get_var(nid, nvarid, ps)
[524]326      IF (ierr .NE. NF_NOERR) THEN
[1403]327         write(lunout,*)"dynetat0: Lecture echouee pour <ps>"
[1930]328         CALL ABORT_gcm("dynetat0", "", 1)
[524]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.