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

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