[Dart-dev] [3821] DART/trunk/time_manager/schedule_mod.f90: The schedule_mod module is intended to declare the temporal schedule for an
nancy at ucar.edu
nancy at ucar.edu
Thu Apr 16 14:21:44 MDT 2009
An HTML attachment was scrubbed...
URL: http://mailman.ucar.edu/pipermail/dart-dev/attachments/20090416/29dc5bdc/attachment-0001.html
-------------- next part --------------
Added: DART/trunk/time_manager/schedule_mod.f90
===================================================================
--- DART/trunk/time_manager/schedule_mod.f90 (rev 0)
+++ DART/trunk/time_manager/schedule_mod.f90 2009-04-16 20:21:43 UTC (rev 3821)
@@ -0,0 +1,313 @@
+! Data Assimilation Research Testbed -- DART
+! Copyright 2004-2007, Data Assimilation Research Section
+! University Corporation for Atmospheric Research
+! Licensed under the GPL -- www.gpl.org/licenses/gpl.html
+
+module schedule_mod
+
+! <next few lines under version control, do not edit>
+! $URL$
+! $Id$
+! $Revision$
+! $Date$
+
+use types_mod, only : missing_i, digits12
+
+use utilities_mod, only : error_handler, E_DBG, E_MSG, E_WARN, E_ERR, &
+ register_module, nmlfileunit, do_output, &
+ check_namelist_read, find_namelist_in_file
+
+use time_manager_mod, only : time_type, set_calendar_type, get_calendar_type, &
+ set_time, set_date, get_time, get_date, &
+ print_time, print_date, &
+ THIRTY_DAY_MONTHS, JULIAN, GREGORIAN, &
+ NOLEAP, NO_CALENDAR, GREGORIAN_MARS, &
+ operator(*), operator(+), operator(-), &
+ operator(>), operator(<), operator(/), &
+ operator(/=), operator(<=)
+
+implicit none
+private
+
+!=======================================================================
+!
+!
+!
+!
+!=======================================================================
+
+! version controlled file description for error handling, do not edit
+character(len=128), parameter :: &
+ source = "$URL$", &
+ revision = "$Revision$", &
+ revdate = "$Date$"
+
+type schedule_type
+ private
+ integer :: num_bins
+ integer :: current_bin
+ logical :: last_bin
+ integer :: calendar
+ character(len=32) :: calendarstring
+ type(time_type) :: binwidth
+ type(time_type) :: bininterval
+ type(time_type), pointer :: binstart( :) => NULL()
+ type(time_type), pointer :: binend( :) => NULL()
+ real(digits12), pointer :: epoch_start(:) => NULL()
+ real(digits12), pointer :: epoch_end( :) => NULL()
+end type schedule_type
+
+!-----------------------------------------------------------------------
+! Namelist with default values
+!-----------------------------------------------------------------------
+
+integer, dimension(6) :: bin_start = (/ 2008, 9, 7, 0, 0, 0 /)
+integer, dimension(6) :: bin_end = (/ 2008, 9, 7, 2, 0, 0 /)
+integer, dimension(6) :: last_bin_end = (/ 2008, 9,11, 0, 0, 0 /)
+integer :: bin_interval_days = 0
+integer :: bin_interval_seconds = 21600
+integer :: max_num_bins = 1000
+character(len=32) :: calendar = 'Gregorian'
+logical :: print_table = .false.
+
+namelist /schedule_nml/ bin_start, bin_end, last_bin_end, &
+ bin_interval_days, bin_interval_seconds, &
+ max_num_bins, calendar, print_table
+
+!-----------------------------------------------------------------------
+
+character(len = 129) :: msgstring
+
+logical, save :: module_initialized = .false.
+
+
+public :: schedule_type ! Module defines a single type
+
+! Subroutines and functions operating on time_type
+public :: set_regular_schedule, get_time_from_schedule, &
+ get_schedule_length
+
+interface get_time_from_schedule
+ module procedure get_timetype_from_schedule
+ module procedure get_realtime_from_schedule
+end interface
+
+!=======================================================================
+contains
+!=======================================================================
+
+
+subroutine schedule_init()
+
+integer :: iunit, io
+
+call register_module(source, revision, revdate)
+
+! Read the namelist entry
+call find_namelist_in_file("input.nml", "schedule_nml", iunit)
+read(iunit, nml = schedule_nml, iostat = io)
+call check_namelist_read(iunit, io, "schedule_nml")
+
+! Write the namelist values to the log file
+if (do_output()) write(nmlfileunit, nml=schedule_nml)
+if (do_output()) write( * , nml=schedule_nml)
+
+call set_calendar_type(calendar)
+
+module_initialized = .true.
+
+end subroutine schedule_init
+
+
+
+
+subroutine set_regular_schedule(schedule)
+! all of the necessary information to set a schedule is gotten from the namelist
+type(schedule_type), intent(out) :: schedule
+
+
+type(time_type) :: beg_time, end_time
+type(time_type) :: bininterval, binwidth
+type(time_type) :: TimeMin, TimeMax
+
+integer :: iepoch, Nepochs, seconds, days
+
+character(len=32) :: str1, str2, str3
+
+if ( .not. module_initialized ) call schedule_init ! reads the namelist
+
+beg_time = set_date(bin_start(1), bin_start(2), &
+ bin_start(3), bin_start(4), &
+ bin_start(5), bin_start(6) )
+end_time = set_date(bin_end(1), bin_end(2), &
+ bin_end(3), bin_end(4), &
+ bin_end(5), bin_end(6) )
+TimeMax = set_date(last_bin_end(1), last_bin_end(2), &
+ last_bin_end(3), last_bin_end(4), &
+ last_bin_end(5), last_bin_end(6) )
+
+bininterval = set_time(bin_interval_seconds, bin_interval_days)
+
+! do some error-checking first
+
+if (end_time < beg_time) then
+ write(msgstring,*)'schedule_nml:bin_end must be at or after bin_start'
+ call error_handler(E_ERR,'set_regular_schedule',msgstring,source,revision,revdate)
+endif
+
+if (TimeMax < end_time) then
+ write(msgstring,*)'schedule_nml:last_bin_end must be at or after bin_end'
+ call error_handler(E_ERR,'set_regular_schedule',msgstring,source,revision,revdate)
+endif
+
+binwidth = beg_time - end_time
+call get_time(binwidth, seconds, days)
+binwidth = set_time(seconds, days)
+
+if (bininterval < binwidth) then
+ write(msgstring,*)'schedule_nml:bin interval must be >= bin width'
+ call error_handler(E_ERR,'set_regular_schedule',msgstring,source,revision,revdate)
+endif
+
+! FIXME
+! Need to check that bin_interval is a multiple of the model advance step
+! for real assimilation experiments. This is not needed for observation-space
+! diagnostics or ...
+
+! Determine temporal bin characteristics.
+! The user input is not guaranteed to align on bin centers.
+! So -- we will assume the start time is correct and take strides till we
+! get past the last time of interest.
+! Nepochs will be the total number of time intervals of the period requested.
+
+TimeMin = end_time
+Nepochs = 0
+NepochLoop : do iepoch = 1,max_num_bins
+ if ( TimeMin > TimeMax ) exit NepochLoop
+ Nepochs = iepoch
+ TimeMin = TimeMin + bininterval
+enddo NepochLoop
+
+if (do_output()) write(*,*)'Requesting ',Nepochs,' assimilation periods.'
+
+if (Nepochs < 1) then
+ write(msgstring,*)'schedule_nml:Requesting ZERO assimilation periods.'
+ call error_handler(E_ERR,'set_regular_schedule',msgstring,source,revision,revdate)
+endif
+
+! Now that we know the number of assimilation epochs, allocate and fill.
+! Our assimilation bins start 1 second AFTER the stated time, and end ON
+! the stated time. If you specify a bin from 00Z to 03Z ... and again
+! from 03Z to 06Z ... the observation at 03Z is considered to be part
+! of the bin from 00Z to 03Z ONLY. Mathematically, ( 00Z, 03Z ]
+
+allocate(schedule%binstart( Nepochs), schedule%binend( Nepochs), &
+ schedule%epoch_start(Nepochs), schedule%epoch_end(Nepochs))
+
+schedule%binstart(1) = beg_time + set_time(1,0)
+schedule%binend( 1) = end_time
+schedule%binwidth = binwidth
+schedule%bininterval = bininterval
+schedule%current_bin = 0
+schedule%last_bin = .false.
+schedule%calendar = get_calendar_type()
+schedule%calendarstring = calendar
+schedule%num_bins = Nepochs
+
+call get_time(schedule%binstart(1), seconds, days)
+schedule%epoch_start(1) = days + seconds/86400.0_digits12
+
+call get_time(schedule%binend( 1), seconds, days)
+schedule%epoch_end( 1) = days + seconds/86400.0_digits12
+
+BinLoop : do iepoch = 2,Nepochs
+
+ schedule%binstart(iepoch) = schedule%binstart(iepoch-1) + bininterval
+ schedule%binend( iepoch) = schedule%binend( iepoch-1) + bininterval
+
+ call get_time(schedule%binstart(iepoch), seconds, days)
+ schedule%epoch_start(iepoch) = days + seconds/86400.0_digits12
+
+ call get_time(schedule%binend( iepoch), seconds, days)
+ schedule%epoch_end( iepoch) = days + seconds/86400.0_digits12
+
+enddo BinLoop
+
+if ( print_table ) then
+do iepoch = 1,Nepochs
+ write( * ,*)
+ write(str1,'(''epoch '',i6,'' start'')')iepoch
+ write(str2,'(''epoch '',i6,'' center'')')iepoch
+ write(str3,'(''epoch '',i6,'' end'')')iepoch
+
+ call print_time( schedule%binstart(iepoch), str1)
+ call print_time( schedule%binend( iepoch), str3)
+
+ call print_date( schedule%binstart(iepoch), str1)
+ call print_date( schedule%binend( iepoch), str3)
+enddo
+write( * ,*)
+endif
+
+end subroutine set_regular_schedule
+
+
+
+subroutine get_timetype_from_schedule(mytime, schedule, iepoch, edge)
+
+type(time_type), intent(OUT) :: mytime
+type(schedule_type), intent(IN) :: schedule
+integer, intent(IN) :: iepoch
+integer, optional, intent(IN) :: edge
+
+if (iepoch > schedule%num_bins) then
+ write(msgstring,*)'schedule has ',schedule%num_bins,' bins; you wanted bin',iepoch
+ call error_handler(E_ERR,'get_timetype_from_schedule',msgstring, &
+ source,revision,revdate)
+endif
+
+if (present(edge)) then
+ if (edge > 1) then
+ mytime = schedule%binend(iepoch)
+ else
+ mytime = schedule%binstart(iepoch)
+ endif
+else
+ mytime = schedule%binstart(iepoch)
+endif
+
+end subroutine
+
+
+
+subroutine get_realtime_from_schedule(mytime, schedule, iepoch, edge)
+
+real(digits12), intent(OUT) :: mytime
+type(schedule_type), intent(IN) :: schedule
+integer, intent(IN) :: iepoch
+integer, optional, intent(IN) :: edge
+
+type(time_type) :: yourtime
+integer :: seconds, days
+
+if (present(edge)) then
+ call get_timetype_from_schedule(yourtime, schedule, iepoch, edge)
+else
+ call get_timetype_from_schedule(yourtime, schedule, iepoch)
+endif
+
+call get_time(yourtime, seconds, days)
+
+mytime = days + seconds/86400.0_digits12
+
+end subroutine
+
+
+function get_schedule_length(schedule)
+ type(schedule_type), intent(IN) :: schedule
+ integer :: get_schedule_length
+
+ get_schedule_length = schedule%num_bins
+end function
+
+end module schedule_mod
Property changes on: DART/trunk/time_manager/schedule_mod.f90
___________________________________________________________________
Name: mime-type
+ text/plain
Name: svn:keywords
+ Date Rev Author URL Id
Name: svn:eol-style
+ native
More information about the Dart-dev
mailing list