LMDZ
dynetat0.F
Go to the documentation of this file.
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 
14 c=======================================================================
15 c
16 c Auteur: P. Le Van / L.Fairhead
17 c -------
18 c
19 c objet:
20 c ------
21 c
22 c Lecture de l'etat initial
23 c
24 c=======================================================================
25 c-----------------------------------------------------------------------
26 c Declarations:
27 c -------------
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 
42 c Arguments:
43 c ----------
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 
52 c Variables
53 c
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  INTEGER idecal
60 
61 c-----------------------------------------------------------------------
62 
63 c 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,*)'dynetat0: Pb d''ouverture du fichier start.nc'
68  write(lunout,*)' ierr = ', ierr
69  CALL abort_gcm("dynetat0", "", 1)
70  ENDIF
71 
72 c
73  ierr = nf_inq_varid(nid, "controle", nvarid)
74  IF (ierr .NE. nf_noerr) THEN
75  write(lunout,*)"dynetat0: Le champ <controle> est absent"
76  CALL abort_gcm("dynetat0", "", 1)
77  ENDIF
78  ierr = nf90_get_var(nid, nvarid, tab_cntrl)
79  IF (ierr .NE. nf_noerr) THEN
80  write(lunout,*)"dynetat0: Lecture echoue pour <controle>"
81  CALL abort_gcm("dynetat0", "", 1)
82  ENDIF
83 
84  !!! AS: idecal is a hack to be able to read planeto starts...
85  !!! .... while keeping everything OK for LMDZ EARTH
86  if (planet_type.eq."generic") then
87  print*,'NOTE NOTE NOTE : Planeto-like start files'
88  idecal = 4
89  annee_ref = 2000
90  else
91  print*,'NOTE NOTE NOTE : Earth-like start files'
92  idecal = 5
93  annee_ref = tab_cntrl(5)
94  endif
95 
96 
97  im = tab_cntrl(1)
98  jm = tab_cntrl(2)
99  lllm = tab_cntrl(3)
100  day_ref = tab_cntrl(4)
101  rad = tab_cntrl(idecal+1)
102  omeg = tab_cntrl(idecal+2)
103  g = tab_cntrl(idecal+3)
104  cpp = tab_cntrl(idecal+4)
105  kappa = tab_cntrl(idecal+5)
106  daysec = tab_cntrl(idecal+6)
107  dtvr = tab_cntrl(idecal+7)
108  etot0 = tab_cntrl(idecal+8)
109  ptot0 = tab_cntrl(idecal+9)
110  ztot0 = tab_cntrl(idecal+10)
111  stot0 = tab_cntrl(idecal+11)
112  ang0 = tab_cntrl(idecal+12)
113  pa = tab_cntrl(idecal+13)
114  preff = tab_cntrl(idecal+14)
115 c
116  clon = tab_cntrl(idecal+15)
117  clat = tab_cntrl(idecal+16)
118  grossismx = tab_cntrl(idecal+17)
119  grossismy = tab_cntrl(idecal+18)
120 c
121  IF ( tab_cntrl(idecal+19).EQ.1. ) THEN
122  fxyhypb = . true .
123 c dzoomx = tab_cntrl(25)
124 c dzoomy = tab_cntrl(26)
125 c taux = tab_cntrl(28)
126 c tauy = tab_cntrl(29)
127  ELSE
128  fxyhypb = . false .
129  ysinus = . false .
130  IF( tab_cntrl(idecal+22).EQ.1. ) ysinus = . true.
131  ENDIF
132 
133  day_ini = tab_cntrl(30)
134  itau_dyn = tab_cntrl(31)
135  start_time = tab_cntrl(32)
136 c .................................................................
137 c
138 c
139  write(lunout,*)'dynetat0: rad,omeg,g,cpp,kappa',
140  & rad,omeg,g,cpp,kappa
141 
142  IF( im.ne.iim ) THEN
143  print 1,im,iim
144  stop
145  ELSE IF( jm.ne.jjm ) THEN
146  print 2,jm,jjm
147  stop
148  ELSE IF( lllm.ne.llm ) THEN
149  print 3,lllm,llm
150  stop
151  ENDIF
152 
153  ierr = nf_inq_varid(nid, "rlonu", nvarid)
154  IF (ierr .NE. nf_noerr) THEN
155  write(lunout,*)"dynetat0: Le champ <rlonu> est absent"
156  CALL abort_gcm("dynetat0", "", 1)
157  ENDIF
158  ierr = nf90_get_var(nid, nvarid, rlonu)
159  IF (ierr .NE. nf_noerr) THEN
160  write(lunout,*)"dynetat0: Lecture echouee pour <rlonu>"
161  CALL abort_gcm("dynetat0", "", 1)
162  ENDIF
163 
164  ierr = nf_inq_varid(nid, "rlatu", nvarid)
165  IF (ierr .NE. nf_noerr) THEN
166  write(lunout,*)"dynetat0: Le champ <rlatu> est absent"
167  CALL abort_gcm("dynetat0", "", 1)
168  ENDIF
169  ierr = nf90_get_var(nid, nvarid, rlatu)
170  IF (ierr .NE. nf_noerr) THEN
171  write(lunout,*)"dynetat0: Lecture echouee pour <rlatu>"
172  CALL abort_gcm("dynetat0", "", 1)
173  ENDIF
174 
175  ierr = nf_inq_varid(nid, "rlonv", nvarid)
176  IF (ierr .NE. nf_noerr) THEN
177  write(lunout,*)"dynetat0: Le champ <rlonv> est absent"
178  CALL abort_gcm("dynetat0", "", 1)
179  ENDIF
180  ierr = nf90_get_var(nid, nvarid, rlonv)
181  IF (ierr .NE. nf_noerr) THEN
182  write(lunout,*)"dynetat0: Lecture echouee pour <rlonv>"
183  CALL abort_gcm("dynetat0", "", 1)
184  ENDIF
185 
186  ierr = nf_inq_varid(nid, "rlatv", nvarid)
187  IF (ierr .NE. nf_noerr) THEN
188  write(lunout,*)"dynetat0: Le champ <rlatv> est absent"
189  CALL abort_gcm("dynetat0", "", 1)
190  ENDIF
191  ierr = nf90_get_var(nid, nvarid, rlatv)
192  IF (ierr .NE. nf_noerr) THEN
193  write(lunout,*)"dynetat0: Lecture echouee pour rlatv"
194  CALL abort_gcm("dynetat0", "", 1)
195  ENDIF
196 
197  ierr = nf_inq_varid(nid, "cu", nvarid)
198  IF (ierr .NE. nf_noerr) THEN
199  write(lunout,*)"dynetat0: Le champ <cu> est absent"
200  CALL abort_gcm("dynetat0", "", 1)
201  ENDIF
202  ierr = nf90_get_var(nid, nvarid, cu)
203  IF (ierr .NE. nf_noerr) THEN
204  write(lunout,*)"dynetat0: Lecture echouee pour <cu>"
205  CALL abort_gcm("dynetat0", "", 1)
206  ENDIF
207 
208  ierr = nf_inq_varid(nid, "cv", nvarid)
209  IF (ierr .NE. nf_noerr) THEN
210  write(lunout,*)"dynetat0: Le champ <cv> est absent"
211  CALL abort_gcm("dynetat0", "", 1)
212  ENDIF
213  ierr = nf90_get_var(nid, nvarid, cv)
214  IF (ierr .NE. nf_noerr) THEN
215  write(lunout,*)"dynetat0: Lecture echouee pour <cv>"
216  CALL abort_gcm("dynetat0", "", 1)
217  ENDIF
218 
219  ierr = nf_inq_varid(nid, "aire", nvarid)
220  IF (ierr .NE. nf_noerr) THEN
221  write(lunout,*)"dynetat0: Le champ <aire> est absent"
222  CALL abort_gcm("dynetat0", "", 1)
223  ENDIF
224  ierr = nf90_get_var(nid, nvarid, aire)
225  IF (ierr .NE. nf_noerr) THEN
226  write(lunout,*)"dynetat0: Lecture echouee pour <aire>"
227  CALL abort_gcm("dynetat0", "", 1)
228  ENDIF
229 
230  ierr = nf_inq_varid(nid, "phisinit", nvarid)
231  IF (ierr .NE. nf_noerr) THEN
232  write(lunout,*)"dynetat0: Le champ <phisinit> est absent"
233  CALL abort_gcm("dynetat0", "", 1)
234  ENDIF
235  ierr = nf90_get_var(nid, nvarid, phis)
236  IF (ierr .NE. nf_noerr) THEN
237  write(lunout,*)"dynetat0: Lecture echouee pour <phisinit>"
238  CALL abort_gcm("dynetat0", "", 1)
239  ENDIF
240 
241  ierr = nf_inq_varid(nid, "temps", nvarid)
242  IF (ierr .NE. nf_noerr) THEN
243  write(lunout,*)"dynetat0: Le champ <temps> est absent"
244  write(lunout,*)"dynetat0: J essaie <Time>"
245  ierr = nf_inq_varid(nid, "Time", nvarid)
246  IF (ierr .NE. nf_noerr) THEN
247  write(lunout,*)"dynetat0: Le champ <Time> est absent"
248  CALL abort_gcm("dynetat0", "", 1)
249  ENDIF
250  ENDIF
251  ierr = nf90_get_var(nid, nvarid, time)
252  IF (ierr .NE. nf_noerr) THEN
253  write(lunout,*)"dynetat0: Lecture echouee <temps>"
254  CALL abort_gcm("dynetat0", "", 1)
255  ENDIF
256 
257  ierr = nf_inq_varid(nid, "ucov", nvarid)
258  IF (ierr .NE. nf_noerr) THEN
259  write(lunout,*)"dynetat0: Le champ <ucov> est absent"
260  CALL abort_gcm("dynetat0", "", 1)
261  ENDIF
262  ierr = nf90_get_var(nid, nvarid, ucov)
263  IF (ierr .NE. nf_noerr) THEN
264  write(lunout,*)"dynetat0: Lecture echouee pour <ucov>"
265  CALL abort_gcm("dynetat0", "", 1)
266  ENDIF
267 
268  ierr = nf_inq_varid(nid, "vcov", nvarid)
269  IF (ierr .NE. nf_noerr) THEN
270  write(lunout,*)"dynetat0: Le champ <vcov> est absent"
271  CALL abort_gcm("dynetat0", "", 1)
272  ENDIF
273  ierr = nf90_get_var(nid, nvarid, vcov)
274  IF (ierr .NE. nf_noerr) THEN
275  write(lunout,*)"dynetat0: Lecture echouee pour <vcov>"
276  CALL abort_gcm("dynetat0", "", 1)
277  ENDIF
278 
279  ierr = nf_inq_varid(nid, "teta", nvarid)
280  IF (ierr .NE. nf_noerr) THEN
281  write(lunout,*)"dynetat0: Le champ <teta> est absent"
282  CALL abort_gcm("dynetat0", "", 1)
283  ENDIF
284  ierr = nf90_get_var(nid, nvarid, teta)
285  IF (ierr .NE. nf_noerr) THEN
286  write(lunout,*)"dynetat0: Lecture echouee pour <teta>"
287  CALL abort_gcm("dynetat0", "", 1)
288  ENDIF
289 
290 
291  IF(nqtot.GE.1) THEN
292  DO iq=1,nqtot
293  ierr = nf_inq_varid(nid, tname(iq), nvarid)
294  IF (ierr .NE. nf_noerr) THEN
295  write(lunout,*)"dynetat0: Le traceur <"//trim(tname(iq))//
296  & "> est absent"
297  write(lunout,*)" Il est donc initialise a zero"
298  q(:,:,:,iq)=0.
299  ELSE
300  ierr = nf90_get_var(nid, nvarid, q(:,:,:,iq))
301  IF (ierr .NE. nf_noerr) THEN
302  write(lunout,*)"dynetat0: Lecture echouee pour "//tname(iq)
303  CALL abort_gcm("dynetat0", "", 1)
304  ENDIF
305  ENDIF
306  ENDDO
307  ENDIF
308 
309  ierr = nf_inq_varid(nid, "masse", nvarid)
310  IF (ierr .NE. nf_noerr) THEN
311  write(lunout,*)"dynetat0: Le champ <masse> est absent"
312  CALL abort_gcm("dynetat0", "", 1)
313  ENDIF
314  ierr = nf90_get_var(nid, nvarid, masse)
315  IF (ierr .NE. nf_noerr) THEN
316  write(lunout,*)"dynetat0: Lecture echouee pour <masse>"
317  CALL abort_gcm("dynetat0", "", 1)
318  ENDIF
319 
320  ierr = nf_inq_varid(nid, "ps", nvarid)
321  IF (ierr .NE. nf_noerr) THEN
322  write(lunout,*)"dynetat0: Le champ <ps> est absent"
323  CALL abort_gcm("dynetat0", "", 1)
324  ENDIF
325  ierr = nf90_get_var(nid, nvarid, ps)
326  IF (ierr .NE. nf_noerr) THEN
327  write(lunout,*)"dynetat0: Lecture echouee pour <ps>"
328  CALL abort_gcm("dynetat0", "", 1)
329  ENDIF
330 
331  ierr = nf_close(nid)
332 
333  day_ini=day_ini+int(time)
334  time=time-int(time)
335 
336  1 FORMAT(//10x,'la valeur de im =',i4,2x,'lue sur le fichier de dem
337  *arrage est differente de la valeur parametree iim =',i4//)
338  2 FORMAT(//10x,'la valeur de jm =',i4,2x,'lue sur le fichier de dem
339  *arrage est differente de la valeur parametree jjm =',i4//)
340  3 FORMAT(//10x,'la valeur de lmax =',i4,2x,'lue sur le fichier dema
341  *rrage est differente de la valeur parametree llm =',i4//)
342  4 FORMAT(//10x,'la valeur de dtrv =',i4,2x,'lue sur le fichier dema
343  *rrage est differente de la valeur dtinteg =',i4//)
344 
345  RETURN
346  END
itau_dyn
!$Id && itau_dyn
Definition: temps.h:15
grossismx
!$Header!c!c!c include serre h!c REAL && grossismx
Definition: serre.h:8
dynetat0
subroutine dynetat0(fichnom, vcov, ucov, teta, q, masse, ps, phis, time)
Definition: dynetat0.f90:2
g
!$Id mode_top_bound COMMON comconstr g
Definition: comconst.h:7
preff
!$Id preff
Definition: comvert.h:8
kappa
!$Id mode_top_bound COMMON comconstr kappa
Definition: comconst.h:7
clon
!$Header!c!c!c include serre h!c REAL clon
Definition: serre.h:8
im
!$Id mode_top_bound COMMON comconstr omeg dissip_zref ihf INTEGER im
Definition: comconst.h:7
jm
!$Id jm
Definition: comconst.h:7
control_mod::planet_type
character(len=10), save planet_type
Definition: control_mod.F90:32
abort_gcm
subroutine abort_gcm(modname, message, ierr)
Definition: abort_gcm.F:7
llm
!$Id Turb_fcg_gcssold get_uvd hqturb_gcssold endif!large scale llm day day1 day day1 *dt_toga endif!time annee_ref dt_toga u_toga vq_toga w_prof vq_prof llm day day1 day day1 *dt_dice endif!time annee_ref dt_dice swup_dice vg_dice omega_dice tg_prof vg_profd w_profd omega_profd!do llm!print llm l llm
Definition: 1D_interp_cases.h:103
aire
!$Header!CDK comgeom COMMON comgeom aire
Definition: comgeom.h:25
rlatu
!$Header!CDK comgeom COMMON comgeom rlatu
Definition: comgeom.h:25
infotrac::nqtot
integer, save nqtot
Definition: infotrac.F90:6
day_ini
!$Id && day_ini
Definition: temps.h:15
false
!$Id itapm1 ENDIF!IM on interpole les champs sur les niveaux STD de pression!IM a chaque pas de temps de la physique c!positionnement de l argument logique a false c!pour ne pas recalculer deux fois la meme chose!c!a cet effet un appel a plevel_new a ete deplace c!a la fin de la serie d appels c!la boucle DO nlevSTD a ete internalisee c!dans d ou la creation de cette routine c c!CALL false
Definition: calcul_STDlev.h:26
etot0
!$Id etot0
Definition: ener.h:11
rad
!$Id mode_top_bound COMMON comconstr rad
Definition: comconst.h:7
day_ref
!$Id day_ref
Definition: temps.h:15
fxyhypb
!$Id fxyhypb
Definition: logic.h:10
jjp1
!$Header jjp1
Definition: paramet.h:14
cpp
!$Id mode_top_bound COMMON comconstr cpp
Definition: comconst.h:7
parameter
!$Header!integer nvarmx parameter(nfmx=10, imx=200, jmx=150, lmx=200, nvarmx=1000) real xd(imx
daysec
!$Id mode_top_bound COMMON comconstr daysec
Definition: comconst.h:7
rlonu
!$Header!CDK comgeom COMMON comgeom rlonu
Definition: comgeom.h:25
ztot0
!$Id ztot0
Definition: ener.h:11
rlatv
!$Header!CDK comgeom COMMON comgeom rlatv
Definition: comgeom.h:25
phis
!$Id ***************************************!ECRITURE DU phis
Definition: write_histrac.h:9
x
!$Header!c c INCLUDE fxyprim h c c c Fonctions in line c c REAL fyprim REAL rj c c il faut la calculer avant d appeler ces fonctions c c c Fonctions a changer selon x(x) et y(y) choisis.c-----------------------------------------------------------------c c.....ici
infotrac::tname
character(len=20), dimension(:), allocatable, save tname
Definition: infotrac.F90:18
pa
!$Id && pa
Definition: comvert.h:8
true
!$Id itapm1 ENDIF!IM on interpole les champs sur les niveaux STD de pression!IM a chaque pas de temps de la physique c!positionnement de l argument logique a false c!pour ne pas recalculer deux fois la meme chose!c!a cet effet un appel a plevel_new a ete deplace c!a la fin de la serie d appels c!la boucle DO nlevSTD a ete internalisee c!dans d ou la creation de cette routine c c!CALL ulevSTD CALL &zphi philevSTD CALL &zx_rh rhlevSTD!DO klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon du jour ou toutes les read_climoz CALL true
Definition: calcul_STDlev.h:139
cu
!$Id!Parameters for parameters that control the rate of approach!to quasi equilibrium noff nlm real tlcrit real entp real sigd real coeffs real dtmax real cu real betad real damp real delta COMMON cvparam nlm tlcrit sigd coeffs cu
Definition: cvparam.h:12
lllm
!$Id lllm
Definition: comconst.h:7
grossismy
!$Header!c!c!c include serre h!c REAL grossismy
Definition: serre.h:8
dtvr
!$Id mode_top_bound COMMON comconstr dtvr
Definition: comconst.h:7
iim
c c zjulian c cym CALL iim cym klev iim
Definition: ini_bilKP_ave.h:24
stot0
!$Id stot0
Definition: ener.h:11
clat
!$Header!c!c!c include serre h!c REAL clat
Definition: serre.h:8
cv
!$Header!CDK comgeom COMMON comgeom cv
Definition: comgeom.h:25
start_time
!$Id start_time
Definition: temps.h:15
ptot0
!$Id ptot0
Definition: ener.h:11
control_mod
Definition: control_mod.F90:5
annee_ref
!$Id annee_ref
Definition: temps.h:15
lunout
!$Header!gestion des impressions de sorties et de débogage la sortie standard prt_level COMMON comprint lunout
Definition: iniprint.h:7
rlonv
!$Header!CDK comgeom COMMON comgeom rlonv
Definition: comgeom.h:25