Context Navigation

mod_1D_cases_read.f90 @ 5456

Last change on this file since 5456 was 5390, checked in by yann meurdesoif, 3 weeks ago

Remove UTF8 character that inihibit fortran parsing with GPU morphosis
Add missing END SUBROUTINE instead of simple END, that inhibit correct parsing with regulat expression parser (quick and dirty parsing)

Property svn:keywords set to Id

File size: 35.4 KB

Line
1	!
2	! $Id: mod_1D_cases_read.f90 5390 2024-12-05 16:09:25Z aborella $
3	!
4	MODULE mod_1D_cases_read
5	USE netcdf, ONLY: nf90_get_var, nf90_strerror, nf90_inq_varid, nf90_inquire_dimension, nf90_noerr, &
6	nf90_inq_dimid, nf90_nowrite, nf90_open
7
8
9	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
10	!Declarations specifiques au cas standard
11	character*80 :: fich_cas
12	! Discr?tisation
13	integer nlev_cas, nt_cas
14
15
16	! integer year_ini_cas, day_ini_cas, mth_ini_cas
17	! real heure_ini_cas
18	! real day_ju_ini_cas ! Julian day of case first day
19	! parameter (year_ini_cas=2011)
20	! parameter (year_ini_cas=1969)
21	! parameter (mth_ini_cas=10)
22	! parameter (mth_ini_cas=6)
23	! parameter (day_ini_cas=1) ! 10 = 10Juil2006
24	! parameter (day_ini_cas=24) ! 24 = 24 juin 1969
25	! parameter (heure_ini_cas=0.) !0h en secondes
26	! real pdt_cas
27	! parameter (pdt_cas=3.*3600)
28
29	!CR ATTENTION TEST AMMA
30	! parameter (year_ini_cas=2006)
31	! parameter (mth_ini_cas=7)
32	! parameter (day_ini_cas=10) ! 10 = 10Juil2006
33	! parameter (heure_ini_cas=0.) !0h en secondes
34	! parameter (pdt_cas=1800.)
35
36	!profils environnementaux
37	real, allocatable:: plev_cas(:,:)
38
39	real, allocatable:: z_cas(:,:)
40	real, allocatable:: t_cas(:,:),q_cas(:,:),rh_cas(:,:)
41	real, allocatable:: th_cas(:,:),rv_cas(:,:)
42	real, allocatable:: u_cas(:,:)
43	real, allocatable:: v_cas(:,:)
44
45	!forcing
46	real, allocatable:: ht_cas(:,:),vt_cas(:,:),dt_cas(:,:),dtrad_cas(:,:)
47	real, allocatable:: hth_cas(:,:),vth_cas(:,:),dth_cas(:,:)
48	real, allocatable:: hq_cas(:,:),vq_cas(:,:),dq_cas(:,:)
49	real, allocatable:: hr_cas(:,:),vr_cas(:,:),dr_cas(:,:)
50	real, allocatable:: hu_cas(:,:),vu_cas(:,:),du_cas(:,:)
51	real, allocatable:: hv_cas(:,:),vv_cas(:,:),dv_cas(:,:)
52	real, allocatable:: vitw_cas(:,:)
53	real, allocatable:: ug_cas(:,:),vg_cas(:,:)
54	real, allocatable:: lat_cas(:),sens_cas(:),ts_cas(:),ustar_cas(:)
55	real, allocatable:: uw_cas(:,:),vw_cas(:,:),q1_cas(:,:),q2_cas(:,:)
56
57	!champs interpoles
58	real, allocatable:: plev_prof_cas(:)
59	real, allocatable:: t_prof_cas(:)
60	real, allocatable:: q_prof_cas(:)
61	real, allocatable:: u_prof_cas(:)
62	real, allocatable:: v_prof_cas(:)
63
64	real, allocatable:: vitw_prof_cas(:)
65	real, allocatable:: ug_prof_cas(:)
66	real, allocatable:: vg_prof_cas(:)
67	real, allocatable:: ht_prof_cas(:)
68	real, allocatable:: hq_prof_cas(:)
69	real, allocatable:: vt_prof_cas(:)
70	real, allocatable:: vq_prof_cas(:)
71	real, allocatable:: dt_prof_cas(:)
72	real, allocatable:: dtrad_prof_cas(:)
73	real, allocatable:: dq_prof_cas(:)
74	real, allocatable:: hu_prof_cas(:)
75	real, allocatable:: hv_prof_cas(:)
76	real, allocatable:: vu_prof_cas(:)
77	real, allocatable:: vv_prof_cas(:)
78	real, allocatable:: du_prof_cas(:)
79	real, allocatable:: dv_prof_cas(:)
80	real, allocatable:: uw_prof_cas(:)
81	real, allocatable:: vw_prof_cas(:)
82	real, allocatable:: q1_prof_cas(:)
83	real, allocatable:: q2_prof_cas(:)
84
85
86	real lat_prof_cas,sens_prof_cas,ts_prof_cas,ustar_prof_cas
87
88
89
90	CONTAINS
91
92	SUBROUTINE read_1D_cas
93	implicit none
94
95	INTEGER nid,rid,ierr
96	INTEGER ii,jj
97
98	fich_cas='setup/cas.nc'
99	print*,'fich_cas ',fich_cas
100	ierr = nf90_open(fich_cas,nf90_nowrite,nid)
101	print*,'fich_cas,nf90_nowrite,nid ',fich_cas,nf90_nowrite,nid
102	if (ierr.NE.nf90_noerr) then
103	write(,) 'ERROR: GROS Pb opening forcings nc file '
104	write(,) nf90_strerror(ierr)
105	stop ""
106	endif
107	!.......................................................................
108	ierr=nf90_inq_dimid(nid,'lat',rid)
109	IF (ierr.NE.nf90_noerr) THEN
110	print*, 'Oh probleme lecture dimension lat'
111	ENDIF
112	ierr=nf90_inquire_dimension(nid,rid,len=ii)
113	print*,'OK1 nid,rid,lat',nid,rid,ii
114	!.......................................................................
115	ierr=nf90_inq_dimid(nid,'lon',rid)
116	IF (ierr.NE.nf90_noerr) THEN
117	print*, 'Oh probleme lecture dimension lon'
118	ENDIF
119	ierr=nf90_inquire_dimension(nid,rid,len=jj)
120	print*,'OK2 nid,rid,lat',nid,rid,jj
121	!.......................................................................
122	ierr=nf90_inq_dimid(nid,'lev',rid)
123	IF (ierr.NE.nf90_noerr) THEN
124	print*, 'Oh probleme lecture dimension zz'
125	ENDIF
126	ierr=nf90_inquire_dimension(nid,rid,len=nlev_cas)
127	print*,'OK3 nid,rid,nlev_cas',nid,rid,nlev_cas
128	!.......................................................................
129	ierr=nf90_inq_dimid(nid,'time',rid)
130	print*,'nid,rid',nid,rid
131	nt_cas=0
132	IF (ierr.NE.nf90_noerr) THEN
133	stop 'probleme lecture dimension sens'
134	ENDIF
135	ierr=nf90_inquire_dimension(nid,rid,len=nt_cas)
136	print*,'OK4 nid,rid,nt_cas',nid,rid,nt_cas
137
138	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
139	!profils moyens:
140	allocate(plev_cas(nlev_cas,nt_cas))
141	allocate(z_cas(nlev_cas,nt_cas))
142	allocate(t_cas(nlev_cas,nt_cas),q_cas(nlev_cas,nt_cas),rh_cas(nlev_cas,nt_cas))
143	allocate(th_cas(nlev_cas,nt_cas),rv_cas(nlev_cas,nt_cas))
144	allocate(u_cas(nlev_cas,nt_cas))
145	allocate(v_cas(nlev_cas,nt_cas))
146
147	!forcing
148	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))
149	allocate(hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas),dq_cas(nlev_cas,nt_cas))
150	allocate(hth_cas(nlev_cas,nt_cas),vth_cas(nlev_cas,nt_cas),dth_cas(nlev_cas,nt_cas))
151	allocate(hr_cas(nlev_cas,nt_cas),vr_cas(nlev_cas,nt_cas),dr_cas(nlev_cas,nt_cas))
152	allocate(hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas),du_cas(nlev_cas,nt_cas))
153	allocate(hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas),dv_cas(nlev_cas,nt_cas))
154	allocate(vitw_cas(nlev_cas,nt_cas))
155	allocate(ug_cas(nlev_cas,nt_cas))
156	allocate(vg_cas(nlev_cas,nt_cas))
157	allocate(lat_cas(nt_cas),sens_cas(nt_cas),ts_cas(nt_cas),ustar_cas(nt_cas))
158	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))
159
160
161	!champs interpoles
162	allocate(plev_prof_cas(nlev_cas))
163	allocate(t_prof_cas(nlev_cas))
164	allocate(q_prof_cas(nlev_cas))
165	allocate(u_prof_cas(nlev_cas))
166	allocate(v_prof_cas(nlev_cas))
167
168	allocate(vitw_prof_cas(nlev_cas))
169	allocate(ug_prof_cas(nlev_cas))
170	allocate(vg_prof_cas(nlev_cas))
171	allocate(ht_prof_cas(nlev_cas))
172	allocate(hq_prof_cas(nlev_cas))
173	allocate(hu_prof_cas(nlev_cas))
174	allocate(hv_prof_cas(nlev_cas))
175	allocate(vt_prof_cas(nlev_cas))
176	allocate(vq_prof_cas(nlev_cas))
177	allocate(vu_prof_cas(nlev_cas))
178	allocate(vv_prof_cas(nlev_cas))
179	allocate(dt_prof_cas(nlev_cas))
180	allocate(dtrad_prof_cas(nlev_cas))
181	allocate(dq_prof_cas(nlev_cas))
182	allocate(du_prof_cas(nlev_cas))
183	allocate(dv_prof_cas(nlev_cas))
184	allocate(uw_prof_cas(nlev_cas))
185	allocate(vw_prof_cas(nlev_cas))
186	allocate(q1_prof_cas(nlev_cas))
187	allocate(q2_prof_cas(nlev_cas))
188
189	print*,'Allocations OK'
190	call read_cas(nid,nlev_cas,nt_cas &
191	& ,z_cas,plev_cas,t_cas,q_cas,rh_cas,th_cas,rv_cas,u_cas,v_cas &
192	& ,ug_cas,vg_cas,vitw_cas,du_cas,hu_cas,vu_cas,dv_cas,hv_cas,vv_cas &
193	& ,dt_cas,dtrad_cas,ht_cas,vt_cas,dq_cas,hq_cas,vq_cas &
194	& ,dth_cas,hth_cas,vth_cas,dr_cas,hr_cas,vr_cas,sens_cas,lat_cas,ts_cas&
195	& ,ustar_cas,uw_cas,vw_cas,q1_cas,q2_cas)
196	print*,'Read cas OK'
197
198
199	END SUBROUTINE read_1D_cas
200
201
202
203	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
204	SUBROUTINE deallocate_1D_cases
205	!profils environnementaux:
206	deallocate(plev_cas)
207
208	deallocate(z_cas)
209	deallocate(t_cas,q_cas,rh_cas)
210	deallocate(th_cas,rv_cas)
211	deallocate(u_cas)
212	deallocate(v_cas)
213
214	!forcing
215	deallocate(ht_cas,vt_cas,dt_cas,dtrad_cas)
216	deallocate(hq_cas,vq_cas,dq_cas)
217	deallocate(hth_cas,vth_cas,dth_cas)
218	deallocate(hr_cas,vr_cas,dr_cas)
219	deallocate(hu_cas,vu_cas,du_cas)
220	deallocate(hv_cas,vv_cas,dv_cas)
221	deallocate(vitw_cas)
222	deallocate(ug_cas)
223	deallocate(vg_cas)
224	deallocate(lat_cas,sens_cas,ts_cas,ustar_cas,uw_cas,vw_cas,q1_cas,q2_cas)
225
226	!champs interpoles
227	deallocate(plev_prof_cas)
228	deallocate(t_prof_cas)
229	deallocate(q_prof_cas)
230	deallocate(u_prof_cas)
231	deallocate(v_prof_cas)
232
233	deallocate(vitw_prof_cas)
234	deallocate(ug_prof_cas)
235	deallocate(vg_prof_cas)
236	deallocate(ht_prof_cas)
237	deallocate(hq_prof_cas)
238	deallocate(hu_prof_cas)
239	deallocate(hv_prof_cas)
240	deallocate(vt_prof_cas)
241	deallocate(vq_prof_cas)
242	deallocate(vu_prof_cas)
243	deallocate(vv_prof_cas)
244	deallocate(dt_prof_cas)
245	deallocate(dtrad_prof_cas)
246	deallocate(dq_prof_cas)
247	deallocate(du_prof_cas)
248	deallocate(dv_prof_cas)
249	deallocate(t_prof_cas)
250	deallocate(q_prof_cas)
251	deallocate(u_prof_cas)
252	deallocate(v_prof_cas)
253	deallocate(uw_prof_cas)
254	deallocate(vw_prof_cas)
255	deallocate(q1_prof_cas)
256	deallocate(q2_prof_cas)
257
258	END SUBROUTINE deallocate_1D_cases
259
260
261	END MODULE mod_1D_cases_read
262	!=====================================================================
263	subroutine read_cas(nid,nlevel,ntime &
264	& ,zz,pp,temp,qv,rh,theta,rv,u,v,ug,vg,w, &
265	& du,hu,vu,dv,hv,vv,dt,dtrad,ht,vt,dq,hq,vq, &
266	& dth,hth,vth,dr,hr,vr,sens,flat,ts,ustar,uw,vw,q1,q2)
267	USE netcdf, ONLY: nf90_get_var, nf90_strerror, nf90_inq_varid, nf90_inquire_dimension, nf90_noerr, &
268	nf90_inq_dimid, nf90_nowrite
269
270	!program reading forcing of the case study
271	implicit none
272
273	integer ntime,nlevel
274
275	real zz(nlevel,ntime)
276	real pp(nlevel,ntime)
277	real temp(nlevel,ntime),qv(nlevel,ntime),rh(nlevel,ntime)
278	real theta(nlevel,ntime),rv(nlevel,ntime)
279	real u(nlevel,ntime)
280	real v(nlevel,ntime)
281	real ug(nlevel,ntime)
282	real vg(nlevel,ntime)
283	real w(nlevel,ntime)
284	real du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime)
285	real dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime)
286	real dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime)
287	real dtrad(nlevel,ntime)
288	real dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime)
289	real dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime)
290	real dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime)
291	real flat(ntime),sens(ntime),ts(ntime),ustar(ntime)
292	real uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime)
293
294
295	integer nid, ierr,rid
296	integer nbvar3d
297	parameter(nbvar3d=39)
298	integer var3didin(nbvar3d)
299
300	ierr=nf90_inq_varid(nid,"zz",var3didin(1))
301	if(ierr/=nf90_noerr) then
302	write(,) nf90_strerror(ierr)
303	stop 'lev'
304	endif
305
306	ierr=nf90_inq_varid(nid,"pp",var3didin(2))
307	if(ierr/=nf90_noerr) then
308	write(,) nf90_strerror(ierr)
309	stop 'plev'
310	endif
311
312
313	ierr=nf90_inq_varid(nid,"temp",var3didin(3))
314	if(ierr/=nf90_noerr) then
315	write(,) nf90_strerror(ierr)
316	stop 'temp'
317	endif
318
319	ierr=nf90_inq_varid(nid,"qv",var3didin(4))
320	if(ierr/=nf90_noerr) then
321	write(,) nf90_strerror(ierr)
322	stop 'qv'
323	endif
324
325	ierr=nf90_inq_varid(nid,"rh",var3didin(5))
326	if(ierr/=nf90_noerr) then
327	write(,) nf90_strerror(ierr)
328	stop 'rh'
329	endif
330
331	ierr=nf90_inq_varid(nid,"theta",var3didin(6))
332	if(ierr/=nf90_noerr) then
333	write(,) nf90_strerror(ierr)
334	stop 'theta'
335	endif
336
337	ierr=nf90_inq_varid(nid,"rv",var3didin(7))
338	if(ierr/=nf90_noerr) then
339	write(,) nf90_strerror(ierr)
340	stop 'rv'
341	endif
342
343
344	ierr=nf90_inq_varid(nid,"u",var3didin(8))
345	if(ierr/=nf90_noerr) then
346	write(,) nf90_strerror(ierr)
347	stop 'u'
348	endif
349
350	ierr=nf90_inq_varid(nid,"v",var3didin(9))
351	if(ierr/=nf90_noerr) then
352	write(,) nf90_strerror(ierr)
353	stop 'v'
354	endif
355
356	ierr=nf90_inq_varid(nid,"ug",var3didin(10))
357	if(ierr/=nf90_noerr) then
358	write(,) nf90_strerror(ierr)
359	stop 'ug'
360	endif
361
362	ierr=nf90_inq_varid(nid,"vg",var3didin(11))
363	if(ierr/=nf90_noerr) then
364	write(,) nf90_strerror(ierr)
365	stop 'vg'
366	endif
367
368	ierr=nf90_inq_varid(nid,"w",var3didin(12))
369	if(ierr/=nf90_noerr) then
370	write(,) nf90_strerror(ierr)
371	stop 'w'
372	endif
373
374	ierr=nf90_inq_varid(nid,"advu",var3didin(13))
375	if(ierr/=nf90_noerr) then
376	write(,) nf90_strerror(ierr)
377	stop 'advu'
378	endif
379
380	ierr=nf90_inq_varid(nid,"hu",var3didin(14))
381	if(ierr/=nf90_noerr) then
382	write(,) nf90_strerror(ierr)
383	stop 'hu'
384	endif
385
386	ierr=nf90_inq_varid(nid,"vu",var3didin(15))
387	if(ierr/=nf90_noerr) then
388	write(,) nf90_strerror(ierr)
389	stop 'vu'
390	endif
391
392	ierr=nf90_inq_varid(nid,"advv",var3didin(16))
393	if(ierr/=nf90_noerr) then
394	write(,) nf90_strerror(ierr)
395	stop 'advv'
396	endif
397
398	ierr=nf90_inq_varid(nid,"hv",var3didin(17))
399	if(ierr/=nf90_noerr) then
400	write(,) nf90_strerror(ierr)
401	stop 'hv'
402	endif
403
404	ierr=nf90_inq_varid(nid,"vv",var3didin(18))
405	if(ierr/=nf90_noerr) then
406	write(,) nf90_strerror(ierr)
407	stop 'vv'
408	endif
409
410	ierr=nf90_inq_varid(nid,"advT",var3didin(19))
411	if(ierr/=nf90_noerr) then
412	write(,) nf90_strerror(ierr)
413	stop 'advT'
414	endif
415
416	ierr=nf90_inq_varid(nid,"hT",var3didin(20))
417	if(ierr/=nf90_noerr) then
418	write(,) nf90_strerror(ierr)
419	stop 'hT'
420	endif
421
422	ierr=nf90_inq_varid(nid,"vT",var3didin(21))
423	if(ierr/=nf90_noerr) then
424	write(,) nf90_strerror(ierr)
425	stop 'vT'
426	endif
427
428	ierr=nf90_inq_varid(nid,"advq",var3didin(22))
429	if(ierr/=nf90_noerr) then
430	write(,) nf90_strerror(ierr)
431	stop 'advq'
432	endif
433
434	ierr=nf90_inq_varid(nid,"hq",var3didin(23))
435	if(ierr/=nf90_noerr) then
436	write(,) nf90_strerror(ierr)
437	stop 'hq'
438	endif
439
440	ierr=nf90_inq_varid(nid,"vq",var3didin(24))
441	if(ierr/=nf90_noerr) then
442	write(,) nf90_strerror(ierr)
443	stop 'vq'
444	endif
445
446	ierr=nf90_inq_varid(nid,"advth",var3didin(25))
447	if(ierr/=nf90_noerr) then
448	write(,) nf90_strerror(ierr)
449	stop 'advth'
450	endif
451
452	ierr=nf90_inq_varid(nid,"hth",var3didin(26))
453	if(ierr/=nf90_noerr) then
454	write(,) nf90_strerror(ierr)
455	stop 'hth'
456	endif
457
458	ierr=nf90_inq_varid(nid,"vth",var3didin(27))
459	if(ierr/=nf90_noerr) then
460	write(,) nf90_strerror(ierr)
461	stop 'vth'
462	endif
463
464	ierr=nf90_inq_varid(nid,"advr",var3didin(28))
465	if(ierr/=nf90_noerr) then
466	write(,) nf90_strerror(ierr)
467	stop 'advr'
468	endif
469
470	ierr=nf90_inq_varid(nid,"hr",var3didin(29))
471	if(ierr/=nf90_noerr) then
472	write(,) nf90_strerror(ierr)
473	stop 'hr'
474	endif
475
476	ierr=nf90_inq_varid(nid,"vr",var3didin(30))
477	if(ierr/=nf90_noerr) then
478	write(,) nf90_strerror(ierr)
479	stop 'vr'
480	endif
481
482	ierr=nf90_inq_varid(nid,"radT",var3didin(31))
483	if(ierr/=nf90_noerr) then
484	write(,) nf90_strerror(ierr)
485	stop 'radT'
486	endif
487
488	ierr=nf90_inq_varid(nid,"sens",var3didin(32))
489	if(ierr/=nf90_noerr) then
490	write(,) nf90_strerror(ierr)
491	stop 'sens'
492	endif
493
494	ierr=nf90_inq_varid(nid,"flat",var3didin(33))
495	if(ierr/=nf90_noerr) then
496	write(,) nf90_strerror(ierr)
497	stop 'flat'
498	endif
499
500	ierr=nf90_inq_varid(nid,"ts",var3didin(34))
501	if(ierr/=nf90_noerr) then
502	write(,) nf90_strerror(ierr)
503	stop 'ts'
504	endif
505
506	ierr=nf90_inq_varid(nid,"ustar",var3didin(35))
507	if(ierr/=nf90_noerr) then
508	write(,) nf90_strerror(ierr)
509	stop 'ustar'
510	endif
511
512	ierr=nf90_inq_varid(nid,"uw",var3didin(36))
513	if(ierr/=nf90_noerr) then
514	write(,) nf90_strerror(ierr)
515	stop 'uw'
516	endif
517
518	ierr=nf90_inq_varid(nid,"vw",var3didin(37))
519	if(ierr/=nf90_noerr) then
520	write(,) nf90_strerror(ierr)
521	stop 'vw'
522	endif
523
524	ierr=nf90_inq_varid(nid,"q1",var3didin(38))
525	if(ierr/=nf90_noerr) then
526	write(,) nf90_strerror(ierr)
527	stop 'q1'
528	endif
529
530	ierr=nf90_inq_varid(nid,"q2",var3didin(39))
531	if(ierr/=nf90_noerr) then
532	write(,) nf90_strerror(ierr)
533	stop 'q2'
534	endif
535
536	ierr = nf90_get_var(nid, var3didin(1), zz)
537	if(ierr/=nf90_noerr) then
538	write(,) nf90_strerror(ierr)
539	stop "getvarup"
540	endif
541	! write(,)'lecture z ok',zz
542
543	ierr = nf90_get_var(nid, var3didin(2), pp)
544	if(ierr/=nf90_noerr) then
545	write(,) nf90_strerror(ierr)
546	stop "getvarup"
547	endif
548	! write(,)'lecture pp ok',pp
549
550
551	ierr = nf90_get_var(nid, var3didin(3), temp)
552	if(ierr/=nf90_noerr) then
553	write(,) nf90_strerror(ierr)
554	stop "getvarup"
555	endif
556	! write(,)'lecture T ok',temp
557
558	ierr = nf90_get_var(nid, var3didin(4), qv)
559	if(ierr/=nf90_noerr) then
560	write(,) nf90_strerror(ierr)
561	stop "getvarup"
562	endif
563	! write(,)'lecture qv ok',qv
564
565	ierr = nf90_get_var(nid, var3didin(5), rh)
566	if(ierr/=nf90_noerr) then
567	write(,) nf90_strerror(ierr)
568	stop "getvarup"
569	endif
570	! write(,)'lecture rh ok',rh
571
572	ierr = nf90_get_var(nid, var3didin(6), theta)
573	if(ierr/=nf90_noerr) then
574	write(,) nf90_strerror(ierr)
575	stop "getvarup"
576	endif
577	! write(,)'lecture theta ok',theta
578
579	ierr = nf90_get_var(nid, var3didin(7), rv)
580	if(ierr/=nf90_noerr) then
581	write(,) nf90_strerror(ierr)
582	stop "getvarup"
583	endif
584	! write(,)'lecture rv ok',rv
585
586	ierr = nf90_get_var(nid, var3didin(8), u)
587	if(ierr/=nf90_noerr) then
588	write(,) nf90_strerror(ierr)
589	stop "getvarup"
590	endif
591	! write(,)'lecture u ok',u
592
593	ierr = nf90_get_var(nid, var3didin(9), v)
594	if(ierr/=nf90_noerr) then
595	write(,) nf90_strerror(ierr)
596	stop "getvarup"
597	endif
598	! write(,)'lecture v ok',v
599
600	ierr = nf90_get_var(nid, var3didin(10), ug)
601	if(ierr/=nf90_noerr) then
602	write(,) nf90_strerror(ierr)
603	stop "getvarup"
604	endif
605	! write(,)'lecture ug ok',ug
606
607	ierr = nf90_get_var(nid, var3didin(11), vg)
608	if(ierr/=nf90_noerr) then
609	write(,) nf90_strerror(ierr)
610	stop "getvarup"
611	endif
612	! write(,)'lecture vg ok',vg
613
614	ierr = nf90_get_var(nid, var3didin(12), w)
615	if(ierr/=nf90_noerr) then
616	write(,) nf90_strerror(ierr)
617	stop "getvarup"
618	endif
619	! write(,)'lecture w ok',w
620
621	ierr = nf90_get_var(nid, var3didin(13), du)
622	if(ierr/=nf90_noerr) then
623	write(,) nf90_strerror(ierr)
624	stop "getvarup"
625	endif
626	! write(,)'lecture du ok',du
627
628	ierr = nf90_get_var(nid, var3didin(14), hu)
629	if(ierr/=nf90_noerr) then
630	write(,) nf90_strerror(ierr)
631	stop "getvarup"
632	endif
633	! write(,)'lecture hu ok',hu
634
635	ierr = nf90_get_var(nid, var3didin(15), vu)
636	if(ierr/=nf90_noerr) then
637	write(,) nf90_strerror(ierr)
638	stop "getvarup"
639	endif
640	! write(,)'lecture vu ok',vu
641
642	ierr = nf90_get_var(nid, var3didin(16), dv)
643	if(ierr/=nf90_noerr) then
644	write(,) nf90_strerror(ierr)
645	stop "getvarup"
646	endif
647	! write(,)'lecture dv ok',dv
648
649	ierr = nf90_get_var(nid, var3didin(17), hv)
650	if(ierr/=nf90_noerr) then
651	write(,) nf90_strerror(ierr)
652	stop "getvarup"
653	endif
654	! write(,)'lecture hv ok',hv
655
656	ierr = nf90_get_var(nid, var3didin(18), vv)
657	if(ierr/=nf90_noerr) then
658	write(,) nf90_strerror(ierr)
659	stop "getvarup"
660	endif
661	! write(,)'lecture vv ok',vv
662
663	ierr = nf90_get_var(nid, var3didin(19), dt)
664	if(ierr/=nf90_noerr) then
665	write(,) nf90_strerror(ierr)
666	stop "getvarup"
667	endif
668	! write(,)'lecture dt ok',dt
669
670	ierr = nf90_get_var(nid, var3didin(20), ht)
671	if(ierr/=nf90_noerr) then
672	write(,) nf90_strerror(ierr)
673	stop "getvarup"
674	endif
675	! write(,)'lecture ht ok',ht
676
677	ierr = nf90_get_var(nid, var3didin(21), vt)
678	if(ierr/=nf90_noerr) then
679	write(,) nf90_strerror(ierr)
680	stop "getvarup"
681	endif
682	! write(,)'lecture vt ok',vt
683
684	ierr = nf90_get_var(nid, var3didin(22), dq)
685	if(ierr/=nf90_noerr) then
686	write(,) nf90_strerror(ierr)
687	stop "getvarup"
688	endif
689	! write(,)'lecture dq ok',dq
690
691	ierr = nf90_get_var(nid, var3didin(23), hq)
692	if(ierr/=nf90_noerr) then
693	write(,) nf90_strerror(ierr)
694	stop "getvarup"
695	endif
696	! write(,)'lecture hq ok',hq
697
698	ierr = nf90_get_var(nid, var3didin(24), vq)
699	if(ierr/=nf90_noerr) then
700	write(,) nf90_strerror(ierr)
701	stop "getvarup"
702	endif
703	! write(,)'lecture vq ok',vq
704
705	ierr = nf90_get_var(nid, var3didin(25), dth)
706	if(ierr/=nf90_noerr) then
707	write(,) nf90_strerror(ierr)
708	stop "getvarup"
709	endif
710	! write(,)'lecture dth ok',dth
711
712	ierr = nf90_get_var(nid, var3didin(26), hth)
713	if(ierr/=nf90_noerr) then
714	write(,) nf90_strerror(ierr)
715	stop "getvarup"
716	endif
717	! write(,)'lecture hth ok',hth
718
719	ierr = nf90_get_var(nid, var3didin(27), vth)
720	if(ierr/=nf90_noerr) then
721	write(,) nf90_strerror(ierr)
722	stop "getvarup"
723	endif
724	! write(,)'lecture vth ok',vth
725
726	ierr = nf90_get_var(nid, var3didin(28), dr)
727	if(ierr/=nf90_noerr) then
728	write(,) nf90_strerror(ierr)
729	stop "getvarup"
730	endif
731	! write(,)'lecture dr ok',dr
732
733	ierr = nf90_get_var(nid, var3didin(29), hr)
734	if(ierr/=nf90_noerr) then
735	write(,) nf90_strerror(ierr)
736	stop "getvarup"
737	endif
738	! write(,)'lecture hr ok',hr
739
740	ierr = nf90_get_var(nid, var3didin(30), vr)
741	if(ierr/=nf90_noerr) then
742	write(,) nf90_strerror(ierr)
743	stop "getvarup"
744	endif
745	! write(,)'lecture vr ok',vr
746
747	ierr = nf90_get_var(nid, var3didin(31), dtrad)
748	if(ierr/=nf90_noerr) then
749	write(,) nf90_strerror(ierr)
750	stop "getvarup"
751	endif
752	! write(,)'lecture dtrad ok',dtrad
753
754	ierr = nf90_get_var(nid, var3didin(32), sens)
755	if(ierr/=nf90_noerr) then
756	write(,) nf90_strerror(ierr)
757	stop "getvarup"
758	endif
759	! write(,)'lecture sens ok',sens
760
761	ierr = nf90_get_var(nid, var3didin(33), flat)
762	if(ierr/=nf90_noerr) then
763	write(,) nf90_strerror(ierr)
764	stop "getvarup"
765	endif
766	! write(,)'lecture flat ok',flat
767
768	ierr = nf90_get_var(nid, var3didin(34), ts)
769	if(ierr/=nf90_noerr) then
770	write(,) nf90_strerror(ierr)
771	stop "getvarup"
772	endif
773	! write(,)'lecture ts ok',ts
774
775	ierr = nf90_get_var(nid, var3didin(35), ustar)
776	if(ierr/=nf90_noerr) then
777	write(,) nf90_strerror(ierr)
778	stop "getvarup"
779	endif
780	! write(,)'lecture ustar ok',ustar
781
782	ierr = nf90_get_var(nid, var3didin(36), uw)
783	if(ierr/=nf90_noerr) then
784	write(,) nf90_strerror(ierr)
785	stop "getvarup"
786	endif
787	! write(,)'lecture uw ok',uw
788
789	ierr = nf90_get_var(nid, var3didin(37), vw)
790	if(ierr/=nf90_noerr) then
791	write(,) nf90_strerror(ierr)
792	stop "getvarup"
793	endif
794	! write(,)'lecture vw ok',vw
795
796	ierr = nf90_get_var(nid, var3didin(38), q1)
797	if(ierr/=nf90_noerr) then
798	write(,) nf90_strerror(ierr)
799	stop "getvarup"
800	endif
801	! write(,)'lecture q1 ok',q1
802
803	ierr = nf90_get_var(nid, var3didin(39), q2)
804	if(ierr/=nf90_noerr) then
805	write(,) nf90_strerror(ierr)
806	stop "getvarup"
807	endif
808	! write(,)'lecture q2 ok',q2
809
810
811	return
812	end subroutine read_cas
813	!======================================================================
814	SUBROUTINE interp_case_time(day,day1,annee_ref &
815	! & ,year_cas,day_cas,nt_cas,pdt_forc,nlev_cas &
816	& ,nt_cas,nlev_cas &
817	& ,ts_cas,plev_cas,t_cas,q_cas,u_cas,v_cas &
818	& ,ug_cas,vg_cas,vitw_cas,du_cas,hu_cas,vu_cas &
819	& ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas &
820	& ,dq_cas,hq_cas,vq_cas,lat_cas,sens_cas,ustar_cas &
821	& ,uw_cas,vw_cas,q1_cas,q2_cas &
822	& ,ts_prof_cas,plev_prof_cas,t_prof_cas,q_prof_cas &
823	& ,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas &
824	& ,vitw_prof_cas,du_prof_cas,hu_prof_cas,vu_prof_cas &
825	& ,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas &
826	& ,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas &
827	& ,hq_prof_cas,vq_prof_cas,lat_prof_cas,sens_prof_cas &
828	& ,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas)
829
830	USE compar1d_mod_h
831	USE date_cas_mod_h
832	implicit none
833
834	!---------------------------------------------------------------------------------------
835	! Time interpolation of a 2D field to the timestep corresponding to day
836	!
837	! day: current julian day (e.g. 717538.2)
838	! day1: first day of the simulation
839	! nt_cas: total nb of data in the forcing
840	! pdt_cas: total time interval (in sec) between 2 forcing data
841	!---------------------------------------------------------------------------------------
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 .EQ. 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 .gt. 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 .EQ. 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 SUBROUTINE interp_case_time
1017
1018	!**********************************************************************************************

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

Download in other formats:

Original Format