Context Navigation

mod_1D_cases_read2.F90 @ 3538

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

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

Download in other formats:

Original Format