dc_calendar_internal Module Reference

Internal module for dc_calendar. More...

Functions/Subroutines
subroutine, public	default_cal_set
integer function, public	dccaldate_normalize (year, month, day, hour, min, sec, cal)
integer function, public	dccaldate_ym2d (year, month, day, cal, day_of_year)
character(token) function, public	dccaltype_str (cal_type)
character(token) function, public	dccaldate_str2ustr (str)
integer function, public	dccaldate_str2usym (str)

Variables
type(dc_cal), target, save, public	default_cal
	Default calendar object
type(dc_cal_date), target, save, public	default_date
	Default date object

Detailed Description

Internal module for dc_calendar.

Author

Yasuhiro MORIKAWA

Copyright

Copyright (C) GFD Dennou Club, 2009-2026. All rights reserved.
License is BSD-2-Clause. see COPYRIGHT in detail

Function/Subroutine Documentation

dccaldate_normalize()

integer function, public dc_calendar_internal::dccaldate_normalize	(	integer, intent(inout)	year,
		integer, intent(inout)	month,
		integer, intent(inout)	day,
		integer, intent(inout)	hour,
		integer, intent(inout)	min,
		real(dp), intent(inout)	sec,
		type(dc_cal), intent(in)	cal
	)

Normalize date information

Normalizes date information according to calendar. This is an internal procedure for dc_calendar module.

Normalization is performed in the following cases:

• sec exceeds "seconds in a minute": carry over to minute
• min exceeds "minutes in an hour": carry over to hour
• hour exceeds "hours in a day": carry over to day
• day exceeds "days in a month": carry over to month/year
• sec, min, hour, day are negative: borrow from upper unit
• day is 0: borrow from upper unit

Parameters

[in,out]	year	Year
[in,out]	month	Month
[in,out]	day	Day
[in,out]	hour	Hour
[in,out]	min	Minute
[in,out]	sec	Second
[in]	cal	Calendar object

Returns

Status (DC_NOERR on success, DC_EINCONSISTCALDATE on error)

