dc_date_internal.f90

Go to the documentation of this file.

!-----------------------------------------------------------------------
! Copyright (c) 2000-2026 Gtool Development Group. All rights reserved.
!-----------------------------------------------------------------------
 
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
 
  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
 
  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
 
  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
 
  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