!== 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-20060719 $ ! Copyright:: Copyright (C) GFD Dennou Club, 2000-2005. All rights reserved. ! License:: See COPYRIGHT[link:../../COPYRIGHT] ! ! This file provides dc_date module dc_date !-- !== 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) 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) 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) 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) 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) 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) 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) 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) 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) 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) 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) 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) 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) 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) 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) 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) 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) 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) 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) ! !== 現在時刻を返す ! ! 現在時刻を文字型変数として返します。 ! デフォルトでは 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