source: LMDZ5/branches/testing/libf/dyn3dmem/dynetat0_loc.F @ 1910

Last change on this file since 1910 was 1910, checked in by Laurent Fairhead, 11 years ago

Merged trunk changes r1860:1909 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
File size: 12.7 KB
Line 
1!
2! $Id$
3!
4      SUBROUTINE dynetat0_loc(fichnom,vcov,ucov,
5     .                    teta,q,masse,ps,phis,time)
6      USE infotrac
7      use control_mod, only : planet_type
8      USE parallel_lmdz
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"
37#include "iniprint.h"
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
60      INTEGER idecal
61
62c-----------------------------------------------------------------------
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,*)
68     &  'dynetat0_loc: Pb d''ouverture du fichier start.nc'
69        write(lunout,*)' ierr = ', ierr
70        CALL ABORT
71      ENDIF
72
73c
74      ierr = NF_INQ_VARID (nid, "controle", nvarid)
75      IF (ierr .NE. NF_NOERR) THEN
76         write(lunout,*)"dynetat0_loc: Le champ <controle> est absent"
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
85         write(lunout,*)"dynetat0_loc: Lecture echoue pour <controle>"
86         CALL abort
87      ENDIF
88
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
102      im         = tab_cntrl(1)
103      jm         = tab_cntrl(2)
104      lllm       = tab_cntrl(3)
105      day_ref    = tab_cntrl(4)
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)
120c
121      clon       = tab_cntrl(idecal+15)
122      clat       = tab_cntrl(idecal+16)
123      grossismx  = tab_cntrl(idecal+17)
124      grossismy  = tab_cntrl(idecal+18)
125c
126      IF ( tab_cntrl(idecal+19).EQ.1. )  THEN
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 .
135        IF( tab_cntrl(idecal+22).EQ.1. ) ysinus = . TRUE.
136      ENDIF
137
138      day_ini = tab_cntrl(30)
139      itau_dyn = tab_cntrl(31)
140c   .................................................................
141c
142c
143      write(lunout,*)'dynetat0_loc: rad,omeg,g,cpp,kappa',
144     &               rad,omeg,g,cpp,kappa
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
159         write(lunout,*)"dynetat0_loc: Le champ <rlonu> est absent"
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
168         write(lunout,*)"dynetat0_loc: Lecture echouee pour <rlonu>"
169         CALL abort
170      ENDIF
171
172      ierr = NF_INQ_VARID (nid, "rlatu", nvarid)
173      IF (ierr .NE. NF_NOERR) THEN
174         write(lunout,*)"dynetat0_loc: Le champ <rlatu> est absent"
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
183         write(lunout,*)"dynetat0_loc: Lecture echouee pour <rlatu>"
184         CALL abort
185      ENDIF
186
187      ierr = NF_INQ_VARID (nid, "rlonv", nvarid)
188      IF (ierr .NE. NF_NOERR) THEN
189         write(lunout,*)"dynetat0_loc: Le champ <rlonv> est absent"
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
198         write(lunout,*)"dynetat0_loc: Lecture echouee pour <rlonv>"
199         CALL abort
200      ENDIF
201
202      ierr = NF_INQ_VARID (nid, "rlatv", nvarid)
203      IF (ierr .NE. NF_NOERR) THEN
204         write(lunout,*)"dynetat0_loc: Le champ <rlatv> est absent"
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
213         write(lunout,*)"dynetat0_loc: Lecture echouee pour rlatv"
214         CALL abort
215      ENDIF
216
217      ierr = NF_INQ_VARID (nid, "cu", nvarid)
218      IF (ierr .NE. NF_NOERR) THEN
219         write(lunout,*)"dynetat0_loc: Le champ <cu> est absent"
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
228         write(lunout,*)"dynetat0_loc: Lecture echouee pour <cu>"
229         CALL abort
230      ENDIF
231
232      ierr = NF_INQ_VARID (nid, "cv", nvarid)
233      IF (ierr .NE. NF_NOERR) THEN
234         write(lunout,*)"dynetat0_loc: Le champ <cv> est absent"
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
243         write(lunout,*)"dynetat0_loc: Lecture echouee pour <cv>"
244         CALL abort
245      ENDIF
246
247      ierr = NF_INQ_VARID (nid, "aire", nvarid)
248      IF (ierr .NE. NF_NOERR) THEN
249         write(lunout,*)"dynetat0_loc: Le champ <aire> est absent"
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
258         write(lunout,*)"dynetat0_loc: Lecture echouee pour <aire>"
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
266         write(lunout,*)"dynetat0_loc: Le champ <phisinit> est absent"
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
275         write(lunout,*)"dynetat0_loc: Lecture echouee pour <phisinit>"
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
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
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
297         write(lunout,*)"dynetat0_loc: Lecture echouee <temps>"
298         CALL abort
299      ENDIF
300
301      ierr = NF_INQ_VARID (nid, "ucov", nvarid)
302      IF (ierr .NE. NF_NOERR) THEN
303         write(lunout,*)"dynetat0_loc: Le champ <ucov> est absent"
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
315         write(lunout,*)"dynetat0_loc: Lecture echouee pour <ucov>"
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
325         write(lunout,*)"dynetat0_loc: Le champ <vcov> est absent"
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
334         write(lunout,*)"dynetat0_loc: Lecture echouee pour <vcov>"
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
343         write(lunout,*)"dynetat0_loc: Le champ <teta> est absent"
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
352         write(lunout,*)"dynetat0_loc: Lecture echouee pour <teta>"
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
364           write(lunout,*)"dynetat0_loc: Le traceur <"                  &
365     &     //trim(tname(iq))//"> est absent"
366           write(lunout,*)"Il est donc initialise a zero"
367           q(:,:,iq)=0.
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
375            write(lunout,*)
376     &      "dynetat0_loc: Lecture echouee pour "//tname(iq)
377            CALL abort
378          ENDIF
379        q(ijb_u:ije_u,:,iq)=q_glo(ijb_u:ije_u,:)
380
381        ENDIF
382      ENDDO
383
384      DEALLOCATE(q_glo)
385      ALLOCATE(masse_glo(ip1jmp1,llm))
386
387      ierr = NF_INQ_VARID (nid, "masse", nvarid)
388      IF (ierr .NE. NF_NOERR) THEN
389         write(lunout,*)"dynetat0_loc: Le champ <masse> est absent"
390         CALL abort
391      ENDIF
392#ifdef NC_DOUBLE
393      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, masse_glo)
394#else
395      ierr = NF_GET_VAR_REAL(nid, nvarid, masse_glo)
396#endif
397      IF (ierr .NE. NF_NOERR) THEN
398         write(lunout,*)"dynetat0_loc: Lecture echouee pour <masse>"
399         CALL abort
400      ENDIF
401      masse(ijb_u:ije_u,:)=masse_glo(ijb_u:ije_u,:)
402      DEALLOCATE(masse_glo)
403      ALLOCATE(ps_glo(ip1jmp1))
404
405      ierr = NF_INQ_VARID (nid, "ps", nvarid)
406      IF (ierr .NE. NF_NOERR) THEN
407         write(lunout,*)"dynetat0_loc: Le champ <ps> est absent"
408         CALL abort
409      ENDIF
410#ifdef NC_DOUBLE
411      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, ps_glo)
412#else
413      ierr = NF_GET_VAR_REAL(nid, nvarid, ps_glo)
414#endif
415      IF (ierr .NE. NF_NOERR) THEN
416         write(lunout,*)"dynetat0_loc: Lecture echouee pour <ps>"
417         CALL abort
418      ENDIF
419
420      ps(ijb_u:ije_u)=ps_glo(ijb_u:ije_u)
421      DEALLOCATE(ps_glo)
422
423      ierr = NF_CLOSE(nid)
424
425       day_ini=day_ini+INT(time)
426       time=time-INT(time)
427
428  1   FORMAT(//10x,'la valeur de im =',i4,2x,'lue sur le fichier de dem
429     *arrage est differente de la valeur parametree iim =',i4//)
430   2  FORMAT(//10x,'la valeur de jm =',i4,2x,'lue sur le fichier de dem
431     *arrage est differente de la valeur parametree jjm =',i4//)
432   3  FORMAT(//10x,'la valeur de lmax =',i4,2x,'lue sur le fichier dema
433     *rrage est differente de la valeur parametree llm =',i4//)
434   4  FORMAT(//10x,'la valeur de dtrv =',i4,2x,'lue sur le fichier dema
435     *rrage est differente de la valeur  dtinteg =',i4//)
436
437      RETURN
438      END
Note: See TracBrowser for help on using the repository browser.