Definition at line 177 of file dc_calendar_internal.f90.

    use dc_error, only: dc_noerr, dc_einconsistcaldate
    use dc_calendar_types, only: &
      & cal_user_defined, cal_julian, cal_gregorian
    implicit none
    integer:: stat
    integer, intent(inout):: year
    integer, intent(inout):: month
    integer, intent(inout):: day
    integer, intent(inout):: hour
    integer, intent(inout):: min
    real(DP), intent(inout):: sec
    type(DC_CAL), intent(in):: cal
 
    integer:: day_in_month_jg
    integer, pointer:: day_in_month(:) =>null()
 
    integer:: month_in_year
    integer:: hour_in_day
    integer:: min_in_hour
    real(DP):: sec_in_min
 
    real(DP):: wyear, wday, whour, wmin
    real(DP):: wdb, ychunk_e6, ychunk_e3, chunk_scale_e6, chunk_scale_e3
  continue
    stat = dc_noerr
 
    select case( cal % cal_type )
    case( cal_user_defined )
      if ( month > cal % month_in_year ) stat = dc_einconsistcaldate
    case default
      if ( month > 12 ) stat = dc_einconsistcaldate
    end select
 
    if ( stat /= dc_noerr ) return
 
    month_in_year = cal % month_in_year
    hour_in_day   = cal % hour_in_day
    min_in_hour   = cal % min_in_hour
    sec_in_min    = cal % sec_in_min
    day_in_month => cal % day_in_month
 
    select case( cal % cal_type )
    case( cal_julian )
      chunk_scale_e6 = 4.0e+5
      ychunk_e6 = 146100000.0_dp
      chunk_scale_e3 = 4.0e+2
      ychunk_e3 = 146100.0_dp
    case( cal_gregorian )
      chunk_scale_e6 = 4.0e+5
      ychunk_e6 = 146097000.0_dp
      chunk_scale_e3 = 4.0e+2
      ychunk_e3 = 146097.0_dp
    case default
      chunk_scale_e6 = 1.0e+6
      ychunk_e6 = chunk_scale_e6 * sum( day_in_month(:) )
      chunk_scale_e3 = 1.0e+3
      ychunk_e3 = chunk_scale_e3 * sum( day_in_month(:) )
    end select
 
    wyear  = real( year, dp )
    wday   = real( day, dp )
    whour  = real( hour, dp )
    wmin   = real( min, dp )
 
    if ( .not. sec < sec_in_min ) then
      wmin = wmin + aint( sec / sec_in_min )
      sec = mod( sec, sec_in_min )
    elseif ( sec < 0.0_dp ) then
      wdb = ceiling( abs(sec) / sec_in_min )
      wmin = wmin - wdb
      sec = sec + wdb * sec_in_min
    end if
 
    if ( .not. wmin < min_in_hour ) then
      whour = whour + aint( wmin / min_in_hour )
      wmin = mod( wmin, real( min_in_hour, dp ) )
    elseif ( wmin < 0 ) then
      wdb = ceiling( abs(wmin) / real(min_in_hour) )
      whour = whour - wdb
      wmin = wmin + wdb * min_in_hour
    end if
 
    if ( .not. whour < hour_in_day ) then
      wday = wday + aint( whour / hour_in_day )
      whour = mod( whour, real( hour_in_day, dp ) )
    elseif ( whour < 0 ) then
      wdb = ceiling( abs(whour) / real(hour_in_day) )
      wday = wday - wdb
      whour = whour + wdb * hour_in_day
    end if
 
    if ( wday < 1.0_dp ) then
      select case( cal % cal_type )
      case( cal_julian )
        do while ( wday < 1.0_dp )
          if ( wday < - ychunk_e6 ) then
            wyear = wyear + chunk_scale_e6 * ( aint( wday / ychunk_e6 ) - 1.0_dp )
            wday = mod( wday, ychunk_e6 ) + ychunk_e6
          end if
          if ( wday < 1.0_dp ) then
            wyear = wyear + chunk_scale_e3 * ( aint( wday / ychunk_e3 ) - 1.0_dp )
            wday = mod( wday, ychunk_e3 ) + ychunk_e3
          end if
        end do
      case( cal_gregorian )
        do while ( wday < 1.0_dp )
          if ( wday < - ychunk_e6 ) then
            wyear = wyear + chunk_scale_e6 * ( aint( wday / ychunk_e6 ) - 1.0_dp )
            wday = mod( wday, ychunk_e6 ) + ychunk_e6
          end if
          if ( wday < 1.0_dp ) then
            wyear = wyear + chunk_scale_e3 * ( aint( wday / ychunk_e3 ) - 1.0_dp )
            wday = mod( wday, ychunk_e3 ) + ychunk_e3
          end if
        end do
      case default
        do while ( wday < 1.0_dp )
          if ( wday < - ychunk_e6 ) then
            wyear = wyear + chunk_scale_e6 * ( aint( wday / ychunk_e6 ) - 1.0_dp )
            wday = mod( wday, ychunk_e6 ) + ychunk_e6
          end if
          if ( wday < 1.0_dp ) then
            wyear = wyear + chunk_scale_e3 * ( aint( wday / ychunk_e3 ) - 1.0_dp )
            wday = mod( wday, ychunk_e3 ) + ychunk_e3
          end if
        end do
      end select
    end if
 
    select case( cal % cal_type )
    case( cal_julian )
      if ( wday > ychunk_e6 ) then
        wyear = wyear + chunk_scale_e6 * aint( wday / ychunk_e6 )
        wday = mod( wday, ychunk_e6 )
      end if
      if ( wday > ychunk_e3 ) then
        wyear = wyear + chunk_scale_e3 * aint( wday / ychunk_e3 )
        wday = mod( wday, ychunk_e3 )
      end if
      do
        if ( month == 2 ) then
          if ( mod( nint(wyear), 4 ) == 0 ) then
            day_in_month_jg = 29
          else
            day_in_month_jg = 28
          end if
        else
          day_in_month_jg = day_in_month(month)
        end if
        if ( .not. wday > day_in_month_jg ) exit
        wday = wday - day_in_month_jg
        month = month + 1
        if ( month > month_in_year ) then
          month = 1
          wyear = wyear + 1
        end if
      end do
    case( cal_gregorian )
      if ( wday > ychunk_e6 ) then
        wyear = wyear + chunk_scale_e6 * aint( wday / ychunk_e6 )
        wday = mod( wday, ychunk_e6 )
      end if
      if ( wday > ychunk_e3 ) then
        wyear = wyear + chunk_scale_e3 * aint( wday / ychunk_e3 )
        wday = mod( wday, ychunk_e3 )
      end if
      do
        if ( month == 2 ) then
          if ( mod( nint(wyear), 400 ) == 0 ) then
            day_in_month_jg = 29
          elseif ( mod( nint(wyear), 100 ) == 0 ) then
            day_in_month_jg = 28
          elseif ( mod( nint(wyear), 4 ) == 0 ) then
            day_in_month_jg = 29
          else
            day_in_month_jg = 28
          end if
        else
          day_in_month_jg = day_in_month(month)
        end if
        if ( .not. wday > day_in_month_jg ) exit
        wday = wday - day_in_month_jg
        month = month + 1
        if ( month > month_in_year ) then
          month = 1
          wyear = wyear + 1
        end if
      end do
    case default
      if ( wday > ychunk_e6 ) then
        wyear = wyear + chunk_scale_e6 * aint( wday / ychunk_e6 )
        wday = mod( wday, ychunk_e6 )
      end if
      if ( wday > ychunk_e3 ) then
        wyear = wyear + chunk_scale_e3 * aint( wday / ychunk_e3 )
        wday = mod( wday, ychunk_e3 )
      end if
      do while ( wday > day_in_month(month) )
        wday = wday - day_in_month(month)
        month = month + 1
        if ( month > month_in_year ) then
          month = 1
          wyear = wyear + 1
        end if
      end do
    end select
 
    year  = int(wyear)
    day   = int(wday)
    hour  = int(whour)
    min   = int(wmin)
 

