Context Navigation

mod_1D_cases_read_std.F90 @ 5210

Last change on this file since 5210 was 5084, checked in by Laurent Fairhead, 12 months ago
Reverting to r4065. Updating fortran standard broke too much stuff. Will do it by smaller chunks AB, LF
File size: 58.3 KB

Line
1	!
2	! $Id: mod_1D_cases_read.F90 2373 2015-10-13 17:28:01Z jyg $
3	!
4	MODULE mod_1D_cases_read_std
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(:,:),tke_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:: temp_nudg_cas(:,:),qv_nudg_cas(:,:),u_nudg_cas(:,:),v_nudg_cas(:,:)
31	real, allocatable:: invtau_temp_nudg_cas(:,:),invtau_qv_nudg_cas(:,:),invtau_u_nudg_cas(:,:),invtau_v_nudg_cas(:,:)
32	real, allocatable:: lat_cas(:),sens_cas(:),tskin_cas(:),ts_cas(:),ps_cas(:),ustar_cas(:)
33	real, allocatable:: uw_cas(:,:),vw_cas(:,:),q1_cas(:,:),q2_cas(:,:),tkes_cas(:)
34
35	!champs interpoles
36	real, allocatable:: plev_prof_cas(:)
37	real, allocatable:: t_prof_cas(:)
38	real, allocatable:: theta_prof_cas(:)
39	real, allocatable:: thl_prof_cas(:)
40	real, allocatable:: thv_prof_cas(:)
41	real, allocatable:: q_prof_cas(:)
42	real, allocatable:: qv_prof_cas(:)
43	real, allocatable:: ql_prof_cas(:)
44	real, allocatable:: qi_prof_cas(:)
45	real, allocatable:: rh_prof_cas(:)
46	real, allocatable:: rv_prof_cas(:)
47	real, allocatable:: u_prof_cas(:)
48	real, allocatable:: v_prof_cas(:)
49	real, allocatable:: vitw_prof_cas(:)
50	real, allocatable:: omega_prof_cas(:)
51	real, allocatable:: tke_prof_cas(:)
52	real, allocatable:: ug_prof_cas(:)
53	real, allocatable:: vg_prof_cas(:)
54	real, allocatable:: temp_nudg_prof_cas(:),qv_nudg_prof_cas(:),u_nudg_prof_cas(:),v_nudg_prof_cas(:)
55	real, allocatable:: invtau_temp_nudg_prof_cas(:),invtau_qv_nudg_prof_cas(:),invtau_u_nudg_prof_cas(:),invtau_v_nudg_prof_cas(:)
56
57	real, allocatable:: ht_prof_cas(:)
58	real, allocatable:: hth_prof_cas(:)
59	real, allocatable:: hq_prof_cas(:)
60	real, allocatable:: vt_prof_cas(:)
61	real, allocatable:: vth_prof_cas(:)
62	real, allocatable:: vq_prof_cas(:)
63	real, allocatable:: dt_prof_cas(:)
64	real, allocatable:: dth_prof_cas(:)
65	real, allocatable:: dtrad_prof_cas(:)
66	real, allocatable:: dq_prof_cas(:)
67	real, allocatable:: hu_prof_cas(:)
68	real, allocatable:: hv_prof_cas(:)
69	real, allocatable:: vu_prof_cas(:)
70	real, allocatable:: vv_prof_cas(:)
71	real, allocatable:: du_prof_cas(:)
72	real, allocatable:: dv_prof_cas(:)
73	real, allocatable:: uw_prof_cas(:)
74	real, allocatable:: vw_prof_cas(:)
75	real, allocatable:: q1_prof_cas(:)
76	real, allocatable:: q2_prof_cas(:)
77
78
79	real o3_cas,lat_prof_cas,sens_prof_cas,ts_prof_cas,tskin_prof_cas,ps_prof_cas,ustar_prof_cas,tkes_prof_cas
80	real orog_cas,albedo_cas,emiss_cas,q_skin_cas,mom_rough,heat_rough,rugos_cas,sand_cas,clay_cas
81
82
83
84	CONTAINS
85
86
87	!**********************************************************************************************
88	SUBROUTINE read_SCM_cas
89	use netcdf, only: nf90_get_var
90	implicit none
91
92	INCLUDE "netcdf.inc"
93	INCLUDE "date_cas.h"
94
95	INTEGER nid,rid,ierr
96	INTEGER ii,jj,timeid
97	REAL, ALLOCATABLE :: time_val(:)
98
99	fich_cas='cas.nc'
100	print*,'fich_cas ',fich_cas
101	ierr = NF_OPEN(fich_cas,NF_NOWRITE,nid)
102	print*,'fich_cas,NF_NOWRITE,nid ',fich_cas,NF_NOWRITE,nid
103	if (ierr.NE.NF_NOERR) then
104	write(,) 'ERROR: GROS Pb opening forcings nc file '
105	write(,) NF_STRERROR(ierr)
106	stop ""
107	endif
108	!.......................................................................
109	ierr=NF_INQ_DIMID(nid,'lat',rid)
110	IF (ierr.NE.NF_NOERR) THEN
111	print*, 'Oh probleme lecture dimension lat'
112	ENDIF
113	ierr=NF_INQ_DIMLEN(nid,rid,ii)
114	print*,'OK1 read_SCM_cas: nid,rid,lat',nid,rid,ii
115	!.......................................................................
116	ierr=NF_INQ_DIMID(nid,'lon',rid)
117	IF (ierr.NE.NF_NOERR) THEN
118	print*, 'Oh probleme lecture dimension lon'
119	ENDIF
120	ierr=NF_INQ_DIMLEN(nid,rid,jj)
121	print*,'OK2 read_SCM_cas: nid,rid,lat',nid,rid,jj
122	!.......................................................................
123	ierr=NF_INQ_DIMID(nid,'lev',rid)
124	IF (ierr.NE.NF_NOERR) THEN
125	print*, 'Oh probleme lecture dimension nlev'
126	ENDIF
127	ierr=NF_INQ_DIMLEN(nid,rid,nlev_cas)
128	print*,'OK3 read_SCM_cas: nid,rid,nlev_cas',nid,rid,nlev_cas
129	IF ( .NOT. ( nlev_cas > 10 .AND. nlev_cas < 200000 )) THEN
130	print*,'Valeur de nlev_cas peu probable'
131	STOP
132	ENDIF
133	!.......................................................................
134	ierr=NF_INQ_DIMID(nid,'time',rid)
135	nt_cas=0
136	IF (ierr.NE.NF_NOERR) THEN
137	stop 'Oh probleme lecture dimension time'
138	ENDIF
139	ierr=NF_INQ_DIMLEN(nid,rid,nt_cas)
140	print*,'OK4 read_SCM_cas: nid,rid,nt_cas',nid,rid,nt_cas
141	! Lecture de l'axe des temps
142	print*,'LECTURE DU TEMPS'
143	ierr=NF_INQ_VARID(nid,'time',timeid)
144	if(ierr/=NF_NOERR) then
145	print *,'Variable time manquante dans cas.nc:'
146	ierr=NF_NOERR
147	else
148	allocate(time_val(nt_cas))
149	ierr = NF90_GET_VAR(nid,timeid,time_val)
150	if(ierr/=NF_NOERR) then
151	print *,'A Pb a la lecture de time cas.nc: '
152	endif
153	endif
154	IF (nt_cas>1) THEN
155	pdt_cas=time_val(2)-time_val(1)
156	ELSE
157	pdt_cas=0.
158	ENDIF
159
160
161	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
162	!profils moyens:
163	allocate(plev_cas(nlev_cas,nt_cas),plevh_cas(nlev_cas+1))
164	allocate(z_cas(nlev_cas,nt_cas),zh_cas(nlev_cas+1))
165	allocate(ap_cas(nlev_cas+1),bp_cas(nlev_cas+1))
166	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), &
167	qi_cas(nlev_cas,nt_cas),rh_cas(nlev_cas,nt_cas))
168	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))
169	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))
170	allocate(tke_cas(nlev_cas,nt_cas))
171	!forcing
172	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))
173	allocate(hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas),dq_cas(nlev_cas,nt_cas))
174	allocate(hth_cas(nlev_cas,nt_cas),vth_cas(nlev_cas,nt_cas),dth_cas(nlev_cas,nt_cas))
175	allocate(hr_cas(nlev_cas,nt_cas),vr_cas(nlev_cas,nt_cas),dr_cas(nlev_cas,nt_cas))
176	allocate(hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas),du_cas(nlev_cas,nt_cas))
177	allocate(hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas),dv_cas(nlev_cas,nt_cas))
178	allocate(ug_cas(nlev_cas,nt_cas),vg_cas(nlev_cas,nt_cas))
179	allocate(temp_nudg_cas(nlev_cas,nt_cas),qv_nudg_cas(nlev_cas,nt_cas))
180	allocate(u_nudg_cas(nlev_cas,nt_cas),v_nudg_cas(nlev_cas,nt_cas))
181	allocate(invtau_temp_nudg_cas(nlev_cas,nt_cas),invtau_qv_nudg_cas(nlev_cas,nt_cas))
182	allocate(invtau_u_nudg_cas(nlev_cas,nt_cas),invtau_v_nudg_cas(nlev_cas,nt_cas))
183	allocate(lat_cas(nt_cas),sens_cas(nt_cas),ts_cas(nt_cas),tskin_cas(nt_cas),ps_cas(nt_cas),ustar_cas(nt_cas),tkes_cas(nt_cas))
184	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))
185
186
187
188	!champs interpoles
189	allocate(plev_prof_cas(nlev_cas))
190	allocate(t_prof_cas(nlev_cas))
191	allocate(theta_prof_cas(nlev_cas))
192	allocate(thl_prof_cas(nlev_cas))
193	allocate(thv_prof_cas(nlev_cas))
194	allocate(q_prof_cas(nlev_cas))
195	allocate(qv_prof_cas(nlev_cas))
196	allocate(ql_prof_cas(nlev_cas))
197	allocate(qi_prof_cas(nlev_cas))
198	allocate(rh_prof_cas(nlev_cas))
199	allocate(rv_prof_cas(nlev_cas))
200	allocate(u_prof_cas(nlev_cas))
201	allocate(v_prof_cas(nlev_cas))
202	allocate(vitw_prof_cas(nlev_cas))
203	allocate(omega_prof_cas(nlev_cas))
204	allocate(tke_prof_cas(nlev_cas))
205	allocate(ug_prof_cas(nlev_cas))
206	allocate(vg_prof_cas(nlev_cas))
207	allocate(temp_nudg_prof_cas(nlev_cas),qv_nudg_prof_cas(nlev_cas))
208	allocate(u_nudg_prof_cas(nlev_cas),v_nudg_prof_cas(nlev_cas))
209	allocate(invtau_temp_nudg_prof_cas(nlev_cas),invtau_qv_nudg_prof_cas(nlev_cas))
210	allocate(invtau_u_nudg_prof_cas(nlev_cas),invtau_v_nudg_prof_cas(nlev_cas))
211	allocate(ht_prof_cas(nlev_cas))
212	allocate(hth_prof_cas(nlev_cas))
213	allocate(hq_prof_cas(nlev_cas))
214	allocate(hu_prof_cas(nlev_cas))
215	allocate(hv_prof_cas(nlev_cas))
216	allocate(vt_prof_cas(nlev_cas))
217	allocate(vth_prof_cas(nlev_cas))
218	allocate(vq_prof_cas(nlev_cas))
219	allocate(vu_prof_cas(nlev_cas))
220	allocate(vv_prof_cas(nlev_cas))
221	allocate(dt_prof_cas(nlev_cas))
222	allocate(dth_prof_cas(nlev_cas))
223	allocate(dtrad_prof_cas(nlev_cas))
224	allocate(dq_prof_cas(nlev_cas))
225	allocate(du_prof_cas(nlev_cas))
226	allocate(dv_prof_cas(nlev_cas))
227	allocate(uw_prof_cas(nlev_cas))
228	allocate(vw_prof_cas(nlev_cas))
229	allocate(q1_prof_cas(nlev_cas))
230	allocate(q2_prof_cas(nlev_cas))
231
232	print*,'Allocations OK'
233	CALL read_SCM (nid,nlev_cas,nt_cas, &
234	ap_cas,bp_cas,z_cas,plev_cas,zh_cas,plevh_cas,t_cas,th_cas,thv_cas,thl_cas,qv_cas, &
235	ql_cas,qi_cas,rh_cas,rv_cas,u_cas,v_cas,vitw_cas,omega_cas,tke_cas,ug_cas,vg_cas, &
236	temp_nudg_cas,qv_nudg_cas,u_nudg_cas,v_nudg_cas, &
237	invtau_temp_nudg_cas,invtau_qv_nudg_cas,invtau_u_nudg_cas,invtau_v_nudg_cas, &
238	du_cas,hu_cas,vu_cas, &
239	dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas, &
240	dr_cas,hr_cas,vr_cas,dtrad_cas,sens_cas,lat_cas,ts_cas,tskin_cas,ps_cas,ustar_cas,tkes_cas, &
241	uw_cas,vw_cas,q1_cas,q2_cas,orog_cas,albedo_cas,emiss_cas,q_skin_cas,mom_rough,heat_rough, &
242	o3_cas,rugos_cas,clay_cas,sand_cas)
243	print*,'read_SCM cas OK'
244	do ii=1,nlev_cas
245	print*,'apres read_SCM_cas, plev_cas=',ii,plev_cas(ii,1)
246	!print*,'apres read_SCM, plev_cas=',ii,omega_cas(ii,nt_cas/2+1)
247	enddo
248
249
250	END SUBROUTINE read_SCM_cas
251
252
253	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
254	SUBROUTINE deallocate2_1D_cases
255	!profils environnementaux:
256	deallocate(plev_cas,plevh_cas)
257
258	deallocate(z_cas,zh_cas)
259	deallocate(ap_cas,bp_cas)
260	deallocate(t_cas,q_cas,qv_cas,ql_cas,qi_cas,rh_cas)
261	deallocate(th_cas,thl_cas,thv_cas,rv_cas)
262	deallocate(u_cas,v_cas,vitw_cas,omega_cas,tke_cas)
263
264	!forcing
265	deallocate(ht_cas,vt_cas,dt_cas,dtrad_cas)
266	deallocate(hq_cas,vq_cas,dq_cas)
267	deallocate(hth_cas,vth_cas,dth_cas)
268	deallocate(hr_cas,vr_cas,dr_cas)
269	deallocate(hu_cas,vu_cas,du_cas)
270	deallocate(hv_cas,vv_cas,dv_cas)
271	deallocate(ug_cas)
272	deallocate(vg_cas)
273	deallocate(lat_cas,sens_cas,tskin_cas,ts_cas,ps_cas,ustar_cas,tkes_cas,uw_cas,vw_cas,q1_cas,q2_cas)
274
275	!champs interpoles
276	deallocate(plev_prof_cas)
277	deallocate(t_prof_cas)
278	deallocate(theta_prof_cas)
279	deallocate(thl_prof_cas)
280	deallocate(thv_prof_cas)
281	deallocate(q_prof_cas)
282	deallocate(qv_prof_cas)
283	deallocate(ql_prof_cas)
284	deallocate(qi_prof_cas)
285	deallocate(rh_prof_cas)
286	deallocate(rv_prof_cas)
287	deallocate(u_prof_cas)
288	deallocate(v_prof_cas)
289	deallocate(vitw_prof_cas)
290	deallocate(omega_prof_cas)
291	deallocate(tke_prof_cas)
292	deallocate(ug_prof_cas)
293	deallocate(vg_prof_cas)
294	deallocate(temp_nudg_prof_cas,qv_nudg_prof_cas,u_nudg_prof_cas,v_nudg_prof_cas)
295	deallocate(invtau_temp_nudg_prof_cas,invtau_qv_nudg_prof_cas,invtau_u_nudg_prof_cas,invtau_v_nudg_prof_cas)
296	deallocate(ht_prof_cas)
297	deallocate(hq_prof_cas)
298	deallocate(hu_prof_cas)
299	deallocate(hv_prof_cas)
300	deallocate(vt_prof_cas)
301	deallocate(vq_prof_cas)
302	deallocate(vu_prof_cas)
303	deallocate(vv_prof_cas)
304	deallocate(dt_prof_cas)
305	deallocate(dtrad_prof_cas)
306	deallocate(dq_prof_cas)
307	deallocate(du_prof_cas)
308	deallocate(dv_prof_cas)
309	deallocate(t_prof_cas)
310	deallocate(u_prof_cas)
311	deallocate(v_prof_cas)
312	deallocate(uw_prof_cas)
313	deallocate(vw_prof_cas)
314	deallocate(q1_prof_cas)
315	deallocate(q2_prof_cas)
316
317	END SUBROUTINE deallocate2_1D_cases
318
319
320	!=====================================================================
321	SUBROUTINE read_SCM(nid,nlevel,ntime, &
322	ap,bp,zz,pp,zzh,pph,temp,theta,thv,thl,qv,ql,qi,rh,rv,u,v,vitw,omega,tke,ug,vg,&
323	temp_nudg,qv_nudg,u_nudg,v_nudg, &
324	invtau_temp_nudg,invtau_qv_nudg,invtau_u_nudg,invtau_v_nudg, &
325	du,hu,vu,dv,hv,vv,dt,ht,vt,dq,hq,vq, &
326	dth,hth,vth,dr,hr,vr,dtrad,sens,flat,ts,tskin,ps,ustar,tkes,uw,vw,q1,q2, &
327	orog_cas,albedo_cas,emiss_cas,q_skin_cas,mom_rough, &
328	heat_rough,o3_cas,rugos_cas,clay_cas,sand_cas)
329
330	!program reading forcing of the case study
331	use netcdf, only: nf90_get_var
332	implicit none
333	INCLUDE "netcdf.inc"
334	INCLUDE "compar1d.h"
335
336	integer ntime,nlevel,k,t
337
338	real ap(nlevel+1),bp(nlevel+1)
339	real zz(nlevel,ntime),zzh(nlevel+1)
340	real pp(nlevel,ntime),pph(nlevel+1)
341	!profils initiaux
342	real temp0(nlevel),qv0(nlevel),ql0(nlevel),qi0(nlevel),u0(nlevel),v0(nlevel),tke0(nlevel)
343	real pp0(nlevel)
344	real temp(nlevel,ntime),qv(nlevel,ntime),ql(nlevel,ntime),qi(nlevel,ntime),rh(nlevel,ntime)
345	real theta(nlevel,ntime),thv(nlevel,ntime),thl(nlevel,ntime),rv(nlevel,ntime)
346	real u(nlevel,ntime),v(nlevel,ntime),tkes(ntime)
347	real temp_nudg(nlevel,ntime),qv_nudg(nlevel,ntime),u_nudg(nlevel,ntime),v_nudg(nlevel,ntime)
348	real invtau_temp_nudg(nlevel,ntime),invtau_qv_nudg(nlevel,ntime),invtau_u_nudg(nlevel,ntime),invtau_v_nudg(nlevel,ntime)
349	real ug(nlevel,ntime),vg(nlevel,ntime)
350	real vitw(nlevel,ntime),omega(nlevel,ntime),tke(nlevel,ntime)
351	real du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime)
352	real dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime)
353	real dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime)
354	real dtrad(nlevel,ntime)
355	real dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime)
356	real dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime),hthl(nlevel,ntime)
357	real dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime)
358	real flat(ntime),sens(ntime),ustar(ntime)
359	real uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime)
360	real ts(ntime),tskin(ntime),ps(ntime)
361	real orog_cas,albedo_cas,emiss_cas,q_skin_cas,mom_rough,heat_rough,o3_cas,rugos_cas,clay_cas,sand_cas
362	real apbp(nlevel+1),resul(nlevel,ntime),resul1(nlevel),resul2(ntime),resul3
363
364
365	integer nid, ierr,ierr1,ierr2,rid,i,int_test
366	integer nbvar3d
367	parameter(nbvar3d=78)
368	integer var3didin(nbvar3d),missing_var(nbvar3d)
369	character*13 name_var(1:nbvar3d)
370
371
372	! data name_var/ &
373	! ! coordonnees pression (n+1 niveaux) #4
374	! & 'coor_par_a','coor_par_b','height_h','pressure_h',& ! #1-#4
375	! ! coordonnees pression (n niveaux) #8
376	! &'temp','qv','ql','qi','u','v','tke','pressure',& ! #5-#12
377	! ! coordonnees pression + temps #42
378	! &'w','omega','ug','vg','uadv','uadvh','uadvv','vadv','vadvh','vadvv','temp_adv','tadvh','tadvv',& ! #13 - #25
379	! &'qv_adv','qvadvh','qvadvv','thadv','thadvh','thadvv','thladvh', & ! #26 - #32
380	! & 'radv','radvh','radvv','radcool','q1','q2','ustress','vstress', & ! #33 - #40
381	! & 'rh','temp_nudging','qv_nudging','u_nudging','v_nudging', & ! #41-45
382	! &'height_f','pressure_forc','tempt','theta','thv','thl','qvt','qlt','qit','rv','ut','vt', & ! #46-58
383	! ! coordonnees temps #12
384	! &'tkes','sfc_sens_flx','sfc_lat_flx','ts','ps','ustar',&
385	! &'orog','albedo','emiss','t_skin','q_skin','mom_rough','heat_rough',&
386	! ! scalaires #4
387	! &'o3','rugos','clay','sand'/
388
389
390
391	data name_var/ &
392	! coordonnees pression (n+1 niveaux) #4
393	'coor_par_a','coor_par_b','zf','pressure_h',& ! #1-#4
394	! coordonnees pression (n niveaux) #8
395	'ta','qv','ql','qi','ua','va','tke','pa',& ! #5-#12
396	! coordonnees pression + temps #46
397	'wa','wap','ug','vg','tnua_adv','tnua_advh','tnua_advv','tnva_adv','tnva_advh','tnva_advv','tnta_adv','tnta_advh',& ! #13 - #25
398	'tnta_advv','tnqv_adv','tnqv_advh','tnqv_advv','thadv','thadvh','thadvv','thladvh', & ! #26 - #32
399	'radv','radvh','radvv','tnta_rad','q1','q2','ustress','vstress', & ! #33 - #40
400	'rh','ta_nud','qv_nud','ua_nud','va_nud', & ! #41-45
401	'zh_forc','pa_forc','tat','thetat','thetavt','thetalt','qvt','qlt','qit','rvt','uat','vat', & ! #46-57
402	'nudging_constant_ta', 'nudging_constant_qv', 'nudging_constant_ua', 'nudging_constant_va', & ! # 58-61
403	! coordonnees temps #12
404	'tkes','hfss','hfls','ts_forc','tskin','ps_forc','ustar', & ! 62-68
405	! scalaires
406	'orog','albedo','emiss','q_skin','z0','z0h', & ! 69-74
407	'O3','rugos','clay','sand'/ ! 75-78
408
409
410	!-----------------------------------------------------------------------
411	! First check that we are using a version > v2 of the 1D standard format
412	! use the difference between 'temp' (old version) and 'ta' (new version)
413	!-----------------------------------------------------------------------
414
415
416	ierr=NF_INQ_VARID(nid,'ta',int_test)
417	if(ierr/=NF_NOERR) then
418	print*, '++++++++++++++++++++++++++++++'
419	print*, 'variable ta missing in cas.nc '
420	print*, 'You are probably using an obsolete version of the 1D cases'
421	print*, 'please dowload the last version of the 1D archive from https://lmdz.lmd.jussieu.fr/pub/'
422	print*, '++++++++++++++++++++++++++++++'
423	CALL abort_gcm ('mod_1D_cases_read_std','bad version of 1D directory',0)
424	endif
425
426	!-----------------------------------------------------------------------
427	! Checking availability of variable #i in the cas.nc file
428	! missing_var=1 if the variable is missing
429	!-----------------------------------------------------------------------
430
431	do i=1,nbvar3d
432	missing_var(i)=0.
433	ierr=NF_INQ_VARID(nid,name_var(i),var3didin(i))
434	print*, 'name_var(i)', name_var(i), var3didin(i)
435	if(ierr/=NF_NOERR) then
436	print *,'Variable manquante dans cas.nc:',i,name_var(i)
437	ierr=NF_NOERR
438	missing_var(i)=1
439	else
440
441	!-----------------------------------------------------------------------
442	! Activating keys depending on the presence of specific variables in cas.nc
443	!-----------------------------------------------------------------------
444	if ( 1 == 1 ) THEN
445	! A MODIFIER: il faudrait dire nudging_temp mais faut le declarer dans compar1d.h etc...
446	! if ( name_var(i) == 'temp_nudging' .and. nint(nudging_t)==0) stop 'Nudging inconsistency temp'
447	if ( name_var(i) == 'qv_nud' .and. nint(nudging_qv)==0) stop 'Nudging inconsistency qv'
448	if ( name_var(i) == 'ua_nud' .and. nint(nudging_u)==0) stop 'Nudging inconsistency u'
449	if ( name_var(i) == 'va_nud' .and. nint(nudging_v)==0) stop 'Nudging inconsistency v'
450	ELSE
451	print*,'GUIDAGE : CONSISTENCY CHECK DEACTIVATED FOR TESTS of SANDU/REF'
452	ENDIF
453
454	!-----------------------------------------------------------------------
455	! Reading variables 1D (N+1) vertical variables (nlevelp1,lat,lon)
456	!-----------------------------------------------------------------------
457	if(i.LE.4) then
458	ierr = NF90_GET_VAR(nid,var3didin(i),apbp)
459	print *,'read_SCM(apbp), on a lu ',i,name_var(i)
460	if(ierr/=NF_NOERR) then
461	print *,'B Pb a la lecture de cas.nc: ',name_var(i)
462	stop "getvarup"
463	endif
464
465	!-----------------------------------------------------------------------
466	! Reading 1D (N) vertical varialbes (nlevel,lat,lon)
467	!-----------------------------------------------------------------------
468	else if(i.gt.4.and.i.LE.12) then
469	ierr = NF90_GET_VAR(nid,var3didin(i),resul1)
470	print *,'read_SCM(resul1), on a lu ',i,name_var(i)
471	if(ierr/=NF_NOERR) then
472	print *,'C Pb a la lecture de cas.nc: ',name_var(i)
473	stop "getvarup"
474	endif
475	print*,'Lecture de la variable #i ',i,name_var(i),minval(resul1),maxval(resul1)
476
477	!-----------------------------------------------------------------------
478	! Reading 2D tim-vertical variables (time,nlevel,lat,lon)
479	! TBD : seems to be the same as above.
480	!-----------------------------------------------------------------------
481	else if(i.gt.12.and.i.LE.61) then
482	ierr = NF90_GET_VAR(nid,var3didin(i),resul)
483	print *,'read_SCM(resul), on a lu ',i,name_var(i)
484	if(ierr/=NF_NOERR) then
485	print *,'D Pb a la lecture de cas.nc: ',name_var(i)
486	stop "getvarup"
487	endif
488	print*,'Lecture de la variable #i ',i,name_var(i),minval(resul),maxval(resul)
489
490	!-----------------------------------------------------------------------
491	! Reading 1D time variables (time,lat,lon)
492	!-----------------------------------------------------------------------
493	else if (i.gt.62.and.i.LE.75) then
494	ierr = NF90_GET_VAR(nid,var3didin(i),resul2)
495	print *,'read_SCM(resul2), on a lu ',i,name_var(i)
496	if(ierr/=NF_NOERR) then
497	print *,'E Pb a la lecture de cas.nc: ',name_var(i)
498	stop "getvarup"
499	endif
500	print*,'Lecture de la variable #i ',i,name_var(i),minval(resul2),maxval(resul2)
501
502	!-----------------------------------------------------------------------
503	! Reading scalar variables (lat,lon)
504	!-----------------------------------------------------------------------
505	else
506	ierr = NF90_GET_VAR(nid,var3didin(i),resul3)
507	print *,'read_SCM(resul3), on a lu ',i,name_var(i)
508	if(ierr/=NF_NOERR) then
509	print *,'F Pb a la lecture de cas.nc: ',name_var(i)
510	stop "getvarup"
511	endif
512	print*,'Lecture de la variable #i ',i,name_var(i),resul3
513	endif
514	endif
515
516	!-----------------------------------------------------------------------
517	! Attributing variables
518	!-----------------------------------------------------------------------
519	select case(i)
520	!case(1) ; ap=apbp ! donnees indexees en nlevel+1
521	! case(2) ; bp=apbp
522	case(3) ; zzh=apbp
523	case(4) ; pph=apbp
524	case(5) ; temp0=resul1 ! donnees initiales
525	case(6) ; qv0=resul1
526	case(7) ; ql0=resul1
527	case(8) ; qi0=resul1
528	case(9) ; u0=resul1
529	case(10) ; v0=resul1
530	case(11) ; tke0=resul1
531	case(12) ; pp0=resul1
532	case(13) ; vitw=resul ! donnees indexees en nlevel,time
533	case(14) ; omega=resul
534	case(15) ; ug=resul
535	case(16) ; vg=resul
536	case(17) ; du=resul
537	case(18) ; hu=resul
538	case(19) ; vu=resul
539	case(20) ; dv=resul
540	case(21) ; hv=resul
541	case(22) ; vv=resul
542	case(23) ; dt=resul
543	case(24) ; ht=resul
544	case(25) ; vt=resul
545	case(26) ; dq=resul
546	case(27) ; hq=resul
547	case(28) ; vq=resul
548	case(29) ; dth=resul
549	case(30) ; hth=resul
550	case(31) ; vth=resul
551	case(32) ; hthl=resul
552	case(33) ; dr=resul
553	case(34) ; hr=resul
554	case(35) ; vr=resul
555	case(36) ; dtrad=resul
556	case(37) ; q1=resul
557	case(38) ; q2=resul
558	case(39) ; uw=resul
559	case(40) ; vw=resul
560	case(41) ; rh=resul
561	case(42) ; temp_nudg=resul
562	case(43) ; qv_nudg=resul
563	case(44) ; u_nudg=resul
564	case(45) ; v_nudg=resul
565	case(46) ; zz=resul ! donnees en time,nlevel pour profil initial
566	case(47) ; pp=resul
567	case(48) ; temp=resul
568	case(49) ; theta=resul
569	case(50) ; thv=resul
570	case(51) ; thl=resul
571	case(52) ; qv=resul
572	case(53) ; ql=resul
573	case(54) ; qi=resul
574	case(55) ; rv=resul
575	case(56) ; u=resul
576	case(57) ; v=resul
577	case(58) ; invtau_temp_nudg=resul
578	case(59) ; invtau_qv_nudg=resul
579	case(60) ; invtau_u_nudg=resul
580	case(61) ; invtau_v_nudg=resul
581	case(62) ; tkes=resul2 ! donnees indexees en time
582	case(63) ; sens=resul2
583	case(64) ; flat=resul2
584	case(65) ; ts=resul2
585	case(66) ; tskin=resul2
586	case(67) ; ps=resul2
587	case(68) ; ustar=resul2
588	case(69) ; orog_cas=resul3 ! constantes
589	case(70) ; albedo_cas=resul3
590	case(71) ; emiss_cas=resul3
591	case(72) ; q_skin_cas=resul3
592	case(73) ; mom_rough=resul3
593	case(74) ; heat_rough=resul3
594	case(75) ; o3_cas=resul3
595	case(76) ; rugos_cas=resul3
596	case(77) ; clay_cas=resul3
597	case(78) ; sand_cas=resul3
598	end select
599	resul=0.
600	resul1=0.
601	resul2=0.
602	resul3=0.
603	enddo
604	print*,'Lecture de la variable APRES ,sens ',minval(sens),maxval(sens)
605	print*,'Lecture de la variable APRES ,flat ',minval(flat),maxval(flat)
606
607	!CR:ATTENTION EN ATTENTE DE REGLER LA QUESTION DU PAS DE TEMPS INITIAL
608	do t=1,ntime
609	do k=1,nlevel
610	temp(k,t)=temp0(k)
611	qv(k,t)=qv0(k)
612	ql(k,t)=ql0(k)
613	qi(k,t)=qi0(k)
614	u(k,t)=u0(k)
615	v(k,t)=v0(k)
616	tke(k,t)=tke0(k)
617	enddo
618	enddo
619	!!!! TRAVAIL : EN FONCTION DES DECISIONS SUR LA SPECIFICATION DE W
620	!!!omega=-vitwpresrg/(rd*temp)
621	!-----------------------------------------------------------------------
622
623	return
624	END SUBROUTINE read_SCM
625	!======================================================================
626
627	!======================================================================
628
629	!**********************************************************************************************
630
631	!**********************************************************************************************
632	SUBROUTINE interp_case_time_std(day,day1,annee_ref &
633	! & ,year_cas,day_cas,nt_cas,pdt_forc,nlev_cas &
634	,nt_cas,nlev_cas &
635	,ts_cas,tskin_cas,ps_cas,plev_cas,t_cas,theta_cas,thv_cas,thl_cas &
636	,qv_cas,ql_cas,qi_cas,u_cas,v_cas &
637	,ug_cas,vg_cas,temp_nudg_cas,qv_nudg_cas,u_nudg_cas,v_nudg_cas &
638	,invtau_temp_nudg_cas,invtau_qv_nudg_cas,invtau_u_nudg_cas,invtau_v_nudg_cas &
639	,vitw_cas,omega_cas,tke_cas,du_cas,hu_cas,vu_cas &
640	,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas &
641	,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas &
642	,lat_cas,sens_cas,ustar_cas &
643	,uw_cas,vw_cas,q1_cas,q2_cas,tkes_cas &
644	!
645	,ts_prof_cas,tskin_prof_cas,ps_prof_cas,plev_prof_cas,t_prof_cas,theta_prof_cas &
646	,thv_prof_cas,thl_prof_cas,qv_prof_cas,ql_prof_cas,qi_prof_cas &
647	,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas &
648	,temp_nudg_prof_cas,qv_nudg_prof_cas,u_nudg_prof_cas,v_nudg_prof_cas &
649	,invtau_temp_nudg_prof_cas,invtau_qv_nudg_prof_cas,invtau_u_nudg_prof_cas,invtau_v_nudg_prof_cas &
650	,vitw_prof_cas,omega_prof_cas,tke_prof_cas,du_prof_cas,hu_prof_cas,vu_prof_cas &
651	,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas &
652	,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas &
653	,hq_prof_cas,vq_prof_cas,dth_prof_cas,hth_prof_cas,vth_prof_cas &
654	,lat_prof_cas,sens_prof_cas &
655	,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas,tkes_prof_cas)
656
657
658
659
660
661
662	implicit none
663
664	!---------------------------------------------------------------------------------------
665	! Time interpolation of a 2D field to the timestep corresponding to day
666	!
667	! day: current julian day (e.g. 717538.2)
668	! day1: first day of the simulation
669	! nt_cas: total nb of data in the forcing
670	! pdt_cas: total time interval (in sec) between 2 forcing data
671	!---------------------------------------------------------------------------------------
672
673	INCLUDE "compar1d.h"
674	INCLUDE "date_cas.h"
675
676	! inputs:
677	integer annee_ref
678	integer nt_cas,nlev_cas
679	real day, day1,day_cas
680	real ts_cas(nt_cas),tskin_cas(nt_cas),ps_cas(nt_cas)
681	real plev_cas(nlev_cas,nt_cas)
682	real t_cas(nlev_cas,nt_cas),theta_cas(nlev_cas,nt_cas)
683	real thv_cas(nlev_cas,nt_cas), thl_cas(nlev_cas,nt_cas)
684	real qv_cas(nlev_cas,nt_cas),ql_cas(nlev_cas,nt_cas),qi_cas(nlev_cas,nt_cas)
685	real u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas)
686	real ug_cas(nlev_cas,nt_cas),vg_cas(nlev_cas,nt_cas)
687	real temp_nudg_cas(nlev_cas,nt_cas),qv_nudg_cas(nlev_cas,nt_cas)
688	real u_nudg_cas(nlev_cas,nt_cas),v_nudg_cas(nlev_cas,nt_cas)
689
690	real invtau_temp_nudg_cas(nlev_cas,nt_cas),invtau_qv_nudg_cas(nlev_cas,nt_cas)
691	real invtau_u_nudg_cas(nlev_cas,nt_cas),invtau_v_nudg_cas(nlev_cas,nt_cas)
692
693	real vitw_cas(nlev_cas,nt_cas),omega_cas(nlev_cas,nt_cas),tke_cas(nlev_cas,nt_cas)
694	real du_cas(nlev_cas,nt_cas),hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas)
695	real dv_cas(nlev_cas,nt_cas),hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas)
696	real dt_cas(nlev_cas,nt_cas),ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas)
697	real dth_cas(nlev_cas,nt_cas),hth_cas(nlev_cas,nt_cas),vth_cas(nlev_cas,nt_cas)
698	real dtrad_cas(nlev_cas,nt_cas)
699	real dq_cas(nlev_cas,nt_cas),hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas)
700	real lat_cas(nt_cas),sens_cas(nt_cas),tkes_cas(nt_cas)
701	real ustar_cas(nt_cas),uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas)
702	real q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas)
703
704	! outputs:
705	real plev_prof_cas(nlev_cas)
706	real t_prof_cas(nlev_cas),theta_prof_cas(nlev_cas),thl_prof_cas(nlev_cas),thv_prof_cas(nlev_cas)
707	real qv_prof_cas(nlev_cas),ql_prof_cas(nlev_cas),qi_prof_cas(nlev_cas)
708	real u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
709	real ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas)
710	real temp_nudg_prof_cas(nlev_cas),qv_nudg_prof_cas(nlev_cas)
711	real u_nudg_prof_cas(nlev_cas),v_nudg_prof_cas(nlev_cas)
712
713	real invtau_temp_nudg_prof_cas(nlev_cas),invtau_qv_nudg_prof_cas(nlev_cas)
714	real invtau_u_nudg_prof_cas(nlev_cas),invtau_v_nudg_prof_cas(nlev_cas)
715
716	real vitw_prof_cas(nlev_cas),omega_prof_cas(nlev_cas),tke_prof_cas(nlev_cas)
717	real du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
718	real dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
719	real dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas)
720	real dth_prof_cas(nlev_cas),hth_prof_cas(nlev_cas),vth_prof_cas(nlev_cas)
721	real dtrad_prof_cas(nlev_cas)
722	real dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
723	real lat_prof_cas,sens_prof_cas,tkes_prof_cas,ts_prof_cas,tskin_prof_cas,ps_prof_cas,ustar_prof_cas
724	real uw_prof_cas(nlev_cas),vw_prof_cas(nlev_cas),q1_prof_cas(nlev_cas),q2_prof_cas(nlev_cas)
725	! local:
726	integer it_cas1, it_cas2,k
727	real timeit,time_cas1,time_cas2,frac
728
729
730	print*,'Check time',day1,day_ju_ini_cas,day_deb+1,pdt_cas
731	! do k=1,nlev_cas
732	! print*,'debut de interp2_case_time, plev_cas=',k,plev_cas(k,1)
733	! enddo
734
735	! On teste si la date du cas AMMA est correcte.
736	! C est pour memoire car en fait les fichiers .def
737	! sont censes etre corrects.
738	! A supprimer a terme (MPL 20150623)
739	! if ((forcing_type.eq.10).and.(1.eq.0)) then
740	! Check that initial day of the simulation consistent with AMMA case:
741	! if (annee_ref.ne.2006) then
742	! print*,'Pour AMMA, annee_ref doit etre 2006'
743	! print*,'Changer annee_ref dans run.def'
744	! stop
745	! endif
746	! if (annee_ref.eq.2006 .and. day1.lt.day_cas) then
747	! print*,'AMMA a debute le 10 juillet 2006',day1,day_cas
748	! print*,'Changer dayref dans run.def'
749	! stop
750	! endif
751	! if (annee_ref.eq.2006 .and. day1.gt.day_cas+1) then
752	! print*,'AMMA a fini le 11 juillet'
753	! print*,'Changer dayref ou nday dans run.def'
754	! stop
755	! endif
756	! endif
757
758	! Determine timestep relative to the 1st day:
759	! timeit=(day-day1)*86400.
760	! if (annee_ref.eq.1992) then
761	! timeit=(day-day_cas)*86400.
762	! else
763	! timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992
764	! endif
765	timeit=(day-day_ju_ini_cas)*86400
766	print *,'day=',day
767	print *,'day_ju_ini_cas=',day_ju_ini_cas
768	print *,'pdt_cas=',pdt_cas
769	print *,'timeit=',timeit
770	print *,'nt_cas=',nt_cas
771
772	! Determine the closest observation times:
773	! it_cas1=INT(timeit/pdt_cas)+1
774	! it_cas2=it_cas1 + 1
775	! time_cas1=(it_cas1-1)*pdt_cas
776	! time_cas2=(it_cas2-1)*pdt_cas
777
778	it_cas1=INT(timeit/pdt_cas)+1
779	IF (it_cas1 .EQ. nt_cas) THEN
780	it_cas2=it_cas1
781	ELSE
782	it_cas2=it_cas1 + 1
783	ENDIF
784	time_cas1=(it_cas1-1)*pdt_cas
785	time_cas2=(it_cas2-1)*pdt_cas
786	! print *,'timeit,pdt_cas,nt_cas=',timeit,pdt_cas,nt_cas
787	! print *,'it_cas1,it_cas2,time_cas1,time_cas2=',it_cas1,it_cas2,time_cas1,time_cas2
788
789	if (it_cas1 .gt. nt_cas) then
790	write(,) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: ' &
791	,day,day_ju_ini_cas,it_cas1,it_cas2,timeit
792	stop
793	endif
794
795	! time interpolation:
796	IF (it_cas1 .EQ. it_cas2) THEN
797	frac=0.
798	ELSE
799	frac=(time_cas2-timeit)/(time_cas2-time_cas1)
800	frac=max(frac,0.0)
801	ENDIF
802
803	lat_prof_cas = lat_cas(it_cas2) &
804	-frac*(lat_cas(it_cas2)-lat_cas(it_cas1))
805	sens_prof_cas = sens_cas(it_cas2) &
806	-frac*(sens_cas(it_cas2)-sens_cas(it_cas1))
807	tkes_prof_cas = tkes_cas(it_cas2) &
808	-frac*(tkes_cas(it_cas2)-tkes_cas(it_cas1))
809	ts_prof_cas = ts_cas(it_cas2) &
810	-frac*(ts_cas(it_cas2)-ts_cas(it_cas1))
811	tskin_prof_cas = tskin_cas(it_cas2) &
812	-frac*(tskin_cas(it_cas2)-tskin_cas(it_cas1))
813	ps_prof_cas = ps_cas(it_cas2) &
814	-frac*(ps_cas(it_cas2)-ps_cas(it_cas1))
815	ustar_prof_cas = ustar_cas(it_cas2) &
816	-frac*(ustar_cas(it_cas2)-ustar_cas(it_cas1))
817
818	do k=1,nlev_cas
819	plev_prof_cas(k) = plev_cas(k,it_cas2) &
820	-frac*(plev_cas(k,it_cas2)-plev_cas(k,it_cas1))
821	t_prof_cas(k) = t_cas(k,it_cas2) &
822	-frac*(t_cas(k,it_cas2)-t_cas(k,it_cas1))
823	!print *,'k,frac,plev_cas1,plev_cas2=',k,frac,plev_cas(k,it_cas1),plev_cas(k,it_cas2)
824	theta_prof_cas(k) = theta_cas(k,it_cas2) &
825	-frac*(theta_cas(k,it_cas2)-theta_cas(k,it_cas1))
826	thv_prof_cas(k) = thv_cas(k,it_cas2) &
827	-frac*(thv_cas(k,it_cas2)-thv_cas(k,it_cas1))
828	thl_prof_cas(k) = thl_cas(k,it_cas2) &
829	-frac*(thl_cas(k,it_cas2)-thl_cas(k,it_cas1))
830	qv_prof_cas(k) = qv_cas(k,it_cas2) &
831	-frac*(qv_cas(k,it_cas2)-qv_cas(k,it_cas1))
832	ql_prof_cas(k) = ql_cas(k,it_cas2) &
833	-frac*(ql_cas(k,it_cas2)-ql_cas(k,it_cas1))
834	qi_prof_cas(k) = qi_cas(k,it_cas2) &
835	-frac*(qi_cas(k,it_cas2)-qi_cas(k,it_cas1))
836	u_prof_cas(k) = u_cas(k,it_cas2) &
837	-frac*(u_cas(k,it_cas2)-u_cas(k,it_cas1))
838	v_prof_cas(k) = v_cas(k,it_cas2) &
839	-frac*(v_cas(k,it_cas2)-v_cas(k,it_cas1))
840	ug_prof_cas(k) = ug_cas(k,it_cas2) &
841	-frac*(ug_cas(k,it_cas2)-ug_cas(k,it_cas1))
842	vg_prof_cas(k) = vg_cas(k,it_cas2) &
843	-frac*(vg_cas(k,it_cas2)-vg_cas(k,it_cas1))
844	temp_nudg_prof_cas(k) = temp_nudg_cas(k,it_cas2) &
845	-frac*(temp_nudg_cas(k,it_cas2)-temp_nudg_cas(k,it_cas1))
846	qv_nudg_prof_cas(k) = qv_nudg_cas(k,it_cas2) &
847	-frac*(qv_nudg_cas(k,it_cas2)-qv_nudg_cas(k,it_cas1))
848	u_nudg_prof_cas(k) = u_nudg_cas(k,it_cas2) &
849	-frac*(u_nudg_cas(k,it_cas2)-u_nudg_cas(k,it_cas1))
850	v_nudg_prof_cas(k) = v_nudg_cas(k,it_cas2) &
851	-frac*(v_nudg_cas(k,it_cas2)-v_nudg_cas(k,it_cas1))
852	invtau_temp_nudg_prof_cas(k) = invtau_temp_nudg_cas(k,it_cas2) &
853	-frac*(invtau_temp_nudg_cas(k,it_cas2)-invtau_temp_nudg_cas(k,it_cas1))
854	invtau_qv_nudg_prof_cas(k) = invtau_qv_nudg_cas(k,it_cas2) &
855	-frac*(invtau_qv_nudg_cas(k,it_cas2)-invtau_qv_nudg_cas(k,it_cas1))
856	invtau_u_nudg_prof_cas(k) = invtau_u_nudg_cas(k,it_cas2) &
857	-frac*(invtau_u_nudg_cas(k,it_cas2)-invtau_u_nudg_cas(k,it_cas1))
858	invtau_v_nudg_prof_cas(k) = invtau_v_nudg_cas(k,it_cas2) &
859	-frac*(invtau_v_nudg_cas(k,it_cas2)-invtau_v_nudg_cas(k,it_cas1))
860	vitw_prof_cas(k) = vitw_cas(k,it_cas2) &
861	-frac*(vitw_cas(k,it_cas2)-vitw_cas(k,it_cas1))
862	omega_prof_cas(k) = omega_cas(k,it_cas2) &
863	-frac*(omega_cas(k,it_cas2)-omega_cas(k,it_cas1))
864	tke_prof_cas(k) = tke_cas(k,it_cas2) &
865	-frac*(tke_cas(k,it_cas2)-tke_cas(k,it_cas1))
866	du_prof_cas(k) = du_cas(k,it_cas2) &
867	-frac*(du_cas(k,it_cas2)-du_cas(k,it_cas1))
868	hu_prof_cas(k) = hu_cas(k,it_cas2) &
869	-frac*(hu_cas(k,it_cas2)-hu_cas(k,it_cas1))
870	vu_prof_cas(k) = vu_cas(k,it_cas2) &
871	-frac*(vu_cas(k,it_cas2)-vu_cas(k,it_cas1))
872	dv_prof_cas(k) = dv_cas(k,it_cas2) &
873	-frac*(dv_cas(k,it_cas2)-dv_cas(k,it_cas1))
874	hv_prof_cas(k) = hv_cas(k,it_cas2) &
875	-frac*(hv_cas(k,it_cas2)-hv_cas(k,it_cas1))
876	vv_prof_cas(k) = vv_cas(k,it_cas2) &
877	-frac*(vv_cas(k,it_cas2)-vv_cas(k,it_cas1))
878	dt_prof_cas(k) = dt_cas(k,it_cas2) &
879	-frac*(dt_cas(k,it_cas2)-dt_cas(k,it_cas1))
880	ht_prof_cas(k) = ht_cas(k,it_cas2) &
881	-frac*(ht_cas(k,it_cas2)-ht_cas(k,it_cas1))
882	vt_prof_cas(k) = vt_cas(k,it_cas2) &
883	-frac*(vt_cas(k,it_cas2)-vt_cas(k,it_cas1))
884	dth_prof_cas(k) = dth_cas(k,it_cas2) &
885	-frac*(dth_cas(k,it_cas2)-dth_cas(k,it_cas1))
886	hth_prof_cas(k) = hth_cas(k,it_cas2) &
887	-frac*(hth_cas(k,it_cas2)-hth_cas(k,it_cas1))
888	vth_prof_cas(k) = vth_cas(k,it_cas2) &
889	-frac*(vth_cas(k,it_cas2)-vth_cas(k,it_cas1))
890	dtrad_prof_cas(k) = dtrad_cas(k,it_cas2) &
891	-frac*(dtrad_cas(k,it_cas2)-dtrad_cas(k,it_cas1))
892	dq_prof_cas(k) = dq_cas(k,it_cas2) &
893	-frac*(dq_cas(k,it_cas2)-dq_cas(k,it_cas1))
894	hq_prof_cas(k) = hq_cas(k,it_cas2) &
895	-frac*(hq_cas(k,it_cas2)-hq_cas(k,it_cas1))
896	vq_prof_cas(k) = vq_cas(k,it_cas2) &
897	-frac*(vq_cas(k,it_cas2)-vq_cas(k,it_cas1))
898	uw_prof_cas(k) = uw_cas(k,it_cas2) &
899	-frac*(uw_cas(k,it_cas2)-uw_cas(k,it_cas1))
900	vw_prof_cas(k) = vw_cas(k,it_cas2) &
901	-frac*(vw_cas(k,it_cas2)-vw_cas(k,it_cas1))
902	q1_prof_cas(k) = q1_cas(k,it_cas2) &
903	-frac*(q1_cas(k,it_cas2)-q1_cas(k,it_cas1))
904	q2_prof_cas(k) = q2_cas(k,it_cas2) &
905	-frac*(q2_cas(k,it_cas2)-q2_cas(k,it_cas1))
906	enddo
907
908	return
909	END SUBROUTINE interp_case_time_std
910
911	!**********************************************************************************************
912	!=====================================================================
913	SUBROUTINE interp2_case_vertical_std(play,plev,nlev_cas,plev_prof_cas &
914	,t_prof_cas,th_prof_cas,thv_prof_cas,thl_prof_cas &
915	,qv_prof_cas,ql_prof_cas,qi_prof_cas,u_prof_cas,v_prof_cas &
916	,ug_prof_cas,vg_prof_cas &
917	,temp_nudg_prof_cas,qv_nudg_prof_cas,u_nudg_prof_cas,v_nudg_prof_cas &
918	,invtau_temp_nudg_prof_cas,invtau_qv_nudg_prof_cas,invtau_u_nudg_prof_cas,invtau_v_nudg_prof_cas &
919	,vitw_prof_cas,omega_prof_cas,tke_prof_cas &
920	,du_prof_cas,hu_prof_cas,vu_prof_cas,dv_prof_cas,hv_prof_cas,vv_prof_cas &
921	,dt_prof_cas,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas &
922	,dth_prof_cas,hth_prof_cas,vth_prof_cas &
923	!
924	,t_mod_cas,theta_mod_cas,thv_mod_cas,thl_mod_cas &
925	,qv_mod_cas,ql_mod_cas,qi_mod_cas,u_mod_cas,v_mod_cas &
926	,ug_mod_cas,vg_mod_cas &
927	,temp_nudg_mod_cas,qv_nudg_mod_cas,u_nudg_mod_cas,v_nudg_mod_cas &
928	,invtau_temp_nudg_mod_cas,invtau_qv_nudg_mod_cas,invtau_u_nudg_mod_cas,invtau_v_nudg_mod_cas &
929	,w_mod_cas,omega_mod_cas,tke_mod_cas &
930	,du_mod_cas,hu_mod_cas,vu_mod_cas,dv_mod_cas,hv_mod_cas,vv_mod_cas &
931	,dt_mod_cas,ht_mod_cas,vt_mod_cas,dtrad_mod_cas,dq_mod_cas,hq_mod_cas,vq_mod_cas &
932	,dth_mod_cas,hth_mod_cas,vth_mod_cas,mxcalc)
933
934	implicit none
935
936	INCLUDE "YOMCST.h"
937	INCLUDE "dimensions.h"
938
939	!-------------------------------------------------------------------------
940	! Vertical interpolation of generic case forcing data onto mod_casel levels
941	!-------------------------------------------------------------------------
942
943	integer nlevmax
944	parameter (nlevmax=41)
945	integer nlev_cas,mxcalc
946	! real play(llm), plev_prof(nlevmax)
947	! real t_prof(nlevmax),q_prof(nlevmax)
948	! real u_prof(nlevmax),v_prof(nlevmax), w_prof(nlevmax)
949	! real ht_prof(nlevmax),vt_prof(nlevmax)
950	! real hq_prof(nlevmax),vq_prof(nlevmax)
951
952	real play(llm), plev(llm+1), plev_prof_cas(nlev_cas)
953	real t_prof_cas(nlev_cas),th_prof_cas(nlev_cas),thv_prof_cas(nlev_cas),thl_prof_cas(nlev_cas)
954	real qv_prof_cas(nlev_cas),ql_prof_cas(nlev_cas),qi_prof_cas(nlev_cas)
955	real u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
956	real ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas), vitw_prof_cas(nlev_cas),omega_prof_cas(nlev_cas),tke_prof_cas(nlev_cas)
957	real temp_nudg_prof_cas(nlev_cas),qv_nudg_prof_cas(nlev_cas)
958	real u_nudg_prof_cas(nlev_cas),v_nudg_prof_cas(nlev_cas)
959	real invtau_temp_nudg_prof_cas(nlev_cas),invtau_qv_nudg_prof_cas(nlev_cas)
960	real invtau_u_nudg_prof_cas(nlev_cas),invtau_v_nudg_prof_cas(nlev_cas)
961
962	real du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
963	real dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
964	real dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas),dtrad_prof_cas(nlev_cas)
965	real dth_prof_cas(nlev_cas),hth_prof_cas(nlev_cas),vth_prof_cas(nlev_cas)
966	real dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
967
968	real t_mod_cas(llm),theta_mod_cas(llm),thv_mod_cas(llm),thl_mod_cas(llm)
969	real qv_mod_cas(llm),ql_mod_cas(llm),qi_mod_cas(llm)
970	real u_mod_cas(llm),v_mod_cas(llm)
971	real ug_mod_cas(llm),vg_mod_cas(llm), w_mod_cas(llm),omega_mod_cas(llm),tke_mod_cas(llm+1)
972	real temp_nudg_mod_cas(llm),qv_nudg_mod_cas(llm)
973	real u_nudg_mod_cas(llm),v_nudg_mod_cas(llm)
974	real invtau_temp_nudg_mod_cas(llm),invtau_qv_nudg_mod_cas(llm)
975	real invtau_u_nudg_mod_cas(llm),invtau_v_nudg_mod_cas(llm)
976	real du_mod_cas(llm),hu_mod_cas(llm),vu_mod_cas(llm)
977	real dv_mod_cas(llm),hv_mod_cas(llm),vv_mod_cas(llm)
978	real dt_mod_cas(llm),ht_mod_cas(llm),vt_mod_cas(llm),dtrad_mod_cas(llm)
979	real dth_mod_cas(llm),hth_mod_cas(llm),vth_mod_cas(llm)
980	real dq_mod_cas(llm),hq_mod_cas(llm),vq_mod_cas(llm)
981
982	integer l,k,k1,k2
983	real frac,frac1,frac2,fact
984
985
986
987	! for variables defined at the middle of layers
988
989	do l = 1, llm
990
991	if (play(l).ge.plev_prof_cas(nlev_cas)) then
992
993	mxcalc=l
994	! print *,'debut interp2, mxcalc=',mxcalc
995	k1=0
996	k2=0
997
998	if (play(l).le.plev_prof_cas(1)) then
999
1000	do k = 1, nlev_cas-1
1001	if (play(l).le.plev_prof_cas(k).and. play(l).gt.plev_prof_cas(k+1)) then
1002	k1=k
1003	k2=k+1
1004	endif
1005	enddo
1006
1007	if (k1.eq.0 .or. k2.eq.0) then
1008	write(,) 'PB! k1, k2 = ',k1,k2
1009	write(,) 'l,play(l) = ',l,play(l)/100
1010	do k = 1, nlev_cas-1
1011	write(,) 'k,plev_prof_cas(k) = ',k,plev_prof_cas(k)/100
1012	enddo
1013	endif
1014
1015
1016
1017	frac = (plev_prof_cas(k2)-play(l))/(plev_prof_cas(k2)-plev_prof_cas(k1))
1018
1019	t_mod_cas(l)= t_prof_cas(k2) - frac*(t_prof_cas(k2)-t_prof_cas(k1))
1020	theta_mod_cas(l)= th_prof_cas(k2) - frac*(th_prof_cas(k2)-th_prof_cas(k1))
1021	if(theta_mod_cas(l).NE.0) t_mod_cas(l)= theta_mod_cas(l)(play(l)/100000.)*(RD/RCPD)
1022	thv_mod_cas(l)= thv_prof_cas(k2) - frac*(thv_prof_cas(k2)-thv_prof_cas(k1))
1023	thl_mod_cas(l)= thl_prof_cas(k2) - frac*(thl_prof_cas(k2)-thl_prof_cas(k1))
1024	qv_mod_cas(l)= qv_prof_cas(k2) - frac*(qv_prof_cas(k2)-qv_prof_cas(k1))
1025	ql_mod_cas(l)= ql_prof_cas(k2) - frac*(ql_prof_cas(k2)-ql_prof_cas(k1))
1026	qi_mod_cas(l)= qi_prof_cas(k2) - frac*(qi_prof_cas(k2)-qi_prof_cas(k1))
1027	u_mod_cas(l)= u_prof_cas(k2) - frac*(u_prof_cas(k2)-u_prof_cas(k1))
1028	v_mod_cas(l)= v_prof_cas(k2) - frac*(v_prof_cas(k2)-v_prof_cas(k1))
1029	ug_mod_cas(l)= ug_prof_cas(k2) - frac*(ug_prof_cas(k2)-ug_prof_cas(k1))
1030	vg_mod_cas(l)= vg_prof_cas(k2) - frac*(vg_prof_cas(k2)-vg_prof_cas(k1))
1031	temp_nudg_mod_cas(l)= temp_nudg_prof_cas(k2) - frac*(temp_nudg_prof_cas(k2)-temp_nudg_prof_cas(k1))
1032	qv_nudg_mod_cas(l)= qv_nudg_prof_cas(k2) - frac*(qv_nudg_prof_cas(k2)-qv_nudg_prof_cas(k1))
1033	u_nudg_mod_cas(l)= u_nudg_prof_cas(k2) - frac*(u_nudg_prof_cas(k2)-u_nudg_prof_cas(k1))
1034	v_nudg_mod_cas(l)= v_nudg_prof_cas(k2) - frac*(v_nudg_prof_cas(k2)-v_nudg_prof_cas(k1))
1035
1036	invtau_temp_nudg_mod_cas(l)= invtau_temp_nudg_prof_cas(k2) &
1037	- frac*(invtau_temp_nudg_prof_cas(k2)-invtau_temp_nudg_prof_cas(k1))
1038	invtau_qv_nudg_mod_cas(l)= invtau_qv_nudg_prof_cas(k2) - frac*(invtau_qv_nudg_prof_cas(k2)-invtau_qv_nudg_prof_cas(k1))
1039	invtau_u_nudg_mod_cas(l)= invtau_u_nudg_prof_cas(k2) - frac*(invtau_u_nudg_prof_cas(k2)-invtau_u_nudg_prof_cas(k1))
1040	invtau_v_nudg_mod_cas(l)= invtau_v_nudg_prof_cas(k2) - frac*(invtau_v_nudg_prof_cas(k2)-invtau_v_nudg_prof_cas(k1))
1041
1042	w_mod_cas(l)= vitw_prof_cas(k2) - frac*(vitw_prof_cas(k2)-vitw_prof_cas(k1))
1043	omega_mod_cas(l)= omega_prof_cas(k2) - frac*(omega_prof_cas(k2)-omega_prof_cas(k1))
1044	du_mod_cas(l)= du_prof_cas(k2) - frac*(du_prof_cas(k2)-du_prof_cas(k1))
1045	hu_mod_cas(l)= hu_prof_cas(k2) - frac*(hu_prof_cas(k2)-hu_prof_cas(k1))
1046	vu_mod_cas(l)= vu_prof_cas(k2) - frac*(vu_prof_cas(k2)-vu_prof_cas(k1))
1047	dv_mod_cas(l)= dv_prof_cas(k2) - frac*(dv_prof_cas(k2)-dv_prof_cas(k1))
1048	hv_mod_cas(l)= hv_prof_cas(k2) - frac*(hv_prof_cas(k2)-hv_prof_cas(k1))
1049	vv_mod_cas(l)= vv_prof_cas(k2) - frac*(vv_prof_cas(k2)-vv_prof_cas(k1))
1050	dt_mod_cas(l)= dt_prof_cas(k2) - frac*(dt_prof_cas(k2)-dt_prof_cas(k1))
1051	ht_mod_cas(l)= ht_prof_cas(k2) - frac*(ht_prof_cas(k2)-ht_prof_cas(k1))
1052	vt_mod_cas(l)= vt_prof_cas(k2) - frac*(vt_prof_cas(k2)-vt_prof_cas(k1))
1053	dth_mod_cas(l)= dth_prof_cas(k2) - frac*(dth_prof_cas(k2)-dth_prof_cas(k1))
1054	hth_mod_cas(l)= hth_prof_cas(k2) - frac*(hth_prof_cas(k2)-hth_prof_cas(k1))
1055	vth_mod_cas(l)= vth_prof_cas(k2) - frac*(vth_prof_cas(k2)-vth_prof_cas(k1))
1056	dq_mod_cas(l)= dq_prof_cas(k2) - frac*(dq_prof_cas(k2)-dq_prof_cas(k1))
1057	hq_mod_cas(l)= hq_prof_cas(k2) - frac*(hq_prof_cas(k2)-hq_prof_cas(k1))
1058	vq_mod_cas(l)= vq_prof_cas(k2) - frac*(vq_prof_cas(k2)-vq_prof_cas(k1))
1059	dtrad_mod_cas(l)= dtrad_prof_cas(k2) - frac*(dtrad_prof_cas(k2)-dtrad_prof_cas(k1))
1060
1061	else !play>plev_prof_cas(1)
1062
1063	k1=1
1064	k2=2
1065	print *,'interp2_vert, k1,k2=',plev_prof_cas(k1),plev_prof_cas(k2)
1066	frac1 = (play(l)-plev_prof_cas(k2))/(plev_prof_cas(k1)-plev_prof_cas(k2))
1067	frac2 = (play(l)-plev_prof_cas(k1))/(plev_prof_cas(k1)-plev_prof_cas(k2))
1068	t_mod_cas(l)= frac1t_prof_cas(k1) - frac2t_prof_cas(k2)
1069	theta_mod_cas(l)= frac1th_prof_cas(k1) - frac2th_prof_cas(k2)
1070	if(theta_mod_cas(l).NE.0) t_mod_cas(l)= theta_mod_cas(l)(play(l)/100000.)*(RD/RCPD)
1071	thv_mod_cas(l)= frac1thv_prof_cas(k1) - frac2thv_prof_cas(k2)
1072	thl_mod_cas(l)= frac1thl_prof_cas(k1) - frac2thl_prof_cas(k2)
1073	qv_mod_cas(l)= frac1qv_prof_cas(k1) - frac2qv_prof_cas(k2)
1074	ql_mod_cas(l)= frac1ql_prof_cas(k1) - frac2ql_prof_cas(k2)
1075	qi_mod_cas(l)= frac1qi_prof_cas(k1) - frac2qi_prof_cas(k2)
1076	u_mod_cas(l)= frac1u_prof_cas(k1) - frac2u_prof_cas(k2)
1077	v_mod_cas(l)= frac1v_prof_cas(k1) - frac2v_prof_cas(k2)
1078	ug_mod_cas(l)= frac1ug_prof_cas(k1) - frac2ug_prof_cas(k2)
1079	vg_mod_cas(l)= frac1vg_prof_cas(k1) - frac2vg_prof_cas(k2)
1080	temp_nudg_mod_cas(l)= frac1temp_nudg_prof_cas(k1) - frac2temp_nudg_prof_cas(k2)
1081	qv_nudg_mod_cas(l)= frac1qv_nudg_prof_cas(k1) - frac2qv_nudg_prof_cas(k2)
1082	u_nudg_mod_cas(l)= frac1u_nudg_prof_cas(k1) - frac2u_nudg_prof_cas(k2)
1083	v_nudg_mod_cas(l)= frac1v_nudg_prof_cas(k1) - frac2v_nudg_prof_cas(k2)
1084
1085	invtau_temp_nudg_mod_cas(l)= frac1invtau_temp_nudg_prof_cas(k1) - frac2invtau_temp_nudg_prof_cas(k2)
1086	invtau_qv_nudg_mod_cas(l)= frac1invtau_qv_nudg_prof_cas(k1) - frac2invtau_qv_nudg_prof_cas(k2)
1087	invtau_u_nudg_mod_cas(l)= frac1invtau_u_nudg_prof_cas(k1) - frac2invtau_u_nudg_prof_cas(k2)
1088	invtau_v_nudg_mod_cas(l)= frac1invtau_v_nudg_prof_cas(k1) - frac2invtau_v_nudg_prof_cas(k2)
1089
1090	w_mod_cas(l)= frac1vitw_prof_cas(k1) - frac2vitw_prof_cas(k2)
1091	omega_mod_cas(l)= frac1omega_prof_cas(k1) - frac2omega_prof_cas(k2)
1092	du_mod_cas(l)= frac1du_prof_cas(k1) - frac2du_prof_cas(k2)
1093	hu_mod_cas(l)= frac1hu_prof_cas(k1) - frac2hu_prof_cas(k2)
1094	vu_mod_cas(l)= frac1vu_prof_cas(k1) - frac2vu_prof_cas(k2)
1095	dv_mod_cas(l)= frac1dv_prof_cas(k1) - frac2dv_prof_cas(k2)
1096	hv_mod_cas(l)= frac1hv_prof_cas(k1) - frac2hv_prof_cas(k2)
1097	vv_mod_cas(l)= frac1vv_prof_cas(k1) - frac2vv_prof_cas(k2)
1098	dt_mod_cas(l)= frac1dt_prof_cas(k1) - frac2dt_prof_cas(k2)
1099	ht_mod_cas(l)= frac1ht_prof_cas(k1) - frac2ht_prof_cas(k2)
1100	vt_mod_cas(l)= frac1vt_prof_cas(k1) - frac2vt_prof_cas(k2)
1101	dth_mod_cas(l)= frac1dth_prof_cas(k1) - frac2dth_prof_cas(k2)
1102	hth_mod_cas(l)= frac1hth_prof_cas(k1) - frac2hth_prof_cas(k2)
1103	vth_mod_cas(l)= frac1vth_prof_cas(k1) - frac2vth_prof_cas(k2)
1104	dq_mod_cas(l)= frac1dq_prof_cas(k1) - frac2dq_prof_cas(k2)
1105	hq_mod_cas(l)= frac1hq_prof_cas(k1) - frac2hq_prof_cas(k2)
1106	vq_mod_cas(l)= frac1vq_prof_cas(k1) - frac2vq_prof_cas(k2)
1107	dtrad_mod_cas(l)= frac1dtrad_prof_cas(k1) - frac2dtrad_prof_cas(k2)
1108
1109	endif ! play.le.plev_prof_cas(1)
1110
1111	else ! above max altitude of forcing file
1112
1113	!jyg
1114	fact=20.*(plev_prof_cas(nlev_cas)-play(l))/plev_prof_cas(nlev_cas) !jyg
1115	fact = max(fact,0.) !jyg
1116	fact = exp(-fact) !jyg
1117	t_mod_cas(l)= t_prof_cas(nlev_cas) !jyg
1118	theta_mod_cas(l)= th_prof_cas(nlev_cas) !jyg
1119	thv_mod_cas(l)= thv_prof_cas(nlev_cas) !jyg
1120	thl_mod_cas(l)= thl_prof_cas(nlev_cas) !jyg
1121	qv_mod_cas(l)= qv_prof_cas(nlev_cas)*fact !jyg
1122	ql_mod_cas(l)= ql_prof_cas(nlev_cas)*fact !jyg
1123	qi_mod_cas(l)= qi_prof_cas(nlev_cas)*fact !jyg
1124	u_mod_cas(l)= u_prof_cas(nlev_cas)*fact !jyg
1125	v_mod_cas(l)= v_prof_cas(nlev_cas)*fact !jyg
1126	ug_mod_cas(l)= ug_prof_cas(nlev_cas) !jyg
1127	vg_mod_cas(l)= vg_prof_cas(nlev_cas) !jyg
1128	temp_nudg_mod_cas(l)= temp_nudg_prof_cas(nlev_cas) !jyg
1129	qv_nudg_mod_cas(l)= qv_nudg_prof_cas(nlev_cas) !jyg
1130	u_nudg_mod_cas(l)= u_nudg_prof_cas(nlev_cas) !jyg
1131	v_nudg_mod_cas(l)= v_nudg_prof_cas(nlev_cas) !jyg
1132
1133	invtau_temp_nudg_mod_cas(l)= invtau_temp_nudg_prof_cas(nlev_cas) !jyg
1134	invtau_qv_nudg_mod_cas(l)= invtau_qv_nudg_prof_cas(nlev_cas) !jyg
1135	invtau_u_nudg_mod_cas(l)= invtau_u_nudg_prof_cas(nlev_cas) !jyg
1136	invtau_v_nudg_mod_cas(l)= invtau_v_nudg_prof_cas(nlev_cas) !jyg
1137
1138	thv_mod_cas(l)= thv_prof_cas(nlev_cas) !jyg
1139	w_mod_cas(l)= 0.0 !jyg
1140	omega_mod_cas(l)= 0.0 !jyg
1141	du_mod_cas(l)= du_prof_cas(nlev_cas)*fact
1142	hu_mod_cas(l)= hu_prof_cas(nlev_cas)*fact !jyg
1143	vu_mod_cas(l)= vu_prof_cas(nlev_cas)*fact !jyg
1144	dv_mod_cas(l)= dv_prof_cas(nlev_cas)*fact
1145	hv_mod_cas(l)= hv_prof_cas(nlev_cas)*fact !jyg
1146	vv_mod_cas(l)= vv_prof_cas(nlev_cas)*fact !jyg
1147	dt_mod_cas(l)= dt_prof_cas(nlev_cas)
1148	ht_mod_cas(l)= ht_prof_cas(nlev_cas) !jyg
1149	vt_mod_cas(l)= vt_prof_cas(nlev_cas) !jyg
1150	dth_mod_cas(l)= dth_prof_cas(nlev_cas)
1151	hth_mod_cas(l)= hth_prof_cas(nlev_cas) !jyg
1152	vth_mod_cas(l)= vth_prof_cas(nlev_cas) !jyg
1153	dq_mod_cas(l)= dq_prof_cas(nlev_cas)*fact
1154	hq_mod_cas(l)= hq_prof_cas(nlev_cas)*fact !jyg
1155	vq_mod_cas(l)= vq_prof_cas(nlev_cas)*fact !jyg
1156	dtrad_mod_cas(l)= dtrad_prof_cas(nlev_cas)*fact !jyg
1157
1158	endif ! play
1159
1160	enddo ! l
1161
1162	! for variables defined at layer interfaces (EV):
1163
1164
1165	do l = 1, llm+1
1166
1167	if (plev(l).ge.plev_prof_cas(nlev_cas)) then
1168
1169	mxcalc=l
1170	k1=0
1171	k2=0
1172
1173	if (plev(l).le.plev_prof_cas(1)) then
1174
1175	do k = 1, nlev_cas-1
1176	if (plev(l).le.plev_prof_cas(k).and. plev(l).gt.plev_prof_cas(k+1)) then
1177	k1=k
1178	k2=k+1
1179	endif
1180	enddo
1181
1182	if (k1.eq.0 .or. k2.eq.0) then
1183	write(,) 'PB! k1, k2 = ',k1,k2
1184	write(,) 'l,plev(l) = ',l,plev(l)/100
1185	do k = 1, nlev_cas-1
1186	write(,) 'k,plev_prof_cas(k) = ',k,plev_prof_cas(k)/100
1187	enddo
1188	endif
1189
1190	frac = (plev_prof_cas(k2)-plev(l))/(plev_prof_cas(k2)-plev_prof_cas(k1))
1191	tke_mod_cas(l)= tke_prof_cas(k2) - frac*(tke_prof_cas(k2)-tke_prof_cas(k1))
1192	else !play>plev_prof_cas(1)
1193	k1=1
1194	k2=2
1195	frac1 = (play(l)-plev_prof_cas(k2))/(plev_prof_cas(k1)-plev_prof_cas(k2))
1196	frac2 = (play(l)-plev_prof_cas(k1))/(plev_prof_cas(k1)-plev_prof_cas(k2))
1197	tke_mod_cas(l)= frac1tke_prof_cas(k1) - frac2tke_prof_cas(k2)
1198
1199	endif ! plev.le.plev_prof_cas(1)
1200
1201	else ! above max altitude of forcing file
1202
1203	tke_mod_cas(l)=0.0
1204
1205	endif ! plev
1206
1207	enddo ! l
1208
1209
1210
1211	return
1212	end SUBROUTINE interp2_case_vertical_std
1213	!*****************************************************************************
1214
1215
1216
1217
1218
1219	END MODULE mod_1D_cases_read_std

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

Download in other formats:

Original Format