source: trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phytitan/readstart.F @ 1428

Last change on this file since 1428 was 1403, checked in by emillour, 11 years ago

All models: Reorganizing the physics/dynamics interface.

  • makelmdz and makelmdz_fcm scripts adapted to handle the new directory settings
  • misc: (replaces what was the "bibio" directory)
  • Should only contain extremely generic (and non physics or dynamics-specific) routines
  • Therefore moved initdynav.F90, initfluxsto.F, inithist.F, writedynav.F90, write_field.F90, writehist.F to "dyn3d_common"
  • dynlonlat_phylonlat: (new interface directory)
  • This directory contains routines relevent to physics/dynamics grid interactions, e.g. routines gr_dyn_fi or gr_fi_dyn and calfis
  • Moreover the dynlonlat_phylonlat contains directories "phy*" corresponding to each physics package "phy*" to be used. These subdirectories should only contain specific interfaces (e.g. iniphysiq) or main programs (e.g. newstart)
  • phy*/dyn1d: this subdirectory contains the 1D model using physics from phy*

EM
File size: 13.8 KB
RevLine 
[1056]1!
2! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/dynetat0.F,v 1.2 2004/06/22 11:45:30 lmdzadmin Exp $
3!
4      SUBROUTINE readstart(fichnom,nq,vcov,ucov,
5     .                    teta,q,masse,ps,phis,tab_cntrl)
6
7      USE infotrac
8     
9      IMPLICIT NONE
10
11c=======================================================================
12c
13c   Auteur:  P. Le Van / L.Fairhead
14c   -------
15c
16c   objet:
17c   ------
18c
19c   Lecture de l'etat initial
20c
21c=======================================================================
22c-----------------------------------------------------------------------
23c   Declarations:
24c   -------------
25
26#include "dimensions.h"
27#include "paramet.h"
28#include "temps.h"
29#include "comconst.h"
30#include "comvert.h"
31#include "comgeom.h"
32#include "ener.h"
33#include "description.h"
34#include "serre.h"
35#include "logic.h"
36#include "netcdf.inc"
37
38c   Arguments:
39c   ----------
40
41      CHARACTER*(*) fichnom
42      INTEGER nq
43      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm)
44      REAL q(ip1jmp1,llm,nq),masse(ip1jmp1,llm)
45      REAL ps(ip1jmp1),phis(ip1jmp1)
46      REAL time
47      INTEGER length
48      PARAMETER (length=100)
49      REAL tab_cntrl(length) ! tableau des parametres du run
50
51c   Variables
52c
53      INTEGER iq,i,j,ij,l
54      INTEGER ierr, nid, nvarid
55
56c   local, cas particulier compo.dat
57      integer nyread
58      real    qy(jjp1,llm,nq)
59      character*10 nomy(nq)
60
61c-----------------------------------------------------------------------
62
63c  Ouverture NetCDF du fichier etat initial
64
65      ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
66      IF (ierr.NE.NF_NOERR) THEN
67        write(6,*)' Pb d''ouverture du fichier start.nc'
68        write(6,*)' ierr = ', ierr
69        CALL ABORT
70      ENDIF
71
72c
73      ierr = NF_INQ_VARID (nid, "controle", nvarid)
74      IF (ierr .NE. NF_NOERR) THEN
75         PRINT*, "dynetat0: Le champ <controle> est absent"
76         CALL abort
77      ENDIF
78#ifdef NC_DOUBLE
79      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl)
80#else
81      ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
82#endif
83      IF (ierr .NE. NF_NOERR) THEN
84         PRINT*, "dynetat0: Lecture echoue pour <controle>"
85         CALL abort
86      ENDIF
87
88      im         = tab_cntrl(1)
89      jm         = tab_cntrl(2)
90      lllm       = tab_cntrl(3)
91      day_ref    = tab_cntrl(4)
92      annee_ref  = tab_cntrl(5)
93      rad        = tab_cntrl(6)
94      omeg       = tab_cntrl(7)
95      g          = tab_cntrl(8)
96      cpp        = tab_cntrl(9)
97      kappa      = tab_cntrl(10)
98      daysec     = tab_cntrl(11)
99      dtvr       = tab_cntrl(12)
100      etot0      = tab_cntrl(13)
101      ptot0      = tab_cntrl(14)
102      ztot0      = tab_cntrl(15)
103      stot0      = tab_cntrl(16)
104      ang0       = tab_cntrl(17)
105      pa         = tab_cntrl(18)
106      preff      = tab_cntrl(19)
107c
108      clon       = tab_cntrl(20)
109      clat       = tab_cntrl(21)
110      grossismx  = tab_cntrl(22)
111      grossismy  = tab_cntrl(23)
112c
113      IF ( tab_cntrl(24).EQ.1. )  THEN
114        fxyhypb  = . TRUE .
115c        dzoomx   = tab_cntrl(25)
116c        dzoomy   = tab_cntrl(26)
117c        taux     = tab_cntrl(28)
118c        tauy     = tab_cntrl(29)
119      ELSE
120        fxyhypb = . FALSE .
121        ysinus  = . FALSE .
122        IF( tab_cntrl(27).EQ.1. ) ysinus = . TRUE.
123      ENDIF
124
125      day_ini = tab_cntrl(30)
126      itau_dyn = tab_cntrl(31)
127      start_time = tab_cntrl(32)
128c   .................................................................
129c
130c
131      PRINT*,'rad,omeg,g,cpp,kappa',rad,omeg,g,cpp,kappa
132
133      IF(   im.ne.iim           )  THEN
134          PRINT 1,im,iim
135          STOP
136      ELSE  IF( jm.ne.jjm       )  THEN
137          PRINT 2,jm,jjm
138          STOP
139      ELSE  IF( lllm.ne.llm     )  THEN
140          PRINT 3,lllm,llm
141          STOP
142      ENDIF
143
144      ierr = NF_INQ_VARID (nid, "rlonu", nvarid)
145      IF (ierr .NE. NF_NOERR) THEN
146         PRINT*, "dynetat0: Le champ <rlonu> est absent"
147         CALL abort
148      ENDIF
149#ifdef NC_DOUBLE
150      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonu)
151#else
152      ierr = NF_GET_VAR_REAL(nid, nvarid, rlonu)
153#endif
154      IF (ierr .NE. NF_NOERR) THEN
155         PRINT*, "dynetat0: Lecture echouee pour <rlonu>"
156         CALL abort
157      ENDIF
158
159      ierr = NF_INQ_VARID (nid, "rlatu", nvarid)
160      IF (ierr .NE. NF_NOERR) THEN
161         PRINT*, "dynetat0: Le champ <rlatu> est absent"
162         CALL abort
163      ENDIF
164#ifdef NC_DOUBLE
165      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatu)
166#else
167      ierr = NF_GET_VAR_REAL(nid, nvarid, rlatu)
168#endif
169      IF (ierr .NE. NF_NOERR) THEN
170         PRINT*, "dynetat0: Lecture echouee pour <rlatu>"
171         CALL abort
172      ENDIF
173
174      ierr = NF_INQ_VARID (nid, "rlonv", nvarid)
175      IF (ierr .NE. NF_NOERR) THEN
176         PRINT*, "dynetat0: Le champ <rlonv> est absent"
177         CALL abort
178      ENDIF
179#ifdef NC_DOUBLE
180      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonv)
181#else
182      ierr = NF_GET_VAR_REAL(nid, nvarid, rlonv)
183#endif
184      IF (ierr .NE. NF_NOERR) THEN
185         PRINT*, "dynetat0: Lecture echouee pour <rlonv>"
186         CALL abort
187      ENDIF
188
189      ierr = NF_INQ_VARID (nid, "rlatv", nvarid)
190      IF (ierr .NE. NF_NOERR) THEN
191         PRINT*, "dynetat0: Le champ <rlatv> est absent"
192         CALL abort
193      ENDIF
194#ifdef NC_DOUBLE
195      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatv)
196#else
197      ierr = NF_GET_VAR_REAL(nid, nvarid, rlatv)
198#endif
199      IF (ierr .NE. NF_NOERR) THEN
200         PRINT*, "dynetat0: Lecture echouee pour rlatv"
201         CALL abort
202      ENDIF
203
204      ierr = NF_INQ_VARID (nid, "nivsigs", nvarid)
205      IF (ierr .NE. NF_NOERR) THEN
206         PRINT*, "dynetat0: Le champ <nivsigs> est absent"
207         CALL abort
208      ENDIF
209#ifdef NC_DOUBLE
210      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, nivsigs)
211#else
212      ierr = NF_GET_VAR_REAL(nid, nvarid, nivsigs)
213#endif
214      IF (ierr .NE. NF_NOERR) THEN
215         PRINT*, "dynetat0: Lecture echouee pour <nivsigs>"
216         CALL abort
217      ENDIF
218
219      ierr = NF_INQ_VARID (nid, "nivsig", nvarid)
220      IF (ierr .NE. NF_NOERR) THEN
221         PRINT*, "dynetat0: Le champ <nivsig> est absent"
222         CALL abort
223      ENDIF
224#ifdef NC_DOUBLE
225      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, nivsig)
226#else
227      ierr = NF_GET_VAR_REAL(nid, nvarid, nivsig)
228#endif
229      IF (ierr .NE. NF_NOERR) THEN
230         PRINT*, "dynetat0: Lecture echouee pour <nivsig>"
231         CALL abort
232      ENDIF
233
234      ierr = NF_INQ_VARID (nid, "ap", nvarid)
235      IF (ierr .NE. NF_NOERR) THEN
236         PRINT*, "dynetat0: Le champ <ap> est absent"
237         CALL abort
238      ENDIF
239#ifdef NC_DOUBLE
240      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, ap)
241#else
242      ierr = NF_GET_VAR_REAL(nid, nvarid, ap)
243#endif
244      IF (ierr .NE. NF_NOERR) THEN
245         PRINT*, "dynetat0: Lecture echouee pour <ap>"
246         CALL abort
247      ENDIF
248
249      ierr = NF_INQ_VARID (nid, "bp", nvarid)
250      IF (ierr .NE. NF_NOERR) THEN
251         PRINT*, "dynetat0: Le champ <bp> est absent"
252         CALL abort
253      ENDIF
254#ifdef NC_DOUBLE
255      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, bp)
256#else
257      ierr = NF_GET_VAR_REAL(nid, nvarid, bp)
258#endif
259      IF (ierr .NE. NF_NOERR) THEN
260         PRINT*, "dynetat0: Lecture echouee pour <bp>"
261         CALL abort
262      ENDIF
263
264      ierr = NF_INQ_VARID (nid, "presnivs", nvarid)
265      IF (ierr .NE. NF_NOERR) THEN
266         PRINT*, "dynetat0: Le champ <presnivs> est absent"
267         CALL abort
268      ENDIF
269#ifdef NC_DOUBLE
270      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, presnivs)
271#else
272      ierr = NF_GET_VAR_REAL(nid, nvarid, presnivs)
273#endif
274      IF (ierr .NE. NF_NOERR) THEN
275         PRINT*, "dynetat0: Lecture echouee pour <presnivs>"
276         CALL abort
277      ENDIF
278
279      ierr = NF_INQ_VARID (nid, "cu", nvarid)
280      IF (ierr .NE. NF_NOERR) THEN
281         PRINT*, "dynetat0: Le champ <cu> est absent"
282         CALL abort
283      ENDIF
284#ifdef NC_DOUBLE
285      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, cu)
286#else
287      ierr = NF_GET_VAR_REAL(nid, nvarid, cu)
288#endif
289      IF (ierr .NE. NF_NOERR) THEN
290         PRINT*, "dynetat0: Lecture echouee pour <cu>"
291         CALL abort
292      ENDIF
293
294      ierr = NF_INQ_VARID (nid, "cv", nvarid)
295      IF (ierr .NE. NF_NOERR) THEN
296         PRINT*, "dynetat0: Le champ <cv> est absent"
297         CALL abort
298      ENDIF
299#ifdef NC_DOUBLE
300      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, cv)
301#else
302      ierr = NF_GET_VAR_REAL(nid, nvarid, cv)
303#endif
304      IF (ierr .NE. NF_NOERR) THEN
305         PRINT*, "dynetat0: Lecture echouee pour <cv>"
306         CALL abort
307      ENDIF
308
309      ierr = NF_INQ_VARID (nid, "aire", nvarid)
310      IF (ierr .NE. NF_NOERR) THEN
311         PRINT*, "dynetat0: Le champ <aire> est absent"
312         CALL abort
313      ENDIF
314#ifdef NC_DOUBLE
315      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, aire)
316#else
317      ierr = NF_GET_VAR_REAL(nid, nvarid, aire)
318#endif
319      IF (ierr .NE. NF_NOERR) THEN
320         PRINT*, "dynetat0: Lecture echouee pour <aire>"
321         CALL abort
322      ENDIF
323
324      ierr = NF_INQ_VARID (nid, "phisinit", nvarid)
325      IF (ierr .NE. NF_NOERR) THEN
326         PRINT*, "dynetat0: Le champ <phisinit> est absent"
327         CALL abort
328      ENDIF
329#ifdef NC_DOUBLE
330      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, phis)
331#else
332      ierr = NF_GET_VAR_REAL(nid, nvarid, phis)
333#endif
334      IF (ierr .NE. NF_NOERR) THEN
335         PRINT*, "dynetat0: Lecture echouee pour <phisinit>"
336         CALL abort
337      ENDIF
338
339      ierr = NF_INQ_VARID (nid, "temps", nvarid)
340      IF (ierr .NE. NF_NOERR) THEN
341         PRINT*, "dynetat0: Le champ <temps> est absent"
342         CALL abort
343      ENDIF
344#ifdef NC_DOUBLE
345      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, time)
346#else
347      ierr = NF_GET_VAR_REAL(nid, nvarid, time)
348#endif
349      IF (ierr .NE. NF_NOERR) THEN
350         PRINT*, "dynetat0: Lecture echouee <temps>"
351         CALL abort
352      ENDIF
353
354      ierr = NF_INQ_VARID (nid, "ucov", nvarid)
355      IF (ierr .NE. NF_NOERR) THEN
356         PRINT*, "dynetat0: Le champ <ucov> est absent"
357         CALL abort
358      ENDIF
359#ifdef NC_DOUBLE
360      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, ucov)
361#else
362      ierr = NF_GET_VAR_REAL(nid, nvarid, ucov)
363#endif
364      IF (ierr .NE. NF_NOERR) THEN
365         PRINT*, "dynetat0: Lecture echouee pour <ucov>"
366         CALL abort
367      ENDIF
368 
369      ierr = NF_INQ_VARID (nid, "vcov", nvarid)
370      IF (ierr .NE. NF_NOERR) THEN
371         PRINT*, "dynetat0: Le champ <vcov> est absent"
372         CALL abort
373      ENDIF
374#ifdef NC_DOUBLE
375      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, vcov)
376#else
377      ierr = NF_GET_VAR_REAL(nid, nvarid, vcov)
378#endif
379      IF (ierr .NE. NF_NOERR) THEN
380         PRINT*, "dynetat0: Lecture echouee pour <vcov>"
381         CALL abort
382      ENDIF
383
384      ierr = NF_INQ_VARID (nid, "teta", nvarid)
385      IF (ierr .NE. NF_NOERR) THEN
386         PRINT*, "dynetat0: Le champ <teta> est absent"
387         CALL abort
388      ENDIF
389#ifdef NC_DOUBLE
390      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, teta)
391#else
392      ierr = NF_GET_VAR_REAL(nid, nvarid, teta)
393#endif
394      IF (ierr .NE. NF_NOERR) THEN
395         PRINT*, "dynetat0: Lecture echouee pour <teta>"
396         CALL abort
397      ENDIF
398
399c TNAME: IL EST LU A PARTIR DE traceur.def (mettre l'ancien si
400c                changement du nombre de traceurs)
401
402      IF((nq.GE.1).and.(iflag_trac.eq.1)) THEN
403      DO iq=1,nq
404        ierr =  NF_INQ_VARID (nid, tname(iq), nvarid)
405        IF (ierr .NE. NF_NOERR) THEN
406            PRINT*, "dynetat0: Le champ <"//tname(iq)//"> est absent"
407            PRINT*, "          Il est donc initialise a zero"
408            q(:,:,iq)=0.
409        ELSE
410#ifdef NC_DOUBLE
411          ierr = NF_GET_VAR_DOUBLE(nid, nvarid, q(1,1,iq))
412#else
413          ierr = NF_GET_VAR_REAL(nid, nvarid, q(1,1,iq))
414#endif
415          IF (ierr .NE. NF_NOERR) THEN
416             PRINT*, "dynetat0: Lecture echouee pour "//tname(iq)
417             CALL abort
418          ENDIF
419        ENDIF
420      ENDDO
421      ENDIF
422
423c--------------------------------------------
424c cas particulier: lecture des traceurs 2D dans compo.dat (issu de start 2d)
425c
426      if (1.eq.0) then
427      OPEN(10,file='compo.dat',status='old',form='formatted',
428     . iostat=ierr)
429      IF (ierr.ne.0) THEN
430       WRITE(6,*)' Pb d''ouverture du fichier de demarrage (compo.dat)'
431       WRITE(6,*)' ierr = ', ierr
432       CALL exit(1)
433      ENDIF
434      READ(10,*) nyread
435      print*,"nombre de composes chimiques ajoutes:",nyread
436      READ(10,*) (((qy(ij,l,iq),ij=1,jjp1),l=1,llm),
437     s                   iq=1,nyread)
438      do iq=1,nyread
439         READ(10,'(1X,A10)') nomy(iq)
440         print*,nomy(iq)," = ", tname(iq+10)
441         do i=1,iip1
442          do j=1,jjp1
443           ij = (j-1)*iip1+i
444           q(ij,:,iq+10) = qy(j,:,iq)
445          enddo
446         enddo
447      enddo
448      CLOSE(10)
449      endif
450c--------------------------------------------
451
452      ierr = NF_INQ_VARID (nid, "masse", nvarid)
453      IF (ierr .NE. NF_NOERR) THEN
454         PRINT*, "dynetat0: Le champ <masse> est absent"
455         CALL abort
456      ENDIF
457#ifdef NC_DOUBLE
458      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, masse)
459#else
460      ierr = NF_GET_VAR_REAL(nid, nvarid, masse)
461#endif
462      IF (ierr .NE. NF_NOERR) THEN
463         PRINT*, "dynetat0: Lecture echouee pour <masse>"
464         CALL abort
465      ENDIF
466
467      ierr = NF_INQ_VARID (nid, "ps", nvarid)
468      IF (ierr .NE. NF_NOERR) THEN
469         PRINT*, "dynetat0: Le champ <ps> est absent"
470         CALL abort
471      ENDIF
472#ifdef NC_DOUBLE
473      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, ps)
474#else
475      ierr = NF_GET_VAR_REAL(nid, nvarid, ps)
476#endif
477      IF (ierr .NE. NF_NOERR) THEN
478         PRINT*, "dynetat0: Lecture echouee pour <ps>"
479         CALL abort
480      ENDIF
481
482      ierr = NF_CLOSE(nid)
483
484       day_ini=day_ini+INT(time)
485       time=time-INT(time)
486
487  1   FORMAT(//10x,'la valeur de im =',i4,2x,'lue sur le fichier de dem
488     *arrage est differente de la valeur parametree iim =',i4//)
489   2  FORMAT(//10x,'la valeur de jm =',i4,2x,'lue sur le fichier de dem
490     *arrage est differente de la valeur parametree jjm =',i4//)
491   3  FORMAT(//10x,'la valeur de lmax =',i4,2x,'lue sur le fichier dema
492     *rrage est differente de la valeur parametree llm =',i4//)
493   4  FORMAT(//10x,'la valeur de dtrv =',i4,2x,'lue sur le fichier dema
494     *rrage est differente de la valeur  dtinteg =',i4//)
495
496      RETURN
497      END
Note: See TracBrowser for help on using the repository browser.