Context Navigation

mod_1D_cases_read.F90 @ 2237

Last change on this file since 2237 was 2191, checked in by fhourdin, 10 years ago
Ajout du cas 1D CINDY-DYNAMO, utilisant le nouveau format standard, amené à être étendu aux autres cas. Addition of the CINDY-DYNAMO 1D case, using the new standard format for 1D cases, that will be extended to all 1D cases. Catherine Rio
File size: 33.7 KB

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

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

Download in other formats:

Original Format