source: LMDZ5/branches/LMDZ5-DOFOCO/libf/dyn3dmem/dynetat0_loc.F @ 5440

Last change on this file since 5440 was 1673, checked in by Laurent Fairhead, 12 years ago

Fin du phasage de la dynamique parallele localisee (petite memoire) avec le tronc LMDZ5 r1671
Il reste quelques routines a verifier (en particulier ce qui touche a l'etude des cas academiques)
et la validation a effectuer

End of the phasing of the localised (low memory) parallel dynamics package with the
LMDZ5 trunk (r1671)
Some routines still need some checking (in particular the academic cases) and some
validation is still required
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
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.