Context Navigation

mod_1D_cases_read.F90 @ 3981

Last change on this file since 3981 was 2373, checked in by jyg, 9 years ago
From MPL: Correction of some missing initializations in dyn1D and of two 1D case bugs.
Property svn:keywords set to `Id`
File size: 38.0 KB

Rev	Line
[2307]	1	!
	2	! $Id: mod_1D_cases_read.F90 2373 2015-10-13 17:28:01Z fairhead $
	3	!
[2118]	4	MODULE mod_1D_cases_read
	5
	6	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
[2191]	7	!Declarations specifiques au cas standard
	8	character*80 :: fich_cas
[2332]	9	! Discr?tisation
[2191]	10	integer nlev_cas, nt_cas
[2118]	11
	12
[2332]	13	! integer year_ini_cas, day_ini_cas, mth_ini_cas
	14	! real heure_ini_cas
	15	! real day_ju_ini_cas ! Julian day of case first day
[2307]	16	! parameter (year_ini_cas=2011)
[2332]	17	! parameter (year_ini_cas=1969)
[2307]	18	! parameter (mth_ini_cas=10)
[2332]	19	! parameter (mth_ini_cas=6)
[2307]	20	! parameter (day_ini_cas=1) ! 10 = 10Juil2006
[2332]	21	! parameter (day_ini_cas=24) ! 24 = 24 juin 1969
	22	! parameter (heure_ini_cas=0.) !0h en secondes
	23	! real pdt_cas
	24	! parameter (pdt_cas=3.*3600)
[2118]	25
[2191]	26	!CR ATTENTION TEST AMMA
	27	! parameter (year_ini_cas=2006)
	28	! parameter (mth_ini_cas=7)
	29	! parameter (day_ini_cas=10) ! 10 = 10Juil2006
	30	! parameter (heure_ini_cas=0.) !0h en secondes
	31	! parameter (pdt_cas=1800.)
[2118]	32
[2191]	33	!profils environnementaux
	34	real, allocatable:: plev_cas(:,:)
[2118]	35
[2191]	36	real, allocatable:: z_cas(:,:)
	37	real, allocatable:: t_cas(:,:),q_cas(:,:),rh_cas(:,:)
	38	real, allocatable:: th_cas(:,:),rv_cas(:,:)
	39	real, allocatable:: u_cas(:,:)
	40	real, allocatable:: v_cas(:,:)
[2118]	41
[2191]	42	!forcing
	43	real, allocatable:: ht_cas(:,:),vt_cas(:,:),dt_cas(:,:),dtrad_cas(:,:)
	44	real, allocatable:: hth_cas(:,:),vth_cas(:,:),dth_cas(:,:)
	45	real, allocatable:: hq_cas(:,:),vq_cas(:,:),dq_cas(:,:)
	46	real, allocatable:: hr_cas(:,:),vr_cas(:,:),dr_cas(:,:)
	47	real, allocatable:: hu_cas(:,:),vu_cas(:,:),du_cas(:,:)
	48	real, allocatable:: hv_cas(:,:),vv_cas(:,:),dv_cas(:,:)
	49	real, allocatable:: vitw_cas(:,:)
	50	real, allocatable:: ug_cas(:,:),vg_cas(:,:)
[2307]	51	real, allocatable:: lat_cas(:),sens_cas(:),ts_cas(:),ustar_cas(:)
[2332]	52	real, allocatable:: uw_cas(:,:),vw_cas(:,:),q1_cas(:,:),q2_cas(:,:)
[2118]	53
	54	!champs interpoles
[2191]	55	real, allocatable:: plev_prof_cas(:)
	56	real, allocatable:: t_prof_cas(:)
	57	real, allocatable:: q_prof_cas(:)
	58	real, allocatable:: u_prof_cas(:)
	59	real, allocatable:: v_prof_cas(:)
[2118]	60
[2191]	61	real, allocatable:: vitw_prof_cas(:)
	62	real, allocatable:: ug_prof_cas(:)
	63	real, allocatable:: vg_prof_cas(:)
	64	real, allocatable:: ht_prof_cas(:)
	65	real, allocatable:: hq_prof_cas(:)
	66	real, allocatable:: vt_prof_cas(:)
	67	real, allocatable:: vq_prof_cas(:)
	68	real, allocatable:: dt_prof_cas(:)
	69	real, allocatable:: dtrad_prof_cas(:)
	70	real, allocatable:: dq_prof_cas(:)
	71	real, allocatable:: hu_prof_cas(:)
	72	real, allocatable:: hv_prof_cas(:)
	73	real, allocatable:: vu_prof_cas(:)
	74	real, allocatable:: vv_prof_cas(:)
	75	real, allocatable:: du_prof_cas(:)
	76	real, allocatable:: dv_prof_cas(:)
[2332]	77	real, allocatable:: uw_prof_cas(:)
	78	real, allocatable:: vw_prof_cas(:)
	79	real, allocatable:: q1_prof_cas(:)
	80	real, allocatable:: q2_prof_cas(:)
[2118]	81
[2191]	82
[2307]	83	real lat_prof_cas,sens_prof_cas,ts_prof_cas,ustar_prof_cas
[2191]	84
	85
	86
[2118]	87	CONTAINS
	88
[2191]	89	SUBROUTINE read_1D_cas
[2118]	90	implicit none
	91
	92	#include "netcdf.inc"
	93
	94	INTEGER nid,rid,ierr
[2191]	95	INTEGER ii,jj
[2118]	96
[2191]	97	fich_cas='setup/cas.nc'
	98	print*,'fich_cas ',fich_cas
	99	ierr = NF_OPEN(fich_cas,NF_NOWRITE,nid)
	100	print*,'fich_cas,NF_NOWRITE,nid ',fich_cas,NF_NOWRITE,nid
[2118]	101	if (ierr.NE.NF_NOERR) then
	102	write(,) 'ERROR: GROS Pb opening forcings nc file '
	103	write(,) NF_STRERROR(ierr)
	104	stop ""
	105	endif
	106	!.......................................................................
[2191]	107	ierr=NF_INQ_DIMID(nid,'lat',rid)
	108	IF (ierr.NE.NF_NOERR) THEN
	109	print*, 'Oh probleme lecture dimension lat'
	110	ENDIF
	111	ierr=NF_INQ_DIMLEN(nid,rid,ii)
[2332]	112	print*,'OK1 nid,rid,lat',nid,rid,ii
[2191]	113	!.......................................................................
	114	ierr=NF_INQ_DIMID(nid,'lon',rid)
	115	IF (ierr.NE.NF_NOERR) THEN
	116	print*, 'Oh probleme lecture dimension lon'
	117	ENDIF
	118	ierr=NF_INQ_DIMLEN(nid,rid,jj)
[2332]	119	print*,'OK2 nid,rid,lat',nid,rid,jj
[2191]	120	!.......................................................................
[2118]	121	ierr=NF_INQ_DIMID(nid,'lev',rid)
	122	IF (ierr.NE.NF_NOERR) THEN
	123	print*, 'Oh probleme lecture dimension zz'
	124	ENDIF
