source: LMDZ5/trunk/libf/dynetat0_loc.F @ 1630

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

Importation initiale du répertoire dyn3dmem


Initial import of dyn3dmem directory

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.