25 type(time_type),
intent(in) :: Time
26 real(FMS_TI_KIND_),
intent(out) :: weight
28 integer :: yr, mo, dy, hour, minute, second
29 type(time_type) :: Year_beg, Year_end
32 if ( .not. module_is_initialized )
call time_interp_init
36 call get_date (time, yr, mo, dy, hour, minute, second)
38 year_beg = set_date(yr , 1, 1)
39 year_end = set_date(yr+1, 1, 1)
41 weight = real( (time - year_beg) // (year_end - year_beg) , kind=fms_ti_kind_)
49 type(time_type),
intent(in) :: Time
50 real(FMS_TI_KIND_),
intent(out) :: weight
51 integer ,
intent(out) :: year1, year2
53 integer :: yr, mo, dy, hour, minute, second
54 type (time_type) :: Mid_year, Mid_year1, Mid_year2
57 if ( .not. module_is_initialized )
call time_interp_init()
59 call get_date (time, yr, mo, dy, hour, minute, second)
62 mid_year = year_midpt(yr)
64 if ( time >= mid_year )
then
68 mid_year2 = year_midpt(year2)
69 weight = real( (time - mid_year) // (mid_year2 - mid_year) , kind=fms_ti_kind_ )
74 mid_year1 = year_midpt(year1)
75 weight = real( (time - mid_year1) // (mid_year - mid_year1), kind=fms_ti_kind_ )
83 type(time_type),
intent(in) :: Time
84 real(FMS_TI_KIND_) ,
intent(out) :: weight
85 integer ,
intent(out) :: year1, year2, month1, month2
87 integer :: yr, mo, dy, hour, minute, second, &
88 mid_month, cur_month, mid1, mid2
90 if ( .not. module_is_initialized )
call time_interp_init()
92 call get_date (time, yr, mo, dy, hour, minute, second)
95 mid_month = days_in_month(time) * halfday
97 cur_month = second + secmin*minute + sechour*hour + secday*(dy-1)
99 if ( cur_month >= mid_month )
then
101 year1 = yr; month1 = mo
102 year2 = yr; month2 = mo+1
103 if (month2 > monyear)
then
104 year2 = year2+1; month2 = 1
107 mid2 = days_in_month(set_date(year2,month2,2)) * halfday
108 weight = real(cur_month - mid1, fms_ti_kind_) / real(mid1+mid2, fms_ti_kind_)
111 year2 = yr; month2 = mo
112 year1 = yr; month1 = mo-1
114 year1 = year1-1; month1 = monyear
117 mid1 = days_in_month(set_date(year1,month1,2)) * halfday
122 mid1 = days_in_month(set_date(1,month1,2)) * halfday
125 weight = real(cur_month + mid1, fms_ti_kind_) / real(mid1+mid2, fms_ti_kind_)
133 type(time_type),
intent(in) :: Time
134 real(FMS_TI_KIND_),
intent(out) :: weight
135 integer ,
intent(out) :: year1, year2, month1, month2, day1, day2
137 integer :: yr, mo, dy, hour, minute, second, sday
139 if ( .not. module_is_initialized )
call time_interp_init()
141 call get_date (time, yr, mo, dy, hour, minute, second)
144 sday = second + secmin*minute + sechour*hour
146 if ( sday >= halfday )
then
148 year1 = yr; month1 = mo; day1 = dy
149 year2 = yr; month2 = mo; day2 = dy + 1
150 weight = real(sday - halfday, fms_ti_kind_) / real(secday, fms_ti_kind_)
152 if (day2 > days_in_month(time))
then
155 if (month2 > monyear)
then
156 month2 = 1; year2 = year2+1
161 year2 = yr; month2 = mo ; day2 = dy
162 year1 = yr; month1 = mo; day1 = dy - 1
163 weight = real(sday + halfday,fms_ti_kind_) / real(secday,fms_ti_kind_)
168 month1 = monyear; year1 = year1-1
170 day1 = days_in_month(set_date(year1,month1,2))
181 correct_leap_year_inconsistency, err_msg)
182 type(time_type),
intent(in) :: Time
183 type(time_type),
intent(in) :: Time_beg
184 type(time_type),
intent(in) :: Time_end
185 type(time_type),
intent(in) :: Timelist(:)
186 real(FMS_TI_KIND_) ,
intent(out) :: weight
187 integer ,
intent(out) :: index1, index2
188 logical,
intent(in),
optional :: correct_leap_year_inconsistency
196 character(len=*),
intent(out),
optional :: err_msg
198 type(time_type) :: Period, T
199 integer :: is, ie,i1,i2
200 integer :: ys,ms,ds,hs,mins,ss
201 integer :: ye,me,de,he,mine,se
202 integer :: yt,mt,dt,ht,mint,st
205 integer :: stdoutunit
206 logical :: correct_lyr, calendar_has_leap_years, do_the_lyr_correction
207 integer,
parameter :: kindl = fms_ti_kind_
209 if ( .not. module_is_initialized )
call time_interp_init
210 if(
present(err_msg) ) err_msg =
''
215 if (time_beg>=time_end)
then
216 if(fms_error_handler(
'time_interp_modulo', &
217 'end of the specified time loop interval must be later than its beginning',err_msg))
return
220 calendar_has_leap_years = (get_calendar_type() == julian .or. get_calendar_type() == gregorian)
222 period = time_end-time_beg
224 if(
present(correct_leap_year_inconsistency))
then
225 correct_lyr = correct_leap_year_inconsistency
227 correct_lyr = .false.
233 do_the_lyr_correction = .false.
242 if(calendar_has_leap_years .and. correct_lyr)
then
243 call get_date(time_beg,ys,ms,ds,hs,mins,ss)
244 call get_date(time_end,ye,me,de,he,mine,se)
245 if(ms==me.and.ds==de.and.hs==he.and.mins==mine.and.ss==se)
then
247 do_the_lyr_correction = .true.
251 if(do_the_lyr_correction)
then
252 call get_date(t,yt,mt,dt,ht,mint,st)
253 yt = ys+modulo(yt-ys,ye-ys)
256 if(mt==2.and.dt==29.and..not.leap_year(set_date(yt,1,1))) dt1=28
257 t = set_date(yt,mt,dt1,ht,mint,st)
258 if (t < time_beg)
then
261 if(mt==2.and.dt==29.and..not.leap_year(set_date(ye,1,1))) dt=28
262 t = set_date(ye,mt,dt,ht,mint,st)
265 do while ( t >= time_end )
268 do while ( t < time_beg )
275 if (time_end<=timelist(1).or.time_beg>=timelist(n))
then
276 if(get_calendar_type() == no_calendar)
then
277 call print_time(time_beg,
'Time_beg' )
278 call print_time(time_end,
'Time_end' )
279 call print_time(timelist(1),
'Timelist(1)' )
280 call print_time(timelist(n),
'Timelist(n)' )
282 call print_date(time_beg,
'Time_beg' )
283 call print_date(time_end,
'Time_end' )
284 call print_date(timelist(1),
'Timelist(1)' )
285 call print_date(timelist(n),
'Timelist(n)' )
287 write(stdoutunit,*)
'where n = size(Timelist) =',n
288 if(fms_error_handler(
'time_interp_modulo', &
289 'the entire time list is outside the specified time loop interval',err_msg))
return
292 call bisect(timelist,time_beg,index1=i1,index2=i2)
295 else if (time_beg == timelist(i1))
then
300 call bisect(timelist,time_end,index1=i1,index2=i2)
301 if (time_end > timelist(i1))
then
303 else if (time_end == timelist(i1))
then
304 if(time_beg == timelist(is))
then
316 if(get_calendar_type() == no_calendar)
then
317 call print_time(time_beg,
'Time_beg =')
318 call print_time(time_end,
'Time_end =')
319 call print_time(timelist(1),
'Timelist(1)=')
320 call print_time(timelist(n),
'Timelist(n)=')
322 call print_date(time_beg,
'Time_beg =')
323 call print_date(time_end,
'Time_end =')
324 call print_date(timelist(1),
'Timelist(1)=')
325 call print_date(timelist(n),
'Timelist(n)=')
327 write(stdoutunit,*)
'where n = size(Timelist) =',n
328 write(stdoutunit,*)
'is =',is,
'ie =',ie
329 if(fms_error_handler(
'time_interp_modulo', &
330 'error in calculation of time list bounds within the specified time loop interval',err_msg))
return
334 if( t>=timelist(ie) )
then
336 index1 = ie; index2 = is
337 weight = real((t-timelist(ie))//(period-(timelist(ie)-timelist(is))), fms_ti_kind_ )
338 else if (t<timelist(is))
then
340 index1 = ie; index2 = is
341 weight = 1.0_kindl - real(((timelist(is)-t)//(period-(timelist(ie)-timelist(is)))), fms_ti_kind_ )
343 call bisect(timelist,t,index1,index2)
344 weight = real((t-timelist(index1)) // (timelist(index2)-timelist(index1)), fms_ti_kind_ )
349 subroutine time_interp_list_ ( Time, Timelist, weight, index1, index2, modtime, err_msg )
350 type(time_type) ,
intent(in) :: Time, Timelist(:)
351 real(FMS_TI_KIND_) ,
intent(out) :: weight
352 integer ,
intent(out) :: index1, index2
353 integer,
optional,
intent(in) :: modtime
354 character(len=*),
intent(out),
optional :: err_msg
356 integer :: n, hr, mn, se, mtime
357 type(time_type) :: T, Ts, Te, Td, Period, Time_mod
358 character(len=:),
allocatable :: terr, tserr, teerr
359 integer,
parameter :: kindl = fms_ti_kind_
361 if ( .not. module_is_initialized )
call time_interp_init
363 if(
present(err_msg) ) err_msg =
''
365 weight = 0.0_kindl; index1 = 0; index2 = 0
366 n =
size(timelist(:))
370 if (
present(modtime))
then
372 time_mod = (timelist(1)+timelist(n))/2
373 call get_date (time_mod, yrmod, momod, dymod, hr, mn, se)
374 mod_leapyear = leap_year(time_mod)
382 period = set_time(0,days_in_year(time_mod))
385 if (days_in_month(time_mod) /= days_in_month(time))
then
386 if(fms_error_handler(
'time_interp_list',
'modulo months must have same length',err_msg))
return
388 period = set_time(0,days_in_month(time_mod))
390 period = set_time(0,1)
392 if(fms_error_handler(
'time_interp_list',
'invalid value for argument modtime',err_msg))
return
398 if (mtime /= none .and. timelist(
size(timelist))-timelist(1) == period)
then
399 n =
size(timelist) - 1
408 t = set_modtime(time,mtime)
411 if (mtime /= none)
then
412 if (td > period)
then
413 if(fms_error_handler(
'time_interp_list',
'period of list exceeds modulo period',err_msg))
return
418 if ( t >= ts .and. t < te )
then
419 call bisect(timelist(1:n),t,index1,index2)
420 weight = real( (t-timelist(index1)) // (timelist(index2)-timelist(index1)), fms_ti_kind_)
423 else if ( t < ts )
then
424 if (mtime == none)
then
425 call time_list_error(t,terr)
426 call time_list_error(ts,tserr)
427 call time_list_error(te,teerr)
428 if(fms_error_handler(
'time_interp_list',&
429 'time '//trim(terr)//
' ('//date_to_string(t)//
' is before range of list '//trim(tserr)//
'-'//trim(teerr)//&
430 '('//date_to_string(ts)//
' - '//date_to_string(te)//
')',&
432 deallocate(terr,tserr,teerr)
435 weight = 1.0_kindl - real(((ts-t) // (period-td)), fms_ti_kind_ )
440 else if ( t == te )
then
441 if(perthlike_behavior)
then
448 if (mtime == none)
then
456 else if ( t > te )
then
457 if (mtime == none)
then
458 call time_list_error(t,terr)
459 call time_list_error(ts,tserr)
460 call time_list_error(te,teerr)
461 if(fms_error_handler(
'time_interp_list',&
462 'time '//trim(terr)//
' ('//date_to_string(t)//
' is after range of list '//trim(tserr)//
'-'//trim(teerr)//&
463 '('//date_to_string(ts)//
' - '//date_to_string(te)//
')',&
465 deallocate(terr,tserr,teerr)
468 weight = real( (t-te) // (period-td), fms_ti_kind_)
473 end subroutine time_interp_list_
integer function stdout()
This function returns the current standard fortran unit numbers for output.
subroutine time_interp_year_(Time, weight, year1, year2)
Calculates fractional time between mid points of consecutive years.
subroutine time_interp_month_(Time, weight, year1, year2, month1, month2)
Calculates fractional time between mid points of consecutive months.
subroutine time_interp_frac_(Time, weight)
Calculates the fractional time into the current year.
subroutine time_interp_modulo_(Time, Time_beg, Time_end, Timelist, weight, index1, index2, correct_leap_year_inconsistency, err_msg)
Part of the time_interp interface, calculates for cyclical data Time_beg and Time_end mark a repeatin...
subroutine time_interp_day_(Time, weight, year1, year2, month1, month2, day1, day2)
Calculates fractional time between mid points of consecutive days.