source: LMDZ4/trunk/libf/dyn3dpar/dynetat0.F @ 1345

Last change on this file since 1345 was 1146, checked in by Laurent Fairhead, 16 years ago

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