source: LMDZ5/trunk/libf/dyn3dmem/dynetat0_loc.F @ 1892

Last change on this file since 1892 was 1823, checked in by Ehouarn Millour, 11 years ago

Remplacement de parallel.F90 (en conflit avec orchidée) par parallel_lmdz.F90.
UG
.........................................
Renaming parallel.F90 (conflicting with orchidée) into parallel_lmdz.F90.
UG
File size: 12.7 KB
RevLine 
[1632]1!
[1657]2! $Id$
[1632]3!
4      SUBROUTINE dynetat0_loc(fichnom,vcov,ucov,
5     .                    teta,q,masse,ps,phis,time)
6      USE infotrac
[1673]7      use control_mod, only : planet_type
[1823]8      USE parallel_lmdz
[1632]9      IMPLICIT NONE
10
11c=======================================================================
12c
13c   Auteur:  P. Le Van / L.Fairhead
14c   -------
15c
16c   objet:
17c   ------
18c
19c   Lecture de l'etat initial
20c
21c=======================================================================
22c-----------------------------------------------------------------------
23c   Declarations:
24c   -------------
25
26#include "dimensions.h"
27#include "paramet.h"
28#include "temps.h"
29#include "comconst.h"
30#include "comvert.h"
31#include "comgeom.h"
32#include "ener.h"
33#include "netcdf.inc"
34#include "description.h"
35#include "serre.h"
36#include "logic.h"
[1657]37#include "iniprint.h"
[1632]38
39c   Arguments:
40c   ----------
41
42      CHARACTER*(*) fichnom
43      REAL vcov(ijb_v:ije_v,llm),ucov(ijb_u:ije_u,llm)
44      REAL teta(ijb_u:ije_u,llm)
45      REAL q(ijb_u:ije_u,llm,nqtot),masse(ijb_u:ije_u,llm)
46      REAL ps(ijb_u:ije_u),phis(ijb_u:ije_u)
47
48      REAL time
49
50c   Variables
51c
52      INTEGER length,iq
53      PARAMETER (length = 100)
54      REAL tab_cntrl(length) ! tableau des parametres du run
55      INTEGER ierr, nid, nvarid
56      REAL,ALLOCATABLE :: vcov_glo(:,:),ucov_glo(:,:),teta_glo(:,:)
57      REAL,ALLOCATABLE :: q_glo(:,:),masse_glo(:,:),ps_glo(:)
58      REAL,ALLOCATABLE :: phis_glo(:)
59
[1673]60      INTEGER idecal
61
[1632]62c-----------------------------------------------------------------------
63c  Ouverture NetCDF du fichier etat initial
64
65      ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
66      IF (ierr.NE.NF_NOERR) THEN
[1657]67        write(lunout,*)
68     &  'dynetat0_loc: Pb d''ouverture du fichier start.nc'
69        write(lunout,*)' ierr = ', ierr
[1632]70        CALL ABORT
71      ENDIF
72
73c
74      ierr = NF_INQ_VARID (nid, "controle", nvarid)
75      IF (ierr .NE. NF_NOERR) THEN
[1657]76         write(lunout,*)"dynetat0_loc: Le champ <controle> est absent"
[1632]77         CALL abort
78      ENDIF
79#ifdef NC_DOUBLE
80      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl)
81#else
82      ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
83#endif
84      IF (ierr .NE. NF_NOERR) THEN
[1657]85         write(lunout,*)"dynetat0_loc: Lecture echoue pour <controle>"
[1632]86         CALL abort
87      ENDIF
88
[1673]89      !!! AS: idecal is a hack to be able to read planeto starts...
90      !!!     .... while keeping everything OK for LMDZ EARTH
91      if (planet_type.eq."generic") then
92          print*,'NOTE NOTE NOTE : Planeto-like start files'
93          idecal = 4
94          annee_ref  = 2000
95      else
96          print*,'NOTE NOTE NOTE : Earth-like start files'
97          idecal = 5
98          annee_ref  = tab_cntrl(5)
99      endif
100
101
[1632]102      im         = tab_cntrl(1)
103      jm         = tab_cntrl(2)
104      lllm       = tab_cntrl(3)
105      day_ref    = tab_cntrl(4)
[1673]106      rad        = tab_cntrl(idecal+1)
107      omeg       = tab_cntrl(idecal+2)
108      g          = tab_cntrl(idecal+3)
109      cpp        = tab_cntrl(idecal+4)
110      kappa      = tab_cntrl(idecal+5)
111      daysec     = tab_cntrl(idecal+6)
112      dtvr       = tab_cntrl(idecal+7)
113      etot0      = tab_cntrl(idecal+8)
114      ptot0      = tab_cntrl(idecal+9)
115      ztot0      = tab_cntrl(idecal+10)
116      stot0      = tab_cntrl(idecal+11)
117      ang0       = tab_cntrl(idecal+12)
118      pa         = tab_cntrl(idecal+13)
119      preff      = tab_cntrl(idecal+14)
[1632]120c
[1673]121      clon       = tab_cntrl(idecal+15)
122      clat       = tab_cntrl(idecal+16)
123      grossismx  = tab_cntrl(idecal+17)
124      grossismy  = tab_cntrl(idecal+18)
[1632]125c
[1673]126      IF ( tab_cntrl(idecal+19).EQ.1. )  THEN
[1632]127        fxyhypb  = . TRUE .
128c        dzoomx   = tab_cntrl(25)
129c        dzoomy   = tab_cntrl(26)
130c        taux     = tab_cntrl(28)
131c        tauy     = tab_cntrl(29)
132      ELSE
133        fxyhypb = . FALSE .
134        ysinus  = . FALSE .
[1673]135        IF( tab_cntrl(idecal+22).EQ.1. ) ysinus = . TRUE.
[1632]136      ENDIF
137
138      day_ini = tab_cntrl(30)
139      itau_dyn = tab_cntrl(31)
140c   .................................................................
141c
142c
[1657]143      write(lunout,*)'dynetat0_loc: rad,omeg,g,cpp,kappa',
144     &               rad,omeg,g,cpp,kappa
[1632]145
146      IF(   im.ne.iim           )  THEN
147          PRINT 1,im,iim
148          STOP
149      ELSE  IF( jm.ne.jjm       )  THEN
150          PRINT 2,jm,jjm
151          STOP
152      ELSE  IF( lllm.ne.llm     )  THEN
153          PRINT 3,lllm,llm
154          STOP
155      ENDIF
156
157      ierr = NF_INQ_VARID (nid, "rlonu", nvarid)
158      IF (ierr .NE. NF_NOERR) THEN
[1657]159         write(lunout,*)"dynetat0_loc: Le champ <rlonu> est absent"
[1632]160         CALL abort
161      ENDIF
162#ifdef NC_DOUBLE
163      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonu)
164#else
165      ierr = NF_GET_VAR_REAL(nid, nvarid, rlonu)
166#endif
167      IF (ierr .NE. NF_NOERR) THEN
[1657]168         write(lunout,*)"dynetat0_loc: Lecture echouee pour <rlonu>"
[1632]169         CALL abort
170      ENDIF
171
172      ierr = NF_INQ_VARID (nid, "rlatu", nvarid)
173      IF (ierr .NE. NF_NOERR) THEN
[1657]174         write(lunout,*)"dynetat0_loc: Le champ <rlatu> est absent"
[1632]175         CALL abort
176      ENDIF
177#ifdef NC_DOUBLE
178      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatu)
179#else
180      ierr = NF_GET_VAR_REAL(nid, nvarid, rlatu)
181#endif
182      IF (ierr .NE. NF_NOERR) THEN
[1657]183         write(lunout,*)"dynetat0_loc: Lecture echouee pour <rlatu>"
[1632]184         CALL abort
185      ENDIF
186
187      ierr = NF_INQ_VARID (nid, "rlonv", nvarid)
188      IF (ierr .NE. NF_NOERR) THEN
[1657]189         write(lunout,*)"dynetat0_loc: Le champ <rlonv> est absent"
[1632]190         CALL abort
191      ENDIF
192#ifdef NC_DOUBLE
193      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonv)
194#else
195      ierr = NF_GET_VAR_REAL(nid, nvarid, rlonv)
196#endif
197      IF (ierr .NE. NF_NOERR) THEN
[1657]198         write(lunout,*)"dynetat0_loc: Lecture echouee pour <rlonv>"
[1632]199         CALL abort
200      ENDIF
201
202      ierr = NF_INQ_VARID (nid, "rlatv", nvarid)
203      IF (ierr .NE. NF_NOERR) THEN
[1657]204         write(lunout,*)"dynetat0_loc: Le champ <rlatv> est absent"
[1632]205         CALL abort
206      ENDIF
207#ifdef NC_DOUBLE
208      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatv)
209#else
210      ierr = NF_GET_VAR_REAL(nid, nvarid, rlatv)
211#endif
212      IF (ierr .NE. NF_NOERR) THEN
[1657]213         write(lunout,*)"dynetat0_loc: Lecture echouee pour rlatv"
[1632]214         CALL abort
215      ENDIF
216
217      ierr = NF_INQ_VARID (nid, "cu", nvarid)
218      IF (ierr .NE. NF_NOERR) THEN
[1657]219         write(lunout,*)"dynetat0_loc: Le champ <cu> est absent"
[1632]220         CALL abort
221      ENDIF
222#ifdef NC_DOUBLE
223      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, cu)
224#else
225      ierr = NF_GET_VAR_REAL(nid, nvarid, cu)
226#endif
227      IF (ierr .NE. NF_NOERR) THEN
[1657]228         write(lunout,*)"dynetat0_loc: Lecture echouee pour <cu>"
[1632]229         CALL abort
230      ENDIF
231
232      ierr = NF_INQ_VARID (nid, "cv", nvarid)
233      IF (ierr .NE. NF_NOERR) THEN
[1657]234         write(lunout,*)"dynetat0_loc: Le champ <cv> est absent"
[1632]235         CALL abort
236      ENDIF
237#ifdef NC_DOUBLE
238      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, cv)
239#else
240      ierr = NF_GET_VAR_REAL(nid, nvarid, cv)
241#endif
242      IF (ierr .NE. NF_NOERR) THEN
[1657]243         write(lunout,*)"dynetat0_loc: Lecture echouee pour <cv>"
[1632]244         CALL abort
245      ENDIF
246
247      ierr = NF_INQ_VARID (nid, "aire", nvarid)
248      IF (ierr .NE. NF_NOERR) THEN
[1657]249         write(lunout,*)"dynetat0_loc: Le champ <aire> est absent"
[1632]250         CALL abort
251      ENDIF
252#ifdef NC_DOUBLE
253      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, aire)
254#else
255      ierr = NF_GET_VAR_REAL(nid, nvarid, aire)
256#endif
257      IF (ierr .NE. NF_NOERR) THEN
[1657]258         write(lunout,*)"dynetat0_loc: Lecture echouee pour <aire>"
[1632]259         CALL abort
260      ENDIF
261     
262      ALLOCATE(phis_glo(ip1jmp1))
263     
264      ierr = NF_INQ_VARID (nid, "phisinit", nvarid)
265      IF (ierr .NE. NF_NOERR) THEN
[1657]266         write(lunout,*)"dynetat0_loc: Le champ <phisinit> est absent"
[1632]267         CALL abort
268      ENDIF
269#ifdef NC_DOUBLE
270      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, phis_glo)
271#else
272      ierr = NF_GET_VAR_REAL(nid, nvarid, phis_glo)
273#endif
274      IF (ierr .NE. NF_NOERR) THEN
[1657]275         write(lunout,*)"dynetat0_loc: Lecture echouee pour <phisinit>"
[1632]276         CALL abort
277      ENDIF
278      phis(ijb_u:ije_u)=phis_glo(ijb_u:ije_u)
279      DEALLOCATE(phis_glo)
280
281      ierr = NF_INQ_VARID (nid, "temps", nvarid)
282      IF (ierr .NE. NF_NOERR) THEN
[1673]283         write(lunout,*)"dynetat0: Le champ <temps> est absent"
284         write(lunout,*)"dynetat0: J essaie <Time>"
285         ierr = NF_INQ_VARID (nid, "Time", nvarid)
286         IF (ierr .NE. NF_NOERR) THEN
287            write(lunout,*)"dynetat0: Le champ <Time> est absent"
288            CALL abort
289         ENDIF
[1632]290      ENDIF
291#ifdef NC_DOUBLE
292      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, time)
293#else
294      ierr = NF_GET_VAR_REAL(nid, nvarid, time)
295#endif
296      IF (ierr .NE. NF_NOERR) THEN
[1657]297         write(lunout,*)"dynetat0_loc: Lecture echouee <temps>"
[1632]298         CALL abort
299      ENDIF
300
301      ierr = NF_INQ_VARID (nid, "ucov", nvarid)
302      IF (ierr .NE. NF_NOERR) THEN
[1657]303         write(lunout,*)"dynetat0_loc: Le champ <ucov> est absent"
[1632]304         CALL abort
305      ENDIF
306     
307      ALLOCATE(ucov_glo(ip1jmp1,llm))
308     
309#ifdef NC_DOUBLE
310      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, ucov_glo)
311#else
312      ierr = NF_GET_VAR_REAL(nid, nvarid, ucov_glo)
313#endif
314      IF (ierr .NE. NF_NOERR) THEN
[1657]315         write(lunout,*)"dynetat0_loc: Lecture echouee pour <ucov>"
[1632]316         CALL abort
317      ENDIF
318
319      ucov(ijb_u:ije_u,:)=ucov_glo(ijb_u:ije_u,:)
320      DEALLOCATE(ucov_glo)
321      ALLOCATE(vcov_glo(ip1jm,llm))
322     
323      ierr = NF_INQ_VARID (nid, "vcov", nvarid)
324      IF (ierr .NE. NF_NOERR) THEN
[1657]325         write(lunout,*)"dynetat0_loc: Le champ <vcov> est absent"
[1632]326         CALL abort
327      ENDIF
328#ifdef NC_DOUBLE
329      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, vcov_glo)
330#else
331      ierr = NF_GET_VAR_REAL(nid, nvarid, vcov_glo)
332#endif
333      IF (ierr .NE. NF_NOERR) THEN
[1657]334         write(lunout,*)"dynetat0_loc: Lecture echouee pour <vcov>"
[1632]335         CALL abort
336      ENDIF
337      vcov(ijb_v:ije_v,:)=vcov_glo(ijb_v:ije_v,:)
338      DEALLOCATE(vcov_glo)
339      ALLOCATE(teta_glo(ip1jmp1,llm))
340
341      ierr = NF_INQ_VARID (nid, "teta", nvarid)
342      IF (ierr .NE. NF_NOERR) THEN
[1657]343         write(lunout,*)"dynetat0_loc: Le champ <teta> est absent"
[1632]344         CALL abort
345      ENDIF
346#ifdef NC_DOUBLE
347      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, teta_glo)
348#else
349      ierr = NF_GET_VAR_REAL(nid, nvarid, teta_glo)
350#endif
351      IF (ierr .NE. NF_NOERR) THEN
[1657]352         write(lunout,*)"dynetat0_loc: Lecture echouee pour <teta>"
[1632]353         CALL abort
354      ENDIF
355
356      teta(ijb_u:ije_u,:)=teta_glo(ijb_u:ije_u,:)
357      DEALLOCATE(teta_glo)
358      ALLOCATE(q_glo(ip1jmp1,llm))
359
360
361      DO iq=1,nqtot
362        ierr =  NF_INQ_VARID (nid, tname(iq), nvarid)
363        IF (ierr .NE. NF_NOERR) THEN
[1658]364           write(lunout,*)"dynetat0_loc: Le traceur <"                  &
365     &     //trim(tname(iq))//"> est absent"
366           write(lunout,*)"Il est donc initialise a zero"
[1657]367           q(:,:,iq)=0.
[1632]368        ELSE
369#ifdef NC_DOUBLE
370          ierr = NF_GET_VAR_DOUBLE(nid, nvarid, q_glo)
371#else
372          ierr = NF_GET_VAR_REAL(nid, nvarid, q_glo)
373#endif
374          IF (ierr .NE. NF_NOERR) THEN
[1657]375            write(lunout,*)
376     &      "dynetat0_loc: Lecture echouee pour "//tname(iq)
377            CALL abort
[1632]378          ENDIF
379        ENDIF
380        q(ijb_u:ije_u,:,iq)=q_glo(ijb_u:ije_u,:)
381      ENDDO
382
383      DEALLOCATE(q_glo)
384      ALLOCATE(masse_glo(ip1jmp1,llm))
385
386      ierr = NF_INQ_VARID (nid, "masse", nvarid)
387      IF (ierr .NE. NF_NOERR) THEN
[1657]388         write(lunout,*)"dynetat0_loc: Le champ <masse> est absent"
[1632]389         CALL abort
390      ENDIF
391#ifdef NC_DOUBLE
392      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, masse_glo)
393#else
394      ierr = NF_GET_VAR_REAL(nid, nvarid, masse_glo)
395#endif
396      IF (ierr .NE. NF_NOERR) THEN
[1657]397         write(lunout,*)"dynetat0_loc: Lecture echouee pour <masse>"
[1632]398         CALL abort
399      ENDIF
400      masse(ijb_u:ije_u,:)=masse_glo(ijb_u:ije_u,:)
401      DEALLOCATE(masse_glo)
402      ALLOCATE(ps_glo(ip1jmp1))
403
404      ierr = NF_INQ_VARID (nid, "ps", nvarid)
405      IF (ierr .NE. NF_NOERR) THEN
[1657]406         write(lunout,*)"dynetat0_loc: Le champ <ps> est absent"
[1632]407         CALL abort
408      ENDIF
409#ifdef NC_DOUBLE
410      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, ps_glo)
411#else
412      ierr = NF_GET_VAR_REAL(nid, nvarid, ps_glo)
413#endif
414      IF (ierr .NE. NF_NOERR) THEN
[1657]415         write(lunout,*)"dynetat0_loc: Lecture echouee pour <ps>"
[1632]416         CALL abort
417      ENDIF
418
419      ps(ijb_u:ije_u)=ps_glo(ijb_u:ije_u)
420      DEALLOCATE(ps_glo)
421
422      ierr = NF_CLOSE(nid)
423
424       day_ini=day_ini+INT(time)
425       time=time-INT(time)
426
427  1   FORMAT(//10x,'la valeur de im =',i4,2x,'lue sur le fichier de dem
428     *arrage est differente de la valeur parametree iim =',i4//)
429   2  FORMAT(//10x,'la valeur de jm =',i4,2x,'lue sur le fichier de dem
430     *arrage est differente de la valeur parametree jjm =',i4//)
431   3  FORMAT(//10x,'la valeur de lmax =',i4,2x,'lue sur le fichier dema
432     *rrage est differente de la valeur parametree llm =',i4//)
433   4  FORMAT(//10x,'la valeur de dtrv =',i4,2x,'lue sur le fichier dema
434     *rrage est differente de la valeur  dtinteg =',i4//)
435
436      RETURN
437      END
Note: See TracBrowser for help on using the repository browser.