source: LMDZ5/trunk/libf/dyn3dpar/dynetat0.F @ 3825

Last change on this file since 3825 was 2622, checked in by Ehouarn Millour, 8 years ago

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