[2191]	125	ierr=NF_INQ_DIMLEN(nid,rid,nlev_cas)
[2332]	126	print*,'OK3 nid,rid,nlev_cas',nid,rid,nlev_cas
[2118]	127	!.......................................................................
	128	ierr=NF_INQ_DIMID(nid,'time',rid)
	129	print*,'nid,rid',nid,rid
[2191]	130	nt_cas=0
[2118]	131	IF (ierr.NE.NF_NOERR) THEN
	132	stop 'probleme lecture dimension sens'
	133	ENDIF
[2191]	134	ierr=NF_INQ_DIMLEN(nid,rid,nt_cas)
[2332]	135	print*,'OK4 nid,rid,nt_cas',nid,rid,nt_cas
[2118]	136
	137	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
[2191]	138	!profils moyens:
	139	allocate(plev_cas(nlev_cas,nt_cas))
	140	allocate(z_cas(nlev_cas,nt_cas))
	141	allocate(t_cas(nlev_cas,nt_cas),q_cas(nlev_cas,nt_cas),rh_cas(nlev_cas,nt_cas))
	142	allocate(th_cas(nlev_cas,nt_cas),rv_cas(nlev_cas,nt_cas))
	143	allocate(u_cas(nlev_cas,nt_cas))
	144	allocate(v_cas(nlev_cas,nt_cas))
[2118]	145
[2191]	146	!forcing
	147	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))
	148	allocate(hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas),dq_cas(nlev_cas,nt_cas))
	149	allocate(hth_cas(nlev_cas,nt_cas),vth_cas(nlev_cas,nt_cas),dth_cas(nlev_cas,nt_cas))
	150	allocate(hr_cas(nlev_cas,nt_cas),vr_cas(nlev_cas,nt_cas),dr_cas(nlev_cas,nt_cas))
	151	allocate(hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas),du_cas(nlev_cas,nt_cas))
	152	allocate(hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas),dv_cas(nlev_cas,nt_cas))
	153	allocate(vitw_cas(nlev_cas,nt_cas))
	154	allocate(ug_cas(nlev_cas,nt_cas))
	155	allocate(vg_cas(nlev_cas,nt_cas))
[2307]	156	allocate(lat_cas(nt_cas),sens_cas(nt_cas),ts_cas(nt_cas),ustar_cas(nt_cas))
[2332]	157	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))
[2118]	158
	159
	160	!champs interpoles
[2191]	161	allocate(plev_prof_cas(nlev_cas))
	162	allocate(t_prof_cas(nlev_cas))
	163	allocate(q_prof_cas(nlev_cas))
	164	allocate(u_prof_cas(nlev_cas))
	165	allocate(v_prof_cas(nlev_cas))
[2118]	166
[2191]	167	allocate(vitw_prof_cas(nlev_cas))
	168	allocate(ug_prof_cas(nlev_cas))
	169	allocate(vg_prof_cas(nlev_cas))
	170	allocate(ht_prof_cas(nlev_cas))
	171	allocate(hq_prof_cas(nlev_cas))
	172	allocate(hu_prof_cas(nlev_cas))
	173	allocate(hv_prof_cas(nlev_cas))
	174	allocate(vt_prof_cas(nlev_cas))
	175	allocate(vq_prof_cas(nlev_cas))
	176	allocate(vu_prof_cas(nlev_cas))
	177	allocate(vv_prof_cas(nlev_cas))
	178	allocate(dt_prof_cas(nlev_cas))
	179	allocate(dtrad_prof_cas(nlev_cas))
	180	allocate(dq_prof_cas(nlev_cas))
	181	allocate(du_prof_cas(nlev_cas))
	182	allocate(dv_prof_cas(nlev_cas))
[2332]	183	allocate(uw_prof_cas(nlev_cas))
	184	allocate(vw_prof_cas(nlev_cas))
	185	allocate(q1_prof_cas(nlev_cas))
	186	allocate(q2_prof_cas(nlev_cas))
[2191]	187
[2118]	188	print*,'Allocations OK'
[2332]	189	call read_cas(nid,nlev_cas,nt_cas &
	190	& ,z_cas,plev_cas,t_cas,q_cas,rh_cas,th_cas,rv_cas,u_cas,v_cas &
	191	& ,ug_cas,vg_cas,vitw_cas,du_cas,hu_cas,vu_cas,dv_cas,hv_cas,vv_cas &
	192	& ,dt_cas,dtrad_cas,ht_cas,vt_cas,dq_cas,hq_cas,vq_cas &
	193	& ,dth_cas,hth_cas,vth_cas,dr_cas,hr_cas,vr_cas,sens_cas,lat_cas,ts_cas&
	194	& ,ustar_cas,uw_cas,vw_cas,q1_cas,q2_cas)
	195	print*,'Read cas OK'
[2118]	196
	197
[2191]	198	END SUBROUTINE read_1D_cas
[2118]	199
	200
[2191]	201
[2118]	202	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	203	SUBROUTINE deallocate_1D_cases
[2191]	204	!profils environnementaux:
	205	deallocate(plev_cas)
[2118]	206
[2191]	207	deallocate(z_cas)
	208	deallocate(t_cas,q_cas,rh_cas)
	209	deallocate(th_cas,rv_cas)
	210	deallocate(u_cas)
	211	deallocate(v_cas)
[2118]	212
[2191]	213	!forcing
	214	deallocate(ht_cas,vt_cas,dt_cas,dtrad_cas)
	215	deallocate(hq_cas,vq_cas,dq_cas)
	216	deallocate(hth_cas,vth_cas,dth_cas)
	217	deallocate(hr_cas,vr_cas,dr_cas)
	218	deallocate(hu_cas,vu_cas,du_cas)
	219	deallocate(hv_cas,vv_cas,dv_cas)
	220	deallocate(vitw_cas)
	221	deallocate(ug_cas)
	222	deallocate(vg_cas)
[2332]	223	deallocate(lat_cas,sens_cas,ts_cas,ustar_cas,uw_cas,vw_cas,q1_cas,q2_cas)
[2118]	224
	225	!champs interpoles
[2191]	226	deallocate(plev_prof_cas)
	227	deallocate(t_prof_cas)
	228	deallocate(q_prof_cas)
	229	deallocate(u_prof_cas)
	230	deallocate(v_prof_cas)
	231
	232	deallocate(vitw_prof_cas)
	233	deallocate(ug_prof_cas)
	234	deallocate(vg_prof_cas)
	235	deallocate(ht_prof_cas)
	236	deallocate(hq_prof_cas)
	237	deallocate(hu_prof_cas)
	238	deallocate(hv_prof_cas)
	239	deallocate(vt_prof_cas)
	240	deallocate(vq_prof_cas)
	241	deallocate(vu_prof_cas)
	242	deallocate(vv_prof_cas)
	243	deallocate(dt_prof_cas)
	244	deallocate(dtrad_prof_cas)
	245	deallocate(dq_prof_cas)
	246	deallocate(du_prof_cas)
	247	deallocate(dv_prof_cas)
	248	deallocate(t_prof_cas)
	249	deallocate(q_prof_cas)
	250	deallocate(u_prof_cas)
	251	deallocate(v_prof_cas)
