dc_date_internal.f90

Go to the documentation of this file.

!-----------------------------------------------------------------------
! Copyright (c) 2000-2026 Gtool Development Group. All rights reserved.
!-----------------------------------------------------------------------
!>
!> @author    Yasuhiro MORIKAWA, Eizi TOYODA
!> @copyright Copyright (C) GFD Dennou Club, 2000-2026. All rights reserved. <br/>
!>            License is BSD-2-Clause. see [COPYRIGHT](@ref COPYRIGHT) in detail
!> @private
!> @en
!> @brief Internal module for dc_date
!> @details
!> This module provides internal constants, variables, and procedures
!> used by the dc_date module. These are for internal use only and
!> should not be used outside of dc_date module.
!>
!> @section dcdate_internal_procedures Internal procedures
!>
!> | Procedure               | Description                              |
!> |-------------------------|------------------------------------------|
!> | dcdate_normalize        | Normalize day and seconds                |
!> | dcdate_set_day_seconds_scl | Set scaled seconds for day            |
!> | dcdate_nondimcheck      | Check dimensionality consistency         |
!> | dcdate_parse_unit       | Parse time unit string                   |
!>
!> @enden
!>
!> @ja
!> @brief dc_date用の内部モジュール
!> @details
!> dc_date モジュール内で使用される内部向け定数, 変数, 手続き群を
!> 提供します. これらは内部使用専用であり, dc_date モジュール外では
!> 極力使用しないでください.
!>
!> @section dcdate_internal_procedures_ja 内部手続一覧
!>
!> | 手続名                  | 説明                                     |
!> |-------------------------|------------------------------------------|
!> | dcdate_normalize        | 日と秒の正規化                           |
!> | dcdate_set_day_seconds_scl | 日のスケーリング秒数を設定            |
!> | dcdate_nondimcheck      | 次元の整合性チェック                     |
!> | dcdate_parse_unit       | 時間単位文字列の解析                     |
!>
!> @endja
!>
 
module dc_date_internal
 
  use dc_date_types, only: dc_datetime, dc_difftime
  use dc_types, only: dp, string, token
  use dc_present, only: present_and_not_empty
 
  implicit none
 
  private
  public:: dcdate_normalize, dcdate_parse_unit, dcdate_set_day_seconds_scl
  public:: dcdate_nondimcheck
 
contains
 
  !>
  !> @en
  !> @brief Normalize day and seconds
  !> @details
  !> Normalizes day and seconds values. If sec exceeds day_seconds,
  !> the excess is carried over to day. Also ensures that sec and day
  !> have the same sign.
  !>
  !> This is an internal subroutine and should not be used outside
  !> of dc_date module.
  !>
  !> @param[in,out] day         Day value
  !> @param[in,out] sec         Second value
  !> @param[in]     day_seconds Seconds in a day (optional)
  !> @param[in]     nondim_flag Non-dimensional flag
  !> @enden
  !>
  !> @ja
  !> @brief 日と秒の正規化を行います
  !> @details
  !> 日付 day と秒数 sec の正規化を行います. sec が day_seconds
  !> を超える場合, day に繰上げを行います.
  !> また, sec と day の符号が逆の場合, 同符号になるよう設定します.
  !>
  !> このサブルーチンは内部向けなので dc_date モジュール外では
  !> 極力使用しないでください.
  !>
  !> @param[in,out] day         日
  !> @param[in,out] sec         秒
  !> @param[in]     day_seconds 1日の秒数 (オプション)
  !> @param[in]     nondim_flag 無次元フラグ
  !> @endja
  !>
  subroutine dcdate_normalize(day, sec, day_seconds, nondim_flag)
    use dc_date_types, only: &
      & flag_set_day_seconds_scl, day_seconds_scl
    use dc_scaledsec, only: dc_scaled_sec, &
      & operator(<), operator(>), operator(<=), operator(>=), &
      & operator(+), operator(-), operator(*), operator(/), &
      & modulo, int, abs, sign
    implicit none
    type(dc_scaled_sec), intent(inout):: day
    type(dc_scaled_sec), intent(inout):: sec
    type(dc_scaled_sec), intent(in), optional:: day_seconds
    logical, intent(in):: nondim_flag
    type(dc_scaled_sec):: sgn, day_sec, zero_sec
  continue
    if ( nondim_flag ) return
    if (present(day_seconds)) then
      day_sec = day_seconds
    else
      if ( .not. flag_set_day_seconds_scl ) call dcdate_set_day_seconds_scl
      day_sec = day_seconds_scl
    end if
    if (abs(sec) >= day_sec) then
      day = day + int(sec / day_sec)
      sec = modulo(sec, day_sec)
    end if
