source: LMDZ5/trunk/libf/dyn3dmem/dynetat0.F @ 1649

Last change on this file since 1649 was 1632, checked in by Laurent Fairhead, 13 years ago

Import initial du répertoire dyn3dmem

Attention! ceci n'est qu'une version préliminaire du code "basse mémoire":
le code contenu dans ce répertoire est basé sur la r1320 et a donc besoin
d'être mis à jour par rapport à la dynamique parallèle d'aujourd'hui.
Ce code est toutefois mis à disposition pour circonvenir à des problèmes
de mémoire que certaines configurations du modèle pourraient rencontrer.
Dans l'état, il compile et tourne sur vargas et au CCRT

Initial import of dyn3dmem

Warning! this is just a preliminary version of the memory light code:
it is based on r1320 of the code and thus needs to be updated before
it can replace the present dyn3dpar code. It is nevertheless put at your
disposal to circumvent some memory problems some LMDZ configurations may
encounter. In its present state, it will compile and run on vargas and CCRT

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