[2332]	252	deallocate(uw_prof_cas)
	253	deallocate(vw_prof_cas)
	254	deallocate(q1_prof_cas)
	255	deallocate(q2_prof_cas)
[2191]	256
[2118]	257	END SUBROUTINE deallocate_1D_cases
	258
	259
	260	END MODULE mod_1D_cases_read
	261	!=====================================================================
[2191]	262	subroutine read_cas(nid,nlevel,ntime &
	263	& ,zz,pp,temp,qv,rh,theta,rv,u,v,ug,vg,w, &
	264	& du,hu,vu,dv,hv,vv,dt,dtrad,ht,vt,dq,hq,vq, &
[2332]	265	& dth,hth,vth,dr,hr,vr,sens,flat,ts,ustar,uw,vw,q1,q2)
[2118]	266
[2191]	267	!program reading forcing of the case study
[2118]	268	implicit none
	269	#include "netcdf.inc"
	270
	271	integer ntime,nlevel
	272
[2191]	273	real zz(nlevel,ntime)
	274	real pp(nlevel,ntime)
	275	real temp(nlevel,ntime),qv(nlevel,ntime),rh(nlevel,ntime)
	276	real theta(nlevel,ntime),rv(nlevel,ntime)
	277	real u(nlevel,ntime)
	278	real v(nlevel,ntime)
	279	real ug(nlevel,ntime)
	280	real vg(nlevel,ntime)
	281	real w(nlevel,ntime)
	282	real du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime)
	283	real dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime)
	284	real dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime)
	285	real dtrad(nlevel,ntime)
	286	real dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime)
	287	real dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime)
	288	real dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime)
[2307]	289	real flat(ntime),sens(ntime),ts(ntime),ustar(ntime)
[2332]	290	real uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime)
[2118]	291
	292
	293	integer nid, ierr,rid
	294	integer nbvar3d
[2307]	295	parameter(nbvar3d=39)
[2118]	296	integer var3didin(nbvar3d)
	297
	298	ierr=NF_INQ_VARID(nid,"zz",var3didin(1))
	299	if(ierr/=NF_NOERR) then
	300	write(,) NF_STRERROR(ierr)
	301	stop 'lev'
	302	endif
[2191]	303
	304	ierr=NF_INQ_VARID(nid,"pp",var3didin(2))
	305	if(ierr/=NF_NOERR) then
	306	write(,) NF_STRERROR(ierr)
	307	stop 'plev'
	308	endif
[2118]	309
	310
[2191]	311	ierr=NF_INQ_VARID(nid,"temp",var3didin(3))
[2118]	312	if(ierr/=NF_NOERR) then
	313	write(,) NF_STRERROR(ierr)
	314	stop 'temp'
	315	endif
	316
[2191]	317	ierr=NF_INQ_VARID(nid,"qv",var3didin(4))
[2118]	318	if(ierr/=NF_NOERR) then
	319	write(,) NF_STRERROR(ierr)
	320	stop 'qv'
	321	endif
	322
[2191]	323	ierr=NF_INQ_VARID(nid,"rh",var3didin(5))
[2118]	324	if(ierr/=NF_NOERR) then
	325	write(,) NF_STRERROR(ierr)
[2191]	326	stop 'rh'
	327	endif
	328
	329	ierr=NF_INQ_VARID(nid,"theta",var3didin(6))
	330	if(ierr/=NF_NOERR) then
	331	write(,) NF_STRERROR(ierr)
	332	stop 'theta'
	333	endif
	334
	335	ierr=NF_INQ_VARID(nid,"rv",var3didin(7))
	336	if(ierr/=NF_NOERR) then
	337	write(,) NF_STRERROR(ierr)
	338	stop 'rv'
	339	endif
	340
	341
	342	ierr=NF_INQ_VARID(nid,"u",var3didin(8))
	343	if(ierr/=NF_NOERR) then
	344	write(,) NF_STRERROR(ierr)
[2118]	345	stop 'u'
	346	endif
	347
[2191]	348	ierr=NF_INQ_VARID(nid,"v",var3didin(9))
[2118]	349	if(ierr/=NF_NOERR) then
	350	write(,) NF_STRERROR(ierr)
	351	stop 'v'
	352	endif
	353
[2191]	354	ierr=NF_INQ_VARID(nid,"ug",var3didin(10))
[2118]	355	if(ierr/=NF_NOERR) then
	356	write(,) NF_STRERROR(ierr)
[2191]	357	stop 'ug'
[2118]	358	endif
	359
[2191]	360	ierr=NF_INQ_VARID(nid,"vg",var3didin(11))
[2118]	361	if(ierr/=NF_NOERR) then
	362	write(,) NF_STRERROR(ierr)
[2191]	363	stop 'vg'
[2118]	364	endif
	365
[2191]	366	ierr=NF_INQ_VARID(nid,"w",var3didin(12))
[2118]	367	if(ierr/=NF_NOERR) then
	368	write(,) NF_STRERROR(ierr)
[2191]	369	stop 'w'
[2118]	370	endif
[2191]	371
	372	ierr=NF_INQ_VARID(nid,"advu",var3didin(13))
	373	if(ierr/=NF_NOERR) then
	374	write(,) NF_STRERROR(ierr)
	375	stop 'advu'
	376	endif
	377
	378	ierr=NF_INQ_VARID(nid,"hu",var3didin(14))
	379	if(ierr/=NF_NOERR) then
	380	write(,) NF_STRERROR(ierr)
	381	stop 'hu'
	382	endif
	383
	384	ierr=NF_INQ_VARID(nid,"vu",var3didin(15))
	385	if(ierr/=NF_NOERR) then
	386	write(,) NF_STRERROR(ierr)
	387	stop 'vu'
	388	endif
	389
	390	ierr=NF_INQ_VARID(nid,"advv",var3didin(16))
	391	if(ierr/=NF_NOERR) then
	392	write(,) NF_STRERROR(ierr)
	393	stop 'advv'
	394	endif
	395
	396	ierr=NF_INQ_VARID(nid,"hv",var3didin(17))
	397	if(ierr/=NF_NOERR) then
	398	write(,) NF_STRERROR(ierr)
	399	stop 'hv'
	400	endif
	401
	402	ierr=NF_INQ_VARID(nid,"vv",var3didin(18))
	403	if(ierr/=NF_NOERR) then
	404	write(,) NF_STRERROR(ierr)
	405	stop 'vv'
	406	endif
	407
	408	ierr=NF_INQ_VARID(nid,"advT",var3didin(19))
	409	if(ierr/=NF_NOERR) then
	410	write(,) NF_STRERROR(ierr)
	411	stop 'advT'
	412	endif
	413
	414	ierr=NF_INQ_VARID(nid,"hT",var3didin(20))
	415	if(ierr/=NF_NOERR) then
	416	write(,) NF_STRERROR(ierr)
	417	stop 'hT'
	418	endif
	419
	420	ierr=NF_INQ_VARID(nid,"vT",var3didin(21))
	421	if(ierr/=NF_NOERR) then
	422	write(,) NF_STRERROR(ierr)
	423	stop 'vT'
	424	endif
	425
	426	ierr=NF_INQ_VARID(nid,"advq",var3didin(22))
	427	if(ierr/=NF_NOERR) then
	428	write(,) NF_STRERROR(ierr)
	429	stop 'advq'
	430	endif