!!    zero_sec = 0  (デフォルト値 = 0 を使用する).
    if (      ( sec > zero_sec .and. day < zero_sec ) &
      &  .or. ( sec < zero_sec .and. day > zero_sec )   ) then
      sgn = sign(day, 1)
      day = day - sgn
      sec = sec + sgn * day_sec
    endif
  end subroutine dcdate_normalize
 
  !>
  !> @en
  !> @brief Set scaled seconds for day
  !> @details
  !> Sets the scaled seconds value for day_seconds_scl.
  !> @enden
  !>
  !> @ja
  !> @brief 日のスケーリング秒数を設定します
  !> @details
  !> day_seconds_scl のスケーリング秒数値を設定します.
  !> @endja
  !>
  subroutine dcdate_set_day_seconds_scl
    use dc_scaledsec, only: dc_scaled_sec, assignment(=)
    use dc_date_types, only: day_seconds,  &
      & flag_set_day_seconds_scl, day_seconds_scl
  continue
    if ( .not. flag_set_day_seconds_scl ) then
      flag_set_day_seconds_scl = .true.
      day_seconds_scl = day_seconds
    end if
  end subroutine dcdate_set_day_seconds_scl
 
  !>
  !> @en
  !> @brief Check dimensionality consistency
  !> @details
  !> Checks whether diff1 and diff2 are both dimensional or both
  !> non-dimensional, and applies the result to rslt.
  !> If one is dimensional and the other is non-dimensional,
  !> an error is raised.
  !>
  !> This is an internal subroutine and should not be used outside
  !> of dc_date module.
  !>
  !> @param[in]    opr   Name of the operator
  !> @param[in]    diff1 First operand
  !> @param[in]    diff2 Second operand
  !> @param[inout] rslt  Result operand
  !> @enden
  !>
  !> @ja
  !> @brief 次元の整合性をチェックします
  !> @details
  !> diff1 と diff2 が両方とも有次元もしくは無次元かをチェックし,
  !> 両方が同じであれば, その結果を rslt に適用します.
  !> 2つの引数で片方が有次元, もう片方が無次元の場合には
  !> エラーを発生させます.
  !>
  !> このサブルーチンは内部向けなので dc_date モジュール外では
  !> 極力使用しないでください.
  !>
  !> @param[in]    opr   演算子の名称
  !> @param[in]    diff1 第1オペランド
  !> @param[in]    diff2 第2オペランド
  !> @param[inout] rslt  結果オペランド
  !> @endja
  !>
  subroutine dcdate_nondimcheck(opr, diff1, diff2, rslt)
    use dc_error, only: storeerror, dc_edimtime
    implicit none
    character(*), intent(in):: opr
    type(dc_difftime), intent(in):: diff1, diff2
    type(dc_difftime), intent(inout):: rslt
  continue
    if (      (       diff1 % nondim_flag .and. .not. diff2 % nondim_flag ) &
      &  .or. ( .not. diff1 % nondim_flag .and.       diff2 % nondim_flag ) ) then
      call storeerror(dc_edimtime, opr)
    end if
    rslt % nondim_flag = diff1 % nondim_flag
  end subroutine dcdate_nondimcheck
 
  !>
  !> @en
  !> @brief Parse time unit string and return symbol
  !> @details
  !> Interprets the string str and returns the time unit symbol.
  !> The following strings are interpreted as time units (case insensitive):
  !>
  !> | Unit           | Symbol constant              |
  !> |----------------|------------------------------|
  !> | year           | UNIT_SYMBOL_YEAR             |
  !> | month          | UNIT_SYMBOL_MONTH            |
  !> | day            | UNIT_SYMBOL_DAY              |
  !> | hour           | UNIT_SYMBOL_HOUR             |
  !> | minute         | UNIT_SYMBOL_MIN              |
  !> | second         | UNIT_SYMBOL_SEC              |
  !> | non-dimensional| UNIT_SYMBOL_NONDIM           |
  !>
  !> If str does not match any of these, UNIT_SYMBOL_ERR is returned.
  !>
  !> @param[in] str Input unit string
  !> @return Unit symbol integer
  !> @enden
  !>
  !> @ja
  !> @brief 時間単位文字列を解析しシンボルを返します
  !> @details
  !> 引数 str に与えられた文字列を解釈し, 日時の単位を示す
  !> シンボルを返します. 以下の文字列が日時の単位として解釈されます.
  !> 大文字と小文字は区別されません.
  !>
  !> | 単位           | シンボル定数                 |
  !> |----------------|------------------------------|
  !> | 年             | UNIT_SYMBOL_YEAR             |
  !> | 月             | UNIT_SYMBOL_MONTH            |
  !> | 日             | UNIT_SYMBOL_DAY              |
  !> | 時             | UNIT_SYMBOL_HOUR             |
  !> | 分             | UNIT_SYMBOL_MIN              |
  !> | 秒             | UNIT_SYMBOL_SEC              |
  !> | 無次元時間     | UNIT_SYMBOL_NONDIM           |
  !>
  !> これらに該当しない文字列を str に与えた場合,
  !> UNIT_SYMBOL_ERR が返ります.
  !>
  !> @param[in] str 入力単位文字列
  !> @return 単位シンボル (整数)
  !> @endja
  !>
  !>
  !> @en
  !> @brief Parse time unit string and return unit string
  !> @details
  !> Interprets the string str and returns the time unit string.
  !> Case insensitive. Returns the first element of the unit array.
  !> Returns empty string for unrecognized unit.
  !>
  !> This is an internal function and should not be used outside
  !> of dc_date module.
  !>
  !> @param[in] str Input unit string
  !> @return Standardized unit string
  !> @enden
  !>
  !> @ja
  !> @brief 時間単位文字列を解析し単位文字列を返します
  !> @details
  !> 引数 str に与えられた文字列を解釈し, 日時の単位を返します.
  !> 大文字と小文字は区別されません.
  !> 返る文字列は単位配列の先頭の文字列です.
  !> 該当しない文字列の場合は空文字が返ります.
  !>
  !> この関数は内部向けなので dc_date モジュール外では
  !> 極力使用しないでください.
  !>
  !> @param[in] str 入力単位文字列
  !> @return 標準化された単位文字列
  !> @endja
  !>
  character(TOKEN) function dcdate_parse_unit(str) result(unit)
    use dc_types, only: token
    use dc_date_types, only: unit_year, unit_month, unit_day, &
      & unit_hour, unit_min, unit_sec, unit_nondim
    use dc_string, only: strieq
    implicit none
    character(*), intent(in):: str
    integer :: unit_str_size, i
  continue
    unit = adjustl(str)
    unit_str_size = size(unit_nondim)
    do i = 1, unit_str_size
      if (strieq(trim(unit), trim(unit_nondim(i)))) then
        unit = unit_nondim(1)
        return
      end if
    end do
 
    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 = ''
 
  end function dcdate_parse_unit
 
end module dc_date_internal