source: LMDZ5/branches/testing/libf/dyn3d/dynetat0.F @ 1665

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

Version testing basée sur la r1628

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

Testing release based on r1628
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 10.8 KB
Line 
1!
2! $Id $
3!
4      SUBROUTINE dynetat0(fichnom,vcov,ucov,
5     .                    teta,q,masse,ps,phis,time)
6
7      USE infotrac
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(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm)
43      REAL q(ip1jmp1,llm,nqtot),masse(ip1jmp1,llm)
44      REAL ps(ip1jmp1),phis(ip1jmp1)
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
55c-----------------------------------------------------------------------
56
57c  Ouverture NetCDF du fichier etat initial
58
59      ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
60      IF (ierr.NE.NF_NOERR) THEN
61        write(lunout,*)'dynetat0: Pb d''ouverture du fichier start.nc'
62        write(lunout,*)' ierr = ', ierr
63        CALL ABORT
64      ENDIF
65
66c
67      ierr = NF_INQ_VARID (nid, "controle", nvarid)
68      IF (ierr .NE. NF_NOERR) THEN
69         write(lunout,*)"dynetat0: Le champ <controle> est absent"
70         CALL abort
71      ENDIF
72#ifdef NC_DOUBLE
73      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl)
74#else
75      ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
76#endif
77      IF (ierr .NE. NF_NOERR) THEN
78         write(lunout,*)"dynetat0: Lecture echoue pour <controle>"
79         CALL abort
80      ENDIF
81
82      im         = tab_cntrl(1)
83      jm         = tab_cntrl(2)
84      lllm       = tab_cntrl(3)
85      day_ref    = tab_cntrl(4)
86      annee_ref  = tab_cntrl(5)
87      rad        = tab_cntrl(6)
88      omeg       = tab_cntrl(7)
89      g          = tab_cntrl(8)
90      cpp        = tab_cntrl(9)
91      kappa      = tab_cntrl(10)
92      daysec     = tab_cntrl(11)
93      dtvr       = tab_cntrl(12)
94      etot0      = tab_cntrl(13)
95      ptot0      = tab_cntrl(14)
96      ztot0      = tab_cntrl(15)
97      stot0      = tab_cntrl(16)
98      ang0       = tab_cntrl(17)
99      pa         = tab_cntrl(18)
100      preff      = tab_cntrl(19)
101c
102      clon       = tab_cntrl(20)
103      clat       = tab_cntrl(21)
104      grossismx  = tab_cntrl(22)
105      grossismy  = tab_cntrl(23)
106c
107      IF ( tab_cntrl(24).EQ.1. )  THEN
108        fxyhypb  = . TRUE .
109c        dzoomx   = tab_cntrl(25)
110c        dzoomy   = tab_cntrl(26)
111c        taux     = tab_cntrl(28)
112c        tauy     = tab_cntrl(29)
113      ELSE
114        fxyhypb = . FALSE .
115        ysinus  = . FALSE .
116        IF( tab_cntrl(27).EQ.1. ) ysinus = . TRUE.
117      ENDIF
118
119      day_ini = tab_cntrl(30)
120      itau_dyn = tab_cntrl(31)
121      start_time = tab_cntrl(32)
122c   .................................................................
123c
124c
125      write(lunout,*)'dynetat0: rad,omeg,g,cpp,kappa',
126     &               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         write(lunout,*)"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         write(lunout,*)"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         write(lunout,*)"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         write(lunout,*)"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         write(lunout,*)"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         write(lunout,*)"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         write(lunout,*)"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         write(lunout,*)"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         write(lunout,*)"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         write(lunout,*)"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         write(lunout,*)"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         write(lunout,*)"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         write(lunout,*)"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         write(lunout,*)"dynetat0: Lecture echouee pour <aire>"
241         CALL abort
242      ENDIF
243
244      ierr = NF_INQ_VARID (nid, "phisinit", nvarid)
245      IF (ierr .NE. NF_NOERR) THEN
246         write(lunout,*)"dynetat0: Le champ <phisinit> est absent"
247         CALL abort
248      ENDIF
249#ifdef NC_DOUBLE
250      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, phis)
251#else
252      ierr = NF_GET_VAR_REAL(nid, nvarid, phis)
253#endif
254      IF (ierr .NE. NF_NOERR) THEN
255         write(lunout,*)"dynetat0: Lecture echouee pour <phisinit>"
256         CALL abort
257      ENDIF
258
259      ierr = NF_INQ_VARID (nid, "temps", nvarid)
260      IF (ierr .NE. NF_NOERR) THEN
261         write(lunout,*)"dynetat0: Le champ <temps> est absent"
262         CALL abort
263      ENDIF
264#ifdef NC_DOUBLE
265      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, time)
266#else
267      ierr = NF_GET_VAR_REAL(nid, nvarid, time)
268#endif
269      IF (ierr .NE. NF_NOERR) THEN
270         write(lunout,*)"dynetat0: Lecture echouee <temps>"
271         CALL abort
272      ENDIF
273
274      ierr = NF_INQ_VARID (nid, "ucov", nvarid)
275      IF (ierr .NE. NF_NOERR) THEN
276         write(lunout,*)"dynetat0: Le champ <ucov> est absent"
277         CALL abort
278      ENDIF
279#ifdef NC_DOUBLE
280      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, ucov)
281#else
282      ierr = NF_GET_VAR_REAL(nid, nvarid, ucov)
283#endif
284      IF (ierr .NE. NF_NOERR) THEN
285         write(lunout,*)"dynetat0: Lecture echouee pour <ucov>"
286         CALL abort
287      ENDIF
288 
289      ierr = NF_INQ_VARID (nid, "vcov", nvarid)
290      IF (ierr .NE. NF_NOERR) THEN
291         write(lunout,*)"dynetat0: Le champ <vcov> est absent"
292         CALL abort
293      ENDIF
294#ifdef NC_DOUBLE
295      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, vcov)
296#else
297      ierr = NF_GET_VAR_REAL(nid, nvarid, vcov)
298#endif
299      IF (ierr .NE. NF_NOERR) THEN
300         write(lunout,*)"dynetat0: Lecture echouee pour <vcov>"
301         CALL abort
302      ENDIF
303
304      ierr = NF_INQ_VARID (nid, "teta", nvarid)
305      IF (ierr .NE. NF_NOERR) THEN
306         write(lunout,*)"dynetat0: Le champ <teta> est absent"
307         CALL abort
308      ENDIF
309#ifdef NC_DOUBLE
310      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, teta)
311#else
312      ierr = NF_GET_VAR_REAL(nid, nvarid, teta)
313#endif
314      IF (ierr .NE. NF_NOERR) THEN
315         write(lunout,*)"dynetat0: Lecture echouee pour <teta>"
316         CALL abort
317      ENDIF
318
319
320      IF(nqtot.GE.1) THEN
321      DO iq=1,nqtot
322        ierr =  NF_INQ_VARID (nid, tname(iq), nvarid)
323        IF (ierr .NE. NF_NOERR) THEN
324           write(lunout,*)"dynetat0: Le traceur <"//trim(tname(iq))//
325     &                    "> est absent"
326           write(lunout,*)"          Il est donc initialise a zero"
327           q(:,:,iq)=0.
328        ELSE
329#ifdef NC_DOUBLE
330          ierr = NF_GET_VAR_DOUBLE(nid, nvarid, q(1,1,iq))
331#else
332          ierr = NF_GET_VAR_REAL(nid, nvarid, q(1,1,iq))
333#endif
334          IF (ierr .NE. NF_NOERR) THEN
335            write(lunout,*)"dynetat0: Lecture echouee pour "//tname(iq)
336            CALL abort
337          ENDIF
338        ENDIF
339      ENDDO
340      ENDIF
341
342      ierr = NF_INQ_VARID (nid, "masse", nvarid)
343      IF (ierr .NE. NF_NOERR) THEN
344         write(lunout,*)"dynetat0: Le champ <masse> est absent"
345         CALL abort
346      ENDIF
347#ifdef NC_DOUBLE
348      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, masse)
349#else
350      ierr = NF_GET_VAR_REAL(nid, nvarid, masse)
351#endif
352      IF (ierr .NE. NF_NOERR) THEN
353         write(lunout,*)"dynetat0: Lecture echouee pour <masse>"
354         CALL abort
355      ENDIF
356
357      ierr = NF_INQ_VARID (nid, "ps", nvarid)
358      IF (ierr .NE. NF_NOERR) THEN
359         write(lunout,*)"dynetat0: Le champ <ps> est absent"
360         CALL abort
361      ENDIF
362#ifdef NC_DOUBLE
363      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, ps)
364#else
365      ierr = NF_GET_VAR_REAL(nid, nvarid, ps)
366#endif
367      IF (ierr .NE. NF_NOERR) THEN
368         write(lunout,*)"dynetat0: Lecture echouee pour <ps>"
369         CALL abort
370      ENDIF
371
372      ierr = NF_CLOSE(nid)
373
374       day_ini=day_ini+INT(time)
375       time=time-INT(time)
376
377  1   FORMAT(//10x,'la valeur de im =',i4,2x,'lue sur le fichier de dem
378     *arrage est differente de la valeur parametree iim =',i4//)
379   2  FORMAT(//10x,'la valeur de jm =',i4,2x,'lue sur le fichier de dem
380     *arrage est differente de la valeur parametree jjm =',i4//)
381   3  FORMAT(//10x,'la valeur de lmax =',i4,2x,'lue sur le fichier dema
382     *rrage est differente de la valeur parametree llm =',i4//)
383   4  FORMAT(//10x,'la valeur de dtrv =',i4,2x,'lue sur le fichier dema
384     *rrage est differente de la valeur  dtinteg =',i4//)
385
386      RETURN
387      END
Note: See TracBrowser for help on using the repository browser.