!== dc_date.f90 - 日付・時刻に関する手続きを提供するモジュール
!
! Authors::   Yasuhiro MORIKAWA, Eizi TOYODA
! Version::   $Id: dc_date.f90,v 1.4 2006/01/15 13:23:37 morikawa Exp $
! Tag Name::  $Name: gt4f90io-20060627 $
! Copyright:: Copyright (C) GFD Dennou Club, 2000-2005. All rights reserved.
! License::   See COPYRIGHT[link:../../COPYRIGHT]
!
! This file provides dc_date


module dc_date 2,39
  !--
  !== Overview
  ! 日付・時刻の加減乗除等に用います。まだ実用段階に無いようです。
  !++

  ! 日付時刻と時間間隔を区別する。
  ! 型宣言によって自明に定まるサブルーチンは dc_date_types に置く。
  use dc_date_types, only: DC_DATETIME, DC_DIFFTIME
  use dc_types,      only: DP, STRING
  use dc_present,    only: present_and_not_empty
  use dc_string,     only: CPrintf
  implicit none

  private
  public :: TimeNow


  interface operator(+)
    module procedure dcdate_add_ft
    module procedure dcdate_add_tf
    module procedure dcdate_add_ff
  end interface


  interface operator(-)
    module procedure dcdate_sub_tt
    module procedure dcdate_sub_tf
  end interface


  interface operator(*)
    module procedure dcdate_mul_if
    module procedure dcdate_mul_rf
    module procedure dcdate_mul_df
    module procedure dcdate_mul_fi
    module procedure dcdate_mul_fr
    module procedure dcdate_mul_fd
  end interface


  interface operator(/)
    module procedure dcdate_div_fi
    module procedure dcdate_div_fr
    module procedure dcdate_div_fd
    module procedure dcdate_div_ff
  end interface


  interface mod
    module procedure dcdate_mod_ff
  end interface


  interface TimeNow
    module procedure DCTimeNow
  end interface


  interface assignment(=)

    subroutine DCDateLetFC(diff, string)
      use dc_date_types, only: DC_DIFFTIME
      type(DC_DIFFTIME), intent(out):: diff
      character(len = *), intent(in):: string
    end subroutine DCDateLetFC

    subroutine DCDateLetFS(diff, string)
      use dc_date_types, only: DC_DIFFTIME
      use dc_string, only: VSTRING
      type(DC_DIFFTIME), intent(out):: diff
      type(VSTRING), intent(in):: string
    end subroutine DCDateLetFS

    subroutine DCDateLetTC(time, string)
      use dc_date_types, only: DC_DATETIME
      type(DC_DATETIME), intent(out):: time
      character(len = *), intent(in):: string
    end subroutine DCDateLetTC

    subroutine DCDateLetTS(time, string)
      use dc_date_types, only: DC_DATETIME
      use dc_string, only: VSTRING
      type(DC_DATETIME), intent(out):: time
      type(VSTRING), intent(in):: string
    end subroutine DCDateLetTS

  end interface


  interface toString

    type(VSTRING) function DCDateDiffToString(diff)
      use dc_date_types, only: DC_DIFFTIME
      use dc_string, only: VSTRING
      type(DC_DIFFTIME), intent(in):: diff
    end function DCDateDiffToString

    type(VSTRING) function DCDateTimeToString(time)
      use dc_date_types, only: DC_DATETIME
      use dc_string, only: VSTRING
      type(DC_DATETIME), intent(in):: time
    end function DCDateTimeToString

  end interface


  interface Eval

    subroutine DCDateTimeEval(time, mon, day, sec)
      use dc_date_types, only: DC_DATETIME
      use dc_types,      only: DP
      type(DC_DATETIME), intent(in):: time
      integer, intent(out):: mon, day
      real(DP), intent(out):: sec
    end subroutine DCDateTimeEval

    subroutine DCDateTimeEval2(time, year, mon, day, hour, min, sec)
      use dc_date_types, only: DC_DATETIME
      type(DC_DATETIME), intent(in):: time
      integer, intent(out), optional:: year, mon, day, hour, min, sec
    end subroutine DCDateTimeEval2

    module procedure DCDateDiffEval

  end interface


  interface DiffTime
    type(DC_DIFFTIME) function DCDiffTime(year, mon, day, hour, min, sec)
      use dc_date_types, only: DC_DIFFTIME
      integer, intent(in), optional:: year, mon, day, hour, min, sec
    end function DCDiffTime
  end interface


  interface DateTime
    type(DC_DATETIME) function DCDateTime(mon, day, sec)
      use dc_date_types, only: DC_DATETIME
      use dc_types,      only: DP
      integer, intent(in):: mon, day
      real(DP), intent(in):: sec
    end function DCDateTime

    type(DC_DATETIME) function DCDateTime2(year, mon, day, hour, min, sec)
      use dc_date_types, only: DC_DATETIME
      integer, intent(in), optional:: year, mon, day, hour, min, sec
    end function DCDateTime2
  end interface


