Context Navigation

mod_1D_cases_read.F90 @ 5073

Last change on this file since 5073 was 5073, checked in by abarral, 7 weeks ago
Remove all NC_DOUBLE uses outside of lmdz_netcdf.F90 (except in obsolete/, which I hope we'll ditch soon...) Note: make sure to check convergence at some point, it's possible that we've messed up some when replacing nf_* by nf90_* calls (lint) replace obsolete logical operators along the way
Property svn:keywords set to `Id`
File size: 34.6 KB

Line
1	!
2	! $Id: mod_1D_cases_read.F90 5073 2024-07-18 14:57:05Z abarral $
3	!
4	MODULE mod_1D_cases_read
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	! 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
16	! parameter (year_ini_cas=2011)
17	! parameter (year_ini_cas=1969)
18	! parameter (mth_ini_cas=10)
19	! parameter (mth_ini_cas=6)
20	! parameter (day_ini_cas=1) ! 10 = 10Juil2006
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)
25
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.)
32
33	!profils environnementaux
34	real, allocatable:: plev_cas(:,:)
35
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(:,:)
41
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(:,:)
51	real, allocatable:: lat_cas(:),sens_cas(:),ts_cas(:),ustar_cas(:)
52	real, allocatable:: uw_cas(:,:),vw_cas(:,:),q1_cas(:,:),q2_cas(:,:)
53
54	!champs interpoles
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(:)
60
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(:)
77	real, allocatable:: uw_prof_cas(:)
78	real, allocatable:: vw_prof_cas(:)
79	real, allocatable:: q1_prof_cas(:)
80	real, allocatable:: q2_prof_cas(:)
81
82
83	real lat_prof_cas,sens_prof_cas,ts_prof_cas,ustar_prof_cas
84
85
86
87	CONTAINS
88
89	SUBROUTINE read_1D_cas
90	implicit none
91
92	INCLUDE "netcdf.inc"
93
94	INTEGER nid,rid,ierr
95	INTEGER ii,jj
96
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
101	if (ierr/=NF_NOERR) then
102	write(,) 'ERROR: GROS Pb opening forcings nc file '
103	write(,) NF_STRERROR(ierr)
104	stop ""
105	endif
106	!.......................................................................
107	ierr=NF_INQ_DIMID(nid,'lat',rid)
108	IF (ierr/=NF_NOERR) THEN
109	print*, 'Oh probleme lecture dimension lat'
110	ENDIF
111	ierr=NF_INQ_DIMLEN(nid,rid,ii)
112	print*,'OK1 nid,rid,lat',nid,rid,ii
113	!.......................................................................
114	ierr=NF_INQ_DIMID(nid,'lon',rid)
115	IF (ierr/=NF_NOERR) THEN
116	print*, 'Oh probleme lecture dimension lon'
117	ENDIF
118	ierr=NF_INQ_DIMLEN(nid,rid,jj)
119	print*,'OK2 nid,rid,lat',nid,rid,jj
120	!.......................................................................
121	ierr=NF_INQ_DIMID(nid,'lev',rid)
122	IF (ierr/=NF_NOERR) THEN
123	print*, 'Oh probleme lecture dimension zz'
124	ENDIF
125	ierr=NF_INQ_DIMLEN(nid,rid,nlev_cas)
126	print*,'OK3 nid,rid,nlev_cas',nid,rid,nlev_cas
127	!.......................................................................
128	ierr=NF_INQ_DIMID(nid,'time',rid)
129	print*,'nid,rid',nid,rid
130	nt_cas=0
131	IF (ierr/=NF_NOERR) THEN
132	stop 'probleme lecture dimension sens'
133	ENDIF
134	ierr=NF_INQ_DIMLEN(nid,rid,nt_cas)
135	print*,'OK4 nid,rid,nt_cas',nid,rid,nt_cas
136
137	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
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))
145
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))
156	allocate(lat_cas(nt_cas),sens_cas(nt_cas),ts_cas(nt_cas),ustar_cas(nt_cas))
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))
158
159
160	!champs interpoles
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))
166
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))
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))
187
188	print*,'Allocations OK'
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'
196
197
198	END SUBROUTINE read_1D_cas
199
200
201
202	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
203	SUBROUTINE deallocate_1D_cases
204	!profils environnementaux:
205	deallocate(plev_cas)
206
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)
212
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)
223	deallocate(lat_cas,sens_cas,ts_cas,ustar_cas,uw_cas,vw_cas,q1_cas,q2_cas)
224
225	!champs interpoles
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)
252	deallocate(uw_prof_cas)
253	deallocate(vw_prof_cas)
254	deallocate(q1_prof_cas)
255	deallocate(q2_prof_cas)
256
257	END SUBROUTINE deallocate_1D_cases
258
259
260	END MODULE mod_1D_cases_read
261	!=====================================================================
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, &
265	& dth,hth,vth,dr,hr,vr,sens,flat,ts,ustar,uw,vw,q1,q2)
266
267	!program reading forcing of the case study
268	implicit none
269	INCLUDE "netcdf.inc"
270
271	integer ntime,nlevel
272
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)
289	real flat(ntime),sens(ntime),ts(ntime),ustar(ntime)
290	real uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime)
291
292
293	integer nid, ierr,rid
294	integer nbvar3d
295	parameter(nbvar3d=39)
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
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
309
310
311	ierr=NF_INQ_VARID(nid,"temp",var3didin(3))
312	if(ierr/=NF_NOERR) then
313	write(,) NF_STRERROR(ierr)
314	stop 'temp'
315	endif
316
317	ierr=NF_INQ_VARID(nid,"qv",var3didin(4))
318	if(ierr/=NF_NOERR) then
319	write(,) NF_STRERROR(ierr)
320	stop 'qv'
321	endif
322
323	ierr=NF_INQ_VARID(nid,"rh",var3didin(5))
324	if(ierr/=NF_NOERR) then
325	write(,) NF_STRERROR(ierr)
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)
345	stop 'u'
346	endif
347
348	ierr=NF_INQ_VARID(nid,"v",var3didin(9))
349	if(ierr/=NF_NOERR) then
350	write(,) NF_STRERROR(ierr)
351	stop 'v'
352	endif
353
354	ierr=NF_INQ_VARID(nid,"ug",var3didin(10))
355	if(ierr/=NF_NOERR) then
356	write(,) NF_STRERROR(ierr)
357	stop 'ug'
358	endif
359
360	ierr=NF_INQ_VARID(nid,"vg",var3didin(11))
361	if(ierr/=NF_NOERR) then
362	write(,) NF_STRERROR(ierr)
363	stop 'vg'
364	endif
365
366	ierr=NF_INQ_VARID(nid,"w",var3didin(12))
367	if(ierr/=NF_NOERR) then
368	write(,) NF_STRERROR(ierr)
369	stop 'w'
370	endif
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
431
432	ierr=NF_INQ_VARID(nid,"hq",var3didin(23))
433	if(ierr/=NF_NOERR) then
434	write(,) NF_STRERROR(ierr)
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)
489	stop 'sens'
490	endif
491
492	ierr=NF_INQ_VARID(nid,"flat",var3didin(33))
493	if(ierr/=NF_NOERR) then
494	write(,) NF_STRERROR(ierr)
495	stop 'flat'
496	endif
497
498	ierr=NF_INQ_VARID(nid,"ts",var3didin(34))
499	if(ierr/=NF_NOERR) then
500	write(,) NF_STRERROR(ierr)
501	stop 'ts'
502	endif
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
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
533
534	ierr = nf90_get_var(nid,var3didin(1),zz)
535	if(ierr/=NF_NOERR) then
536	write(,) NF_STRERROR(ierr)
537	stop "getvarup"
538	endif
539	! write(,)'lecture z ok',zz
540
541	ierr = nf90_get_var(nid,var3didin(2),pp)
542	if(ierr/=NF_NOERR) then
543	write(,) NF_STRERROR(ierr)
544	stop "getvarup"
545	endif
546	! write(,)'lecture pp ok',pp
547
548
549	ierr = nf90_get_var(nid,var3didin(3),temp)
550	if(ierr/=NF_NOERR) then
551	write(,) NF_STRERROR(ierr)
552	stop "getvarup"
553	endif
554	! write(,)'lecture T ok',temp
555
556	ierr = nf90_get_var(nid,var3didin(4),qv)
557	if(ierr/=NF_NOERR) then
558	write(,) NF_STRERROR(ierr)
559	stop "getvarup"
560	endif
561	! write(,)'lecture qv ok',qv
562
563	ierr = nf90_get_var(nid,var3didin(5),rh)
564	if(ierr/=NF_NOERR) then
565	write(,) NF_STRERROR(ierr)
566	stop "getvarup"
567	endif
568	! write(,)'lecture rh ok',rh
569
570	ierr = nf90_get_var(nid,var3didin(6),theta)
571	if(ierr/=NF_NOERR) then
572	write(,) NF_STRERROR(ierr)
573	stop "getvarup"
574	endif
575	! write(,)'lecture theta ok',theta
576
577	ierr = nf90_get_var(nid,var3didin(7),rv)
578	if(ierr/=NF_NOERR) then
579	write(,) NF_STRERROR(ierr)
580	stop "getvarup"
581	endif
582	! write(,)'lecture rv ok',rv
583
584	ierr = nf90_get_var(nid,var3didin(8),u)
585	if(ierr/=NF_NOERR) then
586	write(,) NF_STRERROR(ierr)
587	stop "getvarup"
588	endif
589	! write(,)'lecture u ok',u
590
591	ierr = nf90_get_var(nid,var3didin(9),v)
592	if(ierr/=NF_NOERR) then
593	write(,) NF_STRERROR(ierr)
594	stop "getvarup"
595	endif
596	! write(,)'lecture v ok',v
597
598	ierr = nf90_get_var(nid,var3didin(10),ug)
599	if(ierr/=NF_NOERR) then
600	write(,) NF_STRERROR(ierr)
601	stop "getvarup"
602	endif
603	! write(,)'lecture ug ok',ug
604
605	ierr = nf90_get_var(nid,var3didin(11),vg)
606	if(ierr/=NF_NOERR) then
607	write(,) NF_STRERROR(ierr)
608	stop "getvarup"
609	endif
610	! write(,)'lecture vg ok',vg
611
612	ierr = nf90_get_var(nid,var3didin(12),w)
613	if(ierr/=NF_NOERR) then
614	write(,) NF_STRERROR(ierr)
615	stop "getvarup"
616	endif
617	! write(,)'lecture w ok',w
618
619	ierr = nf90_get_var(nid,var3didin(13),du)
620	if(ierr/=NF_NOERR) then
621	write(,) NF_STRERROR(ierr)
622	stop "getvarup"
623	endif
624	! write(,)'lecture du ok',du
625
626	ierr = nf90_get_var(nid,var3didin(14),hu)
627	if(ierr/=NF_NOERR) then
628	write(,) NF_STRERROR(ierr)
629	stop "getvarup"
630	endif
631	! write(,)'lecture hu ok',hu
632
633	ierr = nf90_get_var(nid,var3didin(15),vu)
634	if(ierr/=NF_NOERR) then
635	write(,) NF_STRERROR(ierr)
636	stop "getvarup"
637	endif
638	! write(,)'lecture vu ok',vu
639
640	ierr = nf90_get_var(nid,var3didin(16),dv)
641	if(ierr/=NF_NOERR) then
642	write(,) NF_STRERROR(ierr)
643	stop "getvarup"
644	endif
645	! write(,)'lecture dv ok',dv
646
647	ierr = nf90_get_var(nid,var3didin(17),hv)
648	if(ierr/=NF_NOERR) then
649	write(,) NF_STRERROR(ierr)
650	stop "getvarup"
651	endif
652	! write(,)'lecture hv ok',hv
653
654	ierr = nf90_get_var(nid,var3didin(18),vv)
655	if(ierr/=NF_NOERR) then
656	write(,) NF_STRERROR(ierr)
657	stop "getvarup"
658	endif
659	! write(,)'lecture vv ok',vv
660
661	ierr = nf90_get_var(nid,var3didin(19),dt)
662	if(ierr/=NF_NOERR) then
663	write(,) NF_STRERROR(ierr)
664	stop "getvarup"
665	endif
666	! write(,)'lecture dt ok',dt
667
668	ierr = nf90_get_var(nid,var3didin(20),ht)
669	if(ierr/=NF_NOERR) then
670	write(,) NF_STRERROR(ierr)
671	stop "getvarup"
672	endif
673	! write(,)'lecture ht ok',ht
674
675	ierr = nf90_get_var(nid,var3didin(21),vt)
676	if(ierr/=NF_NOERR) then
677	write(,) NF_STRERROR(ierr)
678	stop "getvarup"
679	endif
680	! write(,)'lecture vt ok',vt
681
682	ierr = nf90_get_var(nid,var3didin(22),dq)
683	if(ierr/=NF_NOERR) then
684	write(,) NF_STRERROR(ierr)
685	stop "getvarup"
686	endif
687	! write(,)'lecture dq ok',dq
688
689	ierr = nf90_get_var(nid,var3didin(23),hq)
690	if(ierr/=NF_NOERR) then
691	write(,) NF_STRERROR(ierr)
692	stop "getvarup"
693	endif
694	! write(,)'lecture hq ok',hq
695
696	ierr = nf90_get_var(nid,var3didin(24),vq)
697	if(ierr/=NF_NOERR) then
698	write(,) NF_STRERROR(ierr)
699	stop "getvarup"
700	endif
701	! write(,)'lecture vq ok',vq
702
703	ierr = nf90_get_var(nid,var3didin(25),dth)
704	if(ierr/=NF_NOERR) then
705	write(,) NF_STRERROR(ierr)
706	stop "getvarup"
707	endif
708	! write(,)'lecture dth ok',dth
709
710	ierr = nf90_get_var(nid,var3didin(26),hth)
711	if(ierr/=NF_NOERR) then
712	write(,) NF_STRERROR(ierr)
713	stop "getvarup"
714	endif
715	! write(,)'lecture hth ok',hth
716
717	ierr = nf90_get_var(nid,var3didin(27),vth)
718	if(ierr/=NF_NOERR) then
719	write(,) NF_STRERROR(ierr)
720	stop "getvarup"
721	endif
722	! write(,)'lecture vth ok',vth
723
724	ierr = nf90_get_var(nid,var3didin(28),dr)
725	if(ierr/=NF_NOERR) then
726	write(,) NF_STRERROR(ierr)
727	stop "getvarup"
728	endif
729	! write(,)'lecture dr ok',dr
730
731	ierr = nf90_get_var(nid,var3didin(29),hr)
732	if(ierr/=NF_NOERR) then
733	write(,) NF_STRERROR(ierr)
734	stop "getvarup"
735	endif
736	! write(,)'lecture hr ok',hr
737
738	ierr = nf90_get_var(nid,var3didin(30),vr)
739	if(ierr/=NF_NOERR) then
740	write(,) NF_STRERROR(ierr)
741	stop "getvarup"
742	endif
743	! write(,)'lecture vr ok',vr
744
745	ierr = nf90_get_var(nid,var3didin(31),dtrad)
746	if(ierr/=NF_NOERR) then
747	write(,) NF_STRERROR(ierr)
748	stop "getvarup"
749	endif
750	! write(,)'lecture dtrad ok',dtrad
751
752	ierr = nf90_get_var(nid,var3didin(32),sens)
753	if(ierr/=NF_NOERR) then
754	write(,) NF_STRERROR(ierr)
755	stop "getvarup"
756	endif
757	! write(,)'lecture sens ok',sens
758
759	ierr = nf90_get_var(nid,var3didin(33),flat)
760	if(ierr/=NF_NOERR) then
761	write(,) NF_STRERROR(ierr)
762	stop "getvarup"
763	endif
764	! write(,)'lecture flat ok',flat
765
766	ierr = nf90_get_var(nid,var3didin(34),ts)
767	if(ierr/=NF_NOERR) then
768	write(,) NF_STRERROR(ierr)
769	stop "getvarup"
770	endif
771	! write(,)'lecture ts ok',ts
772
773	ierr = nf90_get_var(nid,var3didin(35),ustar)
774	if(ierr/=NF_NOERR) then
775	write(,) NF_STRERROR(ierr)
776	stop "getvarup"
777	endif
778	! write(,)'lecture ustar ok',ustar
779
780	ierr = nf90_get_var(nid,var3didin(36),uw)
781	if(ierr/=NF_NOERR) then
782	write(,) NF_STRERROR(ierr)
783	stop "getvarup"
784	endif
785	! write(,)'lecture uw ok',uw
786
787	ierr = nf90_get_var(nid,var3didin(37),vw)
788	if(ierr/=NF_NOERR) then
789	write(,) NF_STRERROR(ierr)
790	stop "getvarup"
791	endif
792	! write(,)'lecture vw ok',vw
793
794	ierr = nf90_get_var(nid,var3didin(38),q1)
795	if(ierr/=NF_NOERR) then
796	write(,) NF_STRERROR(ierr)
797	stop "getvarup"
798	endif
799	! write(,)'lecture q1 ok',q1
800
801	ierr = nf90_get_var(nid,var3didin(39),q2)
802	if(ierr/=NF_NOERR) then
803	write(,) NF_STRERROR(ierr)
804	stop "getvarup"
805	endif
806	! write(,)'lecture q2 ok',q2
807
808
809	return
810	end subroutine read_cas
811	!======================================================================
812	SUBROUTINE interp_case_time(day,day1,annee_ref &
813	! & ,year_cas,day_cas,nt_cas,pdt_forc,nlev_cas &
814	& ,nt_cas,nlev_cas &
815	& ,ts_cas,plev_cas,t_cas,q_cas,u_cas,v_cas &
816	& ,ug_cas,vg_cas,vitw_cas,du_cas,hu_cas,vu_cas &
817	& ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas &
818	& ,dq_cas,hq_cas,vq_cas,lat_cas,sens_cas,ustar_cas &
819	& ,uw_cas,vw_cas,q1_cas,q2_cas &
820	& ,ts_prof_cas,plev_prof_cas,t_prof_cas,q_prof_cas &
821	& ,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas &
822	& ,vitw_prof_cas,du_prof_cas,hu_prof_cas,vu_prof_cas &
823	& ,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas &
824	& ,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas &
825	& ,hq_prof_cas,vq_prof_cas,lat_prof_cas,sens_prof_cas &
826	& ,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas)
827
828
829	implicit none
830
831	!---------------------------------------------------------------------------------------
832	! Time interpolation of a 2D field to the timestep corresponding to day
833	!
834	! day: current julian day (e.g. 717538.2)
835	! day1: first day of the simulation
836	! nt_cas: total nb of data in the forcing
837	! pdt_cas: total time interval (in sec) between 2 forcing data
838	!---------------------------------------------------------------------------------------
839
840	INCLUDE "compar1d.h"
841	INCLUDE "date_cas.h"
842
843	! inputs:
844	integer annee_ref
845	integer nt_cas,nlev_cas
846	real day, day1,day_cas
847	real ts_cas(nt_cas)
848	real plev_cas(nlev_cas,nt_cas)
849	real t_cas(nlev_cas,nt_cas),q_cas(nlev_cas,nt_cas)
850	real u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas)
851	real ug_cas(nlev_cas,nt_cas),vg_cas(nlev_cas,nt_cas)
852	real vitw_cas(nlev_cas,nt_cas)
853	real du_cas(nlev_cas,nt_cas),hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas)
854	real dv_cas(nlev_cas,nt_cas),hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas)
855	real dt_cas(nlev_cas,nt_cas),ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas)
856	real dtrad_cas(nlev_cas,nt_cas)
857	real dq_cas(nlev_cas,nt_cas),hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas)
858	real lat_cas(nt_cas)
859	real sens_cas(nt_cas)
860	real ustar_cas(nt_cas),uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas)
861	real q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas)
862
863	! outputs:
864	real plev_prof_cas(nlev_cas)
865	real t_prof_cas(nlev_cas),q_prof_cas(nlev_cas)
866	real u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
867	real ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas)
868	real vitw_prof_cas(nlev_cas)
869	real du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
870	real dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
871	real dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas)
872	real dtrad_prof_cas(nlev_cas)
873	real dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
874	real lat_prof_cas,sens_prof_cas,ts_prof_cas,ustar_prof_cas
875	real uw_prof_cas(nlev_cas),vw_prof_cas(nlev_cas),q1_prof_cas(nlev_cas),q2_prof_cas(nlev_cas)
876	! local:
877	integer it_cas1, it_cas2,k
878	real timeit,time_cas1,time_cas2,frac
879
880
881	print*,'Check time',day1,day_ju_ini_cas,day_deb+1,pdt_cas
882
883	! On teste si la date du cas AMMA est correcte.
884	! C est pour memoire car en fait les fichiers .def
885	! sont censes etre corrects.
886	! A supprimer a terme (MPL 20150623)
887	! if ((forcing_type.eq.10).and.(1.eq.0)) then
888	! Check that initial day of the simulation consistent with AMMA case:
889	! if (annee_ref.ne.2006) then
890	! print*,'Pour AMMA, annee_ref doit etre 2006'
891	! print*,'Changer annee_ref dans run.def'
892	! stop
893	! endif
894	! if (annee_ref.eq.2006 .and. day1.lt.day_cas) then
895	! print*,'AMMA a debute le 10 juillet 2006',day1,day_cas
896	! print*,'Changer dayref dans run.def'
897	! stop
898	! endif
899	! if (annee_ref.eq.2006 .and. day1.gt.day_cas+1) then
900	! print*,'AMMA a fini le 11 juillet'
901	! print*,'Changer dayref ou nday dans run.def'
902	! stop
903	! endif
904	! endif
905
906	! Determine timestep relative to the 1st day:
907	! timeit=(day-day1)*86400.
908	! if (annee_ref.eq.1992) then
909	! timeit=(day-day_cas)*86400.
910	! else
911	! timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992
912	! endif
913	timeit=(day-day_ju_ini_cas)*86400
914	print *,'day=',day
915	print *,'day_ju_ini_cas=',day_ju_ini_cas
916	print *,'pdt_cas=',pdt_cas
917	print *,'timeit=',timeit
918	print *,'nt_cas=',nt_cas
919
920	! Determine the closest observation times:
921	! it_cas1=INT(timeit/pdt_cas)+1
922	! it_cas2=it_cas1 + 1
923	! time_cas1=(it_cas1-1)*pdt_cas
924	! time_cas2=(it_cas2-1)*pdt_cas
925
926	it_cas1=INT(timeit/pdt_cas)+1
927	IF (it_cas1 == nt_cas) THEN
928	it_cas2=it_cas1
929	ELSE
930	it_cas2=it_cas1 + 1
931	ENDIF
932	time_cas1=(it_cas1-1)*pdt_cas
933	time_cas2=(it_cas2-1)*pdt_cas
934	print *,'it_cas1=',it_cas1
935	print *,'it_cas2=',it_cas2
936	print *,'time_cas1=',time_cas1
937	print *,'time_cas2=',time_cas2
938
939	if (it_cas1 > nt_cas) then
940	write(,) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: ' &
941	& ,day,day_ju_ini_cas,it_cas1,it_cas2,timeit
942	stop
943	endif
944
945	! time interpolation:
946	IF (it_cas1 == it_cas2) THEN
947	frac=0.
948	ELSE
949	frac=(time_cas2-timeit)/(time_cas2-time_cas1)
950	frac=max(frac,0.0)
951	ENDIF
952
953	lat_prof_cas = lat_cas(it_cas2) &
954	& -frac*(lat_cas(it_cas2)-lat_cas(it_cas1))
955	sens_prof_cas = sens_cas(it_cas2) &
956	& -frac*(sens_cas(it_cas2)-sens_cas(it_cas1))
957	ts_prof_cas = ts_cas(it_cas2) &
958	& -frac*(ts_cas(it_cas2)-ts_cas(it_cas1))
959	ustar_prof_cas = ustar_cas(it_cas2) &
960	& -frac*(ustar_cas(it_cas2)-ustar_cas(it_cas1))
961
962	do k=1,nlev_cas
963	plev_prof_cas(k) = plev_cas(k,it_cas2) &
964	& -frac*(plev_cas(k,it_cas2)-plev_cas(k,it_cas1))
965	t_prof_cas(k) = t_cas(k,it_cas2) &
966	& -frac*(t_cas(k,it_cas2)-t_cas(k,it_cas1))
967	q_prof_cas(k) = q_cas(k,it_cas2) &
968	& -frac*(q_cas(k,it_cas2)-q_cas(k,it_cas1))
969	u_prof_cas(k) = u_cas(k,it_cas2) &
970	& -frac*(u_cas(k,it_cas2)-u_cas(k,it_cas1))
971	v_prof_cas(k) = v_cas(k,it_cas2) &
972	& -frac*(v_cas(k,it_cas2)-v_cas(k,it_cas1))
973	ug_prof_cas(k) = ug_cas(k,it_cas2) &
974	& -frac*(ug_cas(k,it_cas2)-ug_cas(k,it_cas1))
975	vg_prof_cas(k) = vg_cas(k,it_cas2) &
976	& -frac*(vg_cas(k,it_cas2)-vg_cas(k,it_cas1))
977	vitw_prof_cas(k) = vitw_cas(k,it_cas2) &
978	& -frac*(vitw_cas(k,it_cas2)-vitw_cas(k,it_cas1))
979	du_prof_cas(k) = du_cas(k,it_cas2) &
980	& -frac*(du_cas(k,it_cas2)-du_cas(k,it_cas1))
981	hu_prof_cas(k) = hu_cas(k,it_cas2) &
982	& -frac*(hu_cas(k,it_cas2)-hu_cas(k,it_cas1))
983	vu_prof_cas(k) = vu_cas(k,it_cas2) &
984	& -frac*(vu_cas(k,it_cas2)-vu_cas(k,it_cas1))
985	dv_prof_cas(k) = dv_cas(k,it_cas2) &
986	& -frac*(dv_cas(k,it_cas2)-dv_cas(k,it_cas1))
987	hv_prof_cas(k) = hv_cas(k,it_cas2) &
988	& -frac*(hv_cas(k,it_cas2)-hv_cas(k,it_cas1))
989	vv_prof_cas(k) = vv_cas(k,it_cas2) &
990	& -frac*(vv_cas(k,it_cas2)-vv_cas(k,it_cas1))
991	dt_prof_cas(k) = dt_cas(k,it_cas2) &
992	& -frac*(dt_cas(k,it_cas2)-dt_cas(k,it_cas1))
993	ht_prof_cas(k) = ht_cas(k,it_cas2) &
994	& -frac*(ht_cas(k,it_cas2)-ht_cas(k,it_cas1))
995	vt_prof_cas(k) = vt_cas(k,it_cas2) &
996	& -frac*(vt_cas(k,it_cas2)-vt_cas(k,it_cas1))
997	dtrad_prof_cas(k) = dtrad_cas(k,it_cas2) &
998	& -frac*(dtrad_cas(k,it_cas2)-dtrad_cas(k,it_cas1))
999	dq_prof_cas(k) = dq_cas(k,it_cas2) &
1000	& -frac*(dq_cas(k,it_cas2)-dq_cas(k,it_cas1))
1001	hq_prof_cas(k) = hq_cas(k,it_cas2) &
1002	& -frac*(hq_cas(k,it_cas2)-hq_cas(k,it_cas1))
1003	vq_prof_cas(k) = vq_cas(k,it_cas2) &
1004	& -frac*(vq_cas(k,it_cas2)-vq_cas(k,it_cas1))
1005	uw_prof_cas(k) = uw_cas(k,it_cas2) &
1006	& -frac*(uw_cas(k,it_cas2)-uw_cas(k,it_cas1))
1007	vw_prof_cas(k) = vw_cas(k,it_cas2) &
1008	& -frac*(vw_cas(k,it_cas2)-vw_cas(k,it_cas1))
1009	q1_prof_cas(k) = q1_cas(k,it_cas2) &
1010	& -frac*(q1_cas(k,it_cas2)-q1_cas(k,it_cas1))
1011	q2_prof_cas(k) = q2_cas(k,it_cas2) &
1012	& -frac*(q2_cas(k,it_cas2)-q2_cas(k,it_cas1))
1013	enddo
1014
1015	return
1016	END
1017
1018	!**********************************************************************************************

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

Download in other formats:

Original Format