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

Last change on this file since 1907 was 1907, checked in by lguez, 10 years ago

Added a copyright property to every file of the distribution, except
for the fcm files (which have their own copyright). Use svn propget on
a file to see the copyright. For instance:

$ svn propget copyright libf/phylmd/physiq.F90
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

Also added the files defining the CeCILL version 2 license, in French
and English, at the top of the LMDZ tree.
  • 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        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
388         write(lunout,*)"dynetat0_loc: Le champ <masse> est absent"
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
397         write(lunout,*)"dynetat0_loc: Lecture echouee pour <masse>"
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
406         write(lunout,*)"dynetat0_loc: Le champ <ps> est absent"
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
415         write(lunout,*)"dynetat0_loc: Lecture echouee pour <ps>"
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.