contains


  subroutine dcdate_normalize(day, sec) 11,1
    use dc_date_types, only: DAY_SECONDS
    integer, intent(inout):: day
    real(DP), intent(inout):: sec
    integer:: sgn
    if (abs(sec) > DAY_SECONDS) then
      day = day + int(sec / DAY_SECONDS)
      sec = modulo(sec, DAY_SECONDS)
    end if
    if ((sec > 0.0 .and. day < 0) .or. (sec < 0.0 .and. day > 0)) then
      sgn = sign(day, 1)
      day = day - sgn
      sec = sec + sgn * DAY_SECONDS
    endif
  end subroutine dcdate_normalize


  type(DC_DATETIME) function dcdate_add_ft(diff, time) result(result) 1
    type(DC_DIFFTIME), intent(in):: diff
    type(DC_DATETIME), intent(in):: time
    result = DateTime(diff%mon, time%day + diff%day, time%sec + diff%sec)
  end function dcdate_add_ft


  type(DC_DATETIME) function dcdate_add_tf(time, diff) result(result) 1
    type(DC_DATETIME), intent(in):: time
    type(DC_DIFFTIME), intent(in):: diff
    result = DateTime(diff%mon, time%day + diff%day, time%sec + diff%sec)
  end function dcdate_add_tf


  type(DC_DIFFTIME) function dcdate_add_ff(diff1, diff2) result(result) 1,1
    type(DC_DIFFTIME), intent(in):: diff1, diff2
    result%mon = diff1%mon + diff2%mon
    result%day = diff1%day + diff2%day
    result%sec = diff1%sec + diff2%sec
    call dcdate_normalize(result%day, result%sec)
  end function dcdate_add_ff


  type(DC_DIFFTIME) function dcdate_sub_tt(time1, time2) result(result) 1,1
    type(DC_DATETIME), intent(in):: time1, time2
    result%day = time1%day - time2%day
    result%sec = time1%sec - time2%sec
    call dcdate_normalize(result%day, result%sec)
  end function dcdate_sub_tt


  type(DC_DATETIME) function dcdate_sub_tf(time, diff) result(result) 1
    type(DC_DATETIME), intent(in):: time
    type(DC_DIFFTIME), intent(in):: diff
    result = DateTime(-diff%mon, time%day - diff%day, time%sec - diff%sec)
  end function dcdate_sub_tf


  type(DC_DIFFTIME) function dcdate_mul_if(factor, diff) result(result) 1,1
    integer, intent(in):: factor
    type(DC_DIFFTIME), intent(in):: diff
    result%mon = factor * diff%mon
    result%day = factor * diff%day
    result%sec = factor * diff%sec
    call dcdate_normalize(result%day, result%sec)
  end function dcdate_mul_if

  ! 月差を非整数倍すると近似的結果になるおそれがある

  type(DC_DIFFTIME) function dcdate_mul_rf(factor, diff) result(result) 1,2
    use dc_date_types, only: CYCLIC_MDAYS
    real, intent(in):: factor
    type(DC_DIFFTIME), intent(in):: diff
    result%mon = int(factor) * diff%mon
    result%day = factor * diff%day + CYCLIC_MDAYS * mod(factor, 1.0)
    result%sec = factor * diff%sec
    call dcdate_normalize(result%day, result%sec)
  end function dcdate_mul_rf

  ! 月差を非整数倍すると近似的結果になるおそれがある

  type(DC_DIFFTIME) function dcdate_mul_df(factor, diff) result(result) 1,2
    use dc_date_types, only: CYCLIC_MDAYS
    real(DP), intent(in):: factor
    type(DC_DIFFTIME), intent(in):: diff
    result%mon = int(factor) * diff%mon
    result%day = factor * diff%day + CYCLIC_MDAYS * mod(factor, 1.0_DP)
    result%sec = factor * diff%sec
    call dcdate_normalize(result%day, result%sec)
  end function dcdate_mul_df


  type(DC_DIFFTIME) function dcdate_mul_fi(diff, factor) result(result) 1,1
    type(DC_DIFFTIME), intent(in):: diff
    integer, intent(in):: factor
    result%mon = factor * diff%mon
    result%day = factor * diff%day
    result%sec = factor * diff%sec
    call dcdate_normalize(result%day, result%sec)
  end function dcdate_mul_fi

  ! 近似的結果になるおそれがある

  type(DC_DIFFTIME) function dcdate_mul_fr(diff, factor) result(result) 1,2
    use dc_date_types, only: CYCLIC_MDAYS, DAY_SECONDS
    type(DC_DIFFTIME), intent(in):: diff
    real, intent(in):: factor
    real(DP):: month, day
    month = factor * diff%mon
    result%mon = int(month)
    day = factor * diff%day + int(CYCLIC_MDAYS * (month - result%mon))
    result%day = int(day)
    result%sec = factor * diff%sec + (day - result%day) * DAY_SECONDS
    call dcdate_normalize(result%day, result%sec)
  end function dcdate_mul_fr

  ! 近似的結果になるおそれがある

  type(DC_DIFFTIME) function dcdate_mul_fd(diff, factor) result(result) 1,2
    use dc_date_types, only: CYCLIC_MDAYS, DAY_SECONDS
    type(DC_DIFFTIME), intent(in):: diff
    real(DP), intent(in):: factor
    real(DP):: month, day
    month = factor * diff%mon
    result%mon = int(month)
    day = factor * diff%day + int(CYCLIC_MDAYS * (month - result%mon))
    result%day = int(day)
    result%sec = factor * diff%sec + (day - result%day) * DAY_SECONDS
    call dcdate_normalize(result%day, result%sec)
  end function dcdate_mul_fd

  ! 月差を除算すると近似的結果になるおそれがある

  type(DC_DIFFTIME) function dcdate_div_fi(diff, denominator) result(result) 1,1
    use dc_date_types, only: CYCLIC_MDAYS, DAY_SECONDS
    type(DC_DIFFTIME), intent(in):: diff
    integer, intent(in):: denominator
  continue
    result%mon = diff%mon / denominator
    ! 月からの近似的繰り下がりは日単位でしか行わない
    result%day = diff%day / denominator + &
      & int((CYCLIC_MDAYS * mod(diff%mon, denominator)) / &
      &     denominator)
    result%sec = diff%sec / denominator + &
      & (DAY_SECONDS * mod(diff%day, denominator)) / &
      & denominator
  end function dcdate_div_fi

  ! 月差を除算すると近似的結果になるおそれがある

  type(DC_DIFFTIME) function dcdate_div_fr(diff, denominator) result(result) 1,2
    use dc_date_types, only: CYCLIC_MDAYS, DAY_SECONDS
    type(DC_DIFFTIME), intent(in):: diff
    real, intent(in):: denominator
    real(DP):: month, day
    month = diff%mon / denominator
    result%mon = int(month)
    day = diff%day / denominator + int(CYCLIC_MDAYS * (month - result%mon))
    result%day = int(day)
    result%sec = diff%sec / denominator + (day - result%day) * DAY_SECONDS
    call dcdate_normalize(result%day, result%sec)
  end function dcdate_div_fr

  ! 月差を除算すると近似的結果になるおそれがある

  type(DC_DIFFTIME) function dcdate_div_fd(diff, denominator) result(result) 1,2
    use dc_date_types, only: CYCLIC_MDAYS, DAY_SECONDS
    type(DC_DIFFTIME), intent(in):: diff
    real(DP), intent(in):: denominator
    real(DP):: month, day
    month = diff%mon / denominator
    result%mon = int(month)
    day = diff%day / denominator + int(CYCLIC_MDAYS * (month - result%mon))
    result%day = int(day)
    result%sec = diff%sec / denominator + (day - result%day) * DAY_SECONDS
    call dcdate_normalize(result%day, result%sec)
  end function dcdate_div_fd

  ! 月差と日時の混在する除算は近似的結果になるおそれがある

  real(DP) function dcdate_div_ff(diff1, diff2) result(result) 1,1
    use dc_date_types, only: CYCLIC_MDAYS, DAY_SECONDS
    type(DC_DIFFTIME), intent(in):: diff1, diff2
    ! ゼロ割対応コードが必要か?
    result = (DAY_SECONDS * (CYCLIC_MDAYS * diff1%mon + diff1%day) + &
      &     diff1%sec) / &
      & (DAY_SECONDS * (CYCLIC_MDAYS * diff2%mon + diff2%day) + &
      &  diff2%sec)
  end function dcdate_div_ff

  ! 月差と日時の混在する除算は近似的結果になるおそれがある

  type(DC_DIFFTIME) function dcdate_mod_ff(diff1, diff2) result(result) 1,2
    use dc_date_types, only: CYCLIC_MDAYS, DAY_SECONDS
    type(DC_DIFFTIME), intent(in):: diff1, diff2
    real(DP):: sec1, sec2
    if (diff1%day == 0 .and. diff2%day == 0 .and. &
      & diff1%sec == 0.0 .and. diff2%sec == 0.0) then
      result%mon = mod(diff1%mon, diff2%mon)
      result%day = 0
      result%sec = 0.0
    else if (diff1%sec == 0.0 .and. diff2%sec == 0.0) then
      result%mon = 0
      result%day = mod((CYCLIC_MDAYS * diff1%mon + diff1%day), &
        & (CYCLIC_MDAYS * diff2%mon + diff2%day))
      result%sec = 0.0
    else
      sec1 = DAY_SECONDS * (CYCLIC_MDAYS * diff1%mon + diff1%day) &
        & + diff1%sec
      sec2 = DAY_SECONDS * (CYCLIC_MDAYS * diff2%mon + diff2%day) &
        & + diff2%sec
      result%sec = mod(sec1, sec2)
      result%day = 0.0
      result%mon = 0.0
      call dcdate_normalize(result%day, result%sec)
    endif
  end function dcdate_mod_ff


  subroutine DCDateDiffEval(diff, year, mon, day, hour, min, sec) 1,1
    use dc_date_types, only: DC_DIFFTIME
    type(DC_DIFFTIME), intent(in):: diff
    integer, intent(out), optional:: year, mon, day, hour, min, sec
    if (present(year)) then
      year = diff%mon / 12
    endif
    if (present(mon)) then
      mon = mod(diff%mon, 12)
    endif
    if (present(day)) then
      day = diff%day
    endif
    if (present(hour)) then
      hour = int(diff%sec / 3600.0)
    endif
    if (present(min)) then
      min = int(mod(diff%sec, 3600.0_DP) / 60.0)
    endif
    if (present(sec)) then
      sec = mod(diff%sec, 60.0_DP)
    endif
  end subroutine DCDateDiffEval


  function DCTimeNow(fmt) result(result) 1,1
    !
    !== 現在時刻を返す
    !
    ! 現在時刻を文字型変数として返します。
    ! デフォルトでは JIS X 0301 の完全表記
    ! の文字列を返します。 (例: 2005-08-05T21:48:37+09:00)。
    !
    !--
    ! 将来的には文字列引数 fmt に文字列を与えることで書式の変更を
    ! 可能にしたい。現在は何を代入しても上記の書式で出力される。
    !++
    !
    implicit none
    character(*),      intent(in), optional :: fmt
    character(STRING)                       :: result

    integer :: values(1:8)
    character(5)  :: zone
    character(6)  :: zone_fmt
    character(4)  :: year
    character(2)  :: month, day, hour, min, sec
  continue

    call date_and_time(zone=zone, values=values)

    zone_fmt = zone(1:3) // ":" // zone(4:5)

    write(year, "(i4.4)") values(1)
    write(month, "(i2.2)") values(2)
    write(day, "(i2.2)") values(3)
    write(hour, "(i2.2)") values(5)
    write(min, "(i2.2)") values(6)
    write(sec, "(i2.2)") values(7)

    if (present_and_not_empty(fmt)) then
      result = CPrintf('%cT%c%c', &
        &     c1= year // '-' // month // '-' // day, &
        &     c2= hour // ':' // min   // ':' // sec, &
        &     c3= trim(zone_fmt) )
    else
      result = CPrintf('%cT%c%c', &
        &     c1= year // '-' // month // '-' // day, &
        &     c2= hour // ':' // min   // ':' // sec, &
        &     c3= trim(zone_fmt) )
    end if

  end function DCTimeNow

end module dc_date