Context Navigation

mod_1D_cases_read2.F90 @ 4536

Last change on this file since 4536 was 4288, checked in by fhourdin, 2 years ago
Une derniere correction pour le 1D
File size: 59.7 KB

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

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

Download in other formats:

Original Format