simulation_datetime.F90

Go to the documentation of this file.

module simulation_datetime
 
  use iso_c_binding
  use datetime
  implicit none
 
  private
 
  type, public :: date_range_t
    type (datetime_t)       :: start
    type (datetime_t)       :: end
    type (datetime_t)       :: curr
    integer (c_int)    :: idoy
    integer (c_int)    :: idaysinmonth
    integer (c_int)    :: idaysinyear
    integer (c_int)    :: iyearofsimulation = 1
    logical (c_bool)   :: lisleapyear
    integer (c_int)    :: inumdaysfromorigin = 0
    integer (c_int)    :: idayofsimulation = 0
 
  contains
 
    procedure :: initialize_datetimes_sub
    generic   :: initialize => initialize_datetimes_sub
 
    procedure :: days_from_origin_fn
    generic   :: days_from_origin => days_from_origin_fn
 
    procedure :: increment_by_one_day_sub
    generic   :: addday => increment_by_one_day_sub
 
    procedure :: advance_curr_to_last_day_of_year_sub
    generic   :: advance_to_last_doy => advance_curr_to_last_day_of_year_sub
 
    procedure :: advance_curr_to_last_day_of_month_sub
    generic   :: advance_to_last_day_of_month => advance_curr_to_last_day_of_month_sub
 
    procedure :: set_curr_to_arbitrary_date_sub
    generic   :: set_current_date => set_curr_to_arbitrary_date_sub
 
    procedure :: percent_complete => percent_complete_fn
 
  end type date_range_t
 
  type (date_range_t), public :: sim_dt
 
contains
 
  subroutine initialize_datetimes_sub( this, start_date, end_date )
 
    class(date_range_t), intent(inout)      :: this
    type (DATETIME_T), intent(inout)         :: start_date
    type (DATETIME_T), intent(inout)         :: end_date
 
    this%start = start_date
    this%end = end_date
    this%curr = start_date
 
  end subroutine initialize_datetimes_sub
 
!------------------------------------------------------------------------------
 
  subroutine set_curr_to_arbitrary_date_sub(this, new_current_date)
 
    class(date_range_t), intent(inout)   :: this
    type (DATETIME_T), intent(in)         :: new_current_date
 
    if (( new_current_date > this%end ) .or. ( new_current_date < this%start ))      &
      stop( "Attempted to set current date to one outside of start and end date." )
 
    this%curr = new_current_date  
    this%iNumDaysFromOrigin = int(this%days_from_origin( new_current_date ), c_int)
    this%iDaysInMonth = this%curr%dayspermonth()
    this%iDaysInYear = this%curr%daysperyear()
    this%lIsLeapYear = this%curr%isLeapYear()
    this%iDOY = day_of_year( this%curr%getJulianDay() )
    this%iDayOfSimulation = int(this%curr - this%start + 1, c_int)
 
  end subroutine set_curr_to_arbitrary_date_sub
 
!------------------------------------------------------------------------------
 
  subroutine advance_curr_to_last_day_of_year_sub(this)
 
    class(date_range_t), intent(inout)   :: this
 
    this%curr%iMonth = 12
    this%curr%iDay = 31
 
    call this%curr%calcJulianDay()
 
    this%iDaysInMonth = this%curr%dayspermonth()
    this%iDaysInYear = this%curr%daysperyear()
    this%lIsLeapYear = this%curr%isLeapYear()
    this%iDOY = day_of_year( this%curr%getJulianDay() )
    this%iYearOfSimulation = this%curr%iYear - this%start%iYear + 1
    this%iNumDaysFromOrigin = this%iNumDaysFromOrigin + 1
    this%iDayOfSimulation = int(this%curr - this%start + 1, c_int)
 
  end subroutine advance_curr_to_last_day_of_year_sub
 
!------------------------------------------------------------------------------
 
  subroutine advance_curr_to_last_day_of_month_sub(this)
 
    class(date_range_t), intent(inout)   :: this
 
    call this%curr%advanceLastDayOfMonth()
 
!    this%iDaysInMonth = this%curr%dayspermonth()
!    this%iDaysInYear = this%curr%daysperyear()
!    this%lIsLeapYear = this%curr%isLeapYear()
    this%iDOY = day_of_year( this%curr%getJulianDay() )
    this%iYearOfSimulation = this%curr%iYear - this%start%iYear + 1
    this%iNumDaysFromOrigin = this%iNumDaysFromOrigin + 1
    this%iDayOfSimulation = int(this%curr - this%start + 1, c_int)
 
  end subroutine advance_curr_to_last_day_of_month_sub
 
!------------------------------------------------------------------------------
 
  function days_from_origin_fn(this, datetime )    result( num_days_from_origin )
 
    class(date_range_t), intent(inout)   :: this
    type (datetime_t), intent(in)         :: datetime
    real (c_double)                  :: num_days_from_origin
 
    num_days_from_origin = real( datetime - this%start, c_double)
 
  end function days_from_origin_fn
 
  function percent_complete_fn( this )   result( percent_complete )
 
    class(date_range_t), intent(inout)   :: this
    real (c_float)                   :: percent_complete
 
    percent_complete = real(this%curr - this%start) / real( this%end - this%start ) * 100.
 
  end function percent_complete_fn
 
  !------------------------------------------------------------------------------
 
  subroutine increment_by_one_day_sub(this)
 
    class(date_range_t), intent(inout)   :: this
 
    call this%curr%addDay()
 
    this%iDaysInMonth = this%curr%dayspermonth()
    this%iDaysInYear = this%curr%daysperyear()
    this%lIsLeapYear = this%curr%isLeapYear()
    this%iDOY = day_of_year( this%curr%getJulianDay() )
    this%iYearOfSimulation = this%curr%iYear - this%start%iYear + 1
    this%iNumDaysFromOrigin = this%iNumDaysFromOrigin + 1
    this%iDayOfSimulation = int(this%curr - this%start + 1, c_int)
 
  end subroutine increment_by_one_day_sub
 
end module simulation_datetime