Context Navigation

mod_1D_cases_read2.F90 @ 3605

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

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

Download in other formats:

Original Format