[2118]	431
[2191]	432	ierr=NF_INQ_VARID(nid,"hq",var3didin(23))
[2118]	433	if(ierr/=NF_NOERR) then
	434	write(,) NF_STRERROR(ierr)
[2191]	435	stop 'hq'
	436	endif
	437
	438	ierr=NF_INQ_VARID(nid,"vq",var3didin(24))
	439	if(ierr/=NF_NOERR) then
	440	write(,) NF_STRERROR(ierr)
	441	stop 'vq'
	442	endif
	443
	444	ierr=NF_INQ_VARID(nid,"advth",var3didin(25))
	445	if(ierr/=NF_NOERR) then
	446	write(,) NF_STRERROR(ierr)
	447	stop 'advth'
	448	endif
	449
	450	ierr=NF_INQ_VARID(nid,"hth",var3didin(26))
	451	if(ierr/=NF_NOERR) then
	452	write(,) NF_STRERROR(ierr)
	453	stop 'hth'
	454	endif
	455
	456	ierr=NF_INQ_VARID(nid,"vth",var3didin(27))
	457	if(ierr/=NF_NOERR) then
	458	write(,) NF_STRERROR(ierr)
	459	stop 'vth'
	460	endif
	461
	462	ierr=NF_INQ_VARID(nid,"advr",var3didin(28))
	463	if(ierr/=NF_NOERR) then
	464	write(,) NF_STRERROR(ierr)
	465	stop 'advr'
	466	endif
	467
	468	ierr=NF_INQ_VARID(nid,"hr",var3didin(29))
	469	if(ierr/=NF_NOERR) then
	470	write(,) NF_STRERROR(ierr)
	471	stop 'hr'
	472	endif
	473
	474	ierr=NF_INQ_VARID(nid,"vr",var3didin(30))
	475	if(ierr/=NF_NOERR) then
	476	write(,) NF_STRERROR(ierr)
	477	stop 'vr'
	478	endif
	479
	480	ierr=NF_INQ_VARID(nid,"radT",var3didin(31))
	481	if(ierr/=NF_NOERR) then
	482	write(,) NF_STRERROR(ierr)
	483	stop 'radT'
	484	endif
	485
	486	ierr=NF_INQ_VARID(nid,"sens",var3didin(32))
	487	if(ierr/=NF_NOERR) then
	488	write(,) NF_STRERROR(ierr)
[2118]	489	stop 'sens'
	490	endif
	491
[2191]	492	ierr=NF_INQ_VARID(nid,"flat",var3didin(33))
[2118]	493	if(ierr/=NF_NOERR) then
	494	write(,) NF_STRERROR(ierr)
	495	stop 'flat'
	496	endif
	497
[2191]	498	ierr=NF_INQ_VARID(nid,"ts",var3didin(34))
[2118]	499	if(ierr/=NF_NOERR) then
	500	write(,) NF_STRERROR(ierr)
[2191]	501	stop 'ts'
	502	endif
[2307]	503
	504	ierr=NF_INQ_VARID(nid,"ustar",var3didin(35))
	505	if(ierr/=NF_NOERR) then
	506	write(,) NF_STRERROR(ierr)
	507	stop 'ustar'
	508	endif
[2332]	509
	510	ierr=NF_INQ_VARID(nid,"uw",var3didin(36))
	511	if(ierr/=NF_NOERR) then
	512	write(,) NF_STRERROR(ierr)
	513	stop 'uw'
	514	endif
	515
	516	ierr=NF_INQ_VARID(nid,"vw",var3didin(37))
	517	if(ierr/=NF_NOERR) then
	518	write(,) NF_STRERROR(ierr)
	519	stop 'vw'
	520	endif
	521
	522	ierr=NF_INQ_VARID(nid,"q1",var3didin(38))
	523	if(ierr/=NF_NOERR) then
	524	write(,) NF_STRERROR(ierr)
	525	stop 'q1'
	526	endif
	527
	528	ierr=NF_INQ_VARID(nid,"q2",var3didin(39))
	529	if(ierr/=NF_NOERR) then
	530	write(,) NF_STRERROR(ierr)
	531	stop 'q2'
	532	endif
[2118]	533
	534	#ifdef NC_DOUBLE
	535	ierr = NF_GET_VAR_DOUBLE(nid,var3didin(1),zz)
	536	#else
	537	ierr = NF_GET_VAR_REAL(nid,var3didin(1),zz)
	538	#endif
	539	if(ierr/=NF_NOERR) then
	540	write(,) NF_STRERROR(ierr)
	541	stop "getvarup"
	542	endif
	543	! write(,)'lecture z ok',zz
	544
	545	#ifdef NC_DOUBLE
[2191]	546	ierr = NF_GET_VAR_DOUBLE(nid,var3didin(2),pp)
[2118]	547	#else
[2191]	548	ierr = NF_GET_VAR_REAL(nid,var3didin(2),pp)
[2118]	549	#endif
	550	if(ierr/=NF_NOERR) then
	551	write(,) NF_STRERROR(ierr)
	552	stop "getvarup"
	553	endif
[2191]	554	! write(,)'lecture pp ok',pp
[2118]	555
[2191]	556
[2118]	557	#ifdef NC_DOUBLE
[2191]	558	ierr = NF_GET_VAR_DOUBLE(nid,var3didin(3),temp)
[2118]	559	#else
[2191]	560	ierr = NF_GET_VAR_REAL(nid,var3didin(3),temp)
[2118]	561	#endif
	562	if(ierr/=NF_NOERR) then
	563	write(,) NF_STRERROR(ierr)
	564	stop "getvarup"
	565	endif
[2191]	566	! write(,)'lecture T ok',temp
	567
	568	#ifdef NC_DOUBLE
	569	ierr = NF_GET_VAR_DOUBLE(nid,var3didin(4),qv)
	570	#else
	571	ierr = NF_GET_VAR_REAL(nid,var3didin(4),qv)
	572	#endif
	573	if(ierr/=NF_NOERR) then
	574	write(,) NF_STRERROR(ierr)
	575	stop "getvarup"
	576	endif
[2118]	577	! write(,)'lecture qv ok',qv
	578
	579	#ifdef NC_DOUBLE
[2191]	580	ierr = NF_GET_VAR_DOUBLE(nid,var3didin(5),rh)
[2118]	581	#else
[2191]	582	ierr = NF_GET_VAR_REAL(nid,var3didin(5),rh)
[2118]	583	#endif
	584	if(ierr/=NF_NOERR) then
	585	write(,) NF_STRERROR(ierr)
	586	stop "getvarup"
	587	endif
