source: LMDZ.3.3/branches/rel-LF/libf/dyn3d/dynetat0.F @ 5392

Last change on this file since 5392 was 353, checked in by lmdzadmin, 23 years ago

2 changements pour les fichiers histoire:

  • utilisation de l'entree "rectilineaire" de IOIPSL pour ne plus avoir

a

lancer ncregular a chaque fois

  • le calendrier des fichiers histoire est maintenant base sur la date d'initialisation de la simulation plutot que sur la date de depart du

job

en cours

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