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

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

Version testing basée sur la r1668

http://lmdz.lmd.jussieu.fr/utilisateurs/distribution-du-modele/versions-intermediaires


Testing release based on r1668

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