[2191]	588	! write(,)'lecture rh ok',rh
	589
	590	#ifdef NC_DOUBLE
	591	ierr = NF_GET_VAR_DOUBLE(nid,var3didin(6),theta)
	592	#else
	593	ierr = NF_GET_VAR_REAL(nid,var3didin(6),theta)
	594	#endif
	595	if(ierr/=NF_NOERR) then
	596	write(,) NF_STRERROR(ierr)
	597	stop "getvarup"
	598	endif
	599	! write(,)'lecture theta ok',theta
	600
	601	#ifdef NC_DOUBLE
	602	ierr = NF_GET_VAR_DOUBLE(nid,var3didin(7),rv)
	603	#else
	604	ierr = NF_GET_VAR_REAL(nid,var3didin(7),rv)
	605	#endif
	606	if(ierr/=NF_NOERR) then
	607	write(,) NF_STRERROR(ierr)
	608	stop "getvarup"
	609	endif
	610	! write(,)'lecture rv ok',rv
	611
	612	#ifdef NC_DOUBLE
	613	ierr = NF_GET_VAR_DOUBLE(nid,var3didin(8),u)
	614	#else
	615	ierr = NF_GET_VAR_REAL(nid,var3didin(8),u)
	616	#endif
	617	if(ierr/=NF_NOERR) then
	618	write(,) NF_STRERROR(ierr)
	619	stop "getvarup"
	620	endif
[2118]	621	! write(,)'lecture u ok',u
	622
	623	#ifdef NC_DOUBLE
[2191]	624	ierr = NF_GET_VAR_DOUBLE(nid,var3didin(9),v)
[2118]	625	#else
[2191]	626	ierr = NF_GET_VAR_REAL(nid,var3didin(9),v)
[2118]	627	#endif
	628	if(ierr/=NF_NOERR) then
	629	write(,) NF_STRERROR(ierr)
	630	stop "getvarup"
	631	endif
	632	! write(,)'lecture v ok',v
	633
	634	#ifdef NC_DOUBLE
[2191]	635	ierr = NF_GET_VAR_DOUBLE(nid,var3didin(10),ug)
[2118]	636	#else
[2191]	637	ierr = NF_GET_VAR_REAL(nid,var3didin(10),ug)
[2118]	638	#endif
	639	if(ierr/=NF_NOERR) then
	640	write(,) NF_STRERROR(ierr)
	641	stop "getvarup"
	642	endif
[2191]	643	! write(,)'lecture ug ok',ug
[2118]	644
	645	#ifdef NC_DOUBLE
[2191]	646	ierr = NF_GET_VAR_DOUBLE(nid,var3didin(11),vg)
[2118]	647	#else
[2191]	648	ierr = NF_GET_VAR_REAL(nid,var3didin(11),vg)
[2118]	649	#endif
	650	if(ierr/=NF_NOERR) then
	651	write(,) NF_STRERROR(ierr)
	652	stop "getvarup"
	653	endif
[2191]	654	! write(,)'lecture vg ok',vg
	655
	656	#ifdef NC_DOUBLE
	657	ierr = NF_GET_VAR_DOUBLE(nid,var3didin(12),w)
	658	#else
	659	ierr = NF_GET_VAR_REAL(nid,var3didin(12),w)
	660	#endif
	661	if(ierr/=NF_NOERR) then
	662	write(,) NF_STRERROR(ierr)
	663	stop "getvarup"
	664	endif
	665	! write(,)'lecture w ok',w
	666
	667	#ifdef NC_DOUBLE
	668	ierr = NF_GET_VAR_DOUBLE(nid,var3didin(13),du)
	669	#else
	670	ierr = NF_GET_VAR_REAL(nid,var3didin(13),du)
	671	#endif
	672	if(ierr/=NF_NOERR) then
	673	write(,) NF_STRERROR(ierr)
	674	stop "getvarup"
	675	endif
	676	! write(,)'lecture du ok',du
	677
	678	#ifdef NC_DOUBLE
	679	ierr = NF_GET_VAR_DOUBLE(nid,var3didin(14),hu)
	680	#else
	681	ierr = NF_GET_VAR_REAL(nid,var3didin(14),hu)
	682	#endif
	683	if(ierr/=NF_NOERR) then
	684	write(,) NF_STRERROR(ierr)
	685	stop "getvarup"
	686	endif
	687	! write(,)'lecture hu ok',hu
	688
	689	#ifdef NC_DOUBLE
	690	ierr = NF_GET_VAR_DOUBLE(nid,var3didin(15),vu)
	691	#else
	692	ierr = NF_GET_VAR_REAL(nid,var3didin(15),vu)
	693	#endif
	694	if(ierr/=NF_NOERR) then
	695	write(,) NF_STRERROR(ierr)
	696	stop "getvarup"
	697	endif
	698	! write(,)'lecture vu ok',vu
	699
	700	#ifdef NC_DOUBLE
	701	ierr = NF_GET_VAR_DOUBLE(nid,var3didin(16),dv)
	702	#else
	703	ierr = NF_GET_VAR_REAL(nid,var3didin(16),dv)
	704	#endif
	705	if(ierr/=NF_NOERR) then
	706	write(,) NF_STRERROR(ierr)
	707	stop "getvarup"
	708	endif
	709	! write(,)'lecture dv ok',dv
	710
	711	#ifdef NC_DOUBLE
	712	ierr = NF_GET_VAR_DOUBLE(nid,var3didin(17),hv)
	713	#else
	714	ierr = NF_GET_VAR_REAL(nid,var3didin(17),hv)
	715	#endif
	716	if(ierr/=NF_NOERR) then
	717	write(,) NF_STRERROR(ierr)
	718	stop "getvarup"
	719	endif
	720	! write(,)'lecture hv ok',hv
	721
	722	#ifdef NC_DOUBLE
	723	ierr = NF_GET_VAR_DOUBLE(nid,var3didin(18),vv)
	724	#else
	725	ierr = NF_GET_VAR_REAL(nid,var3didin(18),vv)
	726	#endif
	727	if(ierr/=NF_NOERR) then
	728	write(,) NF_STRERROR(ierr)
	729	stop "getvarup"
	730	endif
	731	! write(,)'lecture vv ok',vv
	732
	733	#ifdef NC_DOUBLE
	734	ierr = NF_GET_VAR_DOUBLE(nid,var3didin(19),dt)
	735	#else
	736	ierr = NF_GET_VAR_REAL(nid,var3didin(19),dt)
	737	#endif
	738	if(ierr/=NF_NOERR) then
	739	write(,) NF_STRERROR(ierr)
	740	stop "getvarup"
	741	endif
[2118]	742	! write(,)'lecture dt ok',dt
	743
	744	#ifdef NC_DOUBLE
[2191]	745	ierr = NF_GET_VAR_DOUBLE(nid,var3didin(20),ht)
[2118]	746	#else
[2191]	747	ierr = NF_GET_VAR_REAL(nid,var3didin(20),ht)
[2118]	748	#endif
	749	if(ierr/=NF_NOERR) then
	750	write(,) NF_STRERROR(ierr)
	751	stop "getvarup"
	752	endif
[2191]	753	! write(,)'lecture ht ok',ht
	754
	755	#ifdef NC_DOUBLE
	756	ierr = NF_GET_VAR_DOUBLE(nid,var3didin(21),vt)
	757	#else
	758	ierr = NF_GET_VAR_REAL(nid,var3didin(21),vt)
	759	#endif
	760	if(ierr/=NF_NOERR) then
	761	write(,) NF_STRERROR(ierr)
	762	stop "getvarup"
	763	endif
	764	! write(,)'lecture vt ok',vt
	765
	766	#ifdef NC_DOUBLE
	767	ierr = NF_GET_VAR_DOUBLE(nid,var3didin(22),dq)
	768	#else
	769	ierr = NF_GET_VAR_REAL(nid,var3didin(22),dq)
	770	#endif
	771	if(ierr/=NF_NOERR) then
	772	write(,) NF_STRERROR(ierr)
	773	stop "getvarup"
	774	endif
