source: trunk/LMDZ.COMMON/libf/dynphy_lonlat/phyvenus/readstart.F @ 3553

Last change on this file since 3553 was 1443, checked in by emillour, 10 years ago

Titan and Venus GCMs:
Follow-up to the changes in dynamics/physics interface: ener.h, logic.h, serre.h and temps.h are now modules.
EM

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