Context Navigation

mod_1D_amma_read.F90 @ 5249

Last change on this file since 5249 was 5249, checked in by abarral, 3 weeks ago
Replace uses of cpp key NC_DOUBLE
File size: 14.1 KB

Line
1	MODULE mod_1D_amma_read
2
3	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
4	!Declarations specifiques au cas AMMA
5	character*80 :: fich_amma
6	! Option du cas AMMA ou on impose la discretisation verticale (Ap,Bp)
7	integer nlev_amma, nt_amma
8
9
10	integer year_ini_amma, day_ini_amma, mth_ini_amma
11	real heure_ini_amma
12	real day_ju_ini_amma ! Julian day of amma first day
13	parameter (year_ini_amma=2006)
14	parameter (mth_ini_amma=7)
15	parameter (day_ini_amma=10) ! 10 = 10Juil2006
16	parameter (heure_ini_amma=0.) !0h en secondes
17	real dt_amma
18	parameter (dt_amma=1800.)
19
20	!profils initiaux:
21	real, allocatable:: plev_amma(:)
22
23	real, allocatable:: z_amma(:)
24	real, allocatable:: th_amma(:),q_amma(:)
25	real, allocatable:: u_amma(:)
26	real, allocatable:: v_amma(:)
27
28	real, allocatable:: th_ammai(:),q_ammai(:)
29	real, allocatable:: u_ammai(:)
30	real, allocatable:: v_ammai(:)
31	real, allocatable:: vitw_ammai(:)
32	real, allocatable:: ht_ammai(:)
33	real, allocatable:: hq_ammai(:)
34	real, allocatable:: vt_ammai(:)
35	real, allocatable:: vq_ammai(:)
36
37	!forcings
38	real, allocatable:: ht_amma(:,:)
39	real, allocatable:: hq_amma(:,:)
40	real, allocatable:: vitw_amma(:,:)
41	real, allocatable:: lat_amma(:),sens_amma(:)
42
43	!champs interpoles
44	real, allocatable:: vitw_profamma(:)
45	real, allocatable:: ht_profamma(:)
46	real, allocatable:: hq_profamma(:)
47	real lat_profamma,sens_profamma
48	real, allocatable:: vt_profamma(:)
49	real, allocatable:: vq_profamma(:)
50	real, allocatable:: th_profamma(:)
51	real, allocatable:: q_profamma(:)
52	real, allocatable:: u_profamma(:)
53	real, allocatable:: v_profamma(:)
54
55
56	CONTAINS
57
58	SUBROUTINE read_1D_cases
59	implicit none
60
61	INCLUDE "netcdf.inc"
62
63	INTEGER nid,rid,ierr
64
65	fich_amma='amma.nc'
66	print*,'fich_amma ',fich_amma
67	ierr = NF_OPEN(fich_amma,NF_NOWRITE,nid)
68	print*,'fich_amma,NF_NOWRITE,nid ',fich_amma,NF_NOWRITE,nid
69	if (ierr.NE.NF_NOERR) then
70	write(,) 'ERROR: GROS Pb opening forcings nc file '
71	write(,) NF_STRERROR(ierr)
72	stop ""
73	endif
74	!.......................................................................
75	ierr=NF_INQ_DIMID(nid,'lev',rid)
76	IF (ierr.NE.NF_NOERR) THEN
77	print*, 'Oh probleme lecture dimension zz'
78	ENDIF
79	ierr=NF_INQ_DIMLEN(nid,rid,nlev_amma)
80	print*,'OK nid,rid,nlev_amma',nid,rid,nlev_amma
81	!.......................................................................
82	ierr=NF_INQ_DIMID(nid,'time',rid)
83	print*,'nid,rid',nid,rid
84	nt_amma=0
85	IF (ierr.NE.NF_NOERR) THEN
86	stop 'probleme lecture dimension sens'
87	ENDIF
88	ierr=NF_INQ_DIMLEN(nid,rid,nt_amma)
89	print*,'nid,rid,nlev_amma',nid,rid,nt_amma
90
91	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
92	!profils initiaux:
93	allocate(plev_amma(nlev_amma))
94
95	allocate(z_amma(nlev_amma))
96	allocate(th_amma(nlev_amma),q_amma(nlev_amma))
97	allocate(u_amma(nlev_amma))
98	allocate(v_amma(nlev_amma))
99
100	!forcings
101	allocate(ht_amma(nlev_amma,nt_amma))
102	allocate(hq_amma(nlev_amma,nt_amma))
103	allocate(vitw_amma(nlev_amma,nt_amma))
104	allocate(lat_amma(nt_amma),sens_amma(nt_amma))
105
106	!profils initiaux:
107	allocate(th_ammai(nlev_amma),q_ammai(nlev_amma))
108	allocate(u_ammai(nlev_amma))
109	allocate(v_ammai(nlev_amma))
110	allocate(vitw_ammai(nlev_amma) )
111	allocate(ht_ammai(nlev_amma))
112	allocate(hq_ammai(nlev_amma))
113	allocate(vt_ammai(nlev_amma))
114	allocate(vq_ammai(nlev_amma))
115
116	!champs interpoles
117	allocate(vitw_profamma(nlev_amma))
118	allocate(ht_profamma(nlev_amma))
119	allocate(hq_profamma(nlev_amma))
120	allocate(vt_profamma(nlev_amma))
121	allocate(vq_profamma(nlev_amma))
122	allocate(th_profamma(nlev_amma))
123	allocate(q_profamma(nlev_amma))
124	allocate(u_profamma(nlev_amma))
125	allocate(v_profamma(nlev_amma))
126
127	print*,'Allocations OK'
128	call read_amma(nid,nlev_amma,nt_amma &
129	& ,z_amma,plev_amma,th_amma,q_amma,u_amma,v_amma,vitw_amma &
130	& ,ht_amma,hq_amma,sens_amma,lat_amma)
131
132	END SUBROUTINE read_1D_cases
133
134
135
136	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
137	SUBROUTINE deallocate_1D_cases
138	!profils initiaux:
139	deallocate(plev_amma)
140
141	deallocate(z_amma)
142	deallocate(th_amma,q_amma)
143	deallocate(u_amma)
144	deallocate(v_amma)
145
146	deallocate(th_ammai,q_ammai)
147	deallocate(u_ammai)
148	deallocate(v_ammai)
149	deallocate(vitw_ammai )
150	deallocate(ht_ammai)
151	deallocate(hq_ammai)
152	deallocate(vt_ammai)
153	deallocate(vq_ammai)
154
155	!forcings
156	deallocate(ht_amma)
157	deallocate(hq_amma)
158	deallocate(vitw_amma)
159	deallocate(lat_amma,sens_amma)
160
161	!champs interpoles
162	deallocate(vitw_profamma)
163	deallocate(ht_profamma)
164	deallocate(hq_profamma)
165	deallocate(vt_profamma)
166	deallocate(vq_profamma)
167	deallocate(th_profamma)
168	deallocate(q_profamma)
169	deallocate(u_profamma)
170	deallocate(v_profamma)
171	END SUBROUTINE deallocate_1D_cases
172
173
174	END MODULE mod_1D_amma_read
175	!=====================================================================
176	subroutine read_amma(nid,nlevel,ntime &
177	& ,zz,pp,temp,qv,u,v,dw &
178	& ,dt,dq,sens,flat)
179
180	!program reading forcings of the AMMA case study
181	USE netcdf, ONLY: nf90_get_var
182	implicit none
183	INCLUDE "netcdf.inc"
184
185	integer ntime,nlevel
186
187	real zz(nlevel)
188	real temp(nlevel),pp(nlevel)
189	real qv(nlevel),u(nlevel)
190	real v(nlevel)
191	real dw(nlevel,ntime)
192	real dt(nlevel,ntime)
193	real dq(nlevel,ntime)
194	real flat(ntime),sens(ntime)
195
196
197	integer nid, ierr,rid
198	integer nbvar3d
199	parameter(nbvar3d=30)
200	integer var3didin(nbvar3d)
201
202	ierr=NF_INQ_VARID(nid,"zz",var3didin(1))
203	if(ierr/=NF_NOERR) then
204	write(,) NF_STRERROR(ierr)
205	stop 'lev'
206	endif
207
208
209	ierr=NF_INQ_VARID(nid,"temp",var3didin(2))
210	if(ierr/=NF_NOERR) then
211	write(,) NF_STRERROR(ierr)
212	stop 'temp'
213	endif
214
215	ierr=NF_INQ_VARID(nid,"qv",var3didin(3))
216	if(ierr/=NF_NOERR) then
217	write(,) NF_STRERROR(ierr)
218	stop 'qv'
219	endif
220
221	ierr=NF_INQ_VARID(nid,"u",var3didin(4))
222	if(ierr/=NF_NOERR) then
223	write(,) NF_STRERROR(ierr)
224	stop 'u'
225	endif
226
227	ierr=NF_INQ_VARID(nid,"v",var3didin(5))
228	if(ierr/=NF_NOERR) then
229	write(,) NF_STRERROR(ierr)
230	stop 'v'
231	endif
232
233	ierr=NF_INQ_VARID(nid,"dw",var3didin(6))
234	if(ierr/=NF_NOERR) then
235	write(,) NF_STRERROR(ierr)
236	stop 'dw'
237	endif
238
239	ierr=NF_INQ_VARID(nid,"dt",var3didin(7))
240	if(ierr/=NF_NOERR) then
241	write(,) NF_STRERROR(ierr)
242	stop 'dt'
243	endif
244
245	ierr=NF_INQ_VARID(nid,"dq",var3didin(8))
246	if(ierr/=NF_NOERR) then
247	write(,) NF_STRERROR(ierr)
248	stop 'dq'
249	endif
250
251	ierr=NF_INQ_VARID(nid,"sens",var3didin(9))
252	if(ierr/=NF_NOERR) then
253	write(,) NF_STRERROR(ierr)
254	stop 'sens'
255	endif
256
257	ierr=NF_INQ_VARID(nid,"flat",var3didin(10))
258	if(ierr/=NF_NOERR) then
259	write(,) NF_STRERROR(ierr)
260	stop 'flat'
261	endif
262
263	ierr=NF_INQ_VARID(nid,"pp",var3didin(11))
264	if(ierr/=NF_NOERR) then
265	write(,) NF_STRERROR(ierr)
266	endif
267
268	!dimensions lecture
269	! call catchaxis(nid,ntime,nlevel,time,z,ierr)
270
271	ierr = nf90_get_var(nid, var3didin(1), zz)
272	if(ierr/=NF_NOERR) then
273	write(,) NF_STRERROR(ierr)
274	stop "getvarup"
275	endif
276	! write(,)'lecture z ok',zz
277
278	ierr = nf90_get_var(nid, var3didin(2), temp)
279	if(ierr/=NF_NOERR) then
280	write(,) NF_STRERROR(ierr)
281	stop "getvarup"
282	endif
283	! write(,)'lecture th ok',temp
284
285	ierr = nf90_get_var(nid, var3didin(3), qv)
286	if(ierr/=NF_NOERR) then
287	write(,) NF_STRERROR(ierr)
288	stop "getvarup"
289	endif
290	! write(,)'lecture qv ok',qv
291
292	ierr = nf90_get_var(nid, var3didin(4), u)
293	if(ierr/=NF_NOERR) then
294	write(,) NF_STRERROR(ierr)
295	stop "getvarup"
296	endif
297	! write(,)'lecture u ok',u
298
299	ierr = nf90_get_var(nid, var3didin(5), v)
300	if(ierr/=NF_NOERR) then
301	write(,) NF_STRERROR(ierr)
302	stop "getvarup"
303	endif
304	! write(,)'lecture v ok',v
305
306	ierr = nf90_get_var(nid, var3didin(6), dw)
307	if(ierr/=NF_NOERR) then
308	write(,) NF_STRERROR(ierr)
309	stop "getvarup"
310	endif
311	! write(,)'lecture w ok',dw
312
313	ierr = nf90_get_var(nid, var3didin(7), dt)
314	if(ierr/=NF_NOERR) then
315	write(,) NF_STRERROR(ierr)
316	stop "getvarup"
317	endif
318	! write(,)'lecture dt ok',dt
319
320	ierr = nf90_get_var(nid, var3didin(8), dq)
321	if(ierr/=NF_NOERR) then
322	write(,) NF_STRERROR(ierr)
323	stop "getvarup"
324	endif
325	! write(,)'lecture dq ok',dq
326
327	ierr = nf90_get_var(nid, var3didin(9), sens)
328	if(ierr/=NF_NOERR) then
329	write(,) NF_STRERROR(ierr)
330	stop "getvarup"
331	endif
332	! write(,)'lecture sens ok',sens
333
334	ierr = nf90_get_var(nid, var3didin(10), flat)
335	if(ierr/=NF_NOERR) then
336	write(,) NF_STRERROR(ierr)
337	stop "getvarup"
338	endif
339	! write(,)'lecture flat ok',flat
340
341	ierr = nf90_get_var(nid, var3didin(11), pp)
342	if(ierr/=NF_NOERR) then
343	write(,) NF_STRERROR(ierr)
344	stop "getvarup"
345	endif
346	! write(,)'lecture pp ok',pp
347
348	return
349	end subroutine read_amma
350	!======================================================================
351	SUBROUTINE interp_amma_time(day,day1,annee_ref &
352	& ,year_ini_amma,day_ini_amma,nt_amma,dt_amma,nlev_amma &
353	& ,vitw_amma,ht_amma,hq_amma,lat_amma,sens_amma &
354	& ,vitw_prof,ht_prof,hq_prof,lat_prof,sens_prof)
355	implicit none
356
357	!---------------------------------------------------------------------------------------
358	! Time interpolation of a 2D field to the timestep corresponding to day
359	!
360	! day: current julian day (e.g. 717538.2)
361	! day1: first day of the simulation
362	! nt_amma: total nb of data in the forcing (e.g. 48 for AMMA)
363	! dt_amma: total time interval (in sec) between 2 forcing data (e.g. 30min for AMMA)
364	!---------------------------------------------------------------------------------------
365
366	INCLUDE "compar1d.h"
367
368	! inputs:
369	integer annee_ref
370	integer nt_amma,nlev_amma
371	integer year_ini_amma
372	real day, day1,day_ini_amma,dt_amma
373	real vitw_amma(nlev_amma,nt_amma)
374	real ht_amma(nlev_amma,nt_amma)
375	real hq_amma(nlev_amma,nt_amma)
376	real lat_amma(nt_amma)
377	real sens_amma(nt_amma)
378	! outputs:
379	real vitw_prof(nlev_amma)
380	real ht_prof(nlev_amma)
381	real hq_prof(nlev_amma)
382	real lat_prof,sens_prof
383	! local:
384	integer it_amma1, it_amma2,k
385	real timeit,time_amma1,time_amma2,frac
386
387
388	if (forcing_type.eq.6) then
389	! Check that initial day of the simulation consistent with AMMA case:
390	if (annee_ref.ne.2006) then
391	print*,'Pour AMMA, annee_ref doit etre 2006'
392	print*,'Changer annee_ref dans run.def'
393	stop
394	endif
395	if (annee_ref.eq.2006 .and. day1.lt.day_ini_amma) then
396	print*,'AMMA a d�but� le 10 juillet 2006',day1,day_ini_amma
397	print*,'Changer dayref dans run.def'
398	stop
399	endif
400	if (annee_ref.eq.2006 .and. day1.gt.day_ini_amma+1) then
401	print*,'AMMA a fini le 11 juillet'
402	print*,'Changer dayref ou nday dans run.def'
403	stop
404	endif
405	endif
406
407	! Determine timestep relative to the 1st day of AMMA:
408	! timeit=(day-day1)*86400.
409	! if (annee_ref.eq.1992) then
410	! timeit=(day-day_ini_toga)*86400.
411	! else
412	! timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992
413	! endif
414	timeit=(day-day_ini_amma)*86400
415
416	! Determine the closest observation times:
417	! it_amma1=INT(timeit/dt_amma)+1
418	! it_amma2=it_amma1 + 1
419	! time_amma1=(it_amma1-1)*dt_amma
420	! time_amma2=(it_amma2-1)*dt_amma
421
422	it_amma1=INT(timeit/dt_amma)+1
423	IF (it_amma1 .EQ. nt_amma) THEN
424	it_amma2=it_amma1
425	ELSE
426	it_amma2=it_amma1 + 1
427	ENDIF
428	time_amma1=(it_amma1-1)*dt_amma
429	time_amma2=(it_amma2-1)*dt_amma
430
431	if (it_amma1 .gt. nt_amma) then
432	write(,) 'PB-stop: day, it_amma1, it_amma2, timeit: ' &
433	& ,day,day_ini_amma,it_amma1,it_amma2,timeit/86400.
434	stop
435	endif
436
437	! time interpolation:
438	IF (it_amma1 .EQ. it_amma2) THEN
439	frac=0.
440	ELSE
441	frac=(time_amma2-timeit)/(time_amma2-time_amma1)
442	frac=max(frac,0.0)
443	ENDIF
444
445	lat_prof = lat_amma(it_amma2) &
446	& -frac*(lat_amma(it_amma2)-lat_amma(it_amma1))
447	sens_prof = sens_amma(it_amma2) &
448	& -frac*(sens_amma(it_amma2)-sens_amma(it_amma1))
449
450	do k=1,nlev_amma
451	vitw_prof(k) = vitw_amma(k,it_amma2) &
452	& -frac*(vitw_amma(k,it_amma2)-vitw_amma(k,it_amma1))
453	ht_prof(k) = ht_amma(k,it_amma2) &
454	& -frac*(ht_amma(k,it_amma2)-ht_amma(k,it_amma1))
455	hq_prof(k) = hq_amma(k,it_amma2) &
456	& -frac*(hq_amma(k,it_amma2)-hq_amma(k,it_amma1))
457	enddo
458
459	return
460	END
461

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

Download in other formats:

Original Format