[2118]	775	! write(,)'lecture dq ok',dq
	776
	777	#ifdef NC_DOUBLE
[2191]	778	ierr = NF_GET_VAR_DOUBLE(nid,var3didin(23),hq)
[2118]	779	#else
[2191]	780	ierr = NF_GET_VAR_REAL(nid,var3didin(23),hq)
[2118]	781	#endif
	782	if(ierr/=NF_NOERR) then
	783	write(,) NF_STRERROR(ierr)
	784	stop "getvarup"
	785	endif
[2191]	786	! write(,)'lecture hq ok',hq
	787
	788	#ifdef NC_DOUBLE
	789	ierr = NF_GET_VAR_DOUBLE(nid,var3didin(24),vq)
	790	#else
	791	ierr = NF_GET_VAR_REAL(nid,var3didin(24),vq)
	792	#endif
	793	if(ierr/=NF_NOERR) then
	794	write(,) NF_STRERROR(ierr)
	795	stop "getvarup"
	796	endif
	797	! write(,)'lecture vq ok',vq
	798
	799	#ifdef NC_DOUBLE
	800	ierr = NF_GET_VAR_DOUBLE(nid,var3didin(25),dth)
	801	#else
	802	ierr = NF_GET_VAR_REAL(nid,var3didin(25),dth)
	803	#endif
	804	if(ierr/=NF_NOERR) then
	805	write(,) NF_STRERROR(ierr)
	806	stop "getvarup"
	807	endif
	808	! write(,)'lecture dth ok',dth
	809
	810	#ifdef NC_DOUBLE
	811	ierr = NF_GET_VAR_DOUBLE(nid,var3didin(26),hth)
	812	#else
	813	ierr = NF_GET_VAR_REAL(nid,var3didin(26),hth)
	814	#endif
	815	if(ierr/=NF_NOERR) then
	816	write(,) NF_STRERROR(ierr)
	817	stop "getvarup"
	818	endif
	819	! write(,)'lecture hth ok',hth
	820
	821	#ifdef NC_DOUBLE
	822	ierr = NF_GET_VAR_DOUBLE(nid,var3didin(27),vth)
	823	#else
	824	ierr = NF_GET_VAR_REAL(nid,var3didin(27),vth)
	825	#endif
	826	if(ierr/=NF_NOERR) then
	827	write(,) NF_STRERROR(ierr)
	828	stop "getvarup"
	829	endif
	830	! write(,)'lecture vth ok',vth
	831
	832	#ifdef NC_DOUBLE
	833	ierr = NF_GET_VAR_DOUBLE(nid,var3didin(28),dr)
	834	#else
	835	ierr = NF_GET_VAR_REAL(nid,var3didin(28),dr)
	836	#endif
	837	if(ierr/=NF_NOERR) then
	838	write(,) NF_STRERROR(ierr)
	839	stop "getvarup"
	840	endif
	841	! write(,)'lecture dr ok',dr
	842
	843	#ifdef NC_DOUBLE
	844	ierr = NF_GET_VAR_DOUBLE(nid,var3didin(29),hr)
	845	#else
	846	ierr = NF_GET_VAR_REAL(nid,var3didin(29),hr)
	847	#endif
	848	if(ierr/=NF_NOERR) then
	849	write(,) NF_STRERROR(ierr)
	850	stop "getvarup"
	851	endif
	852	! write(,)'lecture hr ok',hr
	853
	854	#ifdef NC_DOUBLE
	855	ierr = NF_GET_VAR_DOUBLE(nid,var3didin(30),vr)
	856	#else
	857	ierr = NF_GET_VAR_REAL(nid,var3didin(30),vr)
	858	#endif
	859	if(ierr/=NF_NOERR) then
	860	write(,) NF_STRERROR(ierr)
	861	stop "getvarup"
	862	endif
	863	! write(,)'lecture vr ok',vr
	864
	865	#ifdef NC_DOUBLE
	866	ierr = NF_GET_VAR_DOUBLE(nid,var3didin(31),dtrad)
	867	#else
	868	ierr = NF_GET_VAR_REAL(nid,var3didin(31),dtrad)
	869	#endif
	870	if(ierr/=NF_NOERR) then
	871	write(,) NF_STRERROR(ierr)
	872	stop "getvarup"
	873	endif
	874	! write(,)'lecture dtrad ok',dtrad
	875
	876	#ifdef NC_DOUBLE
	877	ierr = NF_GET_VAR_DOUBLE(nid,var3didin(32),sens)
	878	#else
	879	ierr = NF_GET_VAR_REAL(nid,var3didin(32),sens)
	880	#endif
	881	if(ierr/=NF_NOERR) then
	882	write(,) NF_STRERROR(ierr)
	883	stop "getvarup"
	884	endif
[2118]	885	! write(,)'lecture sens ok',sens
	886
	887	#ifdef NC_DOUBLE
[2191]	888	ierr = NF_GET_VAR_DOUBLE(nid,var3didin(33),flat)
[2118]	889	#else
[2191]	890	ierr = NF_GET_VAR_REAL(nid,var3didin(33),flat)
[2118]	891	#endif
	892	if(ierr/=NF_NOERR) then
	893	write(,) NF_STRERROR(ierr)
	894	stop "getvarup"
	895	endif
	896	! write(,)'lecture flat ok',flat
	897
	898	#ifdef NC_DOUBLE
[2191]	899	ierr = NF_GET_VAR_DOUBLE(nid,var3didin(34),ts)
[2118]	900	#else
[2191]	901	ierr = NF_GET_VAR_REAL(nid,var3didin(34),ts)
[2118]	902	#endif
	903	if(ierr/=NF_NOERR) then
	904	write(,) NF_STRERROR(ierr)
	905	stop "getvarup"
	906	endif
[2191]	907	! write(,)'lecture ts ok',ts
[2118]	908
[2307]	909	#ifdef NC_DOUBLE
	910	ierr = NF_GET_VAR_DOUBLE(nid,var3didin(35),ustar)
	911	#else
	912	ierr = NF_GET_VAR_REAL(nid,var3didin(35),ustar)
	913	#endif
	914	if(ierr/=NF_NOERR) then
	915	write(,) NF_STRERROR(ierr)
	916	stop "getvarup"
	917	endif
	918	! write(,)'lecture ustar ok',ustar
	919
[2332]	920	#ifdef NC_DOUBLE
	921	ierr = NF_GET_VAR_DOUBLE(nid,var3didin(36),uw)
	922	#else
	923	ierr = NF_GET_VAR_REAL(nid,var3didin(36),uw)
	924	#endif
	925	if(ierr/=NF_NOERR) then
	926	write(,) NF_STRERROR(ierr)
	927	stop "getvarup"
	928	endif
	929	! write(,)'lecture uw ok',uw
