source: LMDZ5/branches/testing/libf/dyn3d/dynetat0.F @ 2337

Last change on this file since 2337 was 2298, checked in by Laurent Fairhead, 9 years ago

Merged trunk changes -r2237:2291 into testing branch
  • 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.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
[1669]8      use netcdf, only: nf90_get_var
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"
[1669]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
[1669]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
[1669]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
[1999]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"
[1999]76         CALL ABORT_gcm("dynetat0", "", 1)
[524]77      ENDIF
[1669]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>"
[1999]81         CALL ABORT_gcm("dynetat0", "", 1)
[524]82      ENDIF
83
[1669]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)
[1669]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
[1669]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
[1669]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 .
[1669]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)
[1665]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"
[1999]156         CALL ABORT_gcm("dynetat0", "", 1)
[524]157      ENDIF
[1669]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>"
[1999]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"
[1999]167         CALL ABORT_gcm("dynetat0", "", 1)
[524]168      ENDIF
[1669]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>"
[1999]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"
[1999]178         CALL ABORT_gcm("dynetat0", "", 1)
[524]179      ENDIF
[1669]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>"
[1999]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"
[1999]189         CALL ABORT_gcm("dynetat0", "", 1)
[524]190      ENDIF
[1669]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"
[1999]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"
[1999]200         CALL ABORT_gcm("dynetat0", "", 1)
[524]201      ENDIF
[1669]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>"
[1999]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"
[1999]211         CALL ABORT_gcm("dynetat0", "", 1)
[524]212      ENDIF
[1669]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>"
[1999]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"
[1999]222         CALL ABORT_gcm("dynetat0", "", 1)
[524]223      ENDIF
[1669]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>"
[1999]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"
[1999]233         CALL ABORT_gcm("dynetat0", "", 1)
[524]234      ENDIF
[1669]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>"
[1999]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"
[1669]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"
[1999]248            CALL ABORT_gcm("dynetat0", "", 1)
[1669]249         ENDIF
[524]250      ENDIF
[1669]251      ierr = nf90_get_var(nid, nvarid, time)
[524]252      IF (ierr .NE. NF_NOERR) THEN
[1403]253         write(lunout,*)"dynetat0: Lecture echouee <temps>"
[1999]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"
[1999]260         CALL ABORT_gcm("dynetat0", "", 1)
[524]261      ENDIF
[1669]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>"
[1999]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"
[1999]271         CALL ABORT_gcm("dynetat0", "", 1)
[524]272      ENDIF
[1669]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>"
[1999]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"
[1999]282         CALL ABORT_gcm("dynetat0", "", 1)
[524]283      ENDIF
[1669]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>"
[1999]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"
[1669]298           q(:,:,:,iq)=0.
[2298]299
300           ! CRisi: pour les isotopes, on peut faire init théorique
301           ! distill de Rayleigh très simplifiée
302           if (ok_isotopes) then
303              if ((iso_num(iq).gt.0).and.(zone_num(iq).eq.0)) then
304                q(:,:,:,iq)=q(:,:,:,iqpere(iq))                         
305     &                   *tnat(iso_num(iq))                             
306     &                   *(q(:,:,:,iqpere(iq))/30.e-3)                 
307     &                   **(alpha_ideal(iso_num(iq))-1)
308              endif
309              if ((iso_num(iq).gt.0).and.(zone_num(iq).eq.1)) then
310                  q(:,:,:,iq)=q(:,:,:,iqiso(iso_indnum(iq),
311     &                   phase_num(iq)))
312              endif 
313           endif !if (ok_isotopes) then
[524]314        ELSE
[1669]315           ierr = NF90_GET_VAR(nid, nvarid, q(:,:,:,iq))
[524]316          IF (ierr .NE. NF_NOERR) THEN
[1403]317            write(lunout,*)"dynetat0: Lecture echouee pour "//tname(iq)
[1999]318            CALL ABORT_gcm("dynetat0", "", 1)
[524]319          ENDIF
320        ENDIF
321      ENDDO
322      ENDIF
323
324      ierr = NF_INQ_VARID (nid, "masse", nvarid)
325      IF (ierr .NE. NF_NOERR) THEN
[1403]326         write(lunout,*)"dynetat0: Le champ <masse> est absent"
[1999]327         CALL ABORT_gcm("dynetat0", "", 1)
[524]328      ENDIF
[1669]329      ierr = nf90_get_var(nid, nvarid, masse)
[524]330      IF (ierr .NE. NF_NOERR) THEN
[1403]331         write(lunout,*)"dynetat0: Lecture echouee pour <masse>"
[1999]332         CALL ABORT_gcm("dynetat0", "", 1)
[524]333      ENDIF
334
335      ierr = NF_INQ_VARID (nid, "ps", nvarid)
336      IF (ierr .NE. NF_NOERR) THEN
[1403]337         write(lunout,*)"dynetat0: Le champ <ps> est absent"
[1999]338         CALL ABORT_gcm("dynetat0", "", 1)
[524]339      ENDIF
[1669]340      ierr = nf90_get_var(nid, nvarid, ps)
[524]341      IF (ierr .NE. NF_NOERR) THEN
[1403]342         write(lunout,*)"dynetat0: Lecture echouee pour <ps>"
[1999]343         CALL ABORT_gcm("dynetat0", "", 1)
[524]344      ENDIF
345
346      ierr = NF_CLOSE(nid)
347
348       day_ini=day_ini+INT(time)
349       time=time-INT(time)
350
351  1   FORMAT(//10x,'la valeur de im =',i4,2x,'lue sur le fichier de dem
352     *arrage est differente de la valeur parametree iim =',i4//)
353   2  FORMAT(//10x,'la valeur de jm =',i4,2x,'lue sur le fichier de dem
354     *arrage est differente de la valeur parametree jjm =',i4//)
355   3  FORMAT(//10x,'la valeur de lmax =',i4,2x,'lue sur le fichier dema
356     *rrage est differente de la valeur parametree llm =',i4//)
357   4  FORMAT(//10x,'la valeur de dtrv =',i4,2x,'lue sur le fichier dema
358     *rrage est differente de la valeur  dtinteg =',i4//)
359
360      RETURN
361      END
Note: See TracBrowser for help on using the repository browser.