References dc_calendar_types::cal_gregorian, dc_calendar_types::cal_julian, dc_calendar_types::cal_user_defined, dc_error::dc_einconsistcaldate, dc_error::dc_noerr, and dc_types::dp.

dccaldate_str2ustr()

character(token) function, public dc_calendar_internal::dccaldate_str2ustr

(

character(*), intent(in)

str

)

Parse unit string and return unit string

Interprets the string given in str and returns the unit string. Case insensitive. Returns the first element of the unit array. Returns empty string for unrecognized unit.

Parameters

[in]

str

Input unit string

Returns

Standardized unit string

Definition at line 549 of file dc_calendar_internal.f90.

    use dc_types, only: token
    use dc_calendar_types, only: unit_year, unit_month, unit_day, &
      & unit_hour, unit_min, unit_sec
    use dc_string, only: strieq
    implicit none
    character(*), intent(in):: str
    character(TOKEN):: unit
    integer :: unit_str_size, i
  continue
    unit = adjustl(str)
 
    unit_str_size = size(unit_sec)
    do i = 1, unit_str_size
      if (strieq(trim(unit), trim(unit_sec(i)))) then
        unit = unit_sec(1)
        return
      end if
    end do
 
    unit_str_size = size(unit_min)
    do i = 1, unit_str_size
      if (strieq(trim(unit), trim(unit_min(i)))) then
        unit = unit_min(1)
        return
      end if
    end do
 
    unit_str_size = size(unit_hour)
    do i = 1, unit_str_size
      if (strieq(trim(unit), trim(unit_hour(i)))) then
        unit = unit_hour(1)
        return
      end if
    end do
 
    unit_str_size = size(unit_day)
    do i = 1, unit_str_size
      if (strieq(trim(unit), trim(unit_day(i)))) then
        unit = unit_day(1)
        return
      end if
    end do
 
    unit_str_size = size(unit_month)
    do i = 1, unit_str_size
      if (strieq(trim(unit), trim(unit_month(i)))) then
        unit = unit_month(1)
        return
      end if
    end do
 
    unit_str_size = size(unit_year)
    do i = 1, unit_str_size
      if (strieq(trim(unit), trim(unit_year(i)))) then
        unit = unit_year(1)
        return
      end if
    end do
 
    unit = ''
 

References dc_types::token, dc_calendar_types::unit_day, dc_calendar_types::unit_hour, dc_calendar_types::unit_min, dc_calendar_types::unit_month, dc_calendar_types::unit_sec, and dc_calendar_types::unit_year.