[2307]	930
[2332]	931	#ifdef NC_DOUBLE
	932	ierr = NF_GET_VAR_DOUBLE(nid,var3didin(37),vw)
	933	#else
	934	ierr = NF_GET_VAR_REAL(nid,var3didin(37),vw)
	935	#endif
	936	if(ierr/=NF_NOERR) then
	937	write(,) NF_STRERROR(ierr)
	938	stop "getvarup"
	939	endif
	940	! write(,)'lecture vw ok',vw
	941
	942	#ifdef NC_DOUBLE
	943	ierr = NF_GET_VAR_DOUBLE(nid,var3didin(38),q1)
	944	#else
	945	ierr = NF_GET_VAR_REAL(nid,var3didin(38),q1)
	946	#endif
	947	if(ierr/=NF_NOERR) then
	948	write(,) NF_STRERROR(ierr)
	949	stop "getvarup"
	950	endif
	951	! write(,)'lecture q1 ok',q1
	952
	953	#ifdef NC_DOUBLE
	954	ierr = NF_GET_VAR_DOUBLE(nid,var3didin(39),q2)
	955	#else
	956	ierr = NF_GET_VAR_REAL(nid,var3didin(39),q2)
	957	#endif
	958	if(ierr/=NF_NOERR) then
	959	write(,) NF_STRERROR(ierr)
	960	stop "getvarup"
	961	endif
	962	! write(,)'lecture q2 ok',q2
	963
	964
[2118]	965	return
[2191]	966	end subroutine read_cas
[2118]	967	!======================================================================
[2191]	968	SUBROUTINE interp_case_time(day,day1,annee_ref &
[2332]	969	! & ,year_cas,day_cas,nt_cas,pdt_forc,nlev_cas &
	970	& ,nt_cas,nlev_cas &
[2191]	971	& ,ts_cas,plev_cas,t_cas,q_cas,u_cas,v_cas &
	972	& ,ug_cas,vg_cas,vitw_cas,du_cas,hu_cas,vu_cas &
	973	& ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas &
[2307]	974	& ,dq_cas,hq_cas,vq_cas,lat_cas,sens_cas,ustar_cas &
[2332]	975	& ,uw_cas,vw_cas,q1_cas,q2_cas &
[2191]	976	& ,ts_prof_cas,plev_prof_cas,t_prof_cas,q_prof_cas &
	977	& ,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas &
	978	& ,vitw_prof_cas,du_prof_cas,hu_prof_cas,vu_prof_cas &
	979	& ,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas &
	980	& ,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas &
[2332]	981	& ,hq_prof_cas,vq_prof_cas,lat_prof_cas,sens_prof_cas &
	982	& ,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas)
[2191]	983
	984
[2118]	985	implicit none
	986
	987	!---------------------------------------------------------------------------------------
	988	! Time interpolation of a 2D field to the timestep corresponding to day
	989	!
	990	! day: current julian day (e.g. 717538.2)
	991	! day1: first day of the simulation
[2191]	992	! nt_cas: total nb of data in the forcing
	993	! pdt_cas: total time interval (in sec) between 2 forcing data
[2118]	994	!---------------------------------------------------------------------------------------
	995
	996	#include "compar1d.h"
[2332]	997	#include "date_cas.h"
[2118]	998
	999	! inputs:
	1000	integer annee_ref
[2191]	1001	integer nt_cas,nlev_cas
[2332]	1002	real day, day1,day_cas
[2191]	1003	real ts_cas(nt_cas)
	1004	real plev_cas(nlev_cas,nt_cas)
	1005	real t_cas(nlev_cas,nt_cas),q_cas(nlev_cas,nt_cas)
	1006	real u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas)
	1007	real ug_cas(nlev_cas,nt_cas),vg_cas(nlev_cas,nt_cas)
	1008	real vitw_cas(nlev_cas,nt_cas)
	1009	real du_cas(nlev_cas,nt_cas),hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas)
	1010	real dv_cas(nlev_cas,nt_cas),hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas)
	1011	real dt_cas(nlev_cas,nt_cas),ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas)
	1012	real dtrad_cas(nlev_cas,nt_cas)
	1013	real dq_cas(nlev_cas,nt_cas),hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas)
	1014	real lat_cas(nt_cas)
	1015	real sens_cas(nt_cas)
[2332]	1016	real ustar_cas(nt_cas),uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas)
	1017	real q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas)
[2191]	1018
[2118]	1019	! outputs:
[2191]	1020	real plev_prof_cas(nlev_cas)
	1021	real t_prof_cas(nlev_cas),q_prof_cas(nlev_cas)
	1022	real u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
	1023	real ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas)
	1024	real vitw_prof_cas(nlev_cas)
	1025	real du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
	1026	real dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
	1027	real dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas)
	1028	real dtrad_prof_cas(nlev_cas)
	1029	real dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
[2307]	1030	real lat_prof_cas,sens_prof_cas,ts_prof_cas,ustar_prof_cas
[2332]	1031	real uw_prof_cas(nlev_cas),vw_prof_cas(nlev_cas),q1_prof_cas(nlev_cas),q2_prof_cas(nlev_cas)
[2118]	1032	! local:
[2191]	1033	integer it_cas1, it_cas2,k
	1034	real timeit,time_cas1,time_cas2,frac
[2118]	1035
	1036
[2332]	1037	print*,'Check time',day1,day_ju_ini_cas,day_deb+1,pdt_cas
[2191]	1038
[2310]	1039	! On teste si la date du cas AMMA est correcte.
	1040	! C est pour memoire car en fait les fichiers .def
	1041	! sont censes etre corrects.
	1042	! A supprimer a terme (MPL 20150623)
[2332]	1043	! if ((forcing_type.eq.10).and.(1.eq.0)) then
[2118]	1044	! Check that initial day of the simulation consistent with AMMA case:
[2332]	1045	! if (annee_ref.ne.2006) then
	1046	! print*,'Pour AMMA, annee_ref doit etre 2006'
	1047	! print*,'Changer annee_ref dans run.def'
	1048	! stop
	1049	! endif
	1050	! if (annee_ref.eq.2006 .and. day1.lt.day_cas) then
	1051	! print*,'AMMA a debute le 10 juillet 2006',day1,day_cas
	1052	! print*,'Changer dayref dans run.def'
	1053	! stop
	1054	! endif
	1055	! if (annee_ref.eq.2006 .and. day1.gt.day_cas+1) then
	1056	! print*,'AMMA a fini le 11 juillet'
	1057	! print*,'Changer dayref ou nday dans run.def'
	1058	! stop
	1059	! endif
	1060	! endif
[2118]	1061
[2191]	1062	! Determine timestep relative to the 1st day:
[2118]	1063	! timeit=(day-day1)*86400.
	1064	! if (annee_ref.eq.1992) then
[2332]	1065	! timeit=(day-day_cas)*86400.
[2118]	1066	! else
	1067	! timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992
	1068	! endif
[2332]	1069	timeit=(day-day_ju_ini_cas)*86400
	1070	print *,'day=',day
	1071	print *,'day_ju_ini_cas=',day_ju_ini_cas
	1072	print *,'pdt_cas=',pdt_cas
	1073	print *,'timeit=',timeit
	1074	print *,'nt_cas=',nt_cas
