source: LMDZ6/trunk/libf/phylmd/dyn1d/mod_1D_cases_read2.F90 @ 5213

Last change on this file since 5213 was 5084, checked in by Laurent Fairhead, 4 months ago

Reverting to r4065. Updating fortran standard broke too much stuff. Will do it by smaller chunks
AB, LF
File size: 59.8 KB
Line 
1!
2! $Id: mod_1D_cases_read.F90 2373 2015-10-13 17:28:01Z jyg $
3!
4MODULE mod_1D_cases_read2
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  !profils environnementaux
14  real, allocatable::  plev_cas(:,:),plevh_cas(:)
15  real, allocatable::  ap_cas(:),bp_cas(:)
16
17  real, allocatable::  z_cas(:,:),zh_cas(:)
18  real, allocatable::  t_cas(:,:),q_cas(:,:),qv_cas(:,:),ql_cas(:,:),qi_cas(:,:),rh_cas(:,:)
19  real, allocatable::  th_cas(:,:),thv_cas(:,:),thl_cas(:,:),rv_cas(:,:)
20  real, allocatable::  u_cas(:,:),v_cas(:,:),vitw_cas(:,:),omega_cas(:,:)
21
22  !forcing
23  real, allocatable::  ht_cas(:,:),vt_cas(:,:),dt_cas(:,:),dtrad_cas(:,:)
24  real, allocatable::  hth_cas(:,:),vth_cas(:,:),dth_cas(:,:)
25  real, allocatable::  hq_cas(:,:),vq_cas(:,:),dq_cas(:,:)
26  real, allocatable::  hr_cas(:,:),vr_cas(:,:),dr_cas(:,:)
27  real, allocatable::  hu_cas(:,:),vu_cas(:,:),du_cas(:,:)
28  real, allocatable::  hv_cas(:,:),vv_cas(:,:),dv_cas(:,:)
29  real, allocatable::  ug_cas(:,:),vg_cas(:,:)
30  real, allocatable::  lat_cas(:),sens_cas(:),ts_cas(:),ps_cas(:),ustar_cas(:)
31  real, allocatable::  uw_cas(:,:),vw_cas(:,:),q1_cas(:,:),q2_cas(:,:),tke_cas(:)
32
33  !champs interpoles
34  real, allocatable::  plev_prof_cas(:)
35  real, allocatable::  t_prof_cas(:)
36  real, allocatable::  theta_prof_cas(:)
37  real, allocatable::  thl_prof_cas(:)
38  real, allocatable::  thv_prof_cas(:)
39  real, allocatable::  q_prof_cas(:)
40  real, allocatable::  qv_prof_cas(:)
41  real, allocatable::  ql_prof_cas(:)
42  real, allocatable::  qi_prof_cas(:)
43  real, allocatable::  rh_prof_cas(:)
44  real, allocatable::  rv_prof_cas(:)
45  real, allocatable::  u_prof_cas(:)
46  real, allocatable::  v_prof_cas(:)       
47  real, allocatable::  vitw_prof_cas(:)
48  real, allocatable::  omega_prof_cas(:)
49  real, allocatable::  ug_prof_cas(:)
50  real, allocatable::  vg_prof_cas(:)
51  real, allocatable::  ht_prof_cas(:)
52  real, allocatable::  hth_prof_cas(:)
53  real, allocatable::  hq_prof_cas(:)
54  real, allocatable::  vt_prof_cas(:)
55  real, allocatable::  vth_prof_cas(:)
56  real, allocatable::  vq_prof_cas(:)
57  real, allocatable::  dt_prof_cas(:)
58  real, allocatable::  dth_prof_cas(:)
59  real, allocatable::  dtrad_prof_cas(:)
60  real, allocatable::  dq_prof_cas(:)
61  real, allocatable::  hu_prof_cas(:)
62  real, allocatable::  hv_prof_cas(:)
63  real, allocatable::  vu_prof_cas(:)
64  real, allocatable::  vv_prof_cas(:)
65  real, allocatable::  du_prof_cas(:)
66  real, allocatable::  dv_prof_cas(:)
67  real, allocatable::  uw_prof_cas(:)
68  real, allocatable::  vw_prof_cas(:)
69  real, allocatable::  q1_prof_cas(:)
70  real, allocatable::  q2_prof_cas(:)
71
72
73  real lat_prof_cas,sens_prof_cas,ts_prof_cas,ps_prof_cas,ustar_prof_cas,tke_prof_cas
74  real o3_cas,orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,heat_rough,rugos_cas,sand_cas,clay_cas
75
76
77
78CONTAINS
79
80  SUBROUTINE read_1D_cas
81    implicit none
82
83    INCLUDE "netcdf.inc"
84
85    INTEGER nid,rid,ierr
86    INTEGER ii,jj
87
88    fich_cas='setup/cas.nc'
89    print*,'fich_cas ',fich_cas
90    ierr = NF_OPEN(fich_cas,NF_NOWRITE,nid)
91    print*,'fich_cas,NF_NOWRITE,nid ',fich_cas,NF_NOWRITE,nid
92    if (ierr.NE.NF_NOERR) then
93       write(*,*) 'ERROR: GROS Pb opening forcings nc file '
94       write(*,*) NF_STRERROR(ierr)
95       stop ""
96    endif
97    !.......................................................................
98    ierr=NF_INQ_DIMID(nid,'lat',rid)
99    IF (ierr.NE.NF_NOERR) THEN
100       print*, 'Oh probleme lecture dimension lat'
101    ENDIF
102    ierr=NF_INQ_DIMLEN(nid,rid,ii)
103    print*,'OK1 nid,rid,lat',nid,rid,ii
104    !.......................................................................
105    ierr=NF_INQ_DIMID(nid,'lon',rid)
106    IF (ierr.NE.NF_NOERR) THEN
107       print*, 'Oh probleme lecture dimension lon'
108    ENDIF
109    ierr=NF_INQ_DIMLEN(nid,rid,jj)
110    print*,'OK2 nid,rid,lat',nid,rid,jj
111    !.......................................................................
112    ierr=NF_INQ_DIMID(nid,'lev',rid)
113    IF (ierr.NE.NF_NOERR) THEN
114       print*, 'Oh probleme lecture dimension zz'
115    ENDIF
116    ierr=NF_INQ_DIMLEN(nid,rid,nlev_cas)
117    print*,'OK3 nid,rid,nlev_cas',nid,rid,nlev_cas
118    !.......................................................................
119    ierr=NF_INQ_DIMID(nid,'time',rid)
120    print*,'nid,rid',nid,rid
121    nt_cas=0
122    IF (ierr.NE.NF_NOERR) THEN
123       stop 'probleme lecture dimension sens'
124    ENDIF
125    ierr=NF_INQ_DIMLEN(nid,rid,nt_cas)
126    print*,'OK4 nid,rid,nt_cas',nid,rid,nt_cas
127
128!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
129    !profils moyens:
130    allocate(plev_cas(nlev_cas,nt_cas))       
131    allocate(z_cas(nlev_cas,nt_cas))
132    allocate(t_cas(nlev_cas,nt_cas),q_cas(nlev_cas,nt_cas),rh_cas(nlev_cas,nt_cas))
133    allocate(th_cas(nlev_cas,nt_cas),rv_cas(nlev_cas,nt_cas))
134    allocate(u_cas(nlev_cas,nt_cas))
135    allocate(v_cas(nlev_cas,nt_cas))
136
137    !forcing
138    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))
139    allocate(hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas),dq_cas(nlev_cas,nt_cas))
140    allocate(hth_cas(nlev_cas,nt_cas),vth_cas(nlev_cas,nt_cas),dth_cas(nlev_cas,nt_cas))
141    allocate(hr_cas(nlev_cas,nt_cas),vr_cas(nlev_cas,nt_cas),dr_cas(nlev_cas,nt_cas))
142    allocate(hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas),du_cas(nlev_cas,nt_cas))
143    allocate(hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas),dv_cas(nlev_cas,nt_cas))
144    allocate(vitw_cas(nlev_cas,nt_cas))
145    allocate(ug_cas(nlev_cas,nt_cas))
146    allocate(vg_cas(nlev_cas,nt_cas))
147    allocate(lat_cas(nt_cas),sens_cas(nt_cas),ts_cas(nt_cas),ps_cas(nt_cas),ustar_cas(nt_cas))
148    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))
149
150
151    !champs interpoles
152    allocate(plev_prof_cas(nlev_cas))
153    allocate(t_prof_cas(nlev_cas))
154    allocate(q_prof_cas(nlev_cas))
155    allocate(u_prof_cas(nlev_cas))
156    allocate(v_prof_cas(nlev_cas))
157
158    allocate(vitw_prof_cas(nlev_cas))
159    allocate(ug_prof_cas(nlev_cas))
160    allocate(vg_prof_cas(nlev_cas))
161    allocate(ht_prof_cas(nlev_cas))
162    allocate(hq_prof_cas(nlev_cas))
163    allocate(hu_prof_cas(nlev_cas))
164    allocate(hv_prof_cas(nlev_cas))
165    allocate(vt_prof_cas(nlev_cas))
166    allocate(vq_prof_cas(nlev_cas))
167    allocate(vu_prof_cas(nlev_cas))
168    allocate(vv_prof_cas(nlev_cas))
169    allocate(dt_prof_cas(nlev_cas))
170    allocate(dtrad_prof_cas(nlev_cas))
171    allocate(dq_prof_cas(nlev_cas))
172    allocate(du_prof_cas(nlev_cas))
173    allocate(dv_prof_cas(nlev_cas))
174    allocate(uw_prof_cas(nlev_cas))
175    allocate(vw_prof_cas(nlev_cas))
176    allocate(q1_prof_cas(nlev_cas))
177    allocate(q2_prof_cas(nlev_cas))
178
179    print*,'Allocations OK'
180    call read_cas2(nid,nlev_cas,nt_cas                                       &
181         ,z_cas,plev_cas,t_cas,q_cas,rh_cas,th_cas,rv_cas,u_cas,v_cas         &
182         ,ug_cas,vg_cas,vitw_cas,du_cas,hu_cas,vu_cas,dv_cas,hv_cas,vv_cas    &
183         ,dt_cas,dtrad_cas,ht_cas,vt_cas,dq_cas,hq_cas,vq_cas                 &
184         ,dth_cas,hth_cas,vth_cas,dr_cas,hr_cas,vr_cas,sens_cas,lat_cas,ts_cas&
185         ,ustar_cas,uw_cas,vw_cas,q1_cas,q2_cas)
186    print*,'Read cas OK'
187
188
189  END SUBROUTINE read_1D_cas
190  !**********************************************************************************************
191  SUBROUTINE read2_1D_cas
192    implicit none
193
194    INCLUDE "netcdf.inc"
195
196    INTEGER nid,rid,ierr
197    INTEGER ii,jj
198
199    fich_cas='setup/cas.nc'
200    print*,'fich_cas ',fich_cas
201    ierr = NF_OPEN(fich_cas,NF_NOWRITE,nid)
202    print*,'fich_cas,NF_NOWRITE,nid ',fich_cas,NF_NOWRITE,nid
203    if (ierr.NE.NF_NOERR) then
204       write(*,*) 'ERROR: GROS Pb opening forcings nc file '
205       write(*,*) NF_STRERROR(ierr)
206       stop ""
207    endif
208    !.......................................................................
209    ierr=NF_INQ_DIMID(nid,'lat',rid)
210    IF (ierr.NE.NF_NOERR) THEN
211       print*, 'Oh probleme lecture dimension lat'
212    ENDIF
213    ierr=NF_INQ_DIMLEN(nid,rid,ii)
214    print*,'OK1 read2: nid,rid,lat',nid,rid,ii
215    !.......................................................................
216    ierr=NF_INQ_DIMID(nid,'lon',rid)
217    IF (ierr.NE.NF_NOERR) THEN
218       print*, 'Oh probleme lecture dimension lon'
219    ENDIF
220    ierr=NF_INQ_DIMLEN(nid,rid,jj)
221    print*,'OK2 read2: nid,rid,lat',nid,rid,jj
222    !.......................................................................
223    ierr=NF_INQ_DIMID(nid,'nlev',rid)
224    IF (ierr.NE.NF_NOERR) THEN
225       print*, 'Oh probleme lecture dimension nlev'
226    ENDIF
227    ierr=NF_INQ_DIMLEN(nid,rid,nlev_cas)
228    print*,'OK3 read2: nid,rid,nlev_cas',nid,rid,nlev_cas
229    !.......................................................................
230    ierr=NF_INQ_DIMID(nid,'time',rid)
231    nt_cas=0
232    IF (ierr.NE.NF_NOERR) THEN
233       stop 'Oh probleme lecture dimension time'
234    ENDIF
235    ierr=NF_INQ_DIMLEN(nid,rid,nt_cas)
236    print*,'OK4 read2: nid,rid,nt_cas',nid,rid,nt_cas
237
238!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
239    !profils moyens:
240    allocate(plev_cas(nlev_cas,nt_cas),plevh_cas(nlev_cas+1))       
241    allocate(z_cas(nlev_cas,nt_cas),zh_cas(nlev_cas+1))
242    allocate(ap_cas(nlev_cas+1),bp_cas(nlev_cas+1))
243    allocate(t_cas(nlev_cas,nt_cas),q_cas(nlev_cas,nt_cas),qv_cas(nlev_cas,nt_cas),ql_cas(nlev_cas,nt_cas), &
244         qi_cas(nlev_cas,nt_cas),rh_cas(nlev_cas,nt_cas))
245    allocate(th_cas(nlev_cas,nt_cas),thl_cas(nlev_cas,nt_cas),thv_cas(nlev_cas,nt_cas),rv_cas(nlev_cas,nt_cas))
246    allocate(u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas),vitw_cas(nlev_cas,nt_cas),omega_cas(nlev_cas,nt_cas))
247
248    !forcing
249    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))
250    allocate(hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas),dq_cas(nlev_cas,nt_cas))
251    allocate(hth_cas(nlev_cas,nt_cas),vth_cas(nlev_cas,nt_cas),dth_cas(nlev_cas,nt_cas))
252    allocate(hr_cas(nlev_cas,nt_cas),vr_cas(nlev_cas,nt_cas),dr_cas(nlev_cas,nt_cas))
253    allocate(hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas),du_cas(nlev_cas,nt_cas))
254    allocate(hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas),dv_cas(nlev_cas,nt_cas))
255    allocate(ug_cas(nlev_cas,nt_cas))
256    allocate(vg_cas(nlev_cas,nt_cas))
257    allocate(lat_cas(nt_cas),sens_cas(nt_cas),ts_cas(nt_cas),ps_cas(nt_cas),ustar_cas(nt_cas),tke_cas(nt_cas))
258    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))
259
260
261
262    !champs interpoles
263    allocate(plev_prof_cas(nlev_cas))
264    allocate(t_prof_cas(nlev_cas))
265    allocate(theta_prof_cas(nlev_cas))
266    allocate(thl_prof_cas(nlev_cas))
267    allocate(thv_prof_cas(nlev_cas))
268    allocate(q_prof_cas(nlev_cas))
269    allocate(qv_prof_cas(nlev_cas))
270    allocate(ql_prof_cas(nlev_cas))
271    allocate(qi_prof_cas(nlev_cas))
272    allocate(rh_prof_cas(nlev_cas))
273    allocate(rv_prof_cas(nlev_cas))
274    allocate(u_prof_cas(nlev_cas))
275    allocate(v_prof_cas(nlev_cas))
276    allocate(vitw_prof_cas(nlev_cas))
277    allocate(omega_prof_cas(nlev_cas))
278    allocate(ug_prof_cas(nlev_cas))
279    allocate(vg_prof_cas(nlev_cas))
280    allocate(ht_prof_cas(nlev_cas))
281    allocate(hth_prof_cas(nlev_cas))
282    allocate(hq_prof_cas(nlev_cas))
283    allocate(hu_prof_cas(nlev_cas))
284    allocate(hv_prof_cas(nlev_cas))
285    allocate(vt_prof_cas(nlev_cas))
286    allocate(vth_prof_cas(nlev_cas))
287    allocate(vq_prof_cas(nlev_cas))
288    allocate(vu_prof_cas(nlev_cas))
289    allocate(vv_prof_cas(nlev_cas))
290    allocate(dt_prof_cas(nlev_cas))
291    allocate(dth_prof_cas(nlev_cas))
292    allocate(dtrad_prof_cas(nlev_cas))
293    allocate(dq_prof_cas(nlev_cas))
294    allocate(du_prof_cas(nlev_cas))
295    allocate(dv_prof_cas(nlev_cas))
296    allocate(uw_prof_cas(nlev_cas))
297    allocate(vw_prof_cas(nlev_cas))
298    allocate(q1_prof_cas(nlev_cas))
299    allocate(q2_prof_cas(nlev_cas))
300
301    print*,'Allocations OK'
302    call read2_cas (nid,nlev_cas,nt_cas,                                                                     &
303         ap_cas,bp_cas,z_cas,plev_cas,zh_cas,plevh_cas,t_cas,th_cas,thv_cas,thl_cas,qv_cas,                    &
304         ql_cas,qi_cas,rh_cas,rv_cas,u_cas,v_cas,vitw_cas,omega_cas,ug_cas,vg_cas,du_cas,hu_cas,vu_cas,        &
305         dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas,               &
306         dr_cas,hr_cas,vr_cas,dtrad_cas,sens_cas,lat_cas,ts_cas,ps_cas,ustar_cas,tke_cas,                      &
307         uw_cas,vw_cas,q1_cas,q2_cas,orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,heat_rough, &
308         o3_cas,rugos_cas,clay_cas,sand_cas)
309    print*,'Read2 cas OK'
310    do ii=1,nlev_cas
311       print*,'apres read2_cas, plev_cas=',ii,plev_cas(ii,1)
312    enddo
313
314
315  END SUBROUTINE read2_1D_cas
316
317  !**********************************************************************************************
318  SUBROUTINE old_read_SCM_cas
319    use netcdf, only: nf90_get_var
320    implicit none
321
322    INCLUDE "netcdf.inc"
323    INCLUDE "date_cas.h"
324
325    INTEGER nid,rid,ierr
326    INTEGER ii,jj,timeid
327    REAL, ALLOCATABLE :: time_val(:)
328
329    fich_cas='cas.nc'
330    print*,'fich_cas ',fich_cas
331    ierr = NF_OPEN(fich_cas,NF_NOWRITE,nid)
332    print*,'fich_cas,NF_NOWRITE,nid ',fich_cas,NF_NOWRITE,nid
333    if (ierr.NE.NF_NOERR) then
334       write(*,*) 'ERROR: GROS Pb opening forcings nc file '
335       write(*,*) NF_STRERROR(ierr)
336       stop ""
337    endif
338    !.......................................................................
339    ierr=NF_INQ_DIMID(nid,'lat',rid)
340    IF (ierr.NE.NF_NOERR) THEN
341       print*, 'Oh probleme lecture dimension lat'
342    ENDIF
343    ierr=NF_INQ_DIMLEN(nid,rid,ii)
344    print*,'OK1 read2: nid,rid,lat',nid,rid,ii
345    !.......................................................................
346    ierr=NF_INQ_DIMID(nid,'lon',rid)
347    IF (ierr.NE.NF_NOERR) THEN
348       print*, 'Oh probleme lecture dimension lon'
349    ENDIF
350    ierr=NF_INQ_DIMLEN(nid,rid,jj)
351    print*,'OK2 read2: nid,rid,lat',nid,rid,jj
352    !.......................................................................
353    ierr=NF_INQ_DIMID(nid,'lev',rid)
354    IF (ierr.NE.NF_NOERR) THEN
355       print*, 'Oh probleme lecture dimension nlev'
356    ENDIF
357    ierr=NF_INQ_DIMLEN(nid,rid,nlev_cas)
358    print*,'OK3 read2: nid,rid,nlev_cas',nid,rid,nlev_cas
359    IF ( .NOT. ( nlev_cas > 10 .AND. nlev_cas < 1000 )) THEN
360       print*,'Valeur de nlev_cas peu probable'
361       STOP
362    ENDIF
363    !.......................................................................
364    ierr=NF_INQ_DIMID(nid,'time',rid)
365    nt_cas=0
366    IF (ierr.NE.NF_NOERR) THEN
367       stop 'Oh probleme lecture dimension time'
368    ENDIF
369    ierr=NF_INQ_DIMLEN(nid,rid,nt_cas)
370    print*,'OK4 read2: nid,rid,nt_cas',nid,rid,nt_cas
371    ! Lecture de l'axe des temps
372    print*,'LECTURE DU TEMPS'
373    ierr=NF_INQ_VARID(nid,'time',timeid)
374    if(ierr/=NF_NOERR) then
375       print *,'Variable time manquante dans cas.nc:'
376       ierr=NF_NOERR
377    else
378       allocate(time_val(nt_cas))
379       ierr = NF90_GET_VAR(nid,timeid,time_val)
380       if(ierr/=NF_NOERR) then
381          print *,'Pb a la lecture de time cas.nc: '
382       endif
383    endif
384    IF (nt_cas>1) THEN
385       pdt_cas=time_val(2)-time_val(1)
386    ELSE
387       pdt_cas=0.
388    ENDIF
389
390
391!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
392    !profils moyens:
393    allocate(plev_cas(nlev_cas,nt_cas),plevh_cas(nlev_cas+1))       
394    allocate(z_cas(nlev_cas,nt_cas),zh_cas(nlev_cas+1))
395    allocate(ap_cas(nlev_cas+1),bp_cas(nlev_cas+1))
396    allocate(t_cas(nlev_cas,nt_cas),q_cas(nlev_cas,nt_cas),qv_cas(nlev_cas,nt_cas),ql_cas(nlev_cas,nt_cas), &
397         qi_cas(nlev_cas,nt_cas),rh_cas(nlev_cas,nt_cas))
398    allocate(th_cas(nlev_cas,nt_cas),thl_cas(nlev_cas,nt_cas),thv_cas(nlev_cas,nt_cas),rv_cas(nlev_cas,nt_cas))
399    allocate(u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas),vitw_cas(nlev_cas,nt_cas),omega_cas(nlev_cas,nt_cas))
400
401    !forcing
402    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))
403    allocate(hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas),dq_cas(nlev_cas,nt_cas))
404    allocate(hth_cas(nlev_cas,nt_cas),vth_cas(nlev_cas,nt_cas),dth_cas(nlev_cas,nt_cas))
405    allocate(hr_cas(nlev_cas,nt_cas),vr_cas(nlev_cas,nt_cas),dr_cas(nlev_cas,nt_cas))
406    allocate(hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas),du_cas(nlev_cas,nt_cas))
407    allocate(hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas),dv_cas(nlev_cas,nt_cas))
408    allocate(ug_cas(nlev_cas,nt_cas))
409    allocate(vg_cas(nlev_cas,nt_cas))
410    allocate(lat_cas(nt_cas),sens_cas(nt_cas),ts_cas(nt_cas),ps_cas(nt_cas),ustar_cas(nt_cas),tke_cas(nt_cas))
411    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))
412
413
414
415    !champs interpoles
416    allocate(plev_prof_cas(nlev_cas))
417    allocate(t_prof_cas(nlev_cas))
418    allocate(theta_prof_cas(nlev_cas))
419    allocate(thl_prof_cas(nlev_cas))
420    allocate(thv_prof_cas(nlev_cas))
421    allocate(q_prof_cas(nlev_cas))
422    allocate(qv_prof_cas(nlev_cas))
423    allocate(ql_prof_cas(nlev_cas))
424    allocate(qi_prof_cas(nlev_cas))
425    allocate(rh_prof_cas(nlev_cas))
426    allocate(rv_prof_cas(nlev_cas))
427    allocate(u_prof_cas(nlev_cas))
428    allocate(v_prof_cas(nlev_cas))
429    allocate(vitw_prof_cas(nlev_cas))
430    allocate(omega_prof_cas(nlev_cas))
431    allocate(ug_prof_cas(nlev_cas))
432    allocate(vg_prof_cas(nlev_cas))
433    allocate(ht_prof_cas(nlev_cas))
434    allocate(hth_prof_cas(nlev_cas))
435    allocate(hq_prof_cas(nlev_cas))
436    allocate(hu_prof_cas(nlev_cas))
437    allocate(hv_prof_cas(nlev_cas))
438    allocate(vt_prof_cas(nlev_cas))
439    allocate(vth_prof_cas(nlev_cas))
440    allocate(vq_prof_cas(nlev_cas))
441    allocate(vu_prof_cas(nlev_cas))
442    allocate(vv_prof_cas(nlev_cas))
443    allocate(dt_prof_cas(nlev_cas))
444    allocate(dth_prof_cas(nlev_cas))
445    allocate(dtrad_prof_cas(nlev_cas))
446    allocate(dq_prof_cas(nlev_cas))
447    allocate(du_prof_cas(nlev_cas))
448    allocate(dv_prof_cas(nlev_cas))
449    allocate(uw_prof_cas(nlev_cas))
450    allocate(vw_prof_cas(nlev_cas))
451    allocate(q1_prof_cas(nlev_cas))
452    allocate(q2_prof_cas(nlev_cas))
453
454    print*,'Allocations OK'
455    call old_read_SCM (nid,nlev_cas,nt_cas,                                                                     &
456         ap_cas,bp_cas,z_cas,plev_cas,zh_cas,plevh_cas,t_cas,th_cas,thv_cas,thl_cas,qv_cas,                    &
457         ql_cas,qi_cas,rh_cas,rv_cas,u_cas,v_cas,vitw_cas,omega_cas,ug_cas,vg_cas,du_cas,hu_cas,vu_cas,        &
458         dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas,               &
459         dr_cas,hr_cas,vr_cas,dtrad_cas,sens_cas,lat_cas,ts_cas,ps_cas,ustar_cas,tke_cas,                      &
460         uw_cas,vw_cas,q1_cas,q2_cas,orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,heat_rough, &
461         o3_cas,rugos_cas,clay_cas,sand_cas)
462    print*,'Read2 cas OK'
463    do ii=1,nlev_cas
464       print*,'apres read2_cas, plev_cas=',ii,plev_cas(ii,1)
465    enddo
466
467
468  END SUBROUTINE old_read_SCM_cas
469
470
471!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
472  SUBROUTINE deallocate2_1D_cases
473    !profils environnementaux:
474    deallocate(plev_cas,plevh_cas)
475
476    deallocate(z_cas,zh_cas)
477    deallocate(ap_cas,bp_cas)
478    deallocate(t_cas,q_cas,qv_cas,ql_cas,qi_cas,rh_cas)
479    deallocate(th_cas,thl_cas,thv_cas,rv_cas)
480    deallocate(u_cas,v_cas,vitw_cas,omega_cas)
481
482    !forcing
483    deallocate(ht_cas,vt_cas,dt_cas,dtrad_cas)
484    deallocate(hq_cas,vq_cas,dq_cas)
485    deallocate(hth_cas,vth_cas,dth_cas)
486    deallocate(hr_cas,vr_cas,dr_cas)
487    deallocate(hu_cas,vu_cas,du_cas)
488    deallocate(hv_cas,vv_cas,dv_cas)
489    deallocate(ug_cas)
490    deallocate(vg_cas)
491    deallocate(lat_cas,sens_cas,ts_cas,ps_cas,ustar_cas,tke_cas,uw_cas,vw_cas,q1_cas,q2_cas)
492
493    !champs interpoles
494    deallocate(plev_prof_cas)
495    deallocate(t_prof_cas)
496    deallocate(theta_prof_cas)
497    deallocate(thl_prof_cas)
498    deallocate(thv_prof_cas)
499    deallocate(q_prof_cas)
500    deallocate(qv_prof_cas)
501    deallocate(ql_prof_cas)
502    deallocate(qi_prof_cas)
503    deallocate(rh_prof_cas)
504    deallocate(rv_prof_cas)
505    deallocate(u_prof_cas)
506    deallocate(v_prof_cas)
507    deallocate(vitw_prof_cas)
508    deallocate(omega_prof_cas)
509    deallocate(ug_prof_cas)
510    deallocate(vg_prof_cas)
511    deallocate(ht_prof_cas)
512    deallocate(hq_prof_cas)
513    deallocate(hu_prof_cas)
514    deallocate(hv_prof_cas)
515    deallocate(vt_prof_cas)
516    deallocate(vq_prof_cas)
517    deallocate(vu_prof_cas)
518    deallocate(vv_prof_cas)
519    deallocate(dt_prof_cas)
520    deallocate(dtrad_prof_cas)
521    deallocate(dq_prof_cas)
522    deallocate(du_prof_cas)
523    deallocate(dv_prof_cas)
524    deallocate(t_prof_cas)
525    deallocate(u_prof_cas)
526    deallocate(v_prof_cas)
527    deallocate(uw_prof_cas)
528    deallocate(vw_prof_cas)
529    deallocate(q1_prof_cas)
530    deallocate(q2_prof_cas)
531
532  END SUBROUTINE deallocate2_1D_cases
533
534
535END MODULE mod_1D_cases_read2
536!=====================================================================
537subroutine read_cas2(nid,nlevel,ntime                          &
538     ,zz,pp,temp,qv,rh,theta,rv,u,v,ug,vg,w,                   &
539     du,hu,vu,dv,hv,vv,dt,dtrad,ht,vt,dq,hq,vq,                     &
540     dth,hth,vth,dr,hr,vr,sens,flat,ts,ustar,uw,vw,q1,q2)
541
542  !program reading forcing of the case study
543  use netcdf, only: nf90_get_var
544  implicit none
545  INCLUDE "netcdf.inc"
546
547  integer ntime,nlevel
548
549  real zz(nlevel,ntime)
550  real pp(nlevel,ntime)
551  real temp(nlevel,ntime),qv(nlevel,ntime),rh(nlevel,ntime)
552  real theta(nlevel,ntime),rv(nlevel,ntime)
553  real u(nlevel,ntime)
554  real v(nlevel,ntime)
555  real ug(nlevel,ntime)
556  real vg(nlevel,ntime)
557  real w(nlevel,ntime)
558  real du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime)
559  real dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime)
560  real dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime)
561  real dtrad(nlevel,ntime)
562  real dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime)
563  real dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime)
564  real dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime)
565  real flat(ntime),sens(ntime),ts(ntime),ustar(ntime)
566  real uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime),resul(nlevel,ntime),resul1(ntime)
567
568
569  integer nid, ierr, ierr1,ierr2,rid,i
570  integer nbvar3d
571  parameter(nbvar3d=39)
572  integer var3didin(nbvar3d)
573  character*5 name_var(1:nbvar3d)
574  data name_var/'zz','pp','temp','qv','rh','theta','rv','u','v','ug','vg','w','advu','hu','vu',&
575       'advv','hv','vv','advT','hT','vT','advq','hq','vq','advth','hth','vth','advr','hr','vr',&
576       'radT','uw','vw','q1','q2','sens','flat','ts','ustar'/
577
578
579  do i=1,nbvar3d
580     print *,'Dans read_cas2, on va lire ',nid,i,name_var(i)
581  enddo
582  do i=1,nbvar3d
583     ierr=NF_INQ_VARID(nid,name_var(i),var3didin(i))
584     print *,'ierr=',i,ierr,name_var(i),var3didin(i)
585     if(ierr/=NF_NOERR) then
586        print *,'Variable manquante dans cas.nc:',name_var(i)
587     endif
588  enddo
589  do i=1,nbvar3d
590     print *,'Dans read_cas2, on va lire ',var3didin(i),name_var(i)
591     if(i.LE.35) then
592        ierr = NF90_GET_VAR(nid,var3didin(i),resul, count = [1, 1, nlevel, ntime])
593        print *,'Dans read_cas2, on a lu ',ierr,var3didin(i),name_var(i)
594        if(ierr/=NF_NOERR) then
595           print *,'Pb a la lecture de cas.nc: ',name_var(i)
596           stop "getvarup"
597        endif
598     else
599        print *,'Dans read_cas2, on a lu ',ierr,var3didin(i),name_var(i)
600        ierr = NF90_GET_VAR(nid,var3didin(i),resul1, count = [1, 1, ntime])
601        if(ierr/=NF_NOERR) then
602           print *,'Pb a la lecture de cas.nc: ',name_var(i)
603           stop "getvarup"
604        endif
605     endif
606     select case(i)
607     case(1) ; zz=resul
608     case(2) ; pp=resul
609     case(3) ; temp=resul
610     case(4) ; qv=resul
611     case(5) ; rh=resul
612     case(6) ; theta=resul
613     case(7) ; rv=resul
614     case(8) ; u=resul
615     case(9) ; v=resul
616     case(10) ; ug=resul
617     case(11) ; vg=resul
618     case(12) ; w=resul
619     case(13) ; du=resul
620     case(14) ; hu=resul
621     case(15) ; vu=resul
622     case(16) ; dv=resul
623     case(17) ; hv=resul
624     case(18) ; vv=resul
625     case(19) ; dt=resul
626     case(20) ; ht=resul
627     case(21) ; vt=resul
628     case(22) ; dq=resul
629     case(23) ; hq=resul
630     case(24) ; vq=resul
631     case(25) ; dth=resul
632     case(26) ; hth=resul
633     case(27) ; vth=resul
634     case(28) ; dr=resul
635     case(29) ; hr=resul
636     case(30) ; vr=resul
637     case(31) ; dtrad=resul
638     case(32) ; uw=resul
639     case(33) ; vw=resul
640     case(34) ; q1=resul
641     case(35) ; q2=resul
642     case(36) ; sens=resul1
643     case(37) ; flat=resul1
644     case(38) ; ts=resul1
645     case(39) ; ustar=resul1
646     end select
647  enddo
648
649  return
650end subroutine read_cas2
651!======================================================================
652subroutine read2_cas(nid,nlevel,ntime,                                       &
653     ap,bp,zz,pp,zzh,pph,temp,theta,thv,thl,qv,ql,qi,rh,rv,u,v,vitw,omega,ug,vg,&
654     du,hu,vu,dv,hv,vv,dt,ht,vt,dq,hq,vq,                                    &
655     dth,hth,vth,dr,hr,vr,dtrad,sens,flat,ts,ps,ustar,tke,uw,vw,q1,q2,       &
656     orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,          &
657     heat_rough,o3_cas,rugos_cas,clay_cas,sand_cas)
658
659  !program reading forcing of the case study
660  use netcdf, only: nf90_get_var
661  implicit none
662  INCLUDE "netcdf.inc"
663
664  integer ntime,nlevel
665
666  real ap(nlevel+1),bp(nlevel+1)
667  real zz(nlevel,ntime),zzh(nlevel+1)
668  real pp(nlevel,ntime),pph(nlevel+1)
669  real temp(nlevel,ntime),qv(nlevel,ntime),ql(nlevel,ntime),qi(nlevel,ntime),rh(nlevel,ntime)
670  real theta(nlevel,ntime),thv(nlevel,ntime),thl(nlevel,ntime),rv(nlevel,ntime)
671  real u(nlevel,ntime),v(nlevel,ntime)
672  real ug(nlevel,ntime),vg(nlevel,ntime)
673  real vitw(nlevel,ntime),omega(nlevel,ntime)
674  real du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime)
675  real dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime)
676  real dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime)
677  real dtrad(nlevel,ntime)
678  real dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime)
679  real dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime),hthl(nlevel,ntime)
680  real dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime)
681  real flat(ntime),sens(ntime),ustar(ntime)
682  real uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime)
683  real ts(ntime),ps(ntime),tke(ntime)
684  real orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,heat_rough,o3_cas,rugos_cas,clay_cas,sand_cas
685  real apbp(nlevel+1),resul(nlevel,ntime),resul1(nlevel),resul2(ntime),resul3
686
687
688  integer nid, ierr,ierr1,ierr2,rid,i
689  integer nbvar3d
690  parameter(nbvar3d=62)
691  integer var3didin(nbvar3d),missing_var(nbvar3d)
692  character*12 name_var(1:nbvar3d)
693  data name_var/'coor_par_a','coor_par_b','height_h','pressure_h',&
694       'w','omega','ug','vg','uadv','uadvh','uadvv','vadv','vadvh','vadvv','tadv','tadvh','tadvv',&
695       'qadv','qadvh','qadvv','thadv','thadvh','thadvv','thladvh','radv','radvh','radvv','radcool','q1','q2','ustress','vstress', &
696       'rh',&
697       'height_f','pressure_f','temp','theta','thv','thl','qv','ql','qi','rv','u','v',&
698       'sfc_sens_flx','sfc_lat_flx','ts','ps','ustar','tke',&
699       'orog','albedo','emiss','t_skin','q_skin','mom_rough','heat_rough','o3','rugos','clay','sand'/
700  do i=1,nbvar3d
701     missing_var(i)=0.
702  enddo
703
704  !-----------------------------------------------------------------------
705  do i=1,nbvar3d
706     ierr=NF_INQ_VARID(nid,name_var(i),var3didin(i))
707     if(ierr/=NF_NOERR) then
708        print *,'Variable manquante dans cas.nc:',i,name_var(i)
709        ierr=NF_NOERR
710        missing_var(i)=1
711     else
712        !-----------------------------------------------------------------------
713        if(i.LE.4) then     ! Lecture des coord pression en (nlevelp1,lat,lon)
714           ierr = NF90_GET_VAR(nid,var3didin(i),apbp, count = [1, 1, nlevel + 1])
715           print *,'read2_cas(apbp), on a lu ',i,name_var(i)
716           if(ierr/=NF_NOERR) then
717              print *,'Pb a la lecture de cas.nc: ',name_var(i)
718              stop "getvarup"
719           endif
720           !-----------------------------------------------------------------------
721        else if(i.gt.4.and.i.LE.45) then   ! Lecture des variables en (time,nlevel,lat,lon)
722           ierr = NF90_GET_VAR(nid,var3didin(i),resul, count = [1, 1, nlevel, ntime])
723           print *,'read2_cas(resul), on a lu ',i,name_var(i)
724           if(ierr/=NF_NOERR) then
725              print *,'Pb a la lecture de cas.nc: ',name_var(i)
726              stop "getvarup"
727           endif
728           !-----------------------------------------------------------------------
729        else if (i.gt.45.and.i.LE.51) then   ! Lecture des variables en (time,lat,lon)
730           ierr = NF90_GET_VAR(nid,var3didin(i),resul2, count = [1, 1, ntime])
731           print *,'read2_cas(resul2), on a lu ',i,name_var(i)
732           if(ierr/=NF_NOERR) then
733              print *,'Pb a la lecture de cas.nc: ',name_var(i)
734              stop "getvarup"
735           endif
736           !-----------------------------------------------------------------------
737        else     ! Lecture des constantes (lat,lon)
738           ierr = NF90_GET_VAR(nid,var3didin(i),resul3)
739           print *,'read2_cas(resul3), on a lu ',i,name_var(i)
740           if(ierr/=NF_NOERR) then
741              print *,'Pb a la lecture de cas.nc: ',name_var(i)
742              stop "getvarup"
743           endif
744        endif
745     endif
746     !-----------------------------------------------------------------------
747     select case(i)
748     case(1) ; ap=apbp       ! donnees indexees en nlevel+1
749     case(2) ; bp=apbp
750     case(3) ; zzh=apbp
751     case(4) ; pph=apbp
752     case(5) ; vitw=resul    ! donnees indexees en nlevel,time
753     case(6) ; omega=resul
754     case(7) ; ug=resul
755     case(8) ; vg=resul
756     case(9) ; du=resul
757     case(10) ; hu=resul
758     case(11) ; vu=resul
759     case(12) ; dv=resul
760     case(13) ; hv=resul
761     case(14) ; vv=resul
762     case(15) ; dt=resul
763     case(16) ; ht=resul
764     case(17) ; vt=resul
765     case(18) ; dq=resul
766     case(19) ; hq=resul
767     case(20) ; vq=resul
768     case(21) ; dth=resul
769     case(22) ; hth=resul
770     case(23) ; vth=resul
771     case(24) ; hthl=resul
772     case(25) ; dr=resul
773     case(26) ; hr=resul
774     case(27) ; vr=resul
775     case(28) ; dtrad=resul
776     case(29) ; q1=resul
777     case(30) ; q2=resul
778     case(31) ; uw=resul
779     case(32) ; vw=resul
780     case(33) ; rh=resul
781     case(34) ; zz=resul      ! donnees en time,nlevel pour profil initial
782     case(35) ; pp=resul
783     case(36) ; temp=resul
784     case(37) ; theta=resul
785     case(38) ; thv=resul
786     case(39) ; thl=resul
787     case(40) ; qv=resul
788     case(41) ; ql=resul
789     case(42) ; qi=resul
790     case(43) ; rv=resul
791     case(44) ; u=resul
792     case(45) ; v=resul
793     case(46) ; sens=resul2   ! donnees indexees en time
794     case(47) ; flat=resul2
795     case(48) ; ts=resul2
796     case(49) ; ps=resul2
797     case(50) ; ustar=resul2
798     case(51) ; tke=resul2
799     case(52) ; orog_cas=resul3      ! constantes
800     case(53) ; albedo_cas=resul3
801     case(54) ; emiss_cas=resul3
802     case(55) ; t_skin_cas=resul3
803     case(56) ; q_skin_cas=resul3
804     case(57) ; mom_rough=resul3
805     case(58) ; heat_rough=resul3
806     case(59) ; o3_cas=resul3       
807     case(60) ; rugos_cas=resul3
808     case(61) ; clay_cas=resul3
809     case(62) ; sand_cas=resul3
810     end select
811     resul=0.
812     resul1=0.
813     resul2=0.
814     resul3=0.
815  enddo
816  !-----------------------------------------------------------------------
817
818
819  return
820end subroutine read2_cas
821
822!======================================================================
823subroutine old_read_SCM(nid,nlevel,ntime,                                       &
824     ap,bp,zz,pp,zzh,pph,temp,theta,thv,thl,qv,ql,qi,rh,rv,u,v,vitw,omega,ug,vg,&
825     du,hu,vu,dv,hv,vv,dt,ht,vt,dq,hq,vq,                                    &
826     dth,hth,vth,dr,hr,vr,dtrad,sens,flat,ts,ps,ustar,tke,uw,vw,q1,q2,       &
827     orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,          &
828     heat_rough,o3_cas,rugos_cas,clay_cas,sand_cas)
829
830  !program reading forcing of the case study
831  use netcdf, only: nf90_get_var
832  implicit none
833  INCLUDE "netcdf.inc"
834
835  integer ntime,nlevel,k,t
836
837  real ap(nlevel+1),bp(nlevel+1)
838  real zz(nlevel,ntime),zzh(nlevel+1)
839  real pp(nlevel,ntime),pph(nlevel+1)
840  !profils initiaux
841  real temp0(nlevel),qv0(nlevel),ql0(nlevel),qi0(nlevel),u0(nlevel),v0(nlevel),tke0(nlevel)
842  real pp0(nlevel)   
843  real temp(nlevel,ntime),qv(nlevel,ntime),ql(nlevel,ntime),qi(nlevel,ntime),rh(nlevel,ntime)
844  real theta(nlevel,ntime),thv(nlevel,ntime),thl(nlevel,ntime),rv(nlevel,ntime)
845  real u(nlevel,ntime),v(nlevel,ntime),tke(nlevel,ntime)
846  real ug(nlevel,ntime),vg(nlevel,ntime)
847  real vitw(nlevel,ntime),omega(nlevel,ntime)
848  real du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime)
849  real dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime)
850  real dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime)
851  real dtrad(nlevel,ntime)
852  real dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime)
853  real dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime),hthl(nlevel,ntime)
854  real dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime)
855  real flat(ntime),sens(ntime),ustar(ntime)
856  real uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime)
857  real ts(ntime),ps(ntime)
858  real orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,heat_rough,o3_cas,rugos_cas,clay_cas,sand_cas
859  real apbp(nlevel+1),resul(nlevel,ntime),resul1(nlevel),resul2(ntime),resul3
860
861
862  integer nid, ierr,ierr1,ierr2,rid,i
863  integer nbvar3d
864  parameter(nbvar3d=70)
865  integer var3didin(nbvar3d),missing_var(nbvar3d)
866  character*13 name_var(1:nbvar3d)
867  data name_var/'coor_par_a','coor_par_b','height_h','pressure_h',&
868       'temp','qv','ql','qi','u','v','tke','pressure',&
869       'w','omega','ug','vg','uadv','uadvh','uadvv','vadv','vadvh','vadvv','tadv','tadvh','tadvv',&
870       'qvadv','qvadvh','qvadvv','thadv','thadvh','thadvv','thladvh','radv','radvh','radvv','radcool','q1','q2','ustress', &
871       'vstress','rh',&
872       'height_f','pressure_forc','tempt','theta','thv','thl','qvt','qlt','qit','rv','ut','vt','tket',&
873       'sfc_sens_flx','sfc_lat_flx','ts','ps','ustar',&
874       'orog','albedo','emiss','t_skin','q_skin','mom_rough','heat_rough','o3','rugos','clay','sand'/
875  do i=1,nbvar3d
876     missing_var(i)=0.
877  enddo
878
879  !-----------------------------------------------------------------------
880
881  print*,'ON EST LA'
882  do i=1,nbvar3d
883     ierr=NF_INQ_VARID(nid,name_var(i),var3didin(i))
884     if(ierr/=NF_NOERR) then
885        print *,'Variable manquante dans cas.nc:',i,name_var(i)
886        ierr=NF_NOERR
887        missing_var(i)=1
888     else
889        !-----------------------------------------------------------------------
890        if(i.LE.4) then     ! Lecture des coord pression en (nlevelp1,lat,lon)
891           ierr = NF90_GET_VAR(nid,var3didin(i),apbp)
892           print *,'read2_cas(apbp), on a lu ',i,name_var(i)
893           if(ierr/=NF_NOERR) then
894              print *,'Pb a la lecture de cas.nc: ',name_var(i)
895              stop "getvarup"
896           endif
897           !-----------------------------------------------------------------------
898        else if(i.gt.4.and.i.LE.12) then   ! Lecture des variables en (time,nlevel,lat,lon)
899           ierr = NF90_GET_VAR(nid,var3didin(i),resul1)
900           print *,'read2_cas(resul1), on a lu ',i,name_var(i)
901           if(ierr/=NF_NOERR) then
902              print *,'Pb a la lecture de cas.nc: ',name_var(i)
903              stop "getvarup"
904           endif
905           print*,'Lecture de la variable #i ',i,name_var(i),minval(resul1),maxval(resul1)
906           !-----------------------------------------------------------------------
907        else if(i.gt.12.and.i.LE.54) then   ! Lecture des variables en (time,nlevel,lat,lon)
908           ierr = NF90_GET_VAR(nid,var3didin(i),resul)
909           print *,'read2_cas(resul), on a lu ',i,name_var(i)
910           if(ierr/=NF_NOERR) then
911              print *,'Pb a la lecture de cas.nc: ',name_var(i)
912              stop "getvarup"
913           endif
914           print*,'Lecture de la variable #i ',i,name_var(i),minval(resul),maxval(resul)
915           !-----------------------------------------------------------------------
916        else if (i.gt.54.and.i.LE.65) then   ! Lecture des variables en (time,lat,lon)
917           ierr = NF90_GET_VAR(nid,var3didin(i),resul2)
918           print *,'read2_cas(resul2), on a lu ',i,name_var(i)
919           if(ierr/=NF_NOERR) then
920              print *,'Pb a la lecture de cas.nc: ',name_var(i)
921              stop "getvarup"
922           endif
923           print*,'Lecture de la variable #i  ',i,name_var(i),minval(resul2),maxval(resul2)
924           !-----------------------------------------------------------------------
925        else     ! Lecture des constantes (lat,lon)
926           ierr = NF90_GET_VAR(nid,var3didin(i),resul3)
927           print *,'read2_cas(resul3), on a lu ',i,name_var(i)
928           if(ierr/=NF_NOERR) then
929              print *,'Pb a la lecture de cas.nc: ',name_var(i)
930              stop "getvarup"
931           endif
932           print*,'Lecture de la variable #i ',i,name_var(i),resul3
933        endif
934     endif
935     !-----------------------------------------------------------------------
936     select case(i)
937        !case(1) ; ap=apbp       ! donnees indexees en nlevel+1
938        ! case(2) ; bp=apbp
939     case(3) ; zzh=apbp
940     case(4) ; pph=apbp
941     case(5) ; temp0=resul1    ! donnees initiales
942     case(6) ; qv0=resul1
943     case(7) ; ql0=resul1
944     case(8) ; qi0=resul1
945     case(9) ; u0=resul1
946     case(10) ; v0=resul1
947     case(11) ; tke0=resul1
948     case(12) ; pp0=resul1
949     case(13) ; vitw=resul    ! donnees indexees en nlevel,time
950     case(14) ; omega=resul
951     case(15) ; ug=resul
952     case(16) ; vg=resul
953     case(17) ; du=resul
954     case(18) ; hu=resul
955     case(19) ; vu=resul
956     case(20) ; dv=resul
957     case(21) ; hv=resul
958     case(22) ; vv=resul
959     case(23) ; dt=resul
960     case(24) ; ht=resul
961     case(25) ; vt=resul
962     case(26) ; dq=resul
963     case(27) ; hq=resul
964     case(28) ; vq=resul
965     case(29) ; dth=resul
966     case(30) ; hth=resul
967     case(31) ; vth=resul
968     case(32) ; hthl=resul
969     case(33) ; dr=resul
970     case(34) ; hr=resul
971     case(35) ; vr=resul
972     case(36) ; dtrad=resul
973     case(37) ; q1=resul
974     case(38) ; q2=resul
975     case(39) ; uw=resul
976     case(40) ; vw=resul
977     case(41) ; rh=resul
978     case(42) ; zz=resul      ! donnees en time,nlevel pour profil initial
979     case(43) ; pp=resul
980     case(44) ; temp=resul
981     case(45) ; theta=resul
982     case(46) ; thv=resul
983     case(47) ; thl=resul
984     case(48) ; qv=resul
985     case(49) ; ql=resul
986     case(50) ; qi=resul
987     case(51) ; rv=resul
988     case(52) ; u=resul
989     case(53) ; v=resul
990     case(54) ; tke=resul
991     case(55) ; sens=resul2   ! donnees indexees en time
992     case(56) ; flat=resul2
993     case(57) ; ts=resul2
994     case(58) ; ps=resul2
995     case(59) ; ustar=resul2
996     case(60) ; orog_cas=resul3      ! constantes
997     case(61) ; albedo_cas=resul3
998     case(62) ; emiss_cas=resul3
999     case(63) ; t_skin_cas=resul3
1000     case(64) ; q_skin_cas=resul3
1001     case(65) ; mom_rough=resul3
1002     case(66) ; heat_rough=resul3
1003     case(67) ; o3_cas=resul3       
1004     case(68) ; rugos_cas=resul3
1005     case(69) ; clay_cas=resul3
1006     case(70) ; sand_cas=resul3
1007     end select
1008     resul=0.
1009     resul1=0.
1010     resul2=0.
1011     resul3=0.
1012  enddo
1013  print*,'Lecture de la variable APRES ,sens ',minval(sens),maxval(sens)
1014  print*,'Lecture de la variable APRES ,flat ',minval(flat),maxval(flat)
1015
1016  !CR:ATTENTION EN ATTENTE DE REGLER LA QUESTION DU PAS DE TEMPS INITIAL
1017  do t=1,ntime
1018     do k=1,nlevel
1019        temp(k,t)=temp0(k)
1020        qv(k,t)=qv0(k)
1021        ql(k,t)=ql0(k)
1022        qi(k,t)=qi0(k)
1023        u(k,t)=u0(k)
1024        v(k,t)=v0(k)
1025        tke(k,t)=tke0(k)
1026     enddo
1027  enddo
1028  !-----------------------------------------------------------------------
1029
1030  return
1031end subroutine old_read_SCM
1032!======================================================================
1033
1034!======================================================================
1035SUBROUTINE interp_case_time2(day,day1,annee_ref                &
1036     !    &         ,year_cas,day_cas,nt_cas,pdt_forc,nlev_cas      &
1037     ,nt_cas,nlev_cas                                       &
1038     ,ts_cas,ps_cas,plev_cas,t_cas,q_cas,u_cas,v_cas               &
1039     ,ug_cas,vg_cas,vitw_cas,du_cas,hu_cas,vu_cas           &
1040     ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas   &
1041     ,dq_cas,hq_cas,vq_cas,lat_cas,sens_cas,ustar_cas       &
1042     ,uw_cas,vw_cas,q1_cas,q2_cas                           &
1043     ,ts_prof_cas,plev_prof_cas,t_prof_cas,q_prof_cas       &
1044     ,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas         &
1045     ,vitw_prof_cas,du_prof_cas,hu_prof_cas,vu_prof_cas     &
1046     ,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas       &
1047     ,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas    &
1048     ,hq_prof_cas,vq_prof_cas,lat_prof_cas,sens_prof_cas    &
1049     ,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas)
1050
1051
1052  implicit none
1053
1054  !---------------------------------------------------------------------------------------
1055  ! Time interpolation of a 2D field to the timestep corresponding to day
1056  !
1057  ! day: current julian day (e.g. 717538.2)
1058  ! day1: first day of the simulation
1059  ! nt_cas: total nb of data in the forcing
1060  ! pdt_cas: total time interval (in sec) between 2 forcing data
1061  !---------------------------------------------------------------------------------------
1062
1063  INCLUDE "compar1d.h"
1064  INCLUDE "date_cas.h"
1065
1066  ! inputs:
1067  integer annee_ref
1068  integer nt_cas,nlev_cas
1069  real day, day1,day_cas
1070  real ts_cas(nt_cas),ps_cas(nt_cas)
1071  real plev_cas(nlev_cas,nt_cas)
1072  real t_cas(nlev_cas,nt_cas),q_cas(nlev_cas,nt_cas)
1073  real u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas)
1074  real ug_cas(nlev_cas,nt_cas),vg_cas(nlev_cas,nt_cas)
1075  real vitw_cas(nlev_cas,nt_cas)
1076  real du_cas(nlev_cas,nt_cas),hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas)
1077  real dv_cas(nlev_cas,nt_cas),hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas)
1078  real dt_cas(nlev_cas,nt_cas),ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas)
1079  real dtrad_cas(nlev_cas,nt_cas)
1080  real dq_cas(nlev_cas,nt_cas),hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas)
1081  real lat_cas(nt_cas)
1082  real sens_cas(nt_cas)
1083  real ustar_cas(nt_cas),uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas)
1084  real q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas)
1085
1086  ! outputs:
1087  real plev_prof_cas(nlev_cas)
1088  real t_prof_cas(nlev_cas),q_prof_cas(nlev_cas)
1089  real u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
1090  real ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas)
1091  real vitw_prof_cas(nlev_cas)
1092  real du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
1093  real dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
1094  real dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas)
1095  real dtrad_prof_cas(nlev_cas)
1096  real dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
1097  real lat_prof_cas,sens_prof_cas,ts_prof_cas,ustar_prof_cas
1098  real uw_prof_cas(nlev_cas),vw_prof_cas(nlev_cas),q1_prof_cas(nlev_cas),q2_prof_cas(nlev_cas)
1099  ! local:
1100  integer it_cas1, it_cas2,k
1101  real timeit,time_cas1,time_cas2,frac
1102
1103
1104  print*,'Check time',day1,day_ju_ini_cas,day_deb+1,pdt_cas
1105
1106  ! On teste si la date du cas AMMA est correcte.
1107  ! C est pour memoire car en fait les fichiers .def
1108  ! sont censes etre corrects.
1109  ! A supprimer a terme (MPL 20150623)
1110  !     if ((forcing_type.eq.10).and.(1.eq.0)) then
1111  ! Check that initial day of the simulation consistent with AMMA case:
1112  !      if (annee_ref.ne.2006) then
1113  !       print*,'Pour AMMA, annee_ref doit etre 2006'
1114  !       print*,'Changer annee_ref dans run.def'
1115  !       stop
1116  !      endif
1117  !      if (annee_ref.eq.2006 .and. day1.lt.day_cas) then
1118  !       print*,'AMMA a debute le 10 juillet 2006',day1,day_cas
1119  !       print*,'Changer dayref dans run.def'
1120  !       stop
1121  !      endif
1122  !      if (annee_ref.eq.2006 .and. day1.gt.day_cas+1) then
1123  !       print*,'AMMA a fini le 11 juillet'
1124  !       print*,'Changer dayref ou nday dans run.def'
1125  !       stop
1126  !      endif
1127  !      endif
1128
1129  ! Determine timestep relative to the 1st day:
1130  !       timeit=(day-day1)*86400.
1131  !       if (annee_ref.eq.1992) then
1132  !        timeit=(day-day_cas)*86400.
1133  !       else
1134  !        timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992
1135  !       endif
1136  timeit=(day-day_ju_ini_cas)*86400
1137  !print *,'day=',day
1138  !print *,'day_ju_ini_cas=',day_ju_ini_cas
1139  !print *,'pdt_cas=',pdt_cas
1140  !print *,'timeit=',timeit
1141  !print *,'nt_cas=',nt_cas
1142
1143  ! Determine the closest observation times:
1144  !       it_cas1=INT(timeit/pdt_cas)+1
1145  !       it_cas2=it_cas1 + 1
1146  !       time_cas1=(it_cas1-1)*pdt_cas
1147  !       time_cas2=(it_cas2-1)*pdt_cas
1148
1149  it_cas1=INT(timeit/pdt_cas)+1
1150  IF (it_cas1 .EQ. nt_cas) THEN
1151     it_cas2=it_cas1
1152  ELSE
1153     it_cas2=it_cas1 + 1
1154  ENDIF
1155  time_cas1=(it_cas1-1)*pdt_cas
1156  time_cas2=(it_cas2-1)*pdt_cas
1157  !print *,'it_cas1,it_cas2,time_cas1,time_cas2=',it_cas1,it_cas2,time_cas1,time_cas2
1158
1159  if (it_cas1 .gt. nt_cas) then
1160     write(*,*) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: '            &
1161          ,day,day_ju_ini_cas,it_cas1,it_cas2,timeit
1162     stop
1163  endif
1164
1165  ! time interpolation:
1166  IF (it_cas1 .EQ. it_cas2) THEN
1167     frac=0.
1168  ELSE
1169     frac=(time_cas2-timeit)/(time_cas2-time_cas1)
1170     frac=max(frac,0.0)
1171  ENDIF
1172
1173  lat_prof_cas = lat_cas(it_cas2)                                       &
1174       -frac*(lat_cas(it_cas2)-lat_cas(it_cas1))
1175  sens_prof_cas = sens_cas(it_cas2)                                     &
1176       -frac*(sens_cas(it_cas2)-sens_cas(it_cas1))
1177  ts_prof_cas = ts_cas(it_cas2)                                         &
1178       -frac*(ts_cas(it_cas2)-ts_cas(it_cas1))
1179  ustar_prof_cas = ustar_cas(it_cas2)                                   &
1180       -frac*(ustar_cas(it_cas2)-ustar_cas(it_cas1))
1181
1182  do k=1,nlev_cas
1183     plev_prof_cas(k) = plev_cas(k,it_cas2)                               &
1184          -frac*(plev_cas(k,it_cas2)-plev_cas(k,it_cas1))
1185     t_prof_cas(k) = t_cas(k,it_cas2)                               &
1186          -frac*(t_cas(k,it_cas2)-t_cas(k,it_cas1))
1187     q_prof_cas(k) = q_cas(k,it_cas2)                               &
1188          -frac*(q_cas(k,it_cas2)-q_cas(k,it_cas1))
1189     u_prof_cas(k) = u_cas(k,it_cas2)                               &
1190          -frac*(u_cas(k,it_cas2)-u_cas(k,it_cas1))
1191     v_prof_cas(k) = v_cas(k,it_cas2)                               &
1192          -frac*(v_cas(k,it_cas2)-v_cas(k,it_cas1))
1193     ug_prof_cas(k) = ug_cas(k,it_cas2)                               &
1194          -frac*(ug_cas(k,it_cas2)-ug_cas(k,it_cas1))
1195     vg_prof_cas(k) = vg_cas(k,it_cas2)                               &
1196          -frac*(vg_cas(k,it_cas2)-vg_cas(k,it_cas1))
1197     vitw_prof_cas(k) = vitw_cas(k,it_cas2)                               &
1198          -frac*(vitw_cas(k,it_cas2)-vitw_cas(k,it_cas1))
1199     du_prof_cas(k) = du_cas(k,it_cas2)                                   &
1200          -frac*(du_cas(k,it_cas2)-du_cas(k,it_cas1))
1201     hu_prof_cas(k) = hu_cas(k,it_cas2)                                   &
1202          -frac*(hu_cas(k,it_cas2)-hu_cas(k,it_cas1))
1203     vu_prof_cas(k) = vu_cas(k,it_cas2)                                   &
1204          -frac*(vu_cas(k,it_cas2)-vu_cas(k,it_cas1))
1205     dv_prof_cas(k) = dv_cas(k,it_cas2)                                   &
1206          -frac*(dv_cas(k,it_cas2)-dv_cas(k,it_cas1))
1207     hv_prof_cas(k) = hv_cas(k,it_cas2)                                   &
1208          -frac*(hv_cas(k,it_cas2)-hv_cas(k,it_cas1))
1209     vv_prof_cas(k) = vv_cas(k,it_cas2)                                   &
1210          -frac*(vv_cas(k,it_cas2)-vv_cas(k,it_cas1))
1211     dt_prof_cas(k) = dt_cas(k,it_cas2)                                   &
1212          -frac*(dt_cas(k,it_cas2)-dt_cas(k,it_cas1))
1213     ht_prof_cas(k) = ht_cas(k,it_cas2)                                   &
1214          -frac*(ht_cas(k,it_cas2)-ht_cas(k,it_cas1))
1215     vt_prof_cas(k) = vt_cas(k,it_cas2)                                   &
1216          -frac*(vt_cas(k,it_cas2)-vt_cas(k,it_cas1))
1217     dtrad_prof_cas(k) = dtrad_cas(k,it_cas2)                                   &
1218          -frac*(dtrad_cas(k,it_cas2)-dtrad_cas(k,it_cas1))
1219     dq_prof_cas(k) = dq_cas(k,it_cas2)                                   &
1220          -frac*(dq_cas(k,it_cas2)-dq_cas(k,it_cas1))
1221     hq_prof_cas(k) = hq_cas(k,it_cas2)                                   &
1222          -frac*(hq_cas(k,it_cas2)-hq_cas(k,it_cas1))
1223     vq_prof_cas(k) = vq_cas(k,it_cas2)                                   &
1224          -frac*(vq_cas(k,it_cas2)-vq_cas(k,it_cas1))
1225     uw_prof_cas(k) = uw_cas(k,it_cas2)                                   &
1226          -frac*(uw_cas(k,it_cas2)-uw_cas(k,it_cas1))
1227     vw_prof_cas(k) = vw_cas(k,it_cas2)                                   &
1228          -frac*(vw_cas(k,it_cas2)-vw_cas(k,it_cas1))
1229     q1_prof_cas(k) = q1_cas(k,it_cas2)                                   &
1230          -frac*(q1_cas(k,it_cas2)-q1_cas(k,it_cas1))
1231     q2_prof_cas(k) = q2_cas(k,it_cas2)                                   &
1232          -frac*(q2_cas(k,it_cas2)-q2_cas(k,it_cas1))
1233  enddo
1234
1235  return
1236END SUBROUTINE interp_case_time2
1237
1238!**********************************************************************************************
1239SUBROUTINE interp2_case_time(day,day1,annee_ref                           &
1240     !    &         ,year_cas,day_cas,nt_cas,pdt_forc,nlev_cas                         &
1241     ,nt_cas,nlev_cas                                                   &
1242     ,ts_cas,ps_cas,plev_cas,t_cas,theta_cas,thv_cas,thl_cas            &
1243     ,qv_cas,ql_cas,qi_cas,u_cas,v_cas                                  &
1244     ,ug_cas,vg_cas,vitw_cas,omega_cas,du_cas,hu_cas,vu_cas             &
1245     ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas               &
1246     ,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas                      &
1247     ,lat_cas,sens_cas,ustar_cas                                        &
1248     ,uw_cas,vw_cas,q1_cas,q2_cas,tke_cas                               &
1249     !
1250     ,ts_prof_cas,plev_prof_cas,t_prof_cas,theta_prof_cas               &
1251     ,thv_prof_cas,thl_prof_cas,qv_prof_cas,ql_prof_cas,qi_prof_cas     &
1252     ,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas                     &
1253     ,vitw_prof_cas,omega_prof_cas,du_prof_cas,hu_prof_cas,vu_prof_cas  &
1254     ,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas                   &
1255     ,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas                &
1256     ,hq_prof_cas,vq_prof_cas,dth_prof_cas,hth_prof_cas,vth_prof_cas    &
1257     ,lat_prof_cas,sens_prof_cas                                        &
1258     ,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas,tke_prof_cas)
1259
1260
1261  implicit none
1262
1263  !---------------------------------------------------------------------------------------
1264  ! Time interpolation of a 2D field to the timestep corresponding to day
1265  !
1266  ! day: current julian day (e.g. 717538.2)
1267  ! day1: first day of the simulation
1268  ! nt_cas: total nb of data in the forcing
1269  ! pdt_cas: total time interval (in sec) between 2 forcing data
1270  !---------------------------------------------------------------------------------------
1271
1272  INCLUDE "compar1d.h"
1273  INCLUDE "date_cas.h"
1274
1275  ! inputs:
1276  integer annee_ref
1277  integer nt_cas,nlev_cas
1278  real day, day1,day_cas
1279  real ts_cas(nt_cas),ps_cas(nt_cas)
1280  real plev_cas(nlev_cas,nt_cas)
1281  real t_cas(nlev_cas,nt_cas),theta_cas(nlev_cas,nt_cas),thv_cas(nlev_cas,nt_cas),thl_cas(nlev_cas,nt_cas)
1282  real qv_cas(nlev_cas,nt_cas),ql_cas(nlev_cas,nt_cas),qi_cas(nlev_cas,nt_cas)
1283  real u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas)
1284  real ug_cas(nlev_cas,nt_cas),vg_cas(nlev_cas,nt_cas)
1285  real vitw_cas(nlev_cas,nt_cas),omega_cas(nlev_cas,nt_cas)
1286  real du_cas(nlev_cas,nt_cas),hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas)
1287  real dv_cas(nlev_cas,nt_cas),hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas)
1288  real dt_cas(nlev_cas,nt_cas),ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas)
1289  real dth_cas(nlev_cas,nt_cas),hth_cas(nlev_cas,nt_cas),vth_cas(nlev_cas,nt_cas)
1290  real dtrad_cas(nlev_cas,nt_cas)
1291  real dq_cas(nlev_cas,nt_cas),hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas)
1292  real lat_cas(nt_cas),sens_cas(nt_cas),tke_cas(nt_cas)
1293  real ustar_cas(nt_cas),uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas)
1294  real q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas)
1295
1296  ! outputs:
1297  real plev_prof_cas(nlev_cas)
1298  real t_prof_cas(nlev_cas),theta_prof_cas(nlev_cas),thl_prof_cas(nlev_cas),thv_prof_cas(nlev_cas)
1299  real qv_prof_cas(nlev_cas),ql_prof_cas(nlev_cas),qi_prof_cas(nlev_cas)
1300  real u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
1301  real ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas)
1302  real vitw_prof_cas(nlev_cas),omega_prof_cas(nlev_cas)
1303  real du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
1304  real dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
1305  real dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas)
1306  real dth_prof_cas(nlev_cas),hth_prof_cas(nlev_cas),vth_prof_cas(nlev_cas)
1307  real dtrad_prof_cas(nlev_cas)
1308  real dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
1309  real lat_prof_cas,sens_prof_cas,tke_prof_cas,ts_prof_cas,ustar_prof_cas
1310  real uw_prof_cas(nlev_cas),vw_prof_cas(nlev_cas),q1_prof_cas(nlev_cas),q2_prof_cas(nlev_cas)
1311  ! local:
1312  integer it_cas1, it_cas2,k
1313  real timeit,time_cas1,time_cas2,frac
1314
1315
1316  print*,'Check time',day1,day_ju_ini_cas,day_deb+1,pdt_cas
1317  !       do k=1,nlev_cas
1318  !       print*,'debut de interp2_case_time, plev_cas=',k,plev_cas(k,1)
1319  !       enddo
1320
1321  ! On teste si la date du cas AMMA est correcte.
1322  ! C est pour memoire car en fait les fichiers .def
1323  ! sont censes etre corrects.
1324  ! A supprimer a terme (MPL 20150623)
1325  !     if ((forcing_type.eq.10).and.(1.eq.0)) then
1326  ! Check that initial day of the simulation consistent with AMMA case:
1327  !      if (annee_ref.ne.2006) then
1328  !       print*,'Pour AMMA, annee_ref doit etre 2006'
1329  !       print*,'Changer annee_ref dans run.def'
1330  !       stop
1331  !      endif
1332  !      if (annee_ref.eq.2006 .and. day1.lt.day_cas) then
1333  !       print*,'AMMA a debute le 10 juillet 2006',day1,day_cas
1334  !       print*,'Changer dayref dans run.def'
1335  !       stop
1336  !      endif
1337  !      if (annee_ref.eq.2006 .and. day1.gt.day_cas+1) then
1338  !       print*,'AMMA a fini le 11 juillet'
1339  !       print*,'Changer dayref ou nday dans run.def'
1340  !       stop
1341  !      endif
1342  !      endif
1343
1344  ! Determine timestep relative to the 1st day:
1345  !       timeit=(day-day1)*86400.
1346  !       if (annee_ref.eq.1992) then
1347  !        timeit=(day-day_cas)*86400.
1348  !       else
1349  !        timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992
1350  !       endif
1351  timeit=(day-day_ju_ini_cas)*86400
1352  !print *,'day=',day
1353  !print *,'day_ju_ini_cas=',day_ju_ini_cas
1354  !print *,'pdt_cas=',pdt_cas
1355  !print *,'timeit=',timeit
1356  !print *,'nt_cas=',nt_cas
1357
1358  ! Determine the closest observation times:
1359  !       it_cas1=INT(timeit/pdt_cas)+1
1360  !       it_cas2=it_cas1 + 1
1361  !       time_cas1=(it_cas1-1)*pdt_cas
1362  !       time_cas2=(it_cas2-1)*pdt_cas
1363
1364  it_cas1=INT(timeit/pdt_cas)+1
1365  IF (it_cas1 .EQ. nt_cas) THEN
1366     it_cas2=it_cas1
1367  ELSE
1368     it_cas2=it_cas1 + 1
1369  ENDIF
1370  time_cas1=(it_cas1-1)*pdt_cas
1371  time_cas2=(it_cas2-1)*pdt_cas
1372  !print *,'timeit,pdt_cas,nt_cas=',timeit,pdt_cas,nt_cas
1373  !print *,'it_cas1,it_cas2,time_cas1,time_cas2=',it_cas1,it_cas2,time_cas1,time_cas2
1374
1375  if (it_cas1 .gt. nt_cas) then
1376     write(*,*) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: '            &
1377          ,day,day_ju_ini_cas,it_cas1,it_cas2,timeit
1378     stop
1379  endif
1380
1381  ! time interpolation:
1382  IF (it_cas1 .EQ. it_cas2) THEN
1383     frac=0.
1384  ELSE
1385     frac=(time_cas2-timeit)/(time_cas2-time_cas1)
1386     frac=max(frac,0.0)
1387  ENDIF
1388
1389  lat_prof_cas = lat_cas(it_cas2)                                   &
1390       -frac*(lat_cas(it_cas2)-lat_cas(it_cas1))
1391  sens_prof_cas = sens_cas(it_cas2)                                 &
1392       -frac*(sens_cas(it_cas2)-sens_cas(it_cas1))
1393  tke_prof_cas = tke_cas(it_cas2)                                   &
1394       -frac*(tke_cas(it_cas2)-tke_cas(it_cas1))
1395  ts_prof_cas = ts_cas(it_cas2)                                     &
1396       -frac*(ts_cas(it_cas2)-ts_cas(it_cas1))
1397  ustar_prof_cas = ustar_cas(it_cas2)                               &
1398       -frac*(ustar_cas(it_cas2)-ustar_cas(it_cas1))
1399
1400  do k=1,nlev_cas
1401     plev_prof_cas(k) = plev_cas(k,it_cas2)                           &     
1402          -frac*(plev_cas(k,it_cas2)-plev_cas(k,it_cas1))
1403     t_prof_cas(k) = t_cas(k,it_cas2)                                 &       
1404          -frac*(t_cas(k,it_cas2)-t_cas(k,it_cas1))
1405     !print *,'k,frac,plev_cas1,plev_cas2=',k,frac,plev_cas(k,it_cas1),plev_cas(k,it_cas2)
1406     theta_prof_cas(k) = theta_cas(k,it_cas2)                         &                     
1407          -frac*(theta_cas(k,it_cas2)-theta_cas(k,it_cas1))
1408     thv_prof_cas(k) = thv_cas(k,it_cas2)                             &         
1409          -frac*(thv_cas(k,it_cas2)-thv_cas(k,it_cas1))
1410     thl_prof_cas(k) = thl_cas(k,it_cas2)                             &             
1411          -frac*(thl_cas(k,it_cas2)-thl_cas(k,it_cas1))
1412     qv_prof_cas(k) = qv_cas(k,it_cas2)                               &
1413          -frac*(qv_cas(k,it_cas2)-qv_cas(k,it_cas1))
1414     ql_prof_cas(k) = ql_cas(k,it_cas2)                               &
1415          -frac*(ql_cas(k,it_cas2)-ql_cas(k,it_cas1))
1416     qi_prof_cas(k) = qi_cas(k,it_cas2)                               &
1417          -frac*(qi_cas(k,it_cas2)-qi_cas(k,it_cas1))
1418     u_prof_cas(k) = u_cas(k,it_cas2)                                 &
1419          -frac*(u_cas(k,it_cas2)-u_cas(k,it_cas1))
1420     v_prof_cas(k) = v_cas(k,it_cas2)                                 &
1421          -frac*(v_cas(k,it_cas2)-v_cas(k,it_cas1))
1422     ug_prof_cas(k) = ug_cas(k,it_cas2)                               &
1423          -frac*(ug_cas(k,it_cas2)-ug_cas(k,it_cas1))
1424     vg_prof_cas(k) = vg_cas(k,it_cas2)                               &
1425          -frac*(vg_cas(k,it_cas2)-vg_cas(k,it_cas1))
1426     vitw_prof_cas(k) = vitw_cas(k,it_cas2)                           &
1427          -frac*(vitw_cas(k,it_cas2)-vitw_cas(k,it_cas1))
1428     omega_prof_cas(k) = omega_cas(k,it_cas2)                         &
1429          -frac*(omega_cas(k,it_cas2)-omega_cas(k,it_cas1))
1430     du_prof_cas(k) = du_cas(k,it_cas2)                               &
1431          -frac*(du_cas(k,it_cas2)-du_cas(k,it_cas1))
1432     hu_prof_cas(k) = hu_cas(k,it_cas2)                               &
1433          -frac*(hu_cas(k,it_cas2)-hu_cas(k,it_cas1))
1434     vu_prof_cas(k) = vu_cas(k,it_cas2)                               &
1435          -frac*(vu_cas(k,it_cas2)-vu_cas(k,it_cas1))
1436     dv_prof_cas(k) = dv_cas(k,it_cas2)                               &
1437          -frac*(dv_cas(k,it_cas2)-dv_cas(k,it_cas1))
1438     hv_prof_cas(k) = hv_cas(k,it_cas2)                               &
1439          -frac*(hv_cas(k,it_cas2)-hv_cas(k,it_cas1))
1440     vv_prof_cas(k) = vv_cas(k,it_cas2)                               &
1441          -frac*(vv_cas(k,it_cas2)-vv_cas(k,it_cas1))
1442     dt_prof_cas(k) = dt_cas(k,it_cas2)                               &
1443          -frac*(dt_cas(k,it_cas2)-dt_cas(k,it_cas1))
1444     ht_prof_cas(k) = ht_cas(k,it_cas2)                               &
1445          -frac*(ht_cas(k,it_cas2)-ht_cas(k,it_cas1))
1446     vt_prof_cas(k) = vt_cas(k,it_cas2)                               &
1447          -frac*(vt_cas(k,it_cas2)-vt_cas(k,it_cas1))
1448     dth_prof_cas(k) = dth_cas(k,it_cas2)                             &
1449          -frac*(dth_cas(k,it_cas2)-dth_cas(k,it_cas1))
1450     hth_prof_cas(k) = hth_cas(k,it_cas2)                             &
1451          -frac*(hth_cas(k,it_cas2)-hth_cas(k,it_cas1))
1452     vth_prof_cas(k) = vth_cas(k,it_cas2)                             &
1453          -frac*(vth_cas(k,it_cas2)-vth_cas(k,it_cas1))
1454     dtrad_prof_cas(k) = dtrad_cas(k,it_cas2)                         &
1455          -frac*(dtrad_cas(k,it_cas2)-dtrad_cas(k,it_cas1))
1456     dq_prof_cas(k) = dq_cas(k,it_cas2)                               &
1457          -frac*(dq_cas(k,it_cas2)-dq_cas(k,it_cas1))
1458     hq_prof_cas(k) = hq_cas(k,it_cas2)                               &
1459          -frac*(hq_cas(k,it_cas2)-hq_cas(k,it_cas1))
1460     vq_prof_cas(k) = vq_cas(k,it_cas2)                               &
1461          -frac*(vq_cas(k,it_cas2)-vq_cas(k,it_cas1))
1462     uw_prof_cas(k) = uw_cas(k,it_cas2)                                &
1463          -frac*(uw_cas(k,it_cas2)-uw_cas(k,it_cas1))
1464     vw_prof_cas(k) = vw_cas(k,it_cas2)                                &
1465          -frac*(vw_cas(k,it_cas2)-vw_cas(k,it_cas1))
1466     q1_prof_cas(k) = q1_cas(k,it_cas2)                                &
1467          -frac*(q1_cas(k,it_cas2)-q1_cas(k,it_cas1))
1468     q2_prof_cas(k) = q2_cas(k,it_cas2)                                &
1469          -frac*(q2_cas(k,it_cas2)-q2_cas(k,it_cas1))
1470  enddo
1471
1472  return
1473END SUBROUTINE interp2_case_time
1474
1475!**********************************************************************************************
1476
Note: See TracBrowser for help on using the repository browser.