LMDZ
mod_1D_cases_read.F90
Go to the documentation of this file.
1 !
2 ! $Id: mod_1D_cases_read.F90 2373 2015-10-13 17:28:01Z jyg $
3 !
4 MODULE mod_1d_cases_read
5 
6 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
7 !Declarations specifiques au cas standard
8  character*80 :: fich_cas
9 ! Discr?tisation
10  integer nlev_cas, nt_cas
11 
12 
13 ! integer year_ini_cas, day_ini_cas, mth_ini_cas
14 ! real heure_ini_cas
15 ! real day_ju_ini_cas ! Julian day of case first day
16 ! parameter (year_ini_cas=2011)
17 ! parameter (year_ini_cas=1969)
18 ! parameter (mth_ini_cas=10)
19 ! parameter (mth_ini_cas=6)
20 ! parameter (day_ini_cas=1) ! 10 = 10Juil2006
21 ! parameter (day_ini_cas=24) ! 24 = 24 juin 1969
22 ! parameter (heure_ini_cas=0.) !0h en secondes
23 ! real pdt_cas
24 ! parameter (pdt_cas=3.*3600)
25 
26 !CR ATTENTION TEST AMMA
27 ! parameter (year_ini_cas=2006)
28 ! parameter (mth_ini_cas=7)
29 ! parameter (day_ini_cas=10) ! 10 = 10Juil2006
30 ! parameter (heure_ini_cas=0.) !0h en secondes
31 ! parameter (pdt_cas=1800.)
32 
33 !profils environnementaux
34  real, allocatable:: plev_cas(:,:)
35 
36  real, allocatable:: z_cas(:,:)
37  real, allocatable:: t_cas(:,:),q_cas(:,:),rh_cas(:,:)
38  real, allocatable:: th_cas(:,:),rv_cas(:,:)
39  real, allocatable:: u_cas(:,:)
40  real, allocatable:: v_cas(:,:)
41 
42 !forcing
43  real, allocatable:: ht_cas(:,:),vt_cas(:,:),dt_cas(:,:),dtrad_cas(:,:)
44  real, allocatable:: hth_cas(:,:),vth_cas(:,:),dth_cas(:,:)
45  real, allocatable:: hq_cas(:,:),vq_cas(:,:),dq_cas(:,:)
46  real, allocatable:: hr_cas(:,:),vr_cas(:,:),dr_cas(:,:)
47  real, allocatable:: hu_cas(:,:),vu_cas(:,:),du_cas(:,:)
48  real, allocatable:: hv_cas(:,:),vv_cas(:,:),dv_cas(:,:)
49  real, allocatable:: vitw_cas(:,:)
50  real, allocatable:: ug_cas(:,:),vg_cas(:,:)
51  real, allocatable:: lat_cas(:),sens_cas(:),ts_cas(:),ustar_cas(:)
52  real, allocatable:: uw_cas(:,:),vw_cas(:,:),q1_cas(:,:),q2_cas(:,:)
53 
54 !champs interpoles
55  real, allocatable:: plev_prof_cas(:)
56  real, allocatable:: t_prof_cas(:)
57  real, allocatable:: q_prof_cas(:)
58  real, allocatable:: u_prof_cas(:)
59  real, allocatable:: v_prof_cas(:)
60 
61  real, allocatable:: vitw_prof_cas(:)
62  real, allocatable:: ug_prof_cas(:)
63  real, allocatable:: vg_prof_cas(:)
64  real, allocatable:: ht_prof_cas(:)
65  real, allocatable:: hq_prof_cas(:)
66  real, allocatable:: vt_prof_cas(:)
67  real, allocatable:: vq_prof_cas(:)
68  real, allocatable:: dt_prof_cas(:)
69  real, allocatable:: dtrad_prof_cas(:)
70  real, allocatable:: dq_prof_cas(:)
71  real, allocatable:: hu_prof_cas(:)
72  real, allocatable:: hv_prof_cas(:)
73  real, allocatable:: vu_prof_cas(:)
74  real, allocatable:: vv_prof_cas(:)
75  real, allocatable:: du_prof_cas(:)
76  real, allocatable:: dv_prof_cas(:)
77  real, allocatable:: uw_prof_cas(:)
78  real, allocatable:: vw_prof_cas(:)
79  real, allocatable:: q1_prof_cas(:)
80  real, allocatable:: q2_prof_cas(:)
81 
82 
83  real lat_prof_cas,sens_prof_cas,ts_prof_cas,ustar_prof_cas
84 
85 
86 
87 CONTAINS
88 
89 SUBROUTINE read_1d_cas
90  implicit none
91 
92 #include "netcdf.inc"
93 
94  INTEGER nid,rid,ierr
95  INTEGER ii,jj
96 
97  fich_cas='setup/cas.nc'
98  print*,'fich_cas ',fich_cas
99  ierr = nf_open(fich_cas,nf_nowrite,nid)
100  print*,'fich_cas,NF_NOWRITE,nid ',fich_cas,nf_nowrite,nid
101  if (ierr.NE.nf_noerr) then
102  write(*,*) 'ERROR: GROS Pb opening forcings nc file '
103  write(*,*) nf_strerror(ierr)
104  stop ""
105  endif
106 !.......................................................................
107  ierr=nf_inq_dimid(nid,'lat',rid)
108  IF (ierr.NE.nf_noerr) THEN
109  print*, 'Oh probleme lecture dimension lat'
110  ENDIF
111  ierr=nf_inq_dimlen(nid,rid,ii)
112  print*,'OK1 nid,rid,lat',nid,rid,ii
113 !.......................................................................
114  ierr=nf_inq_dimid(nid,'lon',rid)
115  IF (ierr.NE.nf_noerr) THEN
116  print*, 'Oh probleme lecture dimension lon'
117  ENDIF
118  ierr=nf_inq_dimlen(nid,rid,jj)
119  print*,'OK2 nid,rid,lat',nid,rid,jj
120 !.......................................................................
121  ierr=nf_inq_dimid(nid,'lev',rid)
122  IF (ierr.NE.nf_noerr) THEN
123  print*, 'Oh probleme lecture dimension zz'
124  ENDIF
125  ierr=nf_inq_dimlen(nid,rid,nlev_cas)
126  print*,'OK3 nid,rid,nlev_cas',nid,rid,nlev_cas
127 !.......................................................................
128  ierr=nf_inq_dimid(nid,'time',rid)
129  print*,'nid,rid',nid,rid
130  nt_cas=0
131  IF (ierr.NE.nf_noerr) THEN
132  stop 'probleme lecture dimension sens'
133  ENDIF
134  ierr=nf_inq_dimlen(nid,rid,nt_cas)
135  print*,'OK4 nid,rid,nt_cas',nid,rid,nt_cas
136 
137 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
138 !profils moyens:
139  allocate(plev_cas(nlev_cas,nt_cas))
140  allocate(z_cas(nlev_cas,nt_cas))
141  allocate(t_cas(nlev_cas,nt_cas),q_cas(nlev_cas,nt_cas),rh_cas(nlev_cas,nt_cas))
142  allocate(th_cas(nlev_cas,nt_cas),rv_cas(nlev_cas,nt_cas))
143  allocate(u_cas(nlev_cas,nt_cas))
144  allocate(v_cas(nlev_cas,nt_cas))
145 
146 !forcing
147  allocate(ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas),dt_cas(nlev_cas,nt_cas),dtrad_cas(nlev_cas,nt_cas))
148  allocate(hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas),dq_cas(nlev_cas,nt_cas))
149  allocate(hth_cas(nlev_cas,nt_cas),vth_cas(nlev_cas,nt_cas),dth_cas(nlev_cas,nt_cas))
150  allocate(hr_cas(nlev_cas,nt_cas),vr_cas(nlev_cas,nt_cas),dr_cas(nlev_cas,nt_cas))
151  allocate(hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas),du_cas(nlev_cas,nt_cas))
152  allocate(hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas),dv_cas(nlev_cas,nt_cas))
153  allocate(vitw_cas(nlev_cas,nt_cas))
154  allocate(ug_cas(nlev_cas,nt_cas))
155  allocate(vg_cas(nlev_cas,nt_cas))
156  allocate(lat_cas(nt_cas),sens_cas(nt_cas),ts_cas(nt_cas),ustar_cas(nt_cas))
157  allocate(uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas),q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas))
158 
159 
160 !champs interpoles
161  allocate(plev_prof_cas(nlev_cas))
162  allocate(t_prof_cas(nlev_cas))
163  allocate(q_prof_cas(nlev_cas))
164  allocate(u_prof_cas(nlev_cas))
165  allocate(v_prof_cas(nlev_cas))
166 
167  allocate(vitw_prof_cas(nlev_cas))
168  allocate(ug_prof_cas(nlev_cas))
169  allocate(vg_prof_cas(nlev_cas))
170  allocate(ht_prof_cas(nlev_cas))
171  allocate(hq_prof_cas(nlev_cas))
172  allocate(hu_prof_cas(nlev_cas))
173  allocate(hv_prof_cas(nlev_cas))
174  allocate(vt_prof_cas(nlev_cas))
175  allocate(vq_prof_cas(nlev_cas))
176  allocate(vu_prof_cas(nlev_cas))
177  allocate(vv_prof_cas(nlev_cas))
178  allocate(dt_prof_cas(nlev_cas))
179  allocate(dtrad_prof_cas(nlev_cas))
180  allocate(dq_prof_cas(nlev_cas))
181  allocate(du_prof_cas(nlev_cas))
182  allocate(dv_prof_cas(nlev_cas))
183  allocate(uw_prof_cas(nlev_cas))
184  allocate(vw_prof_cas(nlev_cas))
185  allocate(q1_prof_cas(nlev_cas))
186  allocate(q2_prof_cas(nlev_cas))
187 
188  print*,'Allocations OK'
189  call read_cas(nid,nlev_cas,nt_cas &
190  & ,z_cas,plev_cas,t_cas,q_cas,rh_cas,th_cas,rv_cas,u_cas,v_cas &
191  & ,ug_cas,vg_cas,vitw_cas,du_cas,hu_cas,vu_cas,dv_cas,hv_cas,vv_cas &
192  & ,dt_cas,dtrad_cas,ht_cas,vt_cas,dq_cas,hq_cas,vq_cas &
193  & ,dth_cas,hth_cas,vth_cas,dr_cas,hr_cas,vr_cas,sens_cas,lat_cas,ts_cas&
194  & ,ustar_cas,uw_cas,vw_cas,q1_cas,q2_cas)
195  print*,'Read cas OK'
196 
197 
198 END SUBROUTINE read_1d_cas
199 
200 
201 
202 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
203 SUBROUTINE deallocate_1d_cases
204 !profils environnementaux:
205  deallocate(plev_cas)
206 
207  deallocate(z_cas)
208  deallocate(t_cas,q_cas,rh_cas)
209  deallocate(th_cas,rv_cas)
210  deallocate(u_cas)
211  deallocate(v_cas)
212 
213 !forcing
214  deallocate(ht_cas,vt_cas,dt_cas,dtrad_cas)
215  deallocate(hq_cas,vq_cas,dq_cas)
216  deallocate(hth_cas,vth_cas,dth_cas)
217  deallocate(hr_cas,vr_cas,dr_cas)
218  deallocate(hu_cas,vu_cas,du_cas)
219  deallocate(hv_cas,vv_cas,dv_cas)
220  deallocate(vitw_cas)
221  deallocate(ug_cas)
222  deallocate(vg_cas)
223  deallocate(lat_cas,sens_cas,ts_cas,ustar_cas,uw_cas,vw_cas,q1_cas,q2_cas)
224 
225 !champs interpoles
226  deallocate(plev_prof_cas)
227  deallocate(t_prof_cas)
228  deallocate(q_prof_cas)
229  deallocate(u_prof_cas)
230  deallocate(v_prof_cas)
231 
232  deallocate(vitw_prof_cas)
233  deallocate(ug_prof_cas)
234  deallocate(vg_prof_cas)
235  deallocate(ht_prof_cas)
236  deallocate(hq_prof_cas)
237  deallocate(hu_prof_cas)
238  deallocate(hv_prof_cas)
239  deallocate(vt_prof_cas)
240  deallocate(vq_prof_cas)
241  deallocate(vu_prof_cas)
242  deallocate(vv_prof_cas)
243  deallocate(dt_prof_cas)
244  deallocate(dtrad_prof_cas)
245  deallocate(dq_prof_cas)
246  deallocate(du_prof_cas)
247  deallocate(dv_prof_cas)
248  deallocate(t_prof_cas)
249  deallocate(q_prof_cas)
250  deallocate(u_prof_cas)
251  deallocate(v_prof_cas)
252  deallocate(uw_prof_cas)
253  deallocate(vw_prof_cas)
254  deallocate(q1_prof_cas)
255  deallocate(q2_prof_cas)
256 
257 END SUBROUTINE deallocate_1d_cases
258 
259 
260 END MODULE mod_1d_cases_read
261 !=====================================================================
262  subroutine read_cas(nid,nlevel,ntime &
263  & ,zz,pp,temp,qv,rh,theta,rv,u,v,ug,vg,w, &
264  & du,hu,vu,dv,hv,vv,dt,dtrad,ht,vt,dq,hq,vq, &
265  & dth,hth,vth,dr,hr,vr,sens,flat,ts,ustar,uw,vw,q1,q2)
266 
267 !program reading forcing of the case study
268  implicit none
269 #include "netcdf.inc"
270 
271  integer ntime,nlevel
272 
273  real zz(nlevel,ntime)
274  real pp(nlevel,ntime)
275  real temp(nlevel,ntime),qv(nlevel,ntime),rh(nlevel,ntime)
276  real theta(nlevel,ntime),rv(nlevel,ntime)
277  real u(nlevel,ntime)
278  real v(nlevel,ntime)
279  real ug(nlevel,ntime)
280  real vg(nlevel,ntime)
281  real w(nlevel,ntime)
282  real du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime)
283  real dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime)
284  real dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime)
285  real dtrad(nlevel,ntime)
286  real dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime)
287  real dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime)
288  real dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime)
289  real flat(ntime),sens(ntime),ts(ntime),ustar(ntime)
290  real uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime)
291 
292 
293  integer nid, ierr,rid
294  integer nbvar3d
295  parameter(nbvar3d=39)
296  integer var3didin(nbvar3d)
297 
298  ierr=nf_inq_varid(nid,"zz",var3didin(1))
299  if(ierr/=nf_noerr) then
300  write(*,*) nf_strerror(ierr)
301  stop 'lev'
302  endif
303 
304  ierr=nf_inq_varid(nid,"pp",var3didin(2))
305  if(ierr/=nf_noerr) then
306  write(*,*) nf_strerror(ierr)
307  stop 'plev'
308  endif
309 
310 
311  ierr=nf_inq_varid(nid,"temp",var3didin(3))
312  if(ierr/=nf_noerr) then
313  write(*,*) nf_strerror(ierr)
314  stop 'temp'
315  endif
316 
317  ierr=nf_inq_varid(nid,"qv",var3didin(4))
318  if(ierr/=nf_noerr) then
319  write(*,*) nf_strerror(ierr)
320  stop 'qv'
321  endif
322 
323  ierr=nf_inq_varid(nid,"rh",var3didin(5))
324  if(ierr/=nf_noerr) then
325  write(*,*) nf_strerror(ierr)
326  stop 'rh'
327  endif
328 
329  ierr=nf_inq_varid(nid,"theta",var3didin(6))
330  if(ierr/=nf_noerr) then
331  write(*,*) nf_strerror(ierr)
332  stop 'theta'
333  endif
334 
335  ierr=nf_inq_varid(nid,"rv",var3didin(7))
336  if(ierr/=nf_noerr) then
337  write(*,*) nf_strerror(ierr)
338  stop 'rv'
339  endif
340 
341 
342  ierr=nf_inq_varid(nid,"u",var3didin(8))
343  if(ierr/=nf_noerr) then
344  write(*,*) nf_strerror(ierr)
345  stop 'u'
346  endif
347 
348  ierr=nf_inq_varid(nid,"v",var3didin(9))
349  if(ierr/=nf_noerr) then
350  write(*,*) nf_strerror(ierr)
351  stop 'v'
352  endif
353 
354  ierr=nf_inq_varid(nid,"ug",var3didin(10))
355  if(ierr/=nf_noerr) then
356  write(*,*) nf_strerror(ierr)
357  stop 'ug'
358  endif
359 
360  ierr=nf_inq_varid(nid,"vg",var3didin(11))
361  if(ierr/=nf_noerr) then
362  write(*,*) nf_strerror(ierr)
363  stop 'vg'
364  endif
365 
366  ierr=nf_inq_varid(nid,"w",var3didin(12))
367  if(ierr/=nf_noerr) then
368  write(*,*) nf_strerror(ierr)
369  stop 'w'
370  endif
371 
372  ierr=nf_inq_varid(nid,"advu",var3didin(13))
373  if(ierr/=nf_noerr) then
374  write(*,*) nf_strerror(ierr)
375  stop 'advu'
376  endif
377 
378  ierr=nf_inq_varid(nid,"hu",var3didin(14))
379  if(ierr/=nf_noerr) then
380  write(*,*) nf_strerror(ierr)
381  stop 'hu'
382  endif
383 
384  ierr=nf_inq_varid(nid,"vu",var3didin(15))
385  if(ierr/=nf_noerr) then
386  write(*,*) nf_strerror(ierr)
387  stop 'vu'
388  endif
389 
390  ierr=nf_inq_varid(nid,"advv",var3didin(16))
391  if(ierr/=nf_noerr) then
392  write(*,*) nf_strerror(ierr)
393  stop 'advv'
394  endif
395 
396  ierr=nf_inq_varid(nid,"hv",var3didin(17))
397  if(ierr/=nf_noerr) then
398  write(*,*) nf_strerror(ierr)
399  stop 'hv'
400  endif
401 
402  ierr=nf_inq_varid(nid,"vv",var3didin(18))
403  if(ierr/=nf_noerr) then
404  write(*,*) nf_strerror(ierr)
405  stop 'vv'
406  endif
407 
408  ierr=nf_inq_varid(nid,"advT",var3didin(19))
409  if(ierr/=nf_noerr) then
410  write(*,*) nf_strerror(ierr)
411  stop 'advT'
412  endif
413 
414  ierr=nf_inq_varid(nid,"hT",var3didin(20))
415  if(ierr/=nf_noerr) then
416  write(*,*) nf_strerror(ierr)
417  stop 'hT'
418  endif
419 
420  ierr=nf_inq_varid(nid,"vT",var3didin(21))
421  if(ierr/=nf_noerr) then
422  write(*,*) nf_strerror(ierr)
423  stop 'vT'
424  endif
425 
426  ierr=nf_inq_varid(nid,"advq",var3didin(22))
427  if(ierr/=nf_noerr) then
428  write(*,*) nf_strerror(ierr)
429  stop 'advq'
430  endif
431 
432  ierr=nf_inq_varid(nid,"hq",var3didin(23))
433  if(ierr/=nf_noerr) then
434  write(*,*) nf_strerror(ierr)
435  stop 'hq'
436  endif
437 
438  ierr=nf_inq_varid(nid,"vq",var3didin(24))
439  if(ierr/=nf_noerr) then
440  write(*,*) nf_strerror(ierr)
441  stop 'vq'
442  endif
443 
444  ierr=nf_inq_varid(nid,"advth",var3didin(25))
445  if(ierr/=nf_noerr) then
446  write(*,*) nf_strerror(ierr)
447  stop 'advth'
448  endif
449 
450  ierr=nf_inq_varid(nid,"hth",var3didin(26))
451  if(ierr/=nf_noerr) then
452  write(*,*) nf_strerror(ierr)
453  stop 'hth'
454  endif
455 
456  ierr=nf_inq_varid(nid,"vth",var3didin(27))
457  if(ierr/=nf_noerr) then
458  write(*,*) nf_strerror(ierr)
459  stop 'vth'
460  endif
461 
462  ierr=nf_inq_varid(nid,"advr",var3didin(28))
463  if(ierr/=nf_noerr) then
464  write(*,*) nf_strerror(ierr)
465  stop 'advr'
466  endif
467 
468  ierr=nf_inq_varid(nid,"hr",var3didin(29))
469  if(ierr/=nf_noerr) then
470  write(*,*) nf_strerror(ierr)
471  stop 'hr'
472  endif
473 
474  ierr=nf_inq_varid(nid,"vr",var3didin(30))
475  if(ierr/=nf_noerr) then
476  write(*,*) nf_strerror(ierr)
477  stop 'vr'
478  endif
479 
480  ierr=nf_inq_varid(nid,"radT",var3didin(31))
481  if(ierr/=nf_noerr) then
482  write(*,*) nf_strerror(ierr)
483  stop 'radT'
484  endif
485 
486  ierr=nf_inq_varid(nid,"sens",var3didin(32))
487  if(ierr/=nf_noerr) then
488  write(*,*) nf_strerror(ierr)
489  stop 'sens'
490  endif
491 
492  ierr=nf_inq_varid(nid,"flat",var3didin(33))
493  if(ierr/=nf_noerr) then
494  write(*,*) nf_strerror(ierr)
495  stop 'flat'
496  endif
497 
498  ierr=nf_inq_varid(nid,"ts",var3didin(34))
499  if(ierr/=nf_noerr) then
500  write(*,*) nf_strerror(ierr)
501  stop 'ts'
502  endif
503 
504  ierr=nf_inq_varid(nid,"ustar",var3didin(35))
505  if(ierr/=nf_noerr) then
506  write(*,*) nf_strerror(ierr)
507  stop 'ustar'
508  endif
509 
510  ierr=nf_inq_varid(nid,"uw",var3didin(36))
511  if(ierr/=nf_noerr) then
512  write(*,*) nf_strerror(ierr)
513  stop 'uw'
514  endif
515 
516  ierr=nf_inq_varid(nid,"vw",var3didin(37))
517  if(ierr/=nf_noerr) then
518  write(*,*) nf_strerror(ierr)
519  stop 'vw'
520  endif
521 
522  ierr=nf_inq_varid(nid,"q1",var3didin(38))
523  if(ierr/=nf_noerr) then
524  write(*,*) nf_strerror(ierr)
525  stop 'q1'
526  endif
527 
528  ierr=nf_inq_varid(nid,"q2",var3didin(39))
529  if(ierr/=nf_noerr) then
530  write(*,*) nf_strerror(ierr)
531  stop 'q2'
532  endif
533 
534 #ifdef NC_DOUBLE
535  ierr = nf_get_var_double(nid,var3didin(1),zz)
536 #else
537  ierr = nf_get_var_real(nid,var3didin(1),zz)
538 #endif
539  if(ierr/=nf_noerr) then
540  write(*,*) nf_strerror(ierr)
541  stop "getvarup"
542  endif
543 ! write(*,*)'lecture z ok',zz
544 
545 #ifdef NC_DOUBLE
546  ierr = nf_get_var_double(nid,var3didin(2),pp)
547 #else
548  ierr = nf_get_var_real(nid,var3didin(2),pp)
549 #endif
550  if(ierr/=nf_noerr) then
551  write(*,*) nf_strerror(ierr)
552  stop "getvarup"
553  endif
554 ! write(*,*)'lecture pp ok',pp
555 
556 
557 #ifdef NC_DOUBLE
558  ierr = nf_get_var_double(nid,var3didin(3),temp)
559 #else
560  ierr = nf_get_var_real(nid,var3didin(3),temp)
561 #endif
562  if(ierr/=nf_noerr) then
563  write(*,*) nf_strerror(ierr)
564  stop "getvarup"
565  endif
566 ! write(*,*)'lecture T ok',temp
567 
568 #ifdef NC_DOUBLE
569  ierr = nf_get_var_double(nid,var3didin(4),qv)
570 #else
571  ierr = nf_get_var_real(nid,var3didin(4),qv)
572 #endif
573  if(ierr/=nf_noerr) then
574  write(*,*) nf_strerror(ierr)
575  stop "getvarup"
576  endif
577 ! write(*,*)'lecture qv ok',qv
578 
579 #ifdef NC_DOUBLE
580  ierr = nf_get_var_double(nid,var3didin(5),rh)
581 #else
582  ierr = nf_get_var_real(nid,var3didin(5),rh)
583 #endif
584  if(ierr/=nf_noerr) then
585  write(*,*) nf_strerror(ierr)
586  stop "getvarup"
587  endif
588 ! write(*,*)'lecture rh ok',rh
589 
590 #ifdef NC_DOUBLE
591  ierr = nf_get_var_double(nid,var3didin(6),theta)
592 #else
593  ierr = nf_get_var_real(nid,var3didin(6),theta)
594 #endif
595  if(ierr/=nf_noerr) then
596  write(*,*) nf_strerror(ierr)
597  stop "getvarup"
598  endif
599 ! write(*,*)'lecture theta ok',theta
600 
601 #ifdef NC_DOUBLE
602  ierr = nf_get_var_double(nid,var3didin(7),rv)
603 #else
604  ierr = nf_get_var_real(nid,var3didin(7),rv)
605 #endif
606  if(ierr/=nf_noerr) then
607  write(*,*) nf_strerror(ierr)
608  stop "getvarup"
609  endif
610 ! write(*,*)'lecture rv ok',rv
611 
612 #ifdef NC_DOUBLE
613  ierr = nf_get_var_double(nid,var3didin(8),u)
614 #else
615  ierr = nf_get_var_real(nid,var3didin(8),u)
616 #endif
617  if(ierr/=nf_noerr) then
618  write(*,*) nf_strerror(ierr)
619  stop "getvarup"
620  endif
621 ! write(*,*)'lecture u ok',u
622 
623 #ifdef NC_DOUBLE
624  ierr = nf_get_var_double(nid,var3didin(9),v)
625 #else
626  ierr = nf_get_var_real(nid,var3didin(9),v)
627 #endif
628  if(ierr/=nf_noerr) then
629  write(*,*) nf_strerror(ierr)
630  stop "getvarup"
631  endif
632 ! write(*,*)'lecture v ok',v
633 
634 #ifdef NC_DOUBLE
635  ierr = nf_get_var_double(nid,var3didin(10),ug)
636 #else
637  ierr = nf_get_var_real(nid,var3didin(10),ug)
638 #endif
639  if(ierr/=nf_noerr) then
640  write(*,*) nf_strerror(ierr)
641  stop "getvarup"
642  endif
643 ! write(*,*)'lecture ug ok',ug
644 
645 #ifdef NC_DOUBLE
646  ierr = nf_get_var_double(nid,var3didin(11),vg)
647 #else
648  ierr = nf_get_var_real(nid,var3didin(11),vg)
649 #endif
650  if(ierr/=nf_noerr) then
651  write(*,*) nf_strerror(ierr)
652  stop "getvarup"
653  endif
654 ! write(*,*)'lecture vg ok',vg
655 
656 #ifdef NC_DOUBLE
657  ierr = nf_get_var_double(nid,var3didin(12),w)
658 #else
659  ierr = nf_get_var_real(nid,var3didin(12),w)
660 #endif
661  if(ierr/=nf_noerr) then
662  write(*,*) nf_strerror(ierr)
663  stop "getvarup"
664  endif
665 ! write(*,*)'lecture w ok',w
666 
667 #ifdef NC_DOUBLE
668  ierr = nf_get_var_double(nid,var3didin(13),du)
669 #else
670  ierr = nf_get_var_real(nid,var3didin(13),du)
671 #endif
672  if(ierr/=nf_noerr) then
673  write(*,*) nf_strerror(ierr)
674  stop "getvarup"
675  endif
676 ! write(*,*)'lecture du ok',du
677 
678 #ifdef NC_DOUBLE
679  ierr = nf_get_var_double(nid,var3didin(14),hu)
680 #else
681  ierr = nf_get_var_real(nid,var3didin(14),hu)
682 #endif
683  if(ierr/=nf_noerr) then
684  write(*,*) nf_strerror(ierr)
685  stop "getvarup"
686  endif
687 ! write(*,*)'lecture hu ok',hu
688 
689 #ifdef NC_DOUBLE
690  ierr = nf_get_var_double(nid,var3didin(15),vu)
691 #else
692  ierr = nf_get_var_real(nid,var3didin(15),vu)
693 #endif
694  if(ierr/=nf_noerr) then
695  write(*,*) nf_strerror(ierr)
696  stop "getvarup"
697  endif
698 ! write(*,*)'lecture vu ok',vu
699 
700 #ifdef NC_DOUBLE
701  ierr = nf_get_var_double(nid,var3didin(16),dv)
702 #else
703  ierr = nf_get_var_real(nid,var3didin(16),dv)
704 #endif
705  if(ierr/=nf_noerr) then
706  write(*,*) nf_strerror(ierr)
707  stop "getvarup"
708  endif
709 ! write(*,*)'lecture dv ok',dv
710 
711 #ifdef NC_DOUBLE
712  ierr = nf_get_var_double(nid,var3didin(17),hv)
713 #else
714  ierr = nf_get_var_real(nid,var3didin(17),hv)
715 #endif
716  if(ierr/=nf_noerr) then
717  write(*,*) nf_strerror(ierr)
718  stop "getvarup"
719  endif
720 ! write(*,*)'lecture hv ok',hv
721 
722 #ifdef NC_DOUBLE
723  ierr = nf_get_var_double(nid,var3didin(18),vv)
724 #else
725  ierr = nf_get_var_real(nid,var3didin(18),vv)
726 #endif
727  if(ierr/=nf_noerr) then
728  write(*,*) nf_strerror(ierr)
729  stop "getvarup"
730  endif
731 ! write(*,*)'lecture vv ok',vv
732 
733 #ifdef NC_DOUBLE
734  ierr = nf_get_var_double(nid,var3didin(19),dt)
735 #else
736  ierr = nf_get_var_real(nid,var3didin(19),dt)
737 #endif
738  if(ierr/=nf_noerr) then
739  write(*,*) nf_strerror(ierr)
740  stop "getvarup"
741  endif
742 ! write(*,*)'lecture dt ok',dt
743 
744 #ifdef NC_DOUBLE
745  ierr = nf_get_var_double(nid,var3didin(20),ht)
746 #else
747  ierr = nf_get_var_real(nid,var3didin(20),ht)
748 #endif
749  if(ierr/=nf_noerr) then
750  write(*,*) nf_strerror(ierr)
751  stop "getvarup"
752  endif
753 ! write(*,*)'lecture ht ok',ht
754 
755 #ifdef NC_DOUBLE
756  ierr = nf_get_var_double(nid,var3didin(21),vt)
757 #else
758  ierr = nf_get_var_real(nid,var3didin(21),vt)
759 #endif
760  if(ierr/=nf_noerr) then
761  write(*,*) nf_strerror(ierr)
762  stop "getvarup"
763  endif
764 ! write(*,*)'lecture vt ok',vt
765 
766 #ifdef NC_DOUBLE
767  ierr = nf_get_var_double(nid,var3didin(22),dq)
768 #else
769  ierr = nf_get_var_real(nid,var3didin(22),dq)
770 #endif
771  if(ierr/=nf_noerr) then
772  write(*,*) nf_strerror(ierr)
773  stop "getvarup"
774  endif
775 ! write(*,*)'lecture dq ok',dq
776 
777 #ifdef NC_DOUBLE
778  ierr = nf_get_var_double(nid,var3didin(23),hq)
779 #else
780  ierr = nf_get_var_real(nid,var3didin(23),hq)
781 #endif
782  if(ierr/=nf_noerr) then
783  write(*,*) nf_strerror(ierr)
784  stop "getvarup"
785  endif
786 ! write(*,*)'lecture hq ok',hq
787 
788 #ifdef NC_DOUBLE
789  ierr = nf_get_var_double(nid,var3didin(24),vq)
790 #else
791  ierr = nf_get_var_real(nid,var3didin(24),vq)
792 #endif
793  if(ierr/=nf_noerr) then
794  write(*,*) nf_strerror(ierr)
795  stop "getvarup"
796  endif
797 ! write(*,*)'lecture vq ok',vq
798 
799 #ifdef NC_DOUBLE
800  ierr = nf_get_var_double(nid,var3didin(25),dth)
801 #else
802  ierr = nf_get_var_real(nid,var3didin(25),dth)
803 #endif
804  if(ierr/=nf_noerr) then
805  write(*,*) nf_strerror(ierr)
806  stop "getvarup"
807  endif
808 ! write(*,*)'lecture dth ok',dth
809 
810 #ifdef NC_DOUBLE
811  ierr = nf_get_var_double(nid,var3didin(26),hth)
812 #else
813  ierr = nf_get_var_real(nid,var3didin(26),hth)
814 #endif
815  if(ierr/=nf_noerr) then
816  write(*,*) nf_strerror(ierr)
817  stop "getvarup"
818  endif
819 ! write(*,*)'lecture hth ok',hth
820 
821 #ifdef NC_DOUBLE
822  ierr = nf_get_var_double(nid,var3didin(27),vth)
823 #else
824  ierr = nf_get_var_real(nid,var3didin(27),vth)
825 #endif
826  if(ierr/=nf_noerr) then
827  write(*,*) nf_strerror(ierr)
828  stop "getvarup"
829  endif
830 ! write(*,*)'lecture vth ok',vth
831 
832 #ifdef NC_DOUBLE
833  ierr = nf_get_var_double(nid,var3didin(28),dr)
834 #else
835  ierr = nf_get_var_real(nid,var3didin(28),dr)
836 #endif
837  if(ierr/=nf_noerr) then
838  write(*,*) nf_strerror(ierr)
839  stop "getvarup"
840  endif
841 ! write(*,*)'lecture dr ok',dr
842 
843 #ifdef NC_DOUBLE
844  ierr = nf_get_var_double(nid,var3didin(29),hr)
845 #else
846  ierr = nf_get_var_real(nid,var3didin(29),hr)
847 #endif
848  if(ierr/=nf_noerr) then
849  write(*,*) nf_strerror(ierr)
850  stop "getvarup"
851  endif
852 ! write(*,*)'lecture hr ok',hr
853 
854 #ifdef NC_DOUBLE
855  ierr = nf_get_var_double(nid,var3didin(30),vr)
856 #else
857  ierr = nf_get_var_real(nid,var3didin(30),vr)
858 #endif
859  if(ierr/=nf_noerr) then
860  write(*,*) nf_strerror(ierr)
861  stop "getvarup"
862  endif
863 ! write(*,*)'lecture vr ok',vr
864 
865 #ifdef NC_DOUBLE
866  ierr = nf_get_var_double(nid,var3didin(31),dtrad)
867 #else
868  ierr = nf_get_var_real(nid,var3didin(31),dtrad)
869 #endif
870  if(ierr/=nf_noerr) then
871  write(*,*) nf_strerror(ierr)
872  stop "getvarup"
873  endif
874 ! write(*,*)'lecture dtrad ok',dtrad
875 
876 #ifdef NC_DOUBLE
877  ierr = nf_get_var_double(nid,var3didin(32),sens)
878 #else
879  ierr = nf_get_var_real(nid,var3didin(32),sens)
880 #endif
881  if(ierr/=nf_noerr) then
882  write(*,*) nf_strerror(ierr)
883  stop "getvarup"
884  endif
885 ! write(*,*)'lecture sens ok',sens
886 
887 #ifdef NC_DOUBLE
888  ierr = nf_get_var_double(nid,var3didin(33),flat)
889 #else
890  ierr = nf_get_var_real(nid,var3didin(33),flat)
891 #endif
892  if(ierr/=nf_noerr) then
893  write(*,*) nf_strerror(ierr)
894  stop "getvarup"
895  endif
896 ! write(*,*)'lecture flat ok',flat
897 
898 #ifdef NC_DOUBLE
899  ierr = nf_get_var_double(nid,var3didin(34),ts)
900 #else
901  ierr = nf_get_var_real(nid,var3didin(34),ts)
902 #endif
903  if(ierr/=nf_noerr) then
904  write(*,*) nf_strerror(ierr)
905  stop "getvarup"
906  endif
907 ! write(*,*)'lecture ts ok',ts
908 
909 #ifdef NC_DOUBLE
910  ierr = nf_get_var_double(nid,var3didin(35),ustar)
911 #else
912  ierr = nf_get_var_real(nid,var3didin(35),ustar)
913 #endif
914  if(ierr/=nf_noerr) then
915  write(*,*) nf_strerror(ierr)
916  stop "getvarup"
917  endif
918 ! write(*,*)'lecture ustar ok',ustar
919 
920 #ifdef NC_DOUBLE
921  ierr = nf_get_var_double(nid,var3didin(36),uw)
922 #else
923  ierr = nf_get_var_real(nid,var3didin(36),uw)
924 #endif
925  if(ierr/=nf_noerr) then
926  write(*,*) nf_strerror(ierr)
927  stop "getvarup"
928  endif
929 ! write(*,*)'lecture uw ok',uw
930 
931 #ifdef NC_DOUBLE
932  ierr = nf_get_var_double(nid,var3didin(37),vw)
933 #else
934  ierr = nf_get_var_real(nid,var3didin(37),vw)
935 #endif
936  if(ierr/=nf_noerr) then
937  write(*,*) nf_strerror(ierr)
938  stop "getvarup"
939  endif
940 ! write(*,*)'lecture vw ok',vw
941 
942 #ifdef NC_DOUBLE
943  ierr = nf_get_var_double(nid,var3didin(38),q1)
944 #else
945  ierr = nf_get_var_real(nid,var3didin(38),q1)
946 #endif
947  if(ierr/=nf_noerr) then
948  write(*,*) nf_strerror(ierr)
949  stop "getvarup"
950  endif
951 ! write(*,*)'lecture q1 ok',q1
952 
953 #ifdef NC_DOUBLE
954  ierr = nf_get_var_double(nid,var3didin(39),q2)
955 #else
956  ierr = nf_get_var_real(nid,var3didin(39),q2)
957 #endif
958  if(ierr/=nf_noerr) then
959  write(*,*) nf_strerror(ierr)
960  stop "getvarup"
961  endif
962 ! write(*,*)'lecture q2 ok',q2
963 
964 
965  return
966  end subroutine read_cas
967 !======================================================================
968  SUBROUTINE interp_case_time(day,day1,annee_ref &
969 ! & ,year_cas,day_cas,nt_cas,pdt_forc,nlev_cas &
970  & ,nt_cas,nlev_cas &
971  & ,ts_cas,plev_cas,t_cas,q_cas,u_cas,v_cas &
972  & ,ug_cas,vg_cas,vitw_cas,du_cas,hu_cas,vu_cas &
973  & ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas &
974  & ,dq_cas,hq_cas,vq_cas,lat_cas,sens_cas,ustar_cas &
975  & ,uw_cas,vw_cas,q1_cas,q2_cas &
976  & ,ts_prof_cas,plev_prof_cas,t_prof_cas,q_prof_cas &
977  & ,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas &
978  & ,vitw_prof_cas,du_prof_cas,hu_prof_cas,vu_prof_cas &
979  & ,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas &
980  & ,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas &
981  & ,hq_prof_cas,vq_prof_cas,lat_prof_cas,sens_prof_cas &
982  & ,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas)
983 
984 
985  implicit none
986 
987 !---------------------------------------------------------------------------------------
988 ! Time interpolation of a 2D field to the timestep corresponding to day
989 !
990 ! day: current julian day (e.g. 717538.2)
991 ! day1: first day of the simulation
992 ! nt_cas: total nb of data in the forcing
993 ! pdt_cas: total time interval (in sec) between 2 forcing data
994 !---------------------------------------------------------------------------------------
995 
996 #include "compar1d.h"
997 #include "date_cas.h"
998 
999 ! inputs:
1000  integer annee_ref
1001  integer nt_cas,nlev_cas
1002  real day, day1,day_cas
1003  real ts_cas(nt_cas)
1004  real plev_cas(nlev_cas,nt_cas)
1005  real t_cas(nlev_cas,nt_cas),q_cas(nlev_cas,nt_cas)
1006  real u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas)
1007  real ug_cas(nlev_cas,nt_cas),vg_cas(nlev_cas,nt_cas)
1008  real vitw_cas(nlev_cas,nt_cas)
1009  real du_cas(nlev_cas,nt_cas),hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas)
1010  real dv_cas(nlev_cas,nt_cas),hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas)
1011  real dt_cas(nlev_cas,nt_cas),ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas)
1012  real dtrad_cas(nlev_cas,nt_cas)
1013  real dq_cas(nlev_cas,nt_cas),hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas)
1014  real lat_cas(nt_cas)
1015  real sens_cas(nt_cas)
1016  real ustar_cas(nt_cas),uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas)
1017  real q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas)
1018 
1019 ! outputs:
1020  real plev_prof_cas(nlev_cas)
1021  real t_prof_cas(nlev_cas),q_prof_cas(nlev_cas)
1022  real u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
1023  real ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas)
1024  real vitw_prof_cas(nlev_cas)
1025  real du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
1026  real dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
1027  real dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas)
1028  real dtrad_prof_cas(nlev_cas)
1029  real dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
1030  real lat_prof_cas,sens_prof_cas,ts_prof_cas,ustar_prof_cas
1031  real uw_prof_cas(nlev_cas),vw_prof_cas(nlev_cas),q1_prof_cas(nlev_cas),q2_prof_cas(nlev_cas)
1032 ! local:
1033  integer it_cas1, it_cas2,k
1034  real timeit,time_cas1,time_cas2,frac
1035 
1036 
1037  print*,'Check time',day1,day_ju_ini_cas,day_deb+1,pdt_cas
1038 
1039 ! On teste si la date du cas AMMA est correcte.
1040 ! C est pour memoire car en fait les fichiers .def
1041 ! sont censes etre corrects.
1042 ! A supprimer a terme (MPL 20150623)
1043 ! if ((forcing_type.eq.10).and.(1.eq.0)) then
1044 ! Check that initial day of the simulation consistent with AMMA case:
1045 ! if (annee_ref.ne.2006) then
1046 ! print*,'Pour AMMA, annee_ref doit etre 2006'
1047 ! print*,'Changer annee_ref dans run.def'
1048 ! stop
1049 ! endif
1050 ! if (annee_ref.eq.2006 .and. day1.lt.day_cas) then
1051 ! print*,'AMMA a debute le 10 juillet 2006',day1,day_cas
1052 ! print*,'Changer dayref dans run.def'
1053 ! stop
1054 ! endif
1055 ! if (annee_ref.eq.2006 .and. day1.gt.day_cas+1) then
1056 ! print*,'AMMA a fini le 11 juillet'
1057 ! print*,'Changer dayref ou nday dans run.def'
1058 ! stop
1059 ! endif
1060 ! endif
1061 
1062 ! Determine timestep relative to the 1st day:
1063 ! timeit=(day-day1)*86400.
1064 ! if (annee_ref.eq.1992) then
1065 ! timeit=(day-day_cas)*86400.
1066 ! else
1067 ! timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992
1068 ! endif
1069  timeit=(day-day_ju_ini_cas)*86400
1070  print *,'day=',day
1071  print *,'day_ju_ini_cas=',day_ju_ini_cas
1072  print *,'pdt_cas=',pdt_cas
1073  print *,'timeit=',timeit
1074  print *,'nt_cas=',nt_cas
1075 
1076 ! Determine the closest observation times:
1077 ! it_cas1=INT(timeit/pdt_cas)+1
1078 ! it_cas2=it_cas1 + 1
1079 ! time_cas1=(it_cas1-1)*pdt_cas
1080 ! time_cas2=(it_cas2-1)*pdt_cas
1081 
1082  it_cas1=int(timeit/pdt_cas)+1
1083  IF (it_cas1 .EQ. nt_cas) THEN
1084  it_cas2=it_cas1
1085  ELSE
1086  it_cas2=it_cas1 + 1
1087  ENDIF
1088  time_cas1=(it_cas1-1)*pdt_cas
1089  time_cas2=(it_cas2-1)*pdt_cas
1090  print *,'it_cas1=',it_cas1
1091  print *,'it_cas2=',it_cas2
1092  print *,'time_cas1=',time_cas1
1093  print *,'time_cas2=',time_cas2
1094 
1095  if (it_cas1 .gt. nt_cas) then
1096  write(*,*) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: ' &
1097  & ,day,day_ju_ini_cas,it_cas1,it_cas2,timeit
1098  stop
1099  endif
1100 
1101 ! time interpolation:
1102  IF (it_cas1 .EQ. it_cas2) THEN
1103  frac=0.
1104  ELSE
1105  frac=(time_cas2-timeit)/(time_cas2-time_cas1)
1106  frac=max(frac,0.0)
1107  ENDIF
1108 
1109  lat_prof_cas = lat_cas(it_cas2) &
1110  & -frac*(lat_cas(it_cas2)-lat_cas(it_cas1))
1111  sens_prof_cas = sens_cas(it_cas2) &
1112  & -frac*(sens_cas(it_cas2)-sens_cas(it_cas1))
1113  ts_prof_cas = ts_cas(it_cas2) &
1114  & -frac*(ts_cas(it_cas2)-ts_cas(it_cas1))
1115  ustar_prof_cas = ustar_cas(it_cas2) &
1116  & -frac*(ustar_cas(it_cas2)-ustar_cas(it_cas1))
1117 
1118  do k=1,nlev_cas
1119  plev_prof_cas(k) = plev_cas(k,it_cas2) &
1120  & -frac*(plev_cas(k,it_cas2)-plev_cas(k,it_cas1))
1121  t_prof_cas(k) = t_cas(k,it_cas2) &
1122  & -frac*(t_cas(k,it_cas2)-t_cas(k,it_cas1))
1123  q_prof_cas(k) = q_cas(k,it_cas2) &
1124  & -frac*(q_cas(k,it_cas2)-q_cas(k,it_cas1))
1125  u_prof_cas(k) = u_cas(k,it_cas2) &
1126  & -frac*(u_cas(k,it_cas2)-u_cas(k,it_cas1))
1127  v_prof_cas(k) = v_cas(k,it_cas2) &
1128  & -frac*(v_cas(k,it_cas2)-v_cas(k,it_cas1))
1129  ug_prof_cas(k) = ug_cas(k,it_cas2) &
1130  & -frac*(ug_cas(k,it_cas2)-ug_cas(k,it_cas1))
1131  vg_prof_cas(k) = vg_cas(k,it_cas2) &
1132  & -frac*(vg_cas(k,it_cas2)-vg_cas(k,it_cas1))
1133  vitw_prof_cas(k) = vitw_cas(k,it_cas2) &
1134  & -frac*(vitw_cas(k,it_cas2)-vitw_cas(k,it_cas1))
1135  du_prof_cas(k) = du_cas(k,it_cas2) &
1136  & -frac*(du_cas(k,it_cas2)-du_cas(k,it_cas1))
1137  hu_prof_cas(k) = hu_cas(k,it_cas2) &
1138  & -frac*(hu_cas(k,it_cas2)-hu_cas(k,it_cas1))
1139  vu_prof_cas(k) = vu_cas(k,it_cas2) &
1140  & -frac*(vu_cas(k,it_cas2)-vu_cas(k,it_cas1))
1141  dv_prof_cas(k) = dv_cas(k,it_cas2) &
1142  & -frac*(dv_cas(k,it_cas2)-dv_cas(k,it_cas1))
1143  hv_prof_cas(k) = hv_cas(k,it_cas2) &
1144  & -frac*(hv_cas(k,it_cas2)-hv_cas(k,it_cas1))
1145  vv_prof_cas(k) = vv_cas(k,it_cas2) &
1146  & -frac*(vv_cas(k,it_cas2)-vv_cas(k,it_cas1))
1147  dt_prof_cas(k) = dt_cas(k,it_cas2) &
1148  & -frac*(dt_cas(k,it_cas2)-dt_cas(k,it_cas1))
1149  ht_prof_cas(k) = ht_cas(k,it_cas2) &
1150  & -frac*(ht_cas(k,it_cas2)-ht_cas(k,it_cas1))
1151  vt_prof_cas(k) = vt_cas(k,it_cas2) &
1152  & -frac*(vt_cas(k,it_cas2)-vt_cas(k,it_cas1))
1153  dtrad_prof_cas(k) = dtrad_cas(k,it_cas2) &
1154  & -frac*(dtrad_cas(k,it_cas2)-dtrad_cas(k,it_cas1))
1155  dq_prof_cas(k) = dq_cas(k,it_cas2) &
1156  & -frac*(dq_cas(k,it_cas2)-dq_cas(k,it_cas1))
1157  hq_prof_cas(k) = hq_cas(k,it_cas2) &
1158  & -frac*(hq_cas(k,it_cas2)-hq_cas(k,it_cas1))
1159  vq_prof_cas(k) = vq_cas(k,it_cas2) &
1160  & -frac*(vq_cas(k,it_cas2)-vq_cas(k,it_cas1))
1161  uw_prof_cas(k) = uw_cas(k,it_cas2) &
1162  & -frac*(uw_cas(k,it_cas2)-uw_cas(k,it_cas1))
1163  vw_prof_cas(k) = vw_cas(k,it_cas2) &
1164  & -frac*(vw_cas(k,it_cas2)-vw_cas(k,it_cas1))
1165  q1_prof_cas(k) = q1_cas(k,it_cas2) &
1166  & -frac*(q1_cas(k,it_cas2)-q1_cas(k,it_cas1))
1167  q2_prof_cas(k) = q2_cas(k,it_cas2) &
1168  & -frac*(q2_cas(k,it_cas2)-q2_cas(k,it_cas1))
1169  enddo
1170 
1171  return
1172  END
1173 
1174 !**********************************************************************************************
mod_1d_cases_read::u_prof_cas
real, dimension(:), allocatable u_prof_cas
Definition: mod_1D_cases_read.F90:58
hq
!$Id hq
Definition: 1Dconv.h:4
mod_1d_cases_read::v_prof_cas
real, dimension(:), allocatable v_prof_cas
Definition: mod_1D_cases_read.F90:59
mod_1d_cases_read::hth_cas
real, dimension(:,:), allocatable hth_cas
Definition: mod_1D_cases_read.F90:44
mod_1d_cases_read::ug_prof_cas
real, dimension(:), allocatable ug_prof_cas
Definition: mod_1D_cases_read.F90:62
mod_1d_cases_read::t_prof_cas
real, dimension(:), allocatable t_prof_cas
Definition: mod_1D_cases_read.F90:56
mod_1d_cases_read::vw_prof_cas
real, dimension(:), allocatable vw_prof_cas
Definition: mod_1D_cases_read.F90:78
mod_1d_cases_read::th_cas
real, dimension(:,:), allocatable th_cas
Definition: mod_1D_cases_read.F90:38
read_cas
subroutine read_cas(nid, nlevel, ntime, zz, pp, temp, qv, rh, theta, rv, u, v, ug, vg, w, du, hu, vu, dv, hv, vv, dt, dtrad, ht, vt, dq, hq, vq, dth, hth, vth, dr, hr, vr, sens, flat, ts, ustar, uw, vw, q1, q2)
Definition: mod_1D_cases_read.F90:266
mod_1d_cases_read::vv_cas
real, dimension(:,:), allocatable vv_cas
Definition: mod_1D_cases_read.F90:48
dq
do llm!au dessus on relaxe vers profil init!on fait l hypothese que dans ce il n y a plus d eau liq au dessus!donc la relaxation en thetal et qt devient relaxation en tempe et qv l dq1 relax dq(l, 1)
mod_1d_cases_read::uw_prof_cas
real, dimension(:), allocatable uw_prof_cas
Definition: mod_1D_cases_read.F90:77
mod_1d_cases_read::ts_prof_cas
real ts_prof_cas
Definition: mod_1D_cases_read.F90:83
mod_1d_cases_read::q1_cas
real, dimension(:,:), allocatable q1_cas
Definition: mod_1D_cases_read.F90:52
mod_1d_cases_read::dv_cas
real, dimension(:,:), allocatable dv_cas
Definition: mod_1D_cases_read.F90:48
dt
!$Id calend INTEGER itaufin INTEGER itau_phy INTEGER day_ref REAL dt
Definition: temps.h:15
mod_1d_cases_read::ts_cas
real, dimension(:), allocatable ts_cas
Definition: mod_1D_cases_read.F90:51
mod_1d_cases_read::vu_prof_cas
real, dimension(:), allocatable vu_prof_cas
Definition: mod_1D_cases_read.F90:73
mod_1d_cases_read::v_cas
real, dimension(:,:), allocatable v_cas
Definition: mod_1D_cases_read.F90:40
mod_1d_cases_read::fich_cas
character *80 fich_cas
Definition: mod_1D_cases_read.F90:8
mod_1d_cases_read::u_cas
real, dimension(:,:), allocatable u_cas
Definition: mod_1D_cases_read.F90:39
mod_1d_cases_read::z_cas
real, dimension(:,:), allocatable z_cas
Definition: mod_1D_cases_read.F90:36
mod_1d_cases_read::vr_cas
real, dimension(:,:), allocatable vr_cas
Definition: mod_1D_cases_read.F90:46
mod_1d_cases_read::vw_cas
real, dimension(:,:), allocatable vw_cas
Definition: mod_1D_cases_read.F90:52
mod_1d_cases_read::dt_cas
real, dimension(:,:), allocatable dt_cas
Definition: mod_1D_cases_read.F90:43
interp_case_time
subroutine interp_case_time(day, day1, annee_ref
Definition: mod_1D_cases_read.F90:970
mod_1d_cases_read::du_cas
real, dimension(:,:), allocatable du_cas
Definition: mod_1D_cases_read.F90:47
mod_1d_cases_read::q_cas
real, dimension(:,:), allocatable q_cas
Definition: mod_1D_cases_read.F90:37
day_deb
integer::year_ini_cas!initial year of the case integer::mth_ini_cas!initial month of the case integer::day_deb!initial day of the case real::heure_ini_cas!start time of the case real::pdt_cas!forcing_frequency real::day_ju_ini_cas!julian day of initial day of the case common date_cas day_deb
Definition: date_cas.h:8
mod_1d_cases_read::vu_cas
real, dimension(:,:), allocatable vu_cas
Definition: mod_1D_cases_read.F90:47
mod_1d_cases_read::sens_prof_cas
real sens_prof_cas
Definition: mod_1D_cases_read.F90:83
mod_1d_cases_read::plev_prof_cas
real, dimension(:), allocatable plev_prof_cas
Definition: mod_1D_cases_read.F90:55
mod_1d_cases_read::lat_cas
real, dimension(:), allocatable lat_cas
Definition: mod_1D_cases_read.F90:51
mod_1d_cases_read::vitw_cas
real, dimension(:,:), allocatable vitw_cas
Definition: mod_1D_cases_read.F90:49
mod_1d_cases_read::hq_cas
real, dimension(:,:), allocatable hq_cas
Definition: mod_1D_cases_read.F90:45
mod_1d_cases_read::t_cas
real, dimension(:,:), allocatable t_cas
Definition: mod_1D_cases_read.F90:37
hv
!$Id hv
Definition: 1Dconv.h:4
mod_1d_cases_read::vg_cas
real, dimension(:,:), allocatable vg_cas
Definition: mod_1D_cases_read.F90:50
mod_1d_cases_read::q1_prof_cas
real, dimension(:), allocatable q1_prof_cas
Definition: mod_1D_cases_read.F90:79
mod_1d_cases_read::ustar_cas
real, dimension(:), allocatable ustar_cas
Definition: mod_1D_cases_read.F90:51
mod_1d_cases_read::ht_cas
real, dimension(:,:), allocatable ht_cas
Definition: mod_1D_cases_read.F90:43
mod_1d_cases_read::rv_cas
real, dimension(:,:), allocatable rv_cas
Definition: mod_1D_cases_read.F90:38
mod_1d_cases_read::uw_cas
real, dimension(:,:), allocatable uw_cas
Definition: mod_1D_cases_read.F90:52
parameter
!$Header!integer nvarmx parameter(nfmx=10, imx=200, jmx=150, lmx=200, nvarmx=1000) real xd(imx
mod_1d_cases_read::vth_cas
real, dimension(:,:), allocatable vth_cas
Definition: mod_1D_cases_read.F90:44
mod_1d_cases_read::lat_prof_cas
real lat_prof_cas
Definition: mod_1D_cases_read.F90:83
mod_1d_cases_read::vq_cas
real, dimension(:,:), allocatable vq_cas
Definition: mod_1D_cases_read.F90:45
u
!$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 u(l)
mod_1d_cases_read::vq_prof_cas
real, dimension(:), allocatable vq_prof_cas
Definition: mod_1D_cases_read.F90:67
mod_1d_cases_read::vt_prof_cas
real, dimension(:), allocatable vt_prof_cas
Definition: mod_1D_cases_read.F90:66
mod_1d_cases_read::nt_cas
integer nt_cas
Definition: mod_1D_cases_read.F90:10
hu
!$Id hu
Definition: 1Dconv.h:4
mod_1d_cases_read::vt_cas
real, dimension(:,:), allocatable vt_cas
Definition: mod_1D_cases_read.F90:43
ht
!$Id && ht
Definition: 1Dconv.h:4
mod_1d_cases_read::hu_cas
real, dimension(:,:), allocatable hu_cas
Definition: mod_1D_cases_read.F90:47
mod_1d_cases_read::q2_cas
real, dimension(:,:), allocatable q2_cas
Definition: mod_1D_cases_read.F90:52
mod_1d_cases_read::hq_prof_cas
real, dimension(:), allocatable hq_prof_cas
Definition: mod_1D_cases_read.F90:65
mod_1d_cases_read::q2_prof_cas
real, dimension(:), allocatable q2_prof_cas
Definition: mod_1D_cases_read.F90:80
mod_1d_cases_read::hr_cas
real, dimension(:,:), allocatable hr_cas
Definition: mod_1D_cases_read.F90:46
mod_1d_cases_read::nlev_cas
integer nlev_cas
Definition: mod_1D_cases_read.F90:10
mod_1d_cases_read::dtrad_prof_cas
real, dimension(:), allocatable dtrad_prof_cas
Definition: mod_1D_cases_read.F90:69
mod_1d_cases_read::q_prof_cas
real, dimension(:), allocatable q_prof_cas
Definition: mod_1D_cases_read.F90:57
mod_1d_cases_read::ustar_prof_cas
real ustar_prof_cas
Definition: mod_1D_cases_read.F90:83
mod_1d_cases_read::ht_prof_cas
real, dimension(:), allocatable ht_prof_cas
Definition: mod_1D_cases_read.F90:64
mod_1d_cases_read::du_prof_cas
real, dimension(:), allocatable du_prof_cas
Definition: mod_1D_cases_read.F90:75
mod_1d_cases_read::vitw_prof_cas
real, dimension(:), allocatable vitw_prof_cas
Definition: mod_1D_cases_read.F90:61
mod_1d_cases_read::dth_cas
real, dimension(:,:), allocatable dth_cas
Definition: mod_1D_cases_read.F90:44
mod_1d_cases_read::dt_prof_cas
real, dimension(:), allocatable dt_prof_cas
Definition: mod_1D_cases_read.F90:68
mod_1d_cases_read::dr_cas
real, dimension(:,:), allocatable dr_cas
Definition: mod_1D_cases_read.F90:46
pdt_cas
integer::year_ini_cas!initial year of the case integer::mth_ini_cas!initial month of the case integer::day_deb!initial day of the case real::heure_ini_cas!start time of the case real::pdt_cas!forcing_frequency real::day_ju_ini_cas!julian day of initial day of the case common date_cas pdt_cas
Definition: date_cas.h:8
mod_1d_cases_read::hu_prof_cas
real, dimension(:), allocatable hu_prof_cas
Definition: mod_1D_cases_read.F90:71
mod_1d_cases_read::dv_prof_cas
real, dimension(:), allocatable dv_prof_cas
Definition: mod_1D_cases_read.F90:76
mod_1d_cases_read
Definition: mod_1D_cases_read.F90:4
mod_1d_cases_read::hv_cas
real, dimension(:,:), allocatable hv_cas
Definition: mod_1D_cases_read.F90:48
mod_1d_cases_read::plev_cas
real, dimension(:,:), allocatable plev_cas
Definition: mod_1D_cases_read.F90:34
mod_1d_cases_read::sens_cas
real, dimension(:), allocatable sens_cas
Definition: mod_1D_cases_read.F90:51
flat
!$Id flat
Definition: flux_arp.h:11
mod_1d_cases_read::read_1d_cas
subroutine read_1d_cas
Definition: mod_1D_cases_read.F90:90
mod_1d_cases_read::dq_prof_cas
real, dimension(:), allocatable dq_prof_cas
Definition: mod_1D_cases_read.F90:70
mod_1d_cases_read::dq_cas
real, dimension(:,:), allocatable dq_cas
Definition: mod_1D_cases_read.F90:45
mod_1d_cases_read::rh_cas
real, dimension(:,:), allocatable rh_cas
Definition: mod_1D_cases_read.F90:37
mod_1d_cases_read::vg_prof_cas
real, dimension(:), allocatable vg_prof_cas
Definition: mod_1D_cases_read.F90:63
mod_1d_cases_read::dtrad_cas
real, dimension(:,:), allocatable dtrad_cas
Definition: mod_1D_cases_read.F90:43
mod_1d_cases_read::vv_prof_cas
real, dimension(:), allocatable vv_prof_cas
Definition: mod_1D_cases_read.F90:74
mod_1d_cases_read::hv_prof_cas
real, dimension(:), allocatable hv_prof_cas
Definition: mod_1D_cases_read.F90:72
mod_1d_cases_read::ug_cas
real, dimension(:,:), allocatable ug_cas
Definition: mod_1D_cases_read.F90:50
mod_1d_cases_read::deallocate_1d_cases
subroutine deallocate_1d_cases
Definition: mod_1D_cases_read.F90:204