Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

forcingdaily_tools.f90 @ 7541

Last change on this file since 7541 was 7541, checked in by fabienne.maignan, 2 years ago
Zhang publication on coupling factor
File size: 25.9 KB

Line
1	! ==============================================================================================================================\n
2	! MODULE forcingdaily_tools : The general idea of this module is to re-generate a diurnal cycle of forcing variables based
3	! on the daily mean values and Tairmin and Tairmax. The approach is to generate a temporal sub-domain
4	! of size "szsbd" which will correspond to "nbdays" days. Thus "nbdays" daily means will be used
5	! to regenerate the diurnal cycles. Doing more than one day allows to use higher order interpolations
6	! in case it is needed and avoid discontinuities. This process is performed by forcingdaily_gensubd when
7	! ever we come to a new day. The the subroutine forcingdaily_getvalues will extract from the "nbdays" of
8	! reconstructed diurnal cycle the values ORCHIDEE needs.
9	! For most variables we have a specific subroutine to re-generate the diurnal cycle with some specific
10	! parameters which allow to adjust the process.
11	!
12	! forcingdaily_gensubd :
13	! forcingdaily_getvalues :
14	!
15	! CONTACT : jan.polcher@lmd.jussieu.fr
16	!
17	! LICENCE : IPSL (2016)
18	! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
19	!
20	!>\BRIEF
21	!!
22	!! RECENT CHANGE(S): None
23	!!
24	!! REFERENCE(S) : None
25	!!
26	!_ ================================================================================================================================
27	!!
28	MODULE forcingdaily_tools
29	!
30	USE defprec
31	USE netcdf
32	!
33	USE ioipsl
34	USE constantes
35	USE solar
36	!
37	USE mod_orchidee_para
38	!
39	IMPLICIT NONE
40	!
41	PRIVATE
42	PUBLIC :: forcingdaily_gensubd, forcingdaily_getvalues
43	!
44	! This PARAMETER essentially manages the memory usage of the module as it
45	! determines how much of the forcing will be uploaded from the netCDF file into
46	! memory.
47	!
48	INTEGER(i_std), SAVE :: current_day = -1
49	REAL(r_std), PARAMETER :: dusk_angle = 0.01
50	INTEGER(i_std), PARAMETER :: nbdays = 3
51	INTEGER(i_std), PARAMETER :: spreadprec = 7200 !! Time over which the precipitation should be distributed (in sec.)
52	REAL(r_std), PARAMETER :: convprec_temp = 20.0 !! Temperature above which all precipitation is supposed to be convective.
53	!! i.e. rainfall occurs only over spreadprec. Below rainfall will last longer.
54	INTEGER(i_std), PARAMETER :: tmaxshift = 10800 !! How long after the solar noon should Tairmax occus ? Time in seconds.
55	INTEGER(i_std), SAVE :: seed = 7865439
56	!
57	INTEGER(i_std), SAVE :: szsubd
58	REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:) :: time_subd
59	REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:) :: tair_subd, qair_subd
60	REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:) :: ztq_subd, zuv_subd
61	REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:) :: rainf_subd, snowf_subd
62	REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:) :: solarang_subd, swdown_subd, lwdown_subd
63	REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:) :: u_subd, v_subd, ps_subd
64	REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: sinangles
65	INTEGER(i_std), SAVE, ALLOCATABLE, DIMENSION(:,:) :: idusk, irise, inoon
66	!
67	CONTAINS
68	!!
69	!! =============================================================================================================================
70	!! SUBROUTINE: forcingdaily_getval
71	!!
72	!!
73	!>\BRIEF Extracts the forcing values needed by ORCHIDEE from teh re-generated diurnal cycles.
74	!!
75	!! DESCRIPTION: As we are in a re-geneted diurnal cycle case, not a lot of precaution is taken to identify the value to be
76	!! used for the next integration interval of ORCHIDEE. Simply the values located closest to the middle of the
77	!! integration interval. This could be improved based on what is coded in forcing_tools.f90.
78	!!
79	!! \n
80	!_ ==============================================================================================================================
81	!
82	SUBROUTINE forcingdaily_getvalues(time_int, dt, ztq, zuv, tair, qair, rainf, snowf, &
83	& swdown, lwdown, solarang, u, v, ps)
84	!
85	! ARGUMENTS
86	!
87	REAL(r_std), INTENT(in) :: time_int(2) !! The time interval over which the forcing is needed.
88	REAL(r_std), INTENT(in) :: dt !! timestep, i.e. distance in seconds between time_int(1) and time_int(2)
89	REAL(r_std), INTENT(out) :: ztq(:), zuv(:)
90	REAL(r_std), INTENT(out) :: tair(:), qair(:), rainf(:), snowf(:)
91	REAL(r_std), INTENT(out) :: swdown(:), lwdown(:), solarang(:)
92	REAL(r_std), INTENT(out) :: u(:), v(:), ps(:)
93	!
94	! LOCAL
95	!
96	INTEGER(i_std) :: imin(1), i
97	REAL(r_std) :: tloc
98	!
99	tloc = (time_int(1)+time_int(2))/2.0
100	imin = MINLOC(ABS((tloc - (time_subd(:)+current_day))))
101	!
102	!
103	tair(:) = tair_subd(:,imin(1))
104	qair(:) = qair_subd(:,imin(1))
105	rainf(:) = rainf_subd(:,imin(1))
106	snowf(:) = snowf_subd(:,imin(1))
107	swdown(:) = swdown_subd(:,imin(1))
108	lwdown(:) = lwdown_subd(:,imin(1))
109	solarang(:) = solarang_subd(:,imin(1))
110	ztq(:) = ztq_subd(:,imin(1))
111	zuv(:) = zuv_subd(:,imin(1))
112	u(:) = u_subd(:,imin(1))
113	v(:) = v_subd(:,imin(1))
114	ps(:) = ps_subd(:,imin(1))
115	!
116	END SUBROUTINE forcingdaily_getvalues
117	!!
118	!! =============================================================================================================================
119	!! SUBROUTINE: forcingdaily_gensubd
120	!!
121	!!
122	!>\BRIEF generates the sub-diurnal cycle for a number of days around the current time step of the ORCHIDEE simulation.
123	!!
124	!! DESCRIPTION: This routine only works when we start a new day so that not too much work is done. At each new day first the
125	!! the diurnal evolution of the solar angle is computed and then from there all the rest is derived. For swdown
126	!! it is a trivial process but for the other variables more complex procedures are used. For those variables
127	!! nothing could be invented the daily mean value is places et the center of the day and a linear interpolation is
128	!! used.
129	!!
130	!! \n
131	!_ ==============================================================================================================================
132	!
133	SUBROUTINE forcingdaily_gensubd(time_int, dt, iim, jjm, lon, lat, gindex_proc, &
134	& szdom, szslab, time_slab, ztq, zuv, tair, tairmin, tairmax, &
135	& qair, rainf, snowf, swdown, lwdown, u, v, ps)
136
137	!
138	! ARGUMENTS
139	!
140	REAL(r_std), INTENT(in) :: time_int(2) !! The time interval over which the forcing is needed.
141	REAL(r_std), INTENT(in) :: dt !! timestep, i.e. distance in seconds between time_int(1) and time_int(2)
142	INTEGER(i_std), INTENT(in) :: szdom, szslab
143	INTEGER(i_std), INTENT(in) :: iim, jjm ! Size of 2D domain
144	REAL(r_std), INTENT(in) :: lon(iim,jjm), lat(iim,jjm) ! Longitude and latitude
145	INTEGER(i_std), INTENT(in) :: gindex_proc(szdom)
146	REAL(r_std), INTENT(in) :: time_slab(szslab)
147	REAL(r_std), INTENT(in) :: ztq(szdom,szslab), zuv(szdom,szslab)
148	REAL(r_std), INTENT(in) :: tair(szdom,szslab), tairmin(szdom,szslab), tairmax(szdom,szslab)
149	REAL(r_std), INTENT(in) :: qair(szdom,szslab), rainf(szdom,szslab), snowf(szdom,szslab)
150	REAL(r_std), INTENT(in) :: swdown(szdom,szslab), lwdown(szdom,szslab)
151	REAL(r_std), INTENT(in) :: u(szdom,szslab), v(szdom,szslab), ps(szdom,szslab)
152	!
153	! LOCAL
154	!
155	REAL(r_std) :: tloc
156	INTEGER(i_std) :: it, i, ist, imin(1), imax(1), tmin(1), iday
157	INTEGER(i_std) :: stpday, half_subd
158	REAL(r_std) :: julian
159	!
160	! Set date to middle of requested interval.
161	!
162	tloc = (time_int(1)+time_int(2))/2.0
163	!
164	IF (INT(tloc) .NE. current_day) THEN
165	!
166	! Save the date on which the 3 days are centered
167	!
168	current_day = INT(tloc)
169	!
170	! The sub-diurnal cycle needs to be generated for the 3 days around the current time step.
171	! Allocate memory needed.
172	!
173	IF ( .NOT. ALLOCATED(time_subd) ) THEN
174	!
175	szsubd=INT(nbdays*one_day/dt)
176	CALL random_seed()
177	!
178	ALLOCATE(time_subd(szsubd))
179	ALLOCATE(tair_subd(szdom,szsubd))
180	ALLOCATE(qair_subd(szdom,szsubd))
181	ALLOCATE(rainf_subd(szdom,szsubd))
182	ALLOCATE(snowf_subd(szdom,szsubd))
183	ALLOCATE(swdown_subd(szdom,szsubd))
184	ALLOCATE(lwdown_subd(szdom,szsubd))
185	ALLOCATE(solarang_subd(szdom,szsubd))
186	ALLOCATE(ztq_subd(szdom,szsubd))
187	ALLOCATE(zuv_subd(szdom,szsubd))
188	ALLOCATE(u_subd(szdom,szsubd))
189	ALLOCATE(v_subd(szdom,szsubd))
190	ALLOCATE(ps_subd(szdom,szsubd))
191	ALLOCATE(sinangles(iim,jjm,szsubd))
192	ALLOCATE(idusk(szdom,nbdays))
193	ALLOCATE(irise(szdom,nbdays))
194	ALLOCATE(inoon(szdom,nbdays))
195	ENDIF
196	!
197	! Number of sub-diurnal time steps per day.
198	! half_subd : number of days on either side of current date to be added.
199	stpday = NINT(REAL(szsubd/nbdays))
200	half_subd=INT(nbdays/2.0)
201	!
202	! Generate time axis for the sub-diurnal domain, over the number of days we have (nbdays)
203	!
204	DO it=1,szsubd
205	! Time will be relative to the day at which we are being called.
206	time_subd(it) = ((-half_subdone_day)+(it-0.5)dt)/one_day
207	ENDDO
208	!
209	CALL forcingdaily_solar(tloc, iim, jjm, lon, lat, gindex_proc, &
210	& szdom, szslab, time_slab, swdown, &
211	& szsubd, swdown_subd, sinangles, irise, inoon, idusk)
212	!
213	! Temperature
214	!
215	CALL forcingdaily_tair(tloc, dt, szdom, nbdays, szslab, time_slab, tairmin, tairmax, &
216	& irise, inoon, szsubd, tair_subd)
217	!
218	! LWdown
219	!
220	CALL forcingdaily_lwdown(tloc, dt, szdom, szslab, time_slab, &
221	& lwdown, szsubd, stpday, lwdown_subd)
222	!
223	! Precipitation
224	!
225	CALL forcingdaily_precip(tloc, dt, iim, jjm, lon, lat, gindex_proc, &
226	& szdom, szslab, time_slab, rainf, snowf, tair, &
227	& szsubd, rainf_subd, snowf_subd)
228	!
229	! Qair, U, V, PS
230	!
231	qair_subd(:,:) = undef_sechiba
232	ztq_subd(:,:) = undef_sechiba
233	zuv_subd(:,:) = undef_sechiba
234	u_subd(:,:) = undef_sechiba
235	v_subd(:,:) = undef_sechiba
236	ps_subd(:,:) = undef_sechiba
237	DO i=1,szdom
238	DO iday=1,nbdays
239	ist = (iday-1)*stpday+stpday/2
240	julian = INT(time_subd(ist) + current_day)+0.5
241	imin = MINLOC(ABS((julian - time_slab(1:szslab))))
242	qair_subd(i,ist) = qair(i,imin(1))
243	ztq_subd(i,ist) = ztq(i,imin(1))
244	zuv_subd(i,ist) = zuv(i,imin(1))
245	u_subd(i,ist) = u(i,imin(1))
246	v_subd(i,ist) = v(i,imin(1))
247	ps_subd(i,ist) = ps(i,imin(1))
248	ENDDO
249	ENDDO
250	CALL forcingdaily_linint(szdom, szsubd, nbdays, qair_subd)
251	CALL forcingdaily_linint(szdom, szsubd, nbdays, ztq_subd)
252	CALL forcingdaily_linint(szdom, szsubd, nbdays, zuv_subd)
253	CALL forcingdaily_linint(szdom, szsubd, nbdays, u_subd)
254	CALL forcingdaily_linint(szdom, szsubd, nbdays, v_subd)
255	CALL forcingdaily_linint(szdom, szsubd, nbdays, ps_subd)
256	ELSE
257	! Nothing to do as the sub-diurnal cycle has already been generated
258	ENDIF
259	END SUBROUTINE forcingdaily_gensubd
260	!!
261	!! =============================================================================================================================
262	!! SUBROUTINE: forcingdaily_linint
263	!!
264	!>\BRIEF Does a linear interpolation of the variables already placed in the variable.
265	!!
266	!! DESCRIPTION: It will replace the undefined values (x >= undef_sechiba) by the interpolated value. Before entering this
267	!! subroutine all time series need to be set to undef_sechiba with only the point between the interpolation should
268	!! be applied filled with actual values.
269	!!
270	!! \n
271	!_ ==============================================================================================================================
272	!
273	SUBROUTINE forcingdaily_linint(xsz, tsz, nbdays, x)
274	!!
275	!! Arguments
276	!!
277	INTEGER(i_std), INTENT(in) :: xsz, tsz, nbdays
278	REAL(r_std), INTENT(inout) :: x(xsz,tsz)
279	!!
280	!! Local
281	!!
282	INTEGER(i_std) :: ii, it, i
283	INTEGER(i_std) :: find, nind, sind
284	REAL(r_std) :: fval, nval, del
285	!!
286	!
287	DO ii=1,xsz
288	!
289	find = -1
290	fval = undef_sechiba
291	nind = 1
292	nval = undef_sechiba
293	!
294	DO WHILE (nind < tsz)
295	!
296	! Look for the next defined value
297	!
298	DO WHILE (nval >= undef_sechiba .AND. nind < tsz)
299	IF (x(ii,nind) < undef_sechiba) THEN
300	nval=x(ii,nind)
301	ELSE
302	nind=nind+1
303	ENDIF
304	IF (nind >= tsz) THEN
305	nval = undef_sechiba
306	nind = tsz
307	ENDIF
308	ENDDO
309	!
310	! Do the filling or interpolation between find and nind
311	!
312	IF ( find < 0 ) THEN
313	DO i=1,nind
314	x(ii,i) = nval
315	ENDDO
316	ELSE IF (nind == tsz) THEN
317	DO i=find,tsz
318	x(ii,i) = fval
319	ENDDO
320	ELSE
321	del = (nval-fval)/(nind-find)
322	DO i=find,nind
323	x(ii,i) = fval+del*(i-find)
324	ENDDO
325	ENDIF
326	!
327	! Move information to first index
328	!
329	find = nind
330	fval = nval
331	nval = undef_sechiba
332	nind = nind+1
333	ENDDO
334	ENDDO
335	END SUBROUTINE forcingdaily_linint
336	!!
337	!! =============================================================================================================================
338	!! SUBROUTINE: forcingdaily_solar
339	!!
340	!!
341	!>\BRIEF Computes the diurnal cycle of the solarangle and incident solar radiation.
342	!!
343	!! DESCRIPTION: This is very close to what is done in forcing_tools.f90 for the SWdown interpolation. The added code here
344	!! is to compute the time indicis of sun rise, noon and sun set. These will be important point in the
345	!! re-generation of the diurnal cycles.
346	!!
347	!! \n
348	!_ ==============================================================================================================================
349	!
350	SUBROUTINE forcingdaily_solar(tloc, iim, jjm, lon, lat, gindex_proc, &
351	& szdom, szslab, time_slab, swdown_loc, &
352	& szsubd, swdown_subd, sinangles, irise, inoon, idusk)
353	!
354	! Arguments
355	!
356	REAL(r_std), INTENT(in) :: tloc
357	INTEGER(i_std), INTENT(in) :: szdom, szslab
358	INTEGER(i_std), INTENT(in) :: iim, jjm ! Size of 2D domain
359	REAL(r_std), INTENT(in) :: lon(iim,jjm), lat(iim,jjm) ! Longitude and latitude
360	INTEGER(i_std), INTENT(in) :: gindex_proc(szdom)
361	REAL(r_std), INTENT(in) :: time_slab(szslab)
362	REAL(r_std), INTENT(in) :: swdown_loc(szdom,szslab)
363	INTEGER(i_std), INTENT(in) :: szsubd
364	REAL(r_std), INTENT(out) :: swdown_subd(szdom,szsubd)
365	REAL(r_std), INTENT(out) :: sinangles(iim,jjm,szsubd)
366	INTEGER(i_std), INTENT(out) :: idusk(szdom,nbdays)
367	INTEGER(i_std), INTENT(out) :: irise(szdom,nbdays)
368	INTEGER(i_std), INTENT(out) :: inoon(szdom,nbdays)
369	!
370	! Local
371	!
372	REAL(r_std) :: cval, lval
373	INTEGER(i_std) :: it, ii, jj, i, ist, imin(1), imax(1), tmin(1), iday
374	INTEGER(i_std) :: year, month, day, hours, minutes
375	INTEGER(i_std) :: stpday, half_subd
376	REAL(r_std) :: sec, julian
377	REAL(r_std), SAVE :: solaryearstart
378	REAL(r_std) :: sinang(iim,jjm), mean_sinang(iim,jjm,nbdays)
379	INTEGER(i_std) :: nbval(nbdays)
380	LOGICAL, SAVE, ALLOCATABLE, DIMENSION(:) :: mask
381	!
382	! Allocate memory
383	!
384	IF ( .NOT. ALLOCATED(mask) ) THEN
385	ALLOCATE(mask(szsubd))
386	ENDIF
387	!
388	! Get some basic dates and dimensions
389	!
390	stpday = NINT(REAL(szsubd/nbdays))
391	half_subd=INT(nbdays/2.0)
392	CALL ju2ymds (tloc, year, month, day, sec)
393	CALL ymds2ju (year, 1, 1, 0.0, solaryearstart)
394	!
395	mean_sinang(:,:,:) = 0.0
396	nbval(:) = 0
397	!
398	! Compute all solar angles
399	!
400	DO it=1,szsubd
401	julian=time_subd(it) + current_day
402	iday = INT(time_subd(it)+(nbdays-half_subd))
403	CALL solarang (julian, solaryearstart, iim, jjm, lon, lat, sinang)
404	DO ii=1,iim
405	DO jj=1,jjm
406	IF ( sinang(ii,jj) > zero .AND. sinang(ii,jj) < dusk_angle ) THEN
407	sinang(ii,jj) = dusk_angle
408	ENDIF
409	mean_sinang(ii,jj,iday) = mean_sinang(ii,jj,iday)+sinang(ii,jj)
410	ENDDO
411	ENDDO
412	nbval(iday) = nbval(iday)+1
413	!
414	sinangles(:,:,it) = sinang(:,:)
415	!
416	ENDDO
417	DO it=1,nbdays
418	mean_sinang(:,:,it) = mean_sinang(:,:,it)/nbval(it)
419	ENDDO
420	!
421	tmin = MINLOC(ABS((tloc-current_day)-time_subd(1:szsubd)))
422	imin = MINLOC(ABS((tloc - time_slab(1:szslab))))
423	sinang(:,:) = sinangles(:,:,tmin(1))
424	!
425	! Set default values for irise, inoon and idusk so that in polar
426	! regions we are not left with these indicis outside of range.
427	! These values only matter when the sun never rises (sinangles < dusk_angle).
428	!
429	DO iday=1,nbdays
430	irise(:,iday) = (iday-1)*stpday + INT(stpday/3)
431	inoon(:,iday) = (iday-1)*stpday + INT(stpday/2)
432	idusk(:,iday) = (iday-1)*stpday + INT(stpday/2) + INT(stpday/3)
433	ENDDO
434	!
435	DO it=1,szsubd
436	DO i=1,szdom
437	!
438	iday = INT(time_subd(it)+(nbdays-half_subd))
439	! Put Julian date to mid-day of current day
440	julian = INT(time_subd(it) + current_day)+0.5
441	imin = MINLOC(ABS((julian - time_slab(1:szslab))))
442	!
443	jj = ((gindex_proc(i)-1)/iim)+1
444	ii = (gindex_proc(i)-(jj-1)*iim)
445	!
446	IF ( mean_sinang(ii,jj,iday) > zero ) THEN
447	swdown_subd(i,it) = swdown_loc(i,imin(1))*sinangles(ii,jj,it)/mean_sinang(ii,jj,iday)
448	ELSE
449	swdown_subd(i,it) = zero
450	ENDIF
451	!
452	!
453	solarang_subd(i,it) = sinangles(ii,jj,it)
454	!
455	lval = sinangles(ii,jj,MAX(it-1,1))
456	cval = sinangles(ii,jj,it)
457	IF ( lval .LE. dusk_angle .AND. cval .GT. dusk_angle ) THEN
458	irise(i,iday) = it
459	ENDIF
460	IF ( lval .GT. dusk_angle .AND. cval .LE. dusk_angle ) THEN
461	idusk(i,iday) = it
462	ENDIF
463	ENDDO
464	ENDDO
465	!
466	! Position the solar noon in each day
467	!
468	DO i=1,szdom
469
470	jj = ((gindex_proc(i)-1)/iim)+1
471	ii = (gindex_proc(i)-(jj-1)*iim)
472
473	DO it=1,nbdays
474	mask=.FALSE.
475	DO ist=1,stpday
476	mask((it-1)*stpday+ist) = .TRUE.
477	ENDDO
478	imax = MAXLOC(swdown_subd(i,:), mask)
479	IF ( sinangles(ii,jj,imax(1)) > dusk_angle ) THEN
480	inoon(i,it) = imax(1)
481	ENDIF
482	ENDDO
483	ENDDO
484	!
485	END SUBROUTINE forcingdaily_solar
486	!! =============================================================================================================================
487	!! SUBROUTINE: forcingdaily_lwdown
488	!!
489	!!
490	!>\BRIEF Re-generates the LWdown variable.
491	!!
492	!! DESCRIPTION: For the moment LW down is maintained to the mean value over the full diurnal cycle. An idea would be to
493	!! to introduce a diurnal cycle related to the lower atmospheric temperature (Tair).
494	!!
495	!! \n
496	!_ ==============================================================================================================================
497	!
498	!! Interpolation of LWdown
499	!!
500	SUBROUTINE forcingdaily_lwdown(tloc, dt, szdom, szslab, time_slab, &
501	& lwdown, szsubd, stpday, lwdown_subd)
502	!
503	! Arguments
504	!
505	REAL(r_std), INTENT(in) :: tloc, dt
506	INTEGER(i_std), INTENT(in) :: szdom, szslab, stpday, szsubd
507	REAL(r_std), INTENT(in) :: time_slab(szslab)
508	REAL(r_std), INTENT(in) :: lwdown(szdom,szslab)
509	REAL(r_std), INTENT(out) :: lwdown_subd(szdom,szsubd)
510	!
511	! Local
512	!
513	INTEGER(i_std) :: i, iday, it, ist, imin(1)
514	REAL(r_std) :: julian
515	!
516	lwdown_subd(:,:) = undef_sechiba
517	DO i=1,szdom
518	DO iday=1,nbdays
519	DO it=1,stpday
520	ist = (iday-1)*stpday+it
521	julian = INT(time_subd(ist) + current_day)+0.5
522	imin = MINLOC(ABS((julian - time_slab(1:szslab))))
523	lwdown_subd(i,ist) = lwdown(i,imin(1))
524	ENDDO
525	ENDDO
526	ENDDO
527	END SUBROUTINE forcingdaily_lwdown
528	!! =============================================================================================================================
529	!! SUBROUTINE: forcingdaily_tair
530	!!
531	!!
532	!>\BRIEF Re-generates the Tair variable.
533	!!
534	!! DESCRIPTION:
535	!!
536	!! \n
537	!_ ==============================================================================================================================
538	!
539	!! Interpolation of Tair
540	!!
541	SUBROUTINE forcingdaily_tair(tloc, dt, szdom, nbdays, szslab, time_slab, tairmin, tairmax, &
542	& irise, inoon, szsubd, tair_subd)
543	!
544	! Arguments
545	!
546	REAL(r_std), INTENT(in) :: tloc, dt
547	INTEGER(i_std), INTENT(in) :: szdom, szslab, nbdays, szsubd
548	REAL(r_std), INTENT(in) :: time_slab(szslab)
549	REAL(r_std), INTENT(in) :: tairmin(szdom,szslab), tairmax(szdom,szslab)
550	INTEGER(i_std), INTENT(in) :: irise(szdom,nbdays), inoon(szdom,nbdays)
551	REAL(r_std), INTENT(out) :: tair_subd(szdom,szsubd)
552	!
553	! Local
554	!
555	INTEGER(i_std) :: i, it, imin(1), in, ir
556	INTEGER(i_std) :: stpday, nbshift
557	REAL(r_std) :: julian
558	!
559	stpday = NINT(REAL(szsubd/nbdays))
560	nbshift = NINT(REAL(tmaxshift/dt))
561	!
562	tair_subd(:,:) = undef_sechiba
563	DO i=1,szdom
564	DO it=1,nbdays
565	!
566	! Tairmax position
567	!
568	in = (it-1)*stpday + MOD(inoon(i,it)+nbshift-1, stpday)+1
569	!! in = inoon(i,it)+nbshift
570	julian = INT(time_subd(in) + current_day)+0.5
571	imin = MINLOC(ABS((julian - time_slab(1:szslab))))
572	tair_subd(i,in) = tairmax(i,imin(1))
573	!
574	! Tairmin position
575	!
576	ir = irise(i,it)
577	julian = INT(time_subd(ir) + current_day)+0.5
578	imin = MINLOC(ABS((julian - time_slab(1:szslab))))
579	tair_subd(i,ir) = tairmin(i,imin(1))
580	ENDDO
581	ENDDO
582	!
583	CALL forcingdaily_linint(szdom, szsubd, nbdays, tair_subd)
584	!
585	END SUBROUTINE forcingdaily_tair
586	!!
587	!! =============================================================================================================================
588	!! SUBROUTINE: forcingdaily_precip
589	!!
590	!>\BRIEF Distributes the rainfall of a day on a period spreadprec in a random place within the diurnal cycle.
591	!!
592	!! DESCRIPTION: Rainfall is distributed randomly within the day over the spreadprec period. A wide room for improvements here.
593	!! We need to think about the geographical variations of spreadprec and the most lieky time of day for rainfall.
594	!!
595	!! \n
596	!_ ==============================================================================================================================
597	!
598	SUBROUTINE forcingdaily_precip(tloc, dt, iim, jjm, lon, lat, gindex_proc, &
599	& szdom, szslab, time_slab, rainf, snowf, tair, &
600	& szsubd, rainf_subd, snowf_subd)
601	!
602	! Arguments
603	!
604	REAL(r_std), INTENT(in) :: tloc, dt
605	INTEGER(i_std), INTENT(in) :: szdom, szslab
606	INTEGER(i_std), INTENT(in) :: iim, jjm ! Size of 2D domain
607	REAL(r_std), INTENT(in) :: lon(iim,jjm), lat(iim,jjm) ! Longitude and latitude
608	INTEGER(i_std), INTENT(in) :: gindex_proc(szdom)
609	REAL(r_std), INTENT(in) :: time_slab(szslab)
610	REAL(r_std), INTENT(in) :: rainf(szdom,szslab), snowf(szdom,szslab)
611	REAL(r_std), INTENT(in) :: tair(szdom,szslab)
612	INTEGER(i_std), INTENT(in) :: szsubd
613	REAL(r_std), INTENT(out) :: rainf_subd(szdom,szsubd), snowf_subd(szdom,szsubd)
614	!
615	! Local
616	!
617	INTEGER(i_std) :: i, ist, iday, it, ip
618	INTEGER(i_std) :: imin(1)
619	INTEGER(i_std) :: stpday, nbstep
620	REAL(r_std) :: julian, rr, rainlength
621	!
622	stpday = NINT(REAL(szsubd/nbdays))
623	!
624	rainf_subd(:,:) = zero
625	snowf_subd(:,:) = zero
626	!
627	DO i=1,szdom
628	DO iday=1,nbdays
629	!
630	ist = (iday-1)*stpday+INT(stpday/2)
631	julian = INT(time_subd(ist) + current_day)+0.5
632	imin = MINLOC(ABS((julian - time_slab(1:szslab))))
633	!
634	! Air temperature decides how long the rainfall will be !
635	! When it is cold the precipitation will last 3 times longer.
636	!
637	rainlength=spreadprec + MIN(MAX(convprec_temp - (tair(i,imin(1)) - tp_00), 0.0), &
638	convprec_temp)/convprec_temp3.0spreadprec
639	nbstep = NINT(REAL(rainlength/dt))
640	!
641	IF (rainf(i,imin(1)) > zero .OR. snowf(i,imin(1)) > zero) THEN
642	CALL random_number(rr)
643	it = INT(rr*stpday)+1
644	DO ist=1,nbstep
645	ip = MOD(it-1+(ist-1),stpday)+1
646	rainf_subd(i,(iday-1)stpday+ip) = rainf(i,imin(1))one_day/rainlength*dt
647	snowf_subd(i,(iday-1)stpday+ip) = snowf(i,imin(1))one_day/rainlength*dt
648	ENDDO
649	ENDIF
650	ENDDO
651	ENDDO
652	!
653	END SUBROUTINE forcingdaily_precip
654	!
655	END MODULE forcingdaily_tools

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

Context Navigation

source: branches/publications/ORCHIDEE_2.2_r7266/ORCHIDEE/src_driver/forcingdaily_tools.f90 @ 7541

Download in other formats: