source: trunk/LMDZ.COMMON/libf/dyn3dpar/dynetat0.F @ 1000

Last change on this file since 1000 was 907, checked in by emillour, 12 years ago

Generic/common/universal models:

  • Added possibility to write restartfi.nc files in parallel (MPI)
  • Added arch files suitable for Ada (IDRIS supercomputer)
  • Some further cleanup is clearly required to merge generic/universal models
  • LMDZ.UNIVERSAL/libf/phygeneric/dimphy.F90 to be uptaded in following commit (can't both remove a symbolic link and create a file with the same name in a single commit with svn).

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