Context Navigation

mod_1D_cases_read2.F90 @ 4287

Last change on this file since 4287 was 4287, checked in by lguez, 21 months ago

Bug fix: add count argument to nf90_get_var

Because, in the rico case, NetCDF variables which are read have
dimensions (..., lat, lon), in NetCDF order, with lon = lat =

Without the count argument, for apbp for example, nf90_get_var

tried to read nlevel + 1 subscript values in the dimension lon, 1
subscript value in the lat dimension, and 1 subscript value in the
nlevp1 dimension: not what we want. I have checked that the cases
ARMCU/REF, amma and rico work with this revision.

File size: 59.7 KB

Line
1	!
2	! $Id: mod_1D_cases_read.F90 2373 2015-10-13 17:28:01Z jyg $
3	!
4	MODULE 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
78	CONTAINS
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(nt_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(nt_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
535	END MODULE mod_1D_cases_read2
536	!=====================================================================
537	subroutine 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	do i=1,nbvar3d
579	print *,'Dans read_cas2, on va lire ',nid,i,name_var(i)
580	enddo
581	do i=1,nbvar3d
582	ierr=NF_INQ_VARID(nid,name_var(i),var3didin(i))
583	print *,'ierr=',i,ierr,name_var(i),var3didin(i)
584	if(ierr/=NF_NOERR) then
585	print *,'Variable manquante dans cas.nc:',name_var(i)
586	endif
587	enddo
588	do i=1,nbvar3d
589	print *,'Dans read_cas2, on va lire ',var3didin(i),name_var(i)
590	if(i.LE.35) then
591	ierr = NF90_GET_VAR(nid,var3didin(i),resul)
592	print *,'Dans read_cas2, on a lu ',ierr,var3didin(i),name_var(i)
593	if(ierr/=NF_NOERR) then
594	print *,'Pb a la lecture de cas.nc: ',name_var(i)
595	stop "getvarup"
596	endif
597	else
598	ierr = NF90_GET_VAR(nid,var3didin(i),resul1)
599	print *,'Dans read_cas2, on a lu ',ierr,var3didin(i),name_var(i)
600	if(ierr/=NF_NOERR) then
601	print *,'Pb a la lecture de cas.nc: ',name_var(i)
602	stop "getvarup"
603	endif
604	endif
605	select case(i)
606	case(1) ; zz=resul
607	case(2) ; pp=resul
608	case(3) ; temp=resul
609	case(4) ; qv=resul
610	case(5) ; rh=resul
611	case(6) ; theta=resul
612	case(7) ; rv=resul
613	case(8) ; u=resul
614	case(9) ; v=resul
615	case(10) ; ug=resul
616	case(11) ; vg=resul
617	case(12) ; w=resul
618	case(13) ; du=resul
619	case(14) ; hu=resul
620	case(15) ; vu=resul
621	case(16) ; dv=resul
622	case(17) ; hv=resul
623	case(18) ; vv=resul
624	case(19) ; dt=resul
625	case(20) ; ht=resul
626	case(21) ; vt=resul
627	case(22) ; dq=resul
628	case(23) ; hq=resul
629	case(24) ; vq=resul
630	case(25) ; dth=resul
631	case(26) ; hth=resul
632	case(27) ; vth=resul
633	case(28) ; dr=resul
634	case(29) ; hr=resul
635	case(30) ; vr=resul
636	case(31) ; dtrad=resul
637	case(32) ; uw=resul
638	case(33) ; vw=resul
639	case(34) ; q1=resul
640	case(35) ; q2=resul
641	case(36) ; sens=resul1
642	case(37) ; flat=resul1
643	case(38) ; ts=resul1
644	case(39) ; ustar=resul1
645	end select
646	enddo
647
648	return
649	end subroutine read_cas2
650	!======================================================================
651	subroutine read2_cas(nid,nlevel,ntime, &
652	ap,bp,zz,pp,zzh,pph,temp,theta,thv,thl,qv,ql,qi,rh,rv,u,v,vitw,omega,ug,vg,&
653	du,hu,vu,dv,hv,vv,dt,ht,vt,dq,hq,vq, &
654	dth,hth,vth,dr,hr,vr,dtrad,sens,flat,ts,ps,ustar,tke,uw,vw,q1,q2, &
655	orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough, &
656	heat_rough,o3_cas,rugos_cas,clay_cas,sand_cas)
657
658	!program reading forcing of the case study
659	use netcdf, only: nf90_get_var
660	implicit none
661	#include "netcdf.inc"
662
663	integer ntime,nlevel
664
665	real ap(nlevel+1),bp(nlevel+1)
666	real zz(nlevel,ntime),zzh(nlevel+1)
667	real pp(nlevel,ntime),pph(nlevel+1)
668	real temp(nlevel,ntime),qv(nlevel,ntime),ql(nlevel,ntime),qi(nlevel,ntime),rh(nlevel,ntime)
669	real theta(nlevel,ntime),thv(nlevel,ntime),thl(nlevel,ntime),rv(nlevel,ntime)
670	real u(nlevel,ntime),v(nlevel,ntime)
671	real ug(nlevel,ntime),vg(nlevel,ntime)
672	real vitw(nlevel,ntime),omega(nlevel,ntime)
673	real du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime)
674	real dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime)
675	real dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime)
676	real dtrad(nlevel,ntime)
677	real dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime)
678	real dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime),hthl(nlevel,ntime)
679	real dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime)
680	real flat(ntime),sens(ntime),ustar(ntime)
681	real uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime)
682	real ts(ntime),ps(ntime),tke(ntime)
683	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
684	real apbp(nlevel+1),resul(nlevel,ntime),resul1(nlevel),resul2(ntime),resul3
685
686
687	integer nid, ierr,ierr1,ierr2,rid,i
688	integer nbvar3d
689	parameter(nbvar3d=62)
690	integer var3didin(nbvar3d),missing_var(nbvar3d)
691	character*12 name_var(1:nbvar3d)
692	data name_var/'coor_par_a','coor_par_b','height_h','pressure_h',&
693	'w','omega','ug','vg','uadv','uadvh','uadvv','vadv','vadvh','vadvv','tadv','tadvh','tadvv',&
694	'qadv','qadvh','qadvv','thadv','thadvh','thadvv','thladvh','radv','radvh','radvv','radcool','q1','q2','ustress','vstress', &
695	'rh',&
696	'height_f','pressure_f','temp','theta','thv','thl','qv','ql','qi','rv','u','v',&
697	'sfc_sens_flx','sfc_lat_flx','ts','ps','ustar','tke',&
698	'orog','albedo','emiss','t_skin','q_skin','mom_rough','heat_rough','o3','rugos','clay','sand'/
699	do i=1,nbvar3d
700	missing_var(i)=0.
701	enddo
702
703	!-----------------------------------------------------------------------
704	do i=1,nbvar3d
705	ierr=NF_INQ_VARID(nid,name_var(i),var3didin(i))
706	if(ierr/=NF_NOERR) then
707	print *,'Variable manquante dans cas.nc:',i,name_var(i)
708	ierr=NF_NOERR
709	missing_var(i)=1
710	else
711	!-----------------------------------------------------------------------
712	if(i.LE.4) then ! Lecture des coord pression en (nlevelp1,lat,lon)
713	ierr = NF90_GET_VAR(nid,var3didin(i),apbp, &
714	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, &
723	count = [1, 1, nlevel, ntime])
724	print *,'read2_cas(resul), on a lu ',i,name_var(i)
725	if(ierr/=NF_NOERR) then
726	print *,'Pb a la lecture de cas.nc: ',name_var(i)
727	stop "getvarup"
728	endif
729	!-----------------------------------------------------------------------
730	else if (i.gt.45.and.i.LE.51) then ! Lecture des variables en (time,lat,lon)
731	ierr = NF90_GET_VAR(nid,var3didin(i),resul2, count = [1, 1, ntime])
732	print *,'read2_cas(resul2), on a lu ',i,name_var(i)
733	if(ierr/=NF_NOERR) then
734	print *,'Pb a la lecture de cas.nc: ',name_var(i)
735	stop "getvarup"
736	endif
737	!-----------------------------------------------------------------------
738	else ! Lecture des constantes (lat,lon)
739	ierr = NF90_GET_VAR(nid,var3didin(i),resul3)
740	print *,'read2_cas(resul3), on a lu ',i,name_var(i)
741	if(ierr/=NF_NOERR) then
742	print *,'Pb a la lecture de cas.nc: ',name_var(i)
743	stop "getvarup"
744	endif
745	endif
746	endif
747	!-----------------------------------------------------------------------
748	select case(i)
749	case(1) ; ap=apbp ! donnees indexees en nlevel+1
750	case(2) ; bp=apbp
751	case(3) ; zzh=apbp
752	case(4) ; pph=apbp
753	case(5) ; vitw=resul ! donnees indexees en nlevel,time
754	case(6) ; omega=resul
755	case(7) ; ug=resul
756	case(8) ; vg=resul
757	case(9) ; du=resul
758	case(10) ; hu=resul
759	case(11) ; vu=resul
760	case(12) ; dv=resul
761	case(13) ; hv=resul
762	case(14) ; vv=resul
763	case(15) ; dt=resul
764	case(16) ; ht=resul
765	case(17) ; vt=resul
766	case(18) ; dq=resul
767	case(19) ; hq=resul
768	case(20) ; vq=resul
769	case(21) ; dth=resul
770	case(22) ; hth=resul
771	case(23) ; vth=resul
772	case(24) ; hthl=resul
773	case(25) ; dr=resul
774	case(26) ; hr=resul
775	case(27) ; vr=resul
776	case(28) ; dtrad=resul
777	case(29) ; q1=resul
778	case(30) ; q2=resul
779	case(31) ; uw=resul
780	case(32) ; vw=resul
781	case(33) ; rh=resul
782	case(34) ; zz=resul ! donnees en time,nlevel pour profil initial
783	case(35) ; pp=resul
784	case(36) ; temp=resul
785	case(37) ; theta=resul
786	case(38) ; thv=resul
787	case(39) ; thl=resul
788	case(40) ; qv=resul
789	case(41) ; ql=resul
790	case(42) ; qi=resul
791	case(43) ; rv=resul
792	case(44) ; u=resul
793	case(45) ; v=resul
794	case(46) ; sens=resul2 ! donnees indexees en time
795	case(47) ; flat=resul2
796	case(48) ; ts=resul2
797	case(49) ; ps=resul2
798	case(50) ; ustar=resul2
799	case(51) ; tke=resul2
800	case(52) ; orog_cas=resul3 ! constantes
801	case(53) ; albedo_cas=resul3
802	case(54) ; emiss_cas=resul3
803	case(55) ; t_skin_cas=resul3
804	case(56) ; q_skin_cas=resul3
805	case(57) ; mom_rough=resul3
806	case(58) ; heat_rough=resul3
807	case(59) ; o3_cas=resul3
808	case(60) ; rugos_cas=resul3
809	case(61) ; clay_cas=resul3
810	case(62) ; sand_cas=resul3
811	end select
812	resul=0.
813	resul1=0.
814	resul2=0.
815	resul3=0.
816	enddo
817	!-----------------------------------------------------------------------
818
819
820	return
821	end subroutine read2_cas
822
823	!======================================================================
824	subroutine old_read_SCM(nid,nlevel,ntime, &
825	ap,bp,zz,pp,zzh,pph,temp,theta,thv,thl,qv,ql,qi,rh,rv,u,v,vitw,omega,ug,vg,&
826	du,hu,vu,dv,hv,vv,dt,ht,vt,dq,hq,vq, &
827	dth,hth,vth,dr,hr,vr,dtrad,sens,flat,ts,ps,ustar,tke,uw,vw,q1,q2, &
828	orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough, &
829	heat_rough,o3_cas,rugos_cas,clay_cas,sand_cas)
830
831	!program reading forcing of the case study
832	use netcdf, only: nf90_get_var
833	implicit none
834	#include "netcdf.inc"
835
836	integer ntime,nlevel,k,t
837
838	real ap(nlevel+1),bp(nlevel+1)
839	real zz(nlevel,ntime),zzh(nlevel+1)
840	real pp(nlevel,ntime),pph(nlevel+1)
841	!profils initiaux
842	real temp0(nlevel),qv0(nlevel),ql0(nlevel),qi0(nlevel),u0(nlevel),v0(nlevel),tke0(nlevel)
843	real pp0(nlevel)
844	real temp(nlevel,ntime),qv(nlevel,ntime),ql(nlevel,ntime),qi(nlevel,ntime),rh(nlevel,ntime)
845	real theta(nlevel,ntime),thv(nlevel,ntime),thl(nlevel,ntime),rv(nlevel,ntime)
846	real u(nlevel,ntime),v(nlevel,ntime),tke(nlevel,ntime)
847	real ug(nlevel,ntime),vg(nlevel,ntime)
848	real vitw(nlevel,ntime),omega(nlevel,ntime)
849	real du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime)
850	real dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime)
851	real dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime)
852	real dtrad(nlevel,ntime)
853	real dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime)
854	real dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime),hthl(nlevel,ntime)
855	real dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime)
856	real flat(ntime),sens(ntime),ustar(ntime)
857	real uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime)
858	real ts(ntime),ps(ntime)
859	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
860	real apbp(nlevel+1),resul(nlevel,ntime),resul1(nlevel),resul2(ntime),resul3
861
862
863	integer nid, ierr,ierr1,ierr2,rid,i
864	integer nbvar3d
865	parameter(nbvar3d=70)
866	integer var3didin(nbvar3d),missing_var(nbvar3d)
867	character*13 name_var(1:nbvar3d)
868	data name_var/'coor_par_a','coor_par_b','height_h','pressure_h',&
869	'temp','qv','ql','qi','u','v','tke','pressure',&
870	'w','omega','ug','vg','uadv','uadvh','uadvv','vadv','vadvh','vadvv','tadv','tadvh','tadvv',&
871	'qvadv','qvadvh','qvadvv','thadv','thadvh','thadvv','thladvh','radv','radvh','radvv','radcool','q1','q2','ustress', &
872	'vstress','rh',&
873	'height_f','pressure_forc','tempt','theta','thv','thl','qvt','qlt','qit','rv','ut','vt','tket',&
874	'sfc_sens_flx','sfc_lat_flx','ts','ps','ustar',&
875	'orog','albedo','emiss','t_skin','q_skin','mom_rough','heat_rough','o3','rugos','clay','sand'/
876	do i=1,nbvar3d
877	missing_var(i)=0.
878	enddo
879
880	!-----------------------------------------------------------------------
881
882	print*,'ON EST LA'
883	do i=1,nbvar3d
884	ierr=NF_INQ_VARID(nid,name_var(i),var3didin(i))
885	if(ierr/=NF_NOERR) then
886	print *,'Variable manquante dans cas.nc:',i,name_var(i)
887	ierr=NF_NOERR
888	missing_var(i)=1
889	else
890	!-----------------------------------------------------------------------
891	if(i.LE.4) then ! Lecture des coord pression en (nlevelp1,lat,lon)
892	ierr = NF90_GET_VAR(nid,var3didin(i),apbp)
893	print *,'read2_cas(apbp), on a lu ',i,name_var(i)
894	if(ierr/=NF_NOERR) then
895	print *,'Pb a la lecture de cas.nc: ',name_var(i)
896	stop "getvarup"
897	endif
898	!-----------------------------------------------------------------------
899	else if(i.gt.4.and.i.LE.12) then ! Lecture des variables en (time,nlevel,lat,lon)
900	ierr = NF90_GET_VAR(nid,var3didin(i),resul1)
901	print *,'read2_cas(resul1), on a lu ',i,name_var(i)
902	if(ierr/=NF_NOERR) then
903	print *,'Pb a la lecture de cas.nc: ',name_var(i)
904	stop "getvarup"
905	endif
906	print*,'Lecture de la variable #i ',i,name_var(i),minval(resul1),maxval(resul1)
907	!-----------------------------------------------------------------------
908	else if(i.gt.12.and.i.LE.54) then ! Lecture des variables en (time,nlevel,lat,lon)
909	ierr = NF90_GET_VAR(nid,var3didin(i),resul)
910	print *,'read2_cas(resul), on a lu ',i,name_var(i)
911	if(ierr/=NF_NOERR) then
912	print *,'Pb a la lecture de cas.nc: ',name_var(i)
913	stop "getvarup"
914	endif
915	print*,'Lecture de la variable #i ',i,name_var(i),minval(resul),maxval(resul)
916	!-----------------------------------------------------------------------
917	else if (i.gt.54.and.i.LE.65) then ! Lecture des variables en (time,lat,lon)
918	ierr = NF90_GET_VAR(nid,var3didin(i),resul2)
919	print *,'read2_cas(resul2), on a lu ',i,name_var(i)
920	if(ierr/=NF_NOERR) then
921	print *,'Pb a la lecture de cas.nc: ',name_var(i)
922	stop "getvarup"
923	endif
924	print*,'Lecture de la variable #i ',i,name_var(i),minval(resul2),maxval(resul2)
925	!-----------------------------------------------------------------------
926	else ! Lecture des constantes (lat,lon)
927	ierr = NF90_GET_VAR(nid,var3didin(i),resul3)
928	print *,'read2_cas(resul3), on a lu ',i,name_var(i)
929	if(ierr/=NF_NOERR) then
930	print *,'Pb a la lecture de cas.nc: ',name_var(i)
931	stop "getvarup"
932	endif
933	print*,'Lecture de la variable #i ',i,name_var(i),resul3
934	endif
935	endif
936	!-----------------------------------------------------------------------
937	select case(i)
938	!case(1) ; ap=apbp ! donnees indexees en nlevel+1
939	! case(2) ; bp=apbp
940	case(3) ; zzh=apbp
941	case(4) ; pph=apbp
942	case(5) ; temp0=resul1 ! donnees initiales
943	case(6) ; qv0=resul1
944	case(7) ; ql0=resul1
945	case(8) ; qi0=resul1
946	case(9) ; u0=resul1
947	case(10) ; v0=resul1
948	case(11) ; tke0=resul1
949	case(12) ; pp0=resul1
950	case(13) ; vitw=resul ! donnees indexees en nlevel,time
951	case(14) ; omega=resul
952	case(15) ; ug=resul
953	case(16) ; vg=resul
954	case(17) ; du=resul
955	case(18) ; hu=resul
956	case(19) ; vu=resul
957	case(20) ; dv=resul
958	case(21) ; hv=resul
959	case(22) ; vv=resul
960	case(23) ; dt=resul
961	case(24) ; ht=resul
962	case(25) ; vt=resul
963	case(26) ; dq=resul
964	case(27) ; hq=resul
965	case(28) ; vq=resul
966	case(29) ; dth=resul
967	case(30) ; hth=resul
968	case(31) ; vth=resul
969	case(32) ; hthl=resul
970	case(33) ; dr=resul
971	case(34) ; hr=resul
972	case(35) ; vr=resul
973	case(36) ; dtrad=resul
974	case(37) ; q1=resul
975	case(38) ; q2=resul
976	case(39) ; uw=resul
977	case(40) ; vw=resul
978	case(41) ; rh=resul
979	case(42) ; zz=resul ! donnees en time,nlevel pour profil initial
980	case(43) ; pp=resul
981	case(44) ; temp=resul
982	case(45) ; theta=resul
983	case(46) ; thv=resul
984	case(47) ; thl=resul
985	case(48) ; qv=resul
986	case(49) ; ql=resul
987	case(50) ; qi=resul
988	case(51) ; rv=resul
989	case(52) ; u=resul
990	case(53) ; v=resul
991	case(54) ; tke=resul
992	case(55) ; sens=resul2 ! donnees indexees en time
993	case(56) ; flat=resul2
994	case(57) ; ts=resul2
995	case(58) ; ps=resul2
996	case(59) ; ustar=resul2
997	case(60) ; orog_cas=resul3 ! constantes
998	case(61) ; albedo_cas=resul3
999	case(62) ; emiss_cas=resul3
1000	case(63) ; t_skin_cas=resul3
1001	case(64) ; q_skin_cas=resul3
1002	case(65) ; mom_rough=resul3
1003	case(66) ; heat_rough=resul3
1004	case(67) ; o3_cas=resul3
1005	case(68) ; rugos_cas=resul3
1006	case(69) ; clay_cas=resul3
1007	case(70) ; sand_cas=resul3
1008	end select
1009	resul=0.
1010	resul1=0.
1011	resul2=0.
1012	resul3=0.
1013	enddo
1014	print*,'Lecture de la variable APRES ,sens ',minval(sens),maxval(sens)
1015	print*,'Lecture de la variable APRES ,flat ',minval(flat),maxval(flat)
1016
1017	!CR:ATTENTION EN ATTENTE DE REGLER LA QUESTION DU PAS DE TEMPS INITIAL
1018	do t=1,ntime
1019	do k=1,nlevel
1020	temp(k,t)=temp0(k)
1021	qv(k,t)=qv0(k)
1022	ql(k,t)=ql0(k)
1023	qi(k,t)=qi0(k)
1024	u(k,t)=u0(k)
1025	v(k,t)=v0(k)
1026	tke(k,t)=tke0(k)
1027	enddo
1028	enddo
1029	!-----------------------------------------------------------------------
1030
1031	return
1032	end subroutine old_read_SCM
1033	!======================================================================
1034
1035	!======================================================================
1036	SUBROUTINE interp_case_time2(day,day1,annee_ref &
1037	! & ,year_cas,day_cas,nt_cas,pdt_forc,nlev_cas &
1038	,nt_cas,nlev_cas &
1039	,ts_cas,ps_cas,plev_cas,t_cas,q_cas,u_cas,v_cas &
1040	,ug_cas,vg_cas,vitw_cas,du_cas,hu_cas,vu_cas &
1041	,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas &
1042	,dq_cas,hq_cas,vq_cas,lat_cas,sens_cas,ustar_cas &
1043	,uw_cas,vw_cas,q1_cas,q2_cas &
1044	,ts_prof_cas,plev_prof_cas,t_prof_cas,q_prof_cas &
1045	,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas &
1046	,vitw_prof_cas,du_prof_cas,hu_prof_cas,vu_prof_cas &
1047	,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas &
1048	,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas &
1049	,hq_prof_cas,vq_prof_cas,lat_prof_cas,sens_prof_cas &
1050	,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas)
1051
1052
1053	implicit none
1054
1055	!---------------------------------------------------------------------------------------
1056	! Time interpolation of a 2D field to the timestep corresponding to day
1057	!
1058	! day: current julian day (e.g. 717538.2)
1059	! day1: first day of the simulation
1060	! nt_cas: total nb of data in the forcing
1061	! pdt_cas: total time interval (in sec) between 2 forcing data
1062	!---------------------------------------------------------------------------------------
1063
1064	#include "compar1d.h"
1065	#include "date_cas.h"
1066
1067	! inputs:
1068	integer annee_ref
1069	integer nt_cas,nlev_cas
1070	real day, day1,day_cas
1071	real ts_cas(nt_cas),ps_cas(nt_cas)
1072	real plev_cas(nlev_cas,nt_cas)
1073	real t_cas(nlev_cas,nt_cas),q_cas(nlev_cas,nt_cas)
1074	real u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas)
1075	real ug_cas(nlev_cas,nt_cas),vg_cas(nlev_cas,nt_cas)
1076	real vitw_cas(nlev_cas,nt_cas)
1077	real du_cas(nlev_cas,nt_cas),hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas)
1078	real dv_cas(nlev_cas,nt_cas),hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas)
1079	real dt_cas(nlev_cas,nt_cas),ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas)
1080	real dtrad_cas(nlev_cas,nt_cas)
1081	real dq_cas(nlev_cas,nt_cas),hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas)
1082	real lat_cas(nt_cas)
1083	real sens_cas(nt_cas)
1084	real ustar_cas(nt_cas),uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas)
1085	real q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas)
1086
1087	! outputs:
1088	real plev_prof_cas(nlev_cas)
1089	real t_prof_cas(nlev_cas),q_prof_cas(nlev_cas)
1090	real u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
1091	real ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas)
1092	real vitw_prof_cas(nlev_cas)
1093	real du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
1094	real dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
1095	real dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas)
1096	real dtrad_prof_cas(nlev_cas)
1097	real dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
1098	real lat_prof_cas,sens_prof_cas,ts_prof_cas,ustar_prof_cas
1099	real uw_prof_cas(nlev_cas),vw_prof_cas(nlev_cas),q1_prof_cas(nlev_cas),q2_prof_cas(nlev_cas)
1100	! local:
1101	integer it_cas1, it_cas2,k
1102	real timeit,time_cas1,time_cas2,frac
1103
1104
1105	print*,'Check time',day1,day_ju_ini_cas,day_deb+1,pdt_cas
1106
1107	! On teste si la date du cas AMMA est correcte.
1108	! C est pour memoire car en fait les fichiers .def
1109	! sont censes etre corrects.
1110	! A supprimer a terme (MPL 20150623)
1111	! if ((forcing_type.eq.10).and.(1.eq.0)) then
1112	! Check that initial day of the simulation consistent with AMMA case:
1113	! if (annee_ref.ne.2006) then
1114	! print*,'Pour AMMA, annee_ref doit etre 2006'
1115	! print*,'Changer annee_ref dans run.def'
1116	! stop
1117	! endif
1118	! if (annee_ref.eq.2006 .and. day1.lt.day_cas) then
1119	! print*,'AMMA a debute le 10 juillet 2006',day1,day_cas
1120	! print*,'Changer dayref dans run.def'
1121	! stop
1122	! endif
1123	! if (annee_ref.eq.2006 .and. day1.gt.day_cas+1) then
1124	! print*,'AMMA a fini le 11 juillet'
1125	! print*,'Changer dayref ou nday dans run.def'
1126	! stop
1127	! endif
1128	! endif
1129
1130	! Determine timestep relative to the 1st day:
1131	! timeit=(day-day1)*86400.
1132	! if (annee_ref.eq.1992) then
1133	! timeit=(day-day_cas)*86400.
1134	! else
1135	! timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992
1136	! endif
1137	timeit=(day-day_ju_ini_cas)*86400
1138	print *,'day=',day
1139	print *,'day_ju_ini_cas=',day_ju_ini_cas
1140	print *,'pdt_cas=',pdt_cas
1141	print *,'timeit=',timeit
1142	print *,'nt_cas=',nt_cas
1143
1144	! Determine the closest observation times:
1145	! it_cas1=INT(timeit/pdt_cas)+1
1146	! it_cas2=it_cas1 + 1
1147	! time_cas1=(it_cas1-1)*pdt_cas
1148	! time_cas2=(it_cas2-1)*pdt_cas
1149
1150	it_cas1=INT(timeit/pdt_cas)+1
1151	IF (it_cas1 .EQ. nt_cas) THEN
1152	it_cas2=it_cas1
1153	ELSE
1154	it_cas2=it_cas1 + 1
1155	ENDIF
1156	time_cas1=(it_cas1-1)*pdt_cas
1157	time_cas2=(it_cas2-1)*pdt_cas
1158	print *,'it_cas1,it_cas2,time_cas1,time_cas2=',it_cas1,it_cas2,time_cas1,time_cas2
1159
1160	if (it_cas1 .gt. nt_cas) then
1161	write(,) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: ' &
1162	,day,day_ju_ini_cas,it_cas1,it_cas2,timeit
1163	stop
1164	endif
1165
1166	! time interpolation:
1167	IF (it_cas1 .EQ. it_cas2) THEN
1168	frac=0.
1169	ELSE
1170	frac=(time_cas2-timeit)/(time_cas2-time_cas1)
1171	frac=max(frac,0.0)
1172	ENDIF
1173
1174	lat_prof_cas = lat_cas(it_cas2) &
1175	-frac*(lat_cas(it_cas2)-lat_cas(it_cas1))
1176	sens_prof_cas = sens_cas(it_cas2) &
1177	-frac*(sens_cas(it_cas2)-sens_cas(it_cas1))
1178	ts_prof_cas = ts_cas(it_cas2) &
1179	-frac*(ts_cas(it_cas2)-ts_cas(it_cas1))
1180	ustar_prof_cas = ustar_cas(it_cas2) &
1181	-frac*(ustar_cas(it_cas2)-ustar_cas(it_cas1))
1182
1183	do k=1,nlev_cas
1184	plev_prof_cas(k) = plev_cas(k,it_cas2) &
1185	-frac*(plev_cas(k,it_cas2)-plev_cas(k,it_cas1))
1186	t_prof_cas(k) = t_cas(k,it_cas2) &
1187	-frac*(t_cas(k,it_cas2)-t_cas(k,it_cas1))
1188	q_prof_cas(k) = q_cas(k,it_cas2) &
1189	-frac*(q_cas(k,it_cas2)-q_cas(k,it_cas1))
1190	u_prof_cas(k) = u_cas(k,it_cas2) &
1191	-frac*(u_cas(k,it_cas2)-u_cas(k,it_cas1))
1192	v_prof_cas(k) = v_cas(k,it_cas2) &
1193	-frac*(v_cas(k,it_cas2)-v_cas(k,it_cas1))
1194	ug_prof_cas(k) = ug_cas(k,it_cas2) &
1195	-frac*(ug_cas(k,it_cas2)-ug_cas(k,it_cas1))
1196	vg_prof_cas(k) = vg_cas(k,it_cas2) &
1197	-frac*(vg_cas(k,it_cas2)-vg_cas(k,it_cas1))
1198	vitw_prof_cas(k) = vitw_cas(k,it_cas2) &
1199	-frac*(vitw_cas(k,it_cas2)-vitw_cas(k,it_cas1))
1200	du_prof_cas(k) = du_cas(k,it_cas2) &
1201	-frac*(du_cas(k,it_cas2)-du_cas(k,it_cas1))
1202	hu_prof_cas(k) = hu_cas(k,it_cas2) &
1203	-frac*(hu_cas(k,it_cas2)-hu_cas(k,it_cas1))
1204	vu_prof_cas(k) = vu_cas(k,it_cas2) &
1205	-frac*(vu_cas(k,it_cas2)-vu_cas(k,it_cas1))
1206	dv_prof_cas(k) = dv_cas(k,it_cas2) &
1207	-frac*(dv_cas(k,it_cas2)-dv_cas(k,it_cas1))
1208	hv_prof_cas(k) = hv_cas(k,it_cas2) &
1209	-frac*(hv_cas(k,it_cas2)-hv_cas(k,it_cas1))
1210	vv_prof_cas(k) = vv_cas(k,it_cas2) &
1211	-frac*(vv_cas(k,it_cas2)-vv_cas(k,it_cas1))
1212	dt_prof_cas(k) = dt_cas(k,it_cas2) &
1213	-frac*(dt_cas(k,it_cas2)-dt_cas(k,it_cas1))
1214	ht_prof_cas(k) = ht_cas(k,it_cas2) &
1215	-frac*(ht_cas(k,it_cas2)-ht_cas(k,it_cas1))
1216	vt_prof_cas(k) = vt_cas(k,it_cas2) &
1217	-frac*(vt_cas(k,it_cas2)-vt_cas(k,it_cas1))
1218	dtrad_prof_cas(k) = dtrad_cas(k,it_cas2) &
1219	-frac*(dtrad_cas(k,it_cas2)-dtrad_cas(k,it_cas1))
1220	dq_prof_cas(k) = dq_cas(k,it_cas2) &
1221	-frac*(dq_cas(k,it_cas2)-dq_cas(k,it_cas1))
1222	hq_prof_cas(k) = hq_cas(k,it_cas2) &
1223	-frac*(hq_cas(k,it_cas2)-hq_cas(k,it_cas1))
1224	vq_prof_cas(k) = vq_cas(k,it_cas2) &
1225	-frac*(vq_cas(k,it_cas2)-vq_cas(k,it_cas1))
1226	uw_prof_cas(k) = uw_cas(k,it_cas2) &
1227	-frac*(uw_cas(k,it_cas2)-uw_cas(k,it_cas1))
1228	vw_prof_cas(k) = vw_cas(k,it_cas2) &
1229	-frac*(vw_cas(k,it_cas2)-vw_cas(k,it_cas1))
1230	q1_prof_cas(k) = q1_cas(k,it_cas2) &
1231	-frac*(q1_cas(k,it_cas2)-q1_cas(k,it_cas1))
1232	q2_prof_cas(k) = q2_cas(k,it_cas2) &
1233	-frac*(q2_cas(k,it_cas2)-q2_cas(k,it_cas1))
1234	enddo
1235
1236	return
1237	END SUBROUTINE interp_case_time2
1238
1239	!**********************************************************************************************
1240	SUBROUTINE interp2_case_time(day,day1,annee_ref &
1241	! & ,year_cas,day_cas,nt_cas,pdt_forc,nlev_cas &
1242	,nt_cas,nlev_cas &
1243	,ts_cas,ps_cas,plev_cas,t_cas,theta_cas,thv_cas,thl_cas &
1244	,qv_cas,ql_cas,qi_cas,u_cas,v_cas &
1245	,ug_cas,vg_cas,vitw_cas,omega_cas,du_cas,hu_cas,vu_cas &
1246	,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas &
1247	,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas &
1248	,lat_cas,sens_cas,ustar_cas &
1249	,uw_cas,vw_cas,q1_cas,q2_cas,tke_cas &
1250	!
1251	,ts_prof_cas,plev_prof_cas,t_prof_cas,theta_prof_cas &
1252	,thv_prof_cas,thl_prof_cas,qv_prof_cas,ql_prof_cas,qi_prof_cas &
1253	,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas &
1254	,vitw_prof_cas,omega_prof_cas,du_prof_cas,hu_prof_cas,vu_prof_cas &
1255	,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas &
1256	,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas &
1257	,hq_prof_cas,vq_prof_cas,dth_prof_cas,hth_prof_cas,vth_prof_cas &
1258	,lat_prof_cas,sens_prof_cas &
1259	,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas,tke_prof_cas)
1260
1261
1262	implicit none
1263
1264	!---------------------------------------------------------------------------------------
1265	! Time interpolation of a 2D field to the timestep corresponding to day
1266	!
1267	! day: current julian day (e.g. 717538.2)
1268	! day1: first day of the simulation
1269	! nt_cas: total nb of data in the forcing
1270	! pdt_cas: total time interval (in sec) between 2 forcing data
1271	!---------------------------------------------------------------------------------------
1272
1273	#include "compar1d.h"
1274	#include "date_cas.h"
1275
1276	! inputs:
1277	integer annee_ref
1278	integer nt_cas,nlev_cas
1279	real day, day1,day_cas
1280	real ts_cas(nt_cas),ps_cas(nt_cas)
1281	real plev_cas(nlev_cas,nt_cas)
1282	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)
1283	real qv_cas(nlev_cas,nt_cas),ql_cas(nlev_cas,nt_cas),qi_cas(nlev_cas,nt_cas)
1284	real u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas)
1285	real ug_cas(nlev_cas,nt_cas),vg_cas(nlev_cas,nt_cas)
1286	real vitw_cas(nlev_cas,nt_cas),omega_cas(nlev_cas,nt_cas)
1287	real du_cas(nlev_cas,nt_cas),hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas)
1288	real dv_cas(nlev_cas,nt_cas),hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas)
1289	real dt_cas(nlev_cas,nt_cas),ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas)
1290	real dth_cas(nlev_cas,nt_cas),hth_cas(nlev_cas,nt_cas),vth_cas(nlev_cas,nt_cas)
1291	real dtrad_cas(nlev_cas,nt_cas)
1292	real dq_cas(nlev_cas,nt_cas),hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas)
1293	real lat_cas(nt_cas),sens_cas(nt_cas),tke_cas(nt_cas)
1294	real ustar_cas(nt_cas),uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas)
1295	real q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas)
1296
1297	! outputs:
1298	real plev_prof_cas(nlev_cas)
1299	real t_prof_cas(nlev_cas),theta_prof_cas(nlev_cas),thl_prof_cas(nlev_cas),thv_prof_cas(nlev_cas)
1300	real qv_prof_cas(nlev_cas),ql_prof_cas(nlev_cas),qi_prof_cas(nlev_cas)
1301	real u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
1302	real ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas)
1303	real vitw_prof_cas(nlev_cas),omega_prof_cas(nlev_cas)
1304	real du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
1305	real dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
1306	real dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas)
1307	real dth_prof_cas(nlev_cas),hth_prof_cas(nlev_cas),vth_prof_cas(nlev_cas)
1308	real dtrad_prof_cas(nlev_cas)
1309	real dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
1310	real lat_prof_cas,sens_prof_cas,tke_prof_cas,ts_prof_cas,ustar_prof_cas
1311	real uw_prof_cas(nlev_cas),vw_prof_cas(nlev_cas),q1_prof_cas(nlev_cas),q2_prof_cas(nlev_cas)
1312	! local:
1313	integer it_cas1, it_cas2,k
1314	real timeit,time_cas1,time_cas2,frac
1315
1316
1317	print*,'Check time',day1,day_ju_ini_cas,day_deb+1,pdt_cas
1318	! do k=1,nlev_cas
1319	! print*,'debut de interp2_case_time, plev_cas=',k,plev_cas(k,1)
1320	! enddo
1321
1322	! On teste si la date du cas AMMA est correcte.
1323	! C est pour memoire car en fait les fichiers .def
1324	! sont censes etre corrects.
1325	! A supprimer a terme (MPL 20150623)
1326	! if ((forcing_type.eq.10).and.(1.eq.0)) then
1327	! Check that initial day of the simulation consistent with AMMA case:
1328	! if (annee_ref.ne.2006) then
1329	! print*,'Pour AMMA, annee_ref doit etre 2006'
1330	! print*,'Changer annee_ref dans run.def'
1331	! stop
1332	! endif
1333	! if (annee_ref.eq.2006 .and. day1.lt.day_cas) then
1334	! print*,'AMMA a debute le 10 juillet 2006',day1,day_cas
1335	! print*,'Changer dayref dans run.def'
1336	! stop
1337	! endif
1338	! if (annee_ref.eq.2006 .and. day1.gt.day_cas+1) then
1339	! print*,'AMMA a fini le 11 juillet'
1340	! print*,'Changer dayref ou nday dans run.def'
1341	! stop
1342	! endif
1343	! endif
1344
1345	! Determine timestep relative to the 1st day:
1346	! timeit=(day-day1)*86400.
1347	! if (annee_ref.eq.1992) then
1348	! timeit=(day-day_cas)*86400.
1349	! else
1350	! timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992
1351	! endif
1352	timeit=(day-day_ju_ini_cas)*86400
1353	print *,'day=',day
1354	print *,'day_ju_ini_cas=',day_ju_ini_cas
1355	print *,'pdt_cas=',pdt_cas
1356	print *,'timeit=',timeit
1357	print *,'nt_cas=',nt_cas
1358
1359	! Determine the closest observation times:
1360	! it_cas1=INT(timeit/pdt_cas)+1
1361	! it_cas2=it_cas1 + 1
1362	! time_cas1=(it_cas1-1)*pdt_cas
1363	! time_cas2=(it_cas2-1)*pdt_cas
1364
1365	it_cas1=INT(timeit/pdt_cas)+1
1366	IF (it_cas1 .EQ. nt_cas) THEN
1367	it_cas2=it_cas1
1368	ELSE
1369	it_cas2=it_cas1 + 1
1370	ENDIF
1371	time_cas1=(it_cas1-1)*pdt_cas
1372	time_cas2=(it_cas2-1)*pdt_cas
1373	print *,'timeit,pdt_cas,nt_cas=',timeit,pdt_cas,nt_cas
1374	print *,'it_cas1,it_cas2,time_cas1,time_cas2=',it_cas1,it_cas2,time_cas1,time_cas2
1375
1376	if (it_cas1 .gt. nt_cas) then
1377	write(,) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: ' &
1378	,day,day_ju_ini_cas,it_cas1,it_cas2,timeit
1379	stop
1380	endif
1381
1382	! time interpolation:
1383	IF (it_cas1 .EQ. it_cas2) THEN
1384	frac=0.
1385	ELSE
1386	frac=(time_cas2-timeit)/(time_cas2-time_cas1)
1387	frac=max(frac,0.0)
1388	ENDIF
1389
1390	lat_prof_cas = lat_cas(it_cas2) &
1391	-frac*(lat_cas(it_cas2)-lat_cas(it_cas1))
1392	sens_prof_cas = sens_cas(it_cas2) &
1393	-frac*(sens_cas(it_cas2)-sens_cas(it_cas1))
1394	tke_prof_cas = tke_cas(it_cas2) &
1395	-frac*(tke_cas(it_cas2)-tke_cas(it_cas1))
1396	ts_prof_cas = ts_cas(it_cas2) &
1397	-frac*(ts_cas(it_cas2)-ts_cas(it_cas1))
1398	ustar_prof_cas = ustar_cas(it_cas2) &
1399	-frac*(ustar_cas(it_cas2)-ustar_cas(it_cas1))
1400
1401	do k=1,nlev_cas
1402	plev_prof_cas(k) = plev_cas(k,it_cas2) &
1403	-frac*(plev_cas(k,it_cas2)-plev_cas(k,it_cas1))
1404	t_prof_cas(k) = t_cas(k,it_cas2) &
1405	-frac*(t_cas(k,it_cas2)-t_cas(k,it_cas1))
1406	print *,'k,frac,plev_cas1,plev_cas2=',k,frac,plev_cas(k,it_cas1),plev_cas(k,it_cas2)
1407	theta_prof_cas(k) = theta_cas(k,it_cas2) &
1408	-frac*(theta_cas(k,it_cas2)-theta_cas(k,it_cas1))
1409	thv_prof_cas(k) = thv_cas(k,it_cas2) &
1410	-frac*(thv_cas(k,it_cas2)-thv_cas(k,it_cas1))
1411	thl_prof_cas(k) = thl_cas(k,it_cas2) &
1412	-frac*(thl_cas(k,it_cas2)-thl_cas(k,it_cas1))
1413	qv_prof_cas(k) = qv_cas(k,it_cas2) &
1414	-frac*(qv_cas(k,it_cas2)-qv_cas(k,it_cas1))
1415	ql_prof_cas(k) = ql_cas(k,it_cas2) &
1416	-frac*(ql_cas(k,it_cas2)-ql_cas(k,it_cas1))
1417	qi_prof_cas(k) = qi_cas(k,it_cas2) &
1418	-frac*(qi_cas(k,it_cas2)-qi_cas(k,it_cas1))
1419	u_prof_cas(k) = u_cas(k,it_cas2) &
1420	-frac*(u_cas(k,it_cas2)-u_cas(k,it_cas1))
1421	v_prof_cas(k) = v_cas(k,it_cas2) &
1422	-frac*(v_cas(k,it_cas2)-v_cas(k,it_cas1))
1423	ug_prof_cas(k) = ug_cas(k,it_cas2) &
1424	-frac*(ug_cas(k,it_cas2)-ug_cas(k,it_cas1))
1425	vg_prof_cas(k) = vg_cas(k,it_cas2) &
1426	-frac*(vg_cas(k,it_cas2)-vg_cas(k,it_cas1))
1427	vitw_prof_cas(k) = vitw_cas(k,it_cas2) &
1428	-frac*(vitw_cas(k,it_cas2)-vitw_cas(k,it_cas1))
1429	omega_prof_cas(k) = omega_cas(k,it_cas2) &
1430	-frac*(omega_cas(k,it_cas2)-omega_cas(k,it_cas1))
1431	du_prof_cas(k) = du_cas(k,it_cas2) &
1432	-frac*(du_cas(k,it_cas2)-du_cas(k,it_cas1))
1433	hu_prof_cas(k) = hu_cas(k,it_cas2) &
1434	-frac*(hu_cas(k,it_cas2)-hu_cas(k,it_cas1))
1435	vu_prof_cas(k) = vu_cas(k,it_cas2) &
1436	-frac*(vu_cas(k,it_cas2)-vu_cas(k,it_cas1))
1437	dv_prof_cas(k) = dv_cas(k,it_cas2) &
1438	-frac*(dv_cas(k,it_cas2)-dv_cas(k,it_cas1))
1439	hv_prof_cas(k) = hv_cas(k,it_cas2) &
1440	-frac*(hv_cas(k,it_cas2)-hv_cas(k,it_cas1))
1441	vv_prof_cas(k) = vv_cas(k,it_cas2) &
1442	-frac*(vv_cas(k,it_cas2)-vv_cas(k,it_cas1))
1443	dt_prof_cas(k) = dt_cas(k,it_cas2) &
1444	-frac*(dt_cas(k,it_cas2)-dt_cas(k,it_cas1))
1445	ht_prof_cas(k) = ht_cas(k,it_cas2) &
1446	-frac*(ht_cas(k,it_cas2)-ht_cas(k,it_cas1))
1447	vt_prof_cas(k) = vt_cas(k,it_cas2) &
1448	-frac*(vt_cas(k,it_cas2)-vt_cas(k,it_cas1))
1449	dth_prof_cas(k) = dth_cas(k,it_cas2) &
1450	-frac*(dth_cas(k,it_cas2)-dth_cas(k,it_cas1))
1451	hth_prof_cas(k) = hth_cas(k,it_cas2) &
1452	-frac*(hth_cas(k,it_cas2)-hth_cas(k,it_cas1))
1453	vth_prof_cas(k) = vth_cas(k,it_cas2) &
1454	-frac*(vth_cas(k,it_cas2)-vth_cas(k,it_cas1))
1455	dtrad_prof_cas(k) = dtrad_cas(k,it_cas2) &
1456	-frac*(dtrad_cas(k,it_cas2)-dtrad_cas(k,it_cas1))
1457	dq_prof_cas(k) = dq_cas(k,it_cas2) &
1458	-frac*(dq_cas(k,it_cas2)-dq_cas(k,it_cas1))
1459	hq_prof_cas(k) = hq_cas(k,it_cas2) &
1460	-frac*(hq_cas(k,it_cas2)-hq_cas(k,it_cas1))
1461	vq_prof_cas(k) = vq_cas(k,it_cas2) &
1462	-frac*(vq_cas(k,it_cas2)-vq_cas(k,it_cas1))
1463	uw_prof_cas(k) = uw_cas(k,it_cas2) &
1464	-frac*(uw_cas(k,it_cas2)-uw_cas(k,it_cas1))
1465	vw_prof_cas(k) = vw_cas(k,it_cas2) &
1466	-frac*(vw_cas(k,it_cas2)-vw_cas(k,it_cas1))
1467	q1_prof_cas(k) = q1_cas(k,it_cas2) &
1468	-frac*(q1_cas(k,it_cas2)-q1_cas(k,it_cas1))
1469	q2_prof_cas(k) = q2_cas(k,it_cas2) &
1470	-frac*(q2_cas(k,it_cas2)-q2_cas(k,it_cas1))
1471	enddo
1472
1473	return
1474	END SUBROUTINE interp2_case_time
1475
1476	!**********************************************************************************************
1477

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format