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

Last change on this file since 279 was 232, checked in by lmdzadmin, 23 years ago

Merge par rapport a la branche principale
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.5 KB
RevLine 
[232]1c
2c $Header$
3c
[2]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_ini    = tab_cntrl(4)
85      anne_ini   = 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)
[232]110        taux     = tab_cntrl(28)
111        tauy     = tab_cntrl(29)
[2]112      ELSE
113        fxyhypb = . FALSE .
114        ysinus  = . FALSE .
115        IF( tab_cntrl(27).EQ.1. ) ysinus = . TRUE.
116      ENDIF
117c   .................................................................
118c
119c
120      PRINT*,'rad,omeg,g,cpp,kappa',rad,omeg,g,cpp,kappa
121
122      IF(   im.ne.iim           )  THEN
123          PRINT 1,im,iim
124          STOP
125      ELSE  IF( jm.ne.jjm       )  THEN
126          PRINT 2,jm,jjm
127          STOP
128      ELSE  IF( lllm.ne.llm     )  THEN
129          PRINT 3,lllm,llm
130          STOP
131      ENDIF
132
133      ierr = NF_INQ_VARID (nid, "rlonu", nvarid)
134      IF (ierr .NE. NF_NOERR) THEN
135         PRINT*, "dynetat0: Le champ <rlonu> est absent"
136         CALL abort
137      ENDIF
138#ifdef NC_DOUBLE
139      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonu)
140#else
141      ierr = NF_GET_VAR_REAL(nid, nvarid, rlonu)
142#endif
143      IF (ierr .NE. NF_NOERR) THEN
144         PRINT*, "dynetat0: Lecture echouee pour <rlonu>"
145         CALL abort
146      ENDIF
147
148      ierr = NF_INQ_VARID (nid, "rlatu", nvarid)
149      IF (ierr .NE. NF_NOERR) THEN
150         PRINT*, "dynetat0: Le champ <rlatu> est absent"
151         CALL abort
152      ENDIF
153#ifdef NC_DOUBLE
154      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatu)
155#else
156      ierr = NF_GET_VAR_REAL(nid, nvarid, rlatu)
157#endif
158      IF (ierr .NE. NF_NOERR) THEN
159         PRINT*, "dynetat0: Lecture echouee pour <rlatu>"
160         CALL abort
161      ENDIF
162
163      ierr = NF_INQ_VARID (nid, "rlonv", nvarid)
164      IF (ierr .NE. NF_NOERR) THEN
165         PRINT*, "dynetat0: Le champ <rlonv> est absent"
166         CALL abort
167      ENDIF
168#ifdef NC_DOUBLE
169      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonv)
170#else
171      ierr = NF_GET_VAR_REAL(nid, nvarid, rlonv)
172#endif
173      IF (ierr .NE. NF_NOERR) THEN
174         PRINT*, "dynetat0: Lecture echouee pour <rlonv>"
175         CALL abort
176      ENDIF
177
178      ierr = NF_INQ_VARID (nid, "rlatv", nvarid)
179      IF (ierr .NE. NF_NOERR) THEN
180         PRINT*, "dynetat0: Le champ <rlatv> est absent"
181         CALL abort
182      ENDIF
183#ifdef NC_DOUBLE
184      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatv)
185#else
186      ierr = NF_GET_VAR_REAL(nid, nvarid, rlatv)
187#endif
188      IF (ierr .NE. NF_NOERR) THEN
189         PRINT*, "dynetat0: Lecture echouee pour rlatv"
190         CALL abort
191      ENDIF
192
193      ierr = NF_INQ_VARID (nid, "cu", nvarid)
194      IF (ierr .NE. NF_NOERR) THEN
195         PRINT*, "dynetat0: Le champ <cu> est absent"
196         CALL abort
197      ENDIF
198#ifdef NC_DOUBLE
199      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, cu)
200#else
201      ierr = NF_GET_VAR_REAL(nid, nvarid, cu)
202#endif
203      IF (ierr .NE. NF_NOERR) THEN
204         PRINT*, "dynetat0: Lecture echouee pour <cu>"
205         CALL abort
206      ENDIF
207
208      ierr = NF_INQ_VARID (nid, "cv", nvarid)
209      IF (ierr .NE. NF_NOERR) THEN
210         PRINT*, "dynetat0: Le champ <cv> est absent"
211         CALL abort
212      ENDIF
213#ifdef NC_DOUBLE
214      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, cv)
215#else
216      ierr = NF_GET_VAR_REAL(nid, nvarid, cv)
217#endif
218      IF (ierr .NE. NF_NOERR) THEN
219         PRINT*, "dynetat0: Lecture echouee pour <cv>"
220         CALL abort
221      ENDIF
222
223      ierr = NF_INQ_VARID (nid, "aire", nvarid)
224      IF (ierr .NE. NF_NOERR) THEN
225         PRINT*, "dynetat0: Le champ <aire> est absent"
226         CALL abort
227      ENDIF
228#ifdef NC_DOUBLE
229      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, aire)
230#else
231      ierr = NF_GET_VAR_REAL(nid, nvarid, aire)
232#endif
233      IF (ierr .NE. NF_NOERR) THEN
234         PRINT*, "dynetat0: Lecture echouee pour <aire>"
235         CALL abort
236      ENDIF
237
238      ierr = NF_INQ_VARID (nid, "phisinit", nvarid)
239      IF (ierr .NE. NF_NOERR) THEN
240         PRINT*, "dynetat0: Le champ <phisinit> est absent"
241         CALL abort
242      ENDIF
243#ifdef NC_DOUBLE
244      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, phis)
245#else
246      ierr = NF_GET_VAR_REAL(nid, nvarid, phis)
247#endif
248      IF (ierr .NE. NF_NOERR) THEN
249         PRINT*, "dynetat0: Lecture echouee pour <phisinit>"
250         CALL abort
251      ENDIF
252
253      ierr = NF_INQ_VARID (nid, "temps", nvarid)
254      IF (ierr .NE. NF_NOERR) THEN
255         PRINT*, "dynetat0: Le champ <temps> est absent"
256         CALL abort
257      ENDIF
258#ifdef NC_DOUBLE
259      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, time)
260#else
261      ierr = NF_GET_VAR_REAL(nid, nvarid, time)
262#endif
263      IF (ierr .NE. NF_NOERR) THEN
264         PRINT*, "dynetat0: Lecture echouee <temps>"
265         CALL abort
266      ENDIF
267
268      ierr = NF_INQ_VARID (nid, "ucov", nvarid)
269      IF (ierr .NE. NF_NOERR) THEN
270         PRINT*, "dynetat0: Le champ <ucov> est absent"
271         CALL abort
272      ENDIF
273#ifdef NC_DOUBLE
274      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, ucov)
275#else
276      ierr = NF_GET_VAR_REAL(nid, nvarid, ucov)
277#endif
278      IF (ierr .NE. NF_NOERR) THEN
279         PRINT*, "dynetat0: Lecture echouee pour <ucov>"
280         CALL abort
281      ENDIF
282 
283      ierr = NF_INQ_VARID (nid, "vcov", nvarid)
284      IF (ierr .NE. NF_NOERR) THEN
285         PRINT*, "dynetat0: Le champ <vcov> est absent"
286         CALL abort
287      ENDIF
288#ifdef NC_DOUBLE
289      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, vcov)
290#else
291      ierr = NF_GET_VAR_REAL(nid, nvarid, vcov)
292#endif
293      IF (ierr .NE. NF_NOERR) THEN
294         PRINT*, "dynetat0: Lecture echouee pour <vcov>"
295         CALL abort
296      ENDIF
297
298      ierr = NF_INQ_VARID (nid, "teta", nvarid)
299      IF (ierr .NE. NF_NOERR) THEN
300         PRINT*, "dynetat0: Le champ <teta> est absent"
301         CALL abort
302      ENDIF
303#ifdef NC_DOUBLE
304      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, teta)
305#else
306      ierr = NF_GET_VAR_REAL(nid, nvarid, teta)
307#endif
308      IF (ierr .NE. NF_NOERR) THEN
309         PRINT*, "dynetat0: Lecture echouee pour <teta>"
310         CALL abort
311      ENDIF
312
313
314      IF(nq.GE.1) THEN
315      DO iq=1,nq
316        str3(1:1)='q'
317        IF(iq.GT.99) THEN
318           PRINT*, "Trop de traceurs"
319           CALL abort
320        ENDIF
321        WRITE(str3(2:3),'(i2.2)') iq
322        ierr =  NF_INQ_VARID (nid, str3, nvarid)
323        IF (ierr .NE. NF_NOERR) THEN
324           PRINT*, "dynetat0: Le champ <"//str3//"> est absent"
325           PRINT*, "          Il est donc initialise a zero"
326           CALL initial0(ijp1llm,q(1,1,iq))
327        ELSE
328#ifdef NC_DOUBLE
329          ierr = NF_GET_VAR_DOUBLE(nid, nvarid, q(1,1,iq))
330#else
331          ierr = NF_GET_VAR_REAL(nid, nvarid, q(1,1,iq))
332#endif
333          IF (ierr .NE. NF_NOERR) THEN
334             PRINT*, "dynetat0: Lecture echouee pour "//str3
335             CALL abort
336          ENDIF
337        ENDIF
338      ENDDO
339      ENDIF
340
341      ierr = NF_INQ_VARID (nid, "masse", nvarid)
342      IF (ierr .NE. NF_NOERR) THEN
343         PRINT*, "dynetat0: Le champ <masse> est absent"
344         CALL abort
345      ENDIF
346#ifdef NC_DOUBLE
347      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, masse)
348#else
349      ierr = NF_GET_VAR_REAL(nid, nvarid, masse)
350#endif
351      IF (ierr .NE. NF_NOERR) THEN
352         PRINT*, "dynetat0: Lecture echouee pour <masse>"
353         CALL abort
354      ENDIF
355
356      ierr = NF_INQ_VARID (nid, "ps", nvarid)
357      IF (ierr .NE. NF_NOERR) THEN
358         PRINT*, "dynetat0: Le champ <ps> est absent"
359         CALL abort
360      ENDIF
361#ifdef NC_DOUBLE
362      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, ps)
363#else
364      ierr = NF_GET_VAR_REAL(nid, nvarid, ps)
365#endif
366      IF (ierr .NE. NF_NOERR) THEN
367         PRINT*, "dynetat0: Lecture echouee pour <ps>"
368         CALL abort
369      ENDIF
370
371      ierr = NF_CLOSE(nid)
372
373       day_ini=day_ini+INT(time)
374       time=time-INT(time)
375
376  1   FORMAT(//10x,'la valeur de im =',i4,2x,'lue sur le fichier de dem
377     *arrage est differente de la valeur parametree iim =',i4//)
378   2  FORMAT(//10x,'la valeur de jm =',i4,2x,'lue sur le fichier de dem
379     *arrage est differente de la valeur parametree jjm =',i4//)
380   3  FORMAT(//10x,'la valeur de lmax =',i4,2x,'lue sur le fichier dema
381     *rrage est differente de la valeur parametree llm =',i4//)
382   4  FORMAT(//10x,'la valeur de dtrv =',i4,2x,'lue sur le fichier dema
383     *rrage est differente de la valeur  dtinteg =',i4//)
384
385      RETURN
386      END
Note: See TracBrowser for help on using the repository browser.