source: LMDZ5/trunk/libf/dyn3dmem/dynetat0_loc.F @ 2277

Last change on this file since 2277 was 2270, checked in by crisi, 10 years ago

Adding isotopes in the dynamics and more generally tracers of tracers.
CRisi
  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
File size: 14.3 KB
Line 
1!
2! $Id$
3!
4      SUBROUTINE dynetat0_loc(fichnom,vcov,ucov,
5     .                    teta,q,masse,ps,phis,time)
6      USE infotrac
7      use control_mod, only : planet_type
8      USE parallel_lmdz
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 "netcdf.inc"
34#include "description.h"
35#include "serre.h"
36#include "logic.h"
37#include "iniprint.h"
38
39c   Arguments:
40c   ----------
41
42      CHARACTER*(*) fichnom
43      REAL vcov(ijb_v:ije_v,llm),ucov(ijb_u:ije_u,llm)
44      REAL teta(ijb_u:ije_u,llm)
45      REAL q(ijb_u:ije_u,llm,nqtot),masse(ijb_u:ije_u,llm)
46      REAL ps(ijb_u:ije_u),phis(ijb_u:ije_u)
47
48      REAL time
49
50c   Variables
51c
52      INTEGER length,iq
53      PARAMETER (length = 100)
54      REAL tab_cntrl(length) ! tableau des parametres du run
55      INTEGER ierr, nid, nvarid
56      REAL,ALLOCATABLE :: vcov_glo(:,:),ucov_glo(:,:),teta_glo(:,:)
57      REAL,ALLOCATABLE :: q_glo(:,:),masse_glo(:,:),ps_glo(:)
58      REAL,ALLOCATABLE :: phis_glo(:)
59
60      INTEGER idecal
61
62c-----------------------------------------------------------------------
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(lunout,*)
68     &  'dynetat0_loc: Pb d''ouverture du fichier start.nc'
69        write(lunout,*)' ierr = ', ierr
70        CALL ABORT_GCM("DYNETAT0", "", 1)
71      ENDIF
72
73c
74      ierr = NF_INQ_VARID (nid, "controle", nvarid)
75      IF (ierr .NE. NF_NOERR) THEN
76         write(lunout,*)"dynetat0_loc: Le champ <controle> est absent"
77         CALL abort_gcm("dynetat0", "", 1)
78      ENDIF
79#ifdef NC_DOUBLE
80      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl)
81#else
82      ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
83#endif
84      IF (ierr .NE. NF_NOERR) THEN
85         write(lunout,*)"dynetat0_loc: Lecture echoue pour <controle>"
86         CALL abort_gcm("dynetat0", "", 1)
87      ENDIF
88
89      !!! AS: idecal is a hack to be able to read planeto starts...
90      !!!     .... while keeping everything OK for LMDZ EARTH
91      if (planet_type.eq."generic") then
92          print*,'NOTE NOTE NOTE : Planeto-like start files'
93          idecal = 4
94          annee_ref  = 2000
95      else
96          print*,'NOTE NOTE NOTE : Earth-like start files'
97          idecal = 5
98          annee_ref  = tab_cntrl(5)
99      endif
100
101
102      im         = tab_cntrl(1)
103      jm         = tab_cntrl(2)
104      lllm       = tab_cntrl(3)
105      day_ref    = tab_cntrl(4)
106      rad        = tab_cntrl(idecal+1)
107      omeg       = tab_cntrl(idecal+2)
108      g          = tab_cntrl(idecal+3)
109      cpp        = tab_cntrl(idecal+4)
110      kappa      = tab_cntrl(idecal+5)
111      daysec     = tab_cntrl(idecal+6)
112      dtvr       = tab_cntrl(idecal+7)
113      etot0      = tab_cntrl(idecal+8)
114      ptot0      = tab_cntrl(idecal+9)
115      ztot0      = tab_cntrl(idecal+10)
116      stot0      = tab_cntrl(idecal+11)
117      ang0       = tab_cntrl(idecal+12)
118      pa         = tab_cntrl(idecal+13)
119      preff      = tab_cntrl(idecal+14)
120c
121      clon       = tab_cntrl(idecal+15)
122      clat       = tab_cntrl(idecal+16)
123      grossismx  = tab_cntrl(idecal+17)
124      grossismy  = tab_cntrl(idecal+18)
125c
126      IF ( tab_cntrl(idecal+19).EQ.1. )  THEN
127        fxyhypb  = . TRUE .
128c        dzoomx   = tab_cntrl(25)
129c        dzoomy   = tab_cntrl(26)
130c        taux     = tab_cntrl(28)
131c        tauy     = tab_cntrl(29)
132      ELSE
133        fxyhypb = . FALSE .
134        ysinus  = . FALSE .
135        IF( tab_cntrl(idecal+22).EQ.1. ) ysinus = . TRUE.
136      ENDIF
137
138      day_ini = tab_cntrl(30)
139      itau_dyn = tab_cntrl(31)
140c   .................................................................
141c
142c
143      write(lunout,*)'dynetat0_loc: rad,omeg,g,cpp,kappa',
144     &               rad,omeg,g,cpp,kappa
145
146      IF(   im.ne.iim           )  THEN
147          PRINT 1,im,iim
148          STOP
149      ELSE  IF( jm.ne.jjm       )  THEN
150          PRINT 2,jm,jjm
151          STOP
152      ELSE  IF( lllm.ne.llm     )  THEN
153          PRINT 3,lllm,llm
154          STOP
155      ENDIF
156
157      ierr = NF_INQ_VARID (nid, "rlonu", nvarid)
158      IF (ierr .NE. NF_NOERR) THEN
159         write(lunout,*)"dynetat0_loc: Le champ <rlonu> est absent"
160         CALL abort_gcm("dynetat0", "", 1)
161      ENDIF
162#ifdef NC_DOUBLE
163      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonu)
164#else
165      ierr = NF_GET_VAR_REAL(nid, nvarid, rlonu)
166#endif
167      IF (ierr .NE. NF_NOERR) THEN
168         write(lunout,*)"dynetat0_loc: Lecture echouee pour <rlonu>"
169         CALL abort_gcm("dynetat0", "", 1)
170      ENDIF
171
172      ierr = NF_INQ_VARID (nid, "rlatu", nvarid)
173      IF (ierr .NE. NF_NOERR) THEN
174         write(lunout,*)"dynetat0_loc: Le champ <rlatu> est absent"
175         CALL abort_gcm("dynetat0", "", 1)
176      ENDIF
177#ifdef NC_DOUBLE
178      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatu)
179#else
180      ierr = NF_GET_VAR_REAL(nid, nvarid, rlatu)
181#endif
182      IF (ierr .NE. NF_NOERR) THEN
183         write(lunout,*)"dynetat0_loc: Lecture echouee pour <rlatu>"
184         CALL abort_gcm("dynetat0", "", 1)
185      ENDIF
186
187      ierr = NF_INQ_VARID (nid, "rlonv", nvarid)
188      IF (ierr .NE. NF_NOERR) THEN
189         write(lunout,*)"dynetat0_loc: Le champ <rlonv> est absent"
190         CALL abort_gcm("dynetat0", "", 1)
191      ENDIF
192#ifdef NC_DOUBLE
193      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonv)
194#else
195      ierr = NF_GET_VAR_REAL(nid, nvarid, rlonv)
196#endif
197      IF (ierr .NE. NF_NOERR) THEN
198         write(lunout,*)"dynetat0_loc: Lecture echouee pour <rlonv>"
199         CALL abort_gcm("dynetat0", "", 1)
200      ENDIF
201
202      ierr = NF_INQ_VARID (nid, "rlatv", nvarid)
203      IF (ierr .NE. NF_NOERR) THEN
204         write(lunout,*)"dynetat0_loc: Le champ <rlatv> est absent"
205         CALL abort_gcm("dynetat0", "", 1)
206      ENDIF
207#ifdef NC_DOUBLE
208      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatv)
209#else
210      ierr = NF_GET_VAR_REAL(nid, nvarid, rlatv)
211#endif
212      IF (ierr .NE. NF_NOERR) THEN
213         write(lunout,*)"dynetat0_loc: Lecture echouee pour rlatv"
214         CALL abort_gcm("dynetat0", "", 1)
215      ENDIF
216
217      ierr = NF_INQ_VARID (nid, "cu", nvarid)
218      IF (ierr .NE. NF_NOERR) THEN
219         write(lunout,*)"dynetat0_loc: Le champ <cu> est absent"
220         CALL abort_gcm("dynetat0", "", 1)
221      ENDIF
222#ifdef NC_DOUBLE
223      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, cu)
224#else
225      ierr = NF_GET_VAR_REAL(nid, nvarid, cu)
226#endif
227      IF (ierr .NE. NF_NOERR) THEN
228         write(lunout,*)"dynetat0_loc: Lecture echouee pour <cu>"
229         CALL abort_gcm("dynetat0", "", 1)
230      ENDIF
231
232      ierr = NF_INQ_VARID (nid, "cv", nvarid)
233      IF (ierr .NE. NF_NOERR) THEN
234         write(lunout,*)"dynetat0_loc: Le champ <cv> est absent"
235         CALL abort_gcm("dynetat0", "", 1)
236      ENDIF
237#ifdef NC_DOUBLE
238      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, cv)
239#else
240      ierr = NF_GET_VAR_REAL(nid, nvarid, cv)
241#endif
242      IF (ierr .NE. NF_NOERR) THEN
243         write(lunout,*)"dynetat0_loc: Lecture echouee pour <cv>"
244         CALL abort_gcm("dynetat0", "", 1)
245      ENDIF
246
247      ierr = NF_INQ_VARID (nid, "aire", nvarid)
248      IF (ierr .NE. NF_NOERR) THEN
249         write(lunout,*)"dynetat0_loc: Le champ <aire> est absent"
250         CALL abort_gcm("dynetat0", "", 1)
251      ENDIF
252#ifdef NC_DOUBLE
253      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, aire)
254#else
255      ierr = NF_GET_VAR_REAL(nid, nvarid, aire)
256#endif
257      IF (ierr .NE. NF_NOERR) THEN
258         write(lunout,*)"dynetat0_loc: Lecture echouee pour <aire>"
259         CALL abort_gcm("dynetat0", "", 1)
260      ENDIF
261     
262      ALLOCATE(phis_glo(ip1jmp1))
263     
264      ierr = NF_INQ_VARID (nid, "phisinit", nvarid)
265      IF (ierr .NE. NF_NOERR) THEN
266         write(lunout,*)"dynetat0_loc: Le champ <phisinit> est absent"
267         CALL abort_gcm("dynetat0", "", 1)
268      ENDIF
269#ifdef NC_DOUBLE
270      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, phis_glo)
271#else
272      ierr = NF_GET_VAR_REAL(nid, nvarid, phis_glo)
273#endif
274      IF (ierr .NE. NF_NOERR) THEN
275         write(lunout,*)"dynetat0_loc: Lecture echouee pour <phisinit>"
276         CALL abort_gcm("dynetat0", "", 1)
277      ENDIF
278      phis(ijb_u:ije_u)=phis_glo(ijb_u:ije_u)
279      DEALLOCATE(phis_glo)
280
281      ierr = NF_INQ_VARID (nid, "temps", nvarid)
282      IF (ierr .NE. NF_NOERR) THEN
283         write(lunout,*)"dynetat0: Le champ <temps> est absent"
284         write(lunout,*)"dynetat0: J essaie <Time>"
285         ierr = NF_INQ_VARID (nid, "Time", nvarid)
286         IF (ierr .NE. NF_NOERR) THEN
287            write(lunout,*)"dynetat0: Le champ <Time> est absent"
288            CALL abort_gcm("dynetat0", "", 1)
289         ENDIF
290      ENDIF
291#ifdef NC_DOUBLE
292      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, time)
293#else
294      ierr = NF_GET_VAR_REAL(nid, nvarid, time)
295#endif
296      IF (ierr .NE. NF_NOERR) THEN
297         write(lunout,*)"dynetat0_loc: Lecture echouee <temps>"
298         CALL abort_gcm("dynetat0", "", 1)
299      ENDIF
300
301      ierr = NF_INQ_VARID (nid, "ucov", nvarid)
302      IF (ierr .NE. NF_NOERR) THEN
303         write(lunout,*)"dynetat0_loc: Le champ <ucov> est absent"
304         CALL abort_gcm("dynetat0", "", 1)
305      ENDIF
306     
307      ALLOCATE(ucov_glo(ip1jmp1,llm))
308     
309#ifdef NC_DOUBLE
310      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, ucov_glo)
311#else
312      ierr = NF_GET_VAR_REAL(nid, nvarid, ucov_glo)
313#endif
314      IF (ierr .NE. NF_NOERR) THEN
315         write(lunout,*)"dynetat0_loc: Lecture echouee pour <ucov>"
316         CALL abort_gcm("dynetat0", "", 1)
317      ENDIF
318
319      ucov(ijb_u:ije_u,:)=ucov_glo(ijb_u:ije_u,:)
320      DEALLOCATE(ucov_glo)
321      ALLOCATE(vcov_glo(ip1jm,llm))
322     
323      ierr = NF_INQ_VARID (nid, "vcov", nvarid)
324      IF (ierr .NE. NF_NOERR) THEN
325         write(lunout,*)"dynetat0_loc: Le champ <vcov> est absent"
326         CALL abort_gcm("dynetat0", "", 1)
327      ENDIF
328#ifdef NC_DOUBLE
329      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, vcov_glo)
330#else
331      ierr = NF_GET_VAR_REAL(nid, nvarid, vcov_glo)
332#endif
333      IF (ierr .NE. NF_NOERR) THEN
334         write(lunout,*)"dynetat0_loc: Lecture echouee pour <vcov>"
335         CALL abort_gcm("dynetat0", "", 1)
336      ENDIF
337      vcov(ijb_v:ije_v,:)=vcov_glo(ijb_v:ije_v,:)
338      DEALLOCATE(vcov_glo)
339      ALLOCATE(teta_glo(ip1jmp1,llm))
340
341      ierr = NF_INQ_VARID (nid, "teta", nvarid)
342      IF (ierr .NE. NF_NOERR) THEN
343         write(lunout,*)"dynetat0_loc: Le champ <teta> est absent"
344         CALL abort_gcm("dynetat0", "", 1)
345      ENDIF
346#ifdef NC_DOUBLE
347      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, teta_glo)
348#else
349      ierr = NF_GET_VAR_REAL(nid, nvarid, teta_glo)
350#endif
351      IF (ierr .NE. NF_NOERR) THEN
352         write(lunout,*)"dynetat0_loc: Lecture echouee pour <teta>"
353         CALL abort_gcm("dynetat0", "", 1)
354      ENDIF
355
356      teta(ijb_u:ije_u,:)=teta_glo(ijb_u:ije_u,:)
357      DEALLOCATE(teta_glo)
358      ALLOCATE(q_glo(ip1jmp1,llm))
359
360
361      DO iq=1,nqtot
362        ierr =  NF_INQ_VARID (nid, tname(iq), nvarid)
363        IF (ierr .NE. NF_NOERR) THEN
364           write(lunout,*)"dynetat0_loc: Le traceur <"                  &
365     &     //trim(tname(iq))//"> est absent"
366           write(lunout,*)"Il est donc initialise a zero"
367           q(:,:,iq)=0.
368
369           ! CRisi: pour les isotopes, on peut faire init théorique
370           ! distill de Rayleigh très simplifiée
371           if (ok_isotopes) then
372              if ((iso_num(iq).gt.0).and.(zone_num(iq).eq.0)) then
373                q(:,:,iq)=q(:,:,iqpere(iq))                             &
374     &                   *tnat(iso_num(iq))                             &
375     &                   *(q(:,:,iqpere(iq))/30.e-3)                    &
376     &                   **(alpha_ideal(iso_num(iq))-1)
377              endif
378              if ((iso_num(iq).gt.0).and.(zone_num(iq).eq.1)) then
379                  q(:,:,iq)=q(:,:,iqiso(iso_indnum(iq),phase_num(iq)))
380              endif 
381           endif !if (ok_isotopes) then       
382
383        ELSE
384#ifdef NC_DOUBLE
385          ierr = NF_GET_VAR_DOUBLE(nid, nvarid, q_glo)
386#else
387          ierr = NF_GET_VAR_REAL(nid, nvarid, q_glo)
388#endif
389          IF (ierr .NE. NF_NOERR) THEN
390            write(lunout,*)
391     &      "dynetat0_loc: Lecture echouee pour "//tname(iq)
392            CALL abort_gcm("dynetat0", "", 1)
393          ENDIF
394        q(ijb_u:ije_u,:,iq)=q_glo(ijb_u:ije_u,:)
395
396        ENDIF
397      ENDDO !DO iq=1,nqtot
398
399      if (ok_iso_verif) then
400         call check_isotopes(q,ijb_u,ije_u,'dynetat0_loc')
401      endif !if (ok_iso_verif) then
402
403      DEALLOCATE(q_glo)
404      ALLOCATE(masse_glo(ip1jmp1,llm))
405
406      ierr = NF_INQ_VARID (nid, "masse", nvarid)
407      IF (ierr .NE. NF_NOERR) THEN
408         write(lunout,*)"dynetat0_loc: Le champ <masse> est absent"
409         CALL abort_gcm("dynetat0", "", 1)
410      ENDIF
411#ifdef NC_DOUBLE
412      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, masse_glo)
413#else
414      ierr = NF_GET_VAR_REAL(nid, nvarid, masse_glo)
415#endif
416      IF (ierr .NE. NF_NOERR) THEN
417         write(lunout,*)"dynetat0_loc: Lecture echouee pour <masse>"
418         CALL abort_gcm("dynetat0", "", 1)
419      ENDIF
420      masse(ijb_u:ije_u,:)=masse_glo(ijb_u:ije_u,:)
421      DEALLOCATE(masse_glo)
422      ALLOCATE(ps_glo(ip1jmp1))
423
424      ierr = NF_INQ_VARID (nid, "ps", nvarid)
425      IF (ierr .NE. NF_NOERR) THEN
426         write(lunout,*)"dynetat0_loc: Le champ <ps> est absent"
427         CALL abort_gcm("dynetat0", "", 1)
428      ENDIF
429#ifdef NC_DOUBLE
430      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, ps_glo)
431#else
432      ierr = NF_GET_VAR_REAL(nid, nvarid, ps_glo)
433#endif
434      IF (ierr .NE. NF_NOERR) THEN
435         write(lunout,*)"dynetat0_loc: Lecture echouee pour <ps>"
436         CALL abort_gcm("dynetat0", "", 1)
437      ENDIF
438
439      ps(ijb_u:ije_u)=ps_glo(ijb_u:ije_u)
440      DEALLOCATE(ps_glo)
441
442      ierr = NF_CLOSE(nid)
443
444       day_ini=day_ini+INT(time)
445       time=time-INT(time)
446
447  1   FORMAT(//10x,'la valeur de im =',i4,2x,'lue sur le fichier de dem
448     *arrage est differente de la valeur parametree iim =',i4//)
449   2  FORMAT(//10x,'la valeur de jm =',i4,2x,'lue sur le fichier de dem
450     *arrage est differente de la valeur parametree jjm =',i4//)
451   3  FORMAT(//10x,'la valeur de lmax =',i4,2x,'lue sur le fichier dema
452     *rrage est differente de la valeur parametree llm =',i4//)
453   4  FORMAT(//10x,'la valeur de dtrv =',i4,2x,'lue sur le fichier dema
454     *rrage est differente de la valeur  dtinteg =',i4//)
455
456      RETURN
457      END
Note: See TracBrowser for help on using the repository browser.