[2118]	1075
	1076	! Determine the closest observation times:
[2191]	1077	! it_cas1=INT(timeit/pdt_cas)+1
	1078	! it_cas2=it_cas1 + 1
	1079	! time_cas1=(it_cas1-1)*pdt_cas
	1080	! time_cas2=(it_cas2-1)*pdt_cas
[2118]	1081
[2191]	1082	it_cas1=INT(timeit/pdt_cas)+1
	1083	IF (it_cas1 .EQ. nt_cas) THEN
	1084	it_cas2=it_cas1
[2118]	1085	ELSE
[2191]	1086	it_cas2=it_cas1 + 1
[2118]	1087	ENDIF
[2191]	1088	time_cas1=(it_cas1-1)*pdt_cas
	1089	time_cas2=(it_cas2-1)*pdt_cas
[2332]	1090	print *,'it_cas1=',it_cas1
	1091	print *,'it_cas2=',it_cas2
	1092	print *,'time_cas1=',time_cas1
	1093	print *,'time_cas2=',time_cas2
[2118]	1094
[2191]	1095	if (it_cas1 .gt. nt_cas) then
[2332]	1096	write(,) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: ' &
	1097	& ,day,day_ju_ini_cas,it_cas1,it_cas2,timeit
[2118]	1098	stop
	1099	endif
	1100
	1101	! time interpolation:
[2373]	1102	IF (it_cas1 .EQ. it_cas2) THEN
	1103	frac=0.
	1104	ELSE
	1105	frac=(time_cas2-timeit)/(time_cas2-time_cas1)
	1106	frac=max(frac,0.0)
	1107	ENDIF
[2118]	1108
[2191]	1109	lat_prof_cas = lat_cas(it_cas2) &
	1110	& -frac*(lat_cas(it_cas2)-lat_cas(it_cas1))
	1111	sens_prof_cas = sens_cas(it_cas2) &
	1112	& -frac*(sens_cas(it_cas2)-sens_cas(it_cas1))
[2307]	1113	ts_prof_cas = ts_cas(it_cas2) &
[2191]	1114	& -frac*(ts_cas(it_cas2)-ts_cas(it_cas1))
[2307]	1115	ustar_prof_cas = ustar_cas(it_cas2) &
	1116	& -frac*(ustar_cas(it_cas2)-ustar_cas(it_cas1))
[2118]	1117
[2191]	1118	do k=1,nlev_cas
	1119	plev_prof_cas(k) = plev_cas(k,it_cas2) &
	1120	& -frac*(plev_cas(k,it_cas2)-plev_cas(k,it_cas1))
	1121	t_prof_cas(k) = t_cas(k,it_cas2) &
	1122	& -frac*(t_cas(k,it_cas2)-t_cas(k,it_cas1))
	1123	q_prof_cas(k) = q_cas(k,it_cas2) &
	1124	& -frac*(q_cas(k,it_cas2)-q_cas(k,it_cas1))
	1125	u_prof_cas(k) = u_cas(k,it_cas2) &
	1126	& -frac*(u_cas(k,it_cas2)-u_cas(k,it_cas1))
	1127	v_prof_cas(k) = v_cas(k,it_cas2) &
	1128	& -frac*(v_cas(k,it_cas2)-v_cas(k,it_cas1))
	1129	ug_prof_cas(k) = ug_cas(k,it_cas2) &
	1130	& -frac*(ug_cas(k,it_cas2)-ug_cas(k,it_cas1))
	1131	vg_prof_cas(k) = vg_cas(k,it_cas2) &
	1132	& -frac*(vg_cas(k,it_cas2)-vg_cas(k,it_cas1))
	1133	vitw_prof_cas(k) = vitw_cas(k,it_cas2) &
	1134	& -frac*(vitw_cas(k,it_cas2)-vitw_cas(k,it_cas1))
	1135	du_prof_cas(k) = du_cas(k,it_cas2) &
	1136	& -frac*(du_cas(k,it_cas2)-du_cas(k,it_cas1))
	1137	hu_prof_cas(k) = hu_cas(k,it_cas2) &
	1138	& -frac*(hu_cas(k,it_cas2)-hu_cas(k,it_cas1))
	1139	vu_prof_cas(k) = vu_cas(k,it_cas2) &
	1140	& -frac*(vu_cas(k,it_cas2)-vu_cas(k,it_cas1))
	1141	dv_prof_cas(k) = dv_cas(k,it_cas2) &
	1142	& -frac*(dv_cas(k,it_cas2)-dv_cas(k,it_cas1))
	1143	hv_prof_cas(k) = hv_cas(k,it_cas2) &
	1144	& -frac*(hv_cas(k,it_cas2)-hv_cas(k,it_cas1))
	1145	vv_prof_cas(k) = vv_cas(k,it_cas2) &
	1146	& -frac*(vv_cas(k,it_cas2)-vv_cas(k,it_cas1))
	1147	dt_prof_cas(k) = dt_cas(k,it_cas2) &
	1148	& -frac*(dt_cas(k,it_cas2)-dt_cas(k,it_cas1))
	1149	ht_prof_cas(k) = ht_cas(k,it_cas2) &
	1150	& -frac*(ht_cas(k,it_cas2)-ht_cas(k,it_cas1))
	1151	vt_prof_cas(k) = vt_cas(k,it_cas2) &
	1152	& -frac*(vt_cas(k,it_cas2)-vt_cas(k,it_cas1))
	1153	dtrad_prof_cas(k) = dtrad_cas(k,it_cas2) &
	1154	& -frac*(dtrad_cas(k,it_cas2)-dtrad_cas(k,it_cas1))
	1155	dq_prof_cas(k) = dq_cas(k,it_cas2) &
	1156	& -frac*(dq_cas(k,it_cas2)-dq_cas(k,it_cas1))
	1157	hq_prof_cas(k) = hq_cas(k,it_cas2) &
	1158	& -frac*(hq_cas(k,it_cas2)-hq_cas(k,it_cas1))
	1159	vq_prof_cas(k) = vq_cas(k,it_cas2) &
	1160	& -frac*(vq_cas(k,it_cas2)-vq_cas(k,it_cas1))
[2332]	1161	uw_prof_cas(k) = uw_cas(k,it_cas2) &
	1162	& -frac*(uw_cas(k,it_cas2)-uw_cas(k,it_cas1))
	1163	vw_prof_cas(k) = vw_cas(k,it_cas2) &
	1164	& -frac*(vw_cas(k,it_cas2)-vw_cas(k,it_cas1))
	1165	q1_prof_cas(k) = q1_cas(k,it_cas2) &
	1166	& -frac*(q1_cas(k,it_cas2)-q1_cas(k,it_cas1))
	1167	q2_prof_cas(k) = q2_cas(k,it_cas2) &
	1168	& -frac*(q2_cas(k,it_cas2)-q2_cas(k,it_cas1))
[2118]	1169	enddo
	1170
	1171	return
	1172	END
	1173
[2191]	1174	!**********************************************************************************************

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

Download in other formats:

Original Format