dccaldate_str2usym()

integer function, public dc_calendar_internal::dccaldate_str2usym

(

character(*), intent(in)

str

)

Parse unit string and return unit symbol

Interprets the string given in str and returns the unit symbol integer. Case insensitive. Returns UNIT_SYMBOL_ERR for unrecognized unit.

Parameters

[in]

str

Input unit string

Returns

Unit symbol integer

Definition at line 633 of file dc_calendar_internal.f90.

    use dc_types, only: token
    use dc_calendar_types, only: unit_year, unit_month, unit_day, &
      & unit_hour, unit_min, unit_sec, &
      & unit_symbol_year, unit_symbol_month, unit_symbol_day, &
      & unit_symbol_hour, unit_symbol_min, unit_symbol_sec, &
      & unit_symbol_err
    use dc_string, only: strieq
    implicit none
    character(*), intent(in):: str
    integer:: symbol
    integer:: unit_str_size, i
    character(TOKEN):: unit
  continue
    unit = adjustl(str)
 
    unit_str_size = size(unit_sec)
    do i = 1, unit_str_size
      if (strieq(trim(unit), trim(unit_sec(i)))) then
        symbol = unit_symbol_sec
        return
      end if
    end do
 
    unit_str_size = size(unit_min)
    do i = 1, unit_str_size
      if (strieq(trim(unit), trim(unit_min(i)))) then
        symbol = unit_symbol_min
        return
      end if
    end do
 
    unit_str_size = size(unit_hour)
    do i = 1, unit_str_size
      if (strieq(trim(unit), trim(unit_hour(i)))) then
        symbol = unit_symbol_hour
        return
      end if
    end do
 
    unit_str_size = size(unit_day)
    do i = 1, unit_str_size
      if (strieq(trim(unit), trim(unit_day(i)))) then
        symbol = unit_symbol_day
        return
      end if
    end do
 
    unit_str_size = size(unit_month)
    do i = 1, unit_str_size
      if (strieq(trim(unit), trim(unit_month(i)))) then
        symbol = unit_symbol_month
        return
      end if
    end do
 
    unit_str_size = size(unit_year)
    do i = 1, unit_str_size
      if (strieq(trim(unit), trim(unit_year(i)))) then
        symbol = unit_symbol_year
        return
      end if
    end do
 
    symbol = unit_symbol_err
 

References dc_types::token, dc_calendar_types::unit_day, dc_calendar_types::unit_hour, dc_calendar_types::unit_min, dc_calendar_types::unit_month, dc_calendar_types::unit_sec, dc_calendar_types::unit_symbol_day, dc_calendar_types::unit_symbol_err, dc_calendar_types::unit_symbol_hour, dc_calendar_types::unit_symbol_min, dc_calendar_types::unit_symbol_month, dc_calendar_types::unit_symbol_sec, dc_calendar_types::unit_symbol_year, and dc_calendar_types::unit_year.

dccaldate_ym2d()

integer function, public dc_calendar_internal::dccaldate_ym2d	(	integer, intent(in)	year,
		integer, intent(in)	month,
		integer, intent(in)	day,
		type(dc_cal), intent(in)	cal,
		real(dp), intent(out)	day_of_year
	)

Convert year/month/day to day of year

Converts year/month/day to day of year according to calendar. Should be called after normalization by dccaldate_normalize.

Parameters

[in]	year	Year
[in]	month	Month
[in]	day	Day
[in]	cal	Calendar object
[out]	day_of_year	Day of year (double precision)

Returns

Status (DC_NOERR on success)

Definition at line 420 of file dc_calendar_internal.f90.

    use dc_error, only: dc_noerr, dc_einconsistcaldate
    use dc_calendar_types, only: &
      & cal_user_defined, cal_julian, cal_gregorian
    implicit none
    integer:: stat
    integer, intent(in):: year
    integer, intent(in):: month
    integer, intent(in):: day
    real(DP), intent(out):: day_of_year
    type(DC_CAL), intent(in):: cal
 
    integer:: i
 
  continue
    stat = dc_noerr
 
    select case( cal % cal_type )
    case( cal_user_defined )
      if ( month > cal % month_in_year ) stat = dc_einconsistcaldate
    case default
      if ( month > 12 ) stat = dc_einconsistcaldate
    end select
 
    if ( stat /= dc_noerr ) return
 
    day_of_year  = real( day, dp )
 
    select case( cal % cal_type )
    case( cal_julian )
      do i = 1, month - 1
        if ( i == 2 ) then
          if ( mod( year, 4 ) == 0 ) then
            day_of_year = day_of_year + 29
          else
            day_of_year = day_of_year + 28
          end if
        else
          day_of_year = day_of_year + cal % day_in_month(i)
        end if
      end do
    case( cal_gregorian )
      do i = 1, month - 1
        if ( i == 2 ) then
          if ( mod( year, 400 ) == 0 ) then
            day_of_year = day_of_year + 29
          elseif ( mod( year, 100 ) == 0 ) then
            day_of_year = day_of_year + 28
          elseif ( mod( year, 4 ) == 0 ) then
            day_of_year = day_of_year + 29
          else
            day_of_year = day_of_year + 28
          end if
        else
          day_of_year = day_of_year + cal % day_in_month(i)
        end if
      end do
    case default
      do i = 1, month - 1
        day_of_year = day_of_year + cal % day_in_month(i)
      end do
    end select
 

References dc_calendar_types::cal_gregorian, dc_calendar_types::cal_julian, dc_calendar_types::cal_user_defined, dc_error::dc_einconsistcaldate, dc_error::dc_noerr, and dc_types::dp.

dccaltype_str()

character(token) function, public dc_calendar_internal::dccaltype_str

(

integer, intent(in)

cal_type

)

Convert calendar type integer to string

Converts integer calendar type to string representation. Returns empty string for invalid calendar type.

Parameters

[in]

cal_type

Calendar type integer

Returns

Calendar type string

Definition at line 505 of file dc_calendar_internal.f90.

    use dc_calendar_types, only: &
      & cal_user_defined, &
      & cal_cyclic, cal_noleap, cal_julian, cal_gregorian, cal_360day
    use dc_types, only: token
    implicit none
    character(TOKEN):: str
    integer, intent(in):: cal_type
 
  continue
    select case( cal_type )
    case(cal_user_defined) ; str = 'user_defined'
    case(cal_cyclic)       ; str = 'cyclic      '
    case(cal_noleap)       ; str = 'noleap      '
    case(cal_julian)       ; str = 'julian      '
    case(cal_gregorian)    ; str = 'gregorian   '
    case(cal_360day)       ; str = '360day      '
    case default           ; str = '            '
    end select

References dc_calendar_types::cal_360day, dc_calendar_types::cal_cyclic, dc_calendar_types::cal_gregorian, dc_calendar_types::cal_julian, dc_calendar_types::cal_noleap, dc_calendar_types::cal_user_defined, and dc_types::token.

default_cal_set()

subroutine, public dc_calendar_internal::default_cal_set

Set default calendar to Gregorian

When DCCal procedures are called without DC_CAL argument, this procedure is called first to set the default calendar to Gregorian calendar.

If default_cal is already initialized, this procedure does nothing and returns immediately.

Definition at line 105 of file dc_calendar_internal.f90.

    use dc_calendar_types, only: cal_gregorian
    implicit none
    type(DC_CAL), pointer:: calp =>null()
  continue
    calp => default_cal
 
    if ( calp % initialized ) return
 
    calp % cal_type = cal_gregorian
    calp % month_in_year = 12
    calp % hour_in_day   = 24
    calp % min_in_hour   = 60
    calp % sec_in_min    = 60.0_dp
    allocate( calp % day_in_month(1:12) )
    calp % day_in_month(1:12) = &
      & (/ 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 /)
 
    calp % initialized = .true.
    nullify( calp )

References dc_calendar_types::cal_gregorian, and default_cal.

Variable Documentation

default_cal

dc_calendar_internal::default_cal

Default calendar object

Definition at line 66 of file dc_calendar_internal.f90.

  type(DC_CAL), save, target, public:: default_cal

default_date

dc_calendar_internal::default_date

Default date object

Definition at line 76 of file dc_calendar_internal.f90.

  type(DC_CAL_DATE), save, target, public:: default_date