My Project
 All Classes Files Functions Variables Macros
dynetat0_loc.F
Go to the documentation of this file.
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
9  IMPLICIT NONE
10 
11 c=======================================================================
12 c
13 c Auteur: P. Le Van / L.Fairhead
14 c -------
15 c
16 c objet:
17 c ------
18 c
19 c Lecture de l'etat initial
20 c
21 c=======================================================================
22 c-----------------------------------------------------------------------
23 c Declarations:
24 c -------------
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 
39 c Arguments:
40 c ----------
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 
50 c Variables
51 c
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 
62 c-----------------------------------------------------------------------
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,*)
68  & 'dynetat0_loc: Pb d''ouverture du fichier start.nc'
69  write(lunout,*)' ierr = ', ierr
70  CALL abort
71  ENDIF
72 
73 c
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
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
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)
120 c
121  clon = tab_cntrl(idecal+15)
122  clat = tab_cntrl(idecal+16)
123  grossismx = tab_cntrl(idecal+17)
124  grossismy = tab_cntrl(idecal+18)
125 c
126  IF ( tab_cntrl(idecal+19).EQ.1. ) THEN
127  fxyhypb = . true .
128 c dzoomx = tab_cntrl(25)
129 c dzoomy = tab_cntrl(26)
130 c taux = tab_cntrl(28)
131 c 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)
140 c .................................................................
141 c
142 c
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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  ELSE
369 #ifdef NC_DOUBLE
370  ierr = nf_get_var_double(nid, nvarid, q_glo)
371 #else
372  ierr = nf_get_var_real(nid, nvarid, q_glo)
373 #endif
374  IF (ierr .NE. nf_noerr) THEN
375  write(lunout,*)
376  & "dynetat0_loc: Lecture echouee pour "//tname(iq)
377  CALL abort
378  ENDIF
379  ENDIF
380  q(ijb_u:ije_u,:,iq)=q_glo(ijb_u:ije_u,:)
381  ENDDO
382 
383  DEALLOCATE(q_glo)
384  ALLOCATE(masse_glo(ip1jmp1,llm))
385 
386  ierr = nf_inq_varid(nid, "masse", nvarid)
387  IF (ierr .NE. nf_noerr) THEN
388  write(lunout,*)"dynetat0_loc: Le champ <masse> est absent"
389  CALL abort
390  ENDIF
391 #ifdef NC_DOUBLE
392  ierr = nf_get_var_double(nid, nvarid, masse_glo)
393 #else
394  ierr = nf_get_var_real(nid, nvarid, masse_glo)
395 #endif
396  IF (ierr .NE. nf_noerr) THEN
397  write(lunout,*)"dynetat0_loc: Lecture echouee pour <masse>"
398  CALL abort
399  ENDIF
400  masse(ijb_u:ije_u,:)=masse_glo(ijb_u:ije_u,:)
401  DEALLOCATE(masse_glo)
402  ALLOCATE(ps_glo(ip1jmp1))
403 
404  ierr = nf_inq_varid(nid, "ps", nvarid)
405  IF (ierr .NE. nf_noerr) THEN
406  write(lunout,*)"dynetat0_loc: Le champ <ps> est absent"
407  CALL abort
408  ENDIF
409 #ifdef NC_DOUBLE
410  ierr = nf_get_var_double(nid, nvarid, ps_glo)
411 #else
412  ierr = nf_get_var_real(nid, nvarid, ps_glo)
413 #endif
414  IF (ierr .NE. nf_noerr) THEN
415  write(lunout,*)"dynetat0_loc: Lecture echouee pour <ps>"
416  CALL abort
417  ENDIF
418 
419  ps(ijb_u:ije_u)=ps_glo(ijb_u:ije_u)
420  DEALLOCATE(ps_glo)
421 
422  ierr = nf_close(nid)
423 
424  day_ini=day_ini+int(time)
425  time=time-int(time)
426 
427  1 FORMAT(//10x,'la valeur de im =',i4,2x,
428 'lue sur le fichier de dem *arrage est differente de la valeur parametree iim =',i4//)
429  2 FORMAT(//10x,'la valeur de jm =',i4,2x,
430 'lue sur le fichier de dem *arrage est differente de la valeur parametree jjm =',i4//)
431  3 FORMAT(//10x,'la valeur de lmax =',i4,2x,
432 'lue sur le fichier dema *rrage est differente de la valeur parametree llm =',i4//)
433  4 FORMAT(//10x,'la valeur de dtrv =',i4,2x,
434 'lue sur le fichier dema *rrage est differente de la valeur dtinteg =',i4//)
435 
436  RETURN
437  END