!== dc_date_types#DC_DATETIME, dc_date_types#DC_DIFFTIME 型変数から月日秒への変換 ! ! Authors:: Yasuhiro MORIKAWA, Eizi TOYODA ! Version:: $Id: dcdatetimeeval.f90,v 1.8 2007-03-21 06:59:06 morikawa Exp $ ! Tag Name:: $Name: gt4f90io-20080812 $ ! Copyright:: Copyright (C) GFD Dennou Club, 2000-2006. All rights reserved. ! License:: See COPYRIGHT[link:../../COPYRIGHT] ! ! このファイルで提供される手続き群は dc_date モジュールにて提供されます。 ! subroutine DCDateTimeEval1(time, year, mon, day, hour, min, sec, caltype, zone) ! ! dc_date_types#DC_DATETIME 型変数 *time* を ! 年 *year*, 月 *mon*, 日 *day*, 時間 *hour*, 分 *min*, 秒 *sec*, ! 暦法 *caltype*, タイムゾーン *zone* に変換して返します. ! use dc_types, only: DP use dc_date_types, only: DC_DATETIME, & & CYCLIC_MDAYS, CAL_NOLEAP, CAL_JULIAN, CAL_CYCLIC, & & YEAR_MONTHS, YEAR_DAYS, FOUR_YEARS, FOUR_CENTURY, & & HOUR_SECONDS, MIN_SECONDS use dc_trace, only: BeginSub, EndSub implicit none type(DC_DATETIME), intent(in):: time integer, intent(out), optional:: year ! 年 integer, intent(out), optional:: mon ! 月 integer, intent(out), optional:: day ! 日 integer, intent(out), optional:: hour ! 時 integer, intent(out), optional:: min ! 分 real(DP),intent(out), optional:: sec ! 秒 integer, intent(out), optional:: caltype ! 暦法 character(*), intent(out), optional:: zone ! タイムゾーン (UTC からの時差) integer:: iyear, month, iday, imon real(DP):: isec character(*), parameter :: subname = 'DCDateTimeEval1' continue call BeginSub(subname) if (present(zone)) then zone = time % zone end if if (present(caltype)) then caltype = time % caltype end if isec = time % sec if (present(hour)) then hour = floor(isec / HOUR_SECONDS) isec = modulo(isec, HOUR_SECONDS) end if if (present(min)) then min = floor(isec / MIN_SECONDS) isec = modulo(isec, MIN_SECONDS) end if if (present(sec)) then sec = isec end if if (time % caltype == CAL_CYCLIC) then iday = time % day if (present(year)) year = 0 if (present(mon)) then mon = floor(real(iday, DP) / CYCLIC_MDAYS) iday = ceiling(modulo(real(iday, DP), CYCLIC_MDAYS)) end if if (present(day)) day = iday goto 999 endif if (time % caltype == CAL_NOLEAP) then iday = modulo(time%day - 91, YEAR_DAYS) iyear = (time%day - 91 - iday) / YEAR_DAYS else if (time % caltype == CAL_JULIAN .or. time%day < 640196) then iday = modulo(time%day - 92, FOUR_YEARS) iyear = (time%day - 92 - iday) / FOUR_YEARS * 4 else iday = modulo(time%day - 94, FOUR_CENTURY) iyear = (time%day - 94 - iday) / FOUR_CENTURY * 400 if (iday == FOUR_CENTURY - 1) then iyear = iyear + 300 iday = 36525 else iyear = iyear + iday / 36524 * 100 iday = modulo(iday, 36524) endif iyear = iyear + iday / FOUR_YEARS * 4 iday = modulo(iday, FOUR_YEARS) endif if (iday == FOUR_YEARS - 1) then iyear = iyear + 3 iday = YEAR_DAYS else iyear = iyear + iday / YEAR_DAYS iday = modulo(iday, YEAR_DAYS) endif endif iday = iday * 10 + 922 month = iday / 306 if (present(year)) then imon = mod(month - 1, YEAR_MONTHS) + 1 year = iyear + (month - imon) / YEAR_MONTHS else imon = month end if if (present(mon)) then iday = mod(iday, 306) / 10 + 1 mon = imon else iday = iday / 10 + 1 end if if (present(day)) day = iday 999 continue call EndSub(subname) end subroutine DCDateTimeEval1 subroutine DCDiffTimeEval1(diff, year, mon, day, hour, min, sec) use dc_types, only: DP use dc_trace, only: BeginSub, EndSub use dc_date_types, only: DC_DIFFTIME, & & MIN_SECONDS, HOUR_SECONDS, YEAR_MONTHS implicit none type(DC_DIFFTIME), intent(in):: diff integer, intent(out), optional:: year ! 年 integer, intent(out), optional:: mon ! 月 integer, intent(out), optional:: day ! 日 integer, intent(out), optional:: hour ! 時 integer, intent(out), optional:: min ! 分 real(DP),intent(out), optional:: sec ! 秒 integer:: imon real(DP):: isec character(*), parameter :: subname = 'DCDiffTimeEval0' continue call BeginSub(subname) imon = diff % mon isec = diff % sec if (present(year)) then year = imon / YEAR_MONTHS imon = mod(imon, YEAR_MONTHS) endif if (present(mon)) then mon = imon endif if (present(day)) then day = diff % day else isec = isec + real(diff % day, DP) * diff % day_seconds endif if (present(hour)) then hour = int(isec / HOUR_SECONDS) isec = mod(isec, HOUR_SECONDS) endif if (present(min)) then min = int(isec / MIN_SECONDS) isec = mod(isec, MIN_SECONDS) endif if (present(sec)) then sec = isec endif 999 continue call EndSub(subname) end subroutine DCDiffTimeEval1 function DCDateTimeEvalDay(time) result(result) ! ! dc_date_types#DC_DATETIME 型変数の日時を日数に換算して ! 倍精度実数型変数で返します. (例えば 12 時間は 0.5 日と換算されます). ! use dc_types, only: DP use dc_date, only: Eval use dc_date_types, only: DC_DATETIME implicit none real(DP):: result type(DC_DATETIME), intent(in):: time integer :: day real(DP):: sec continue call Eval(time, day=day, sec=sec) result = real(day, DP) + sec / time % day_seconds end function DCDateTimeEvalDay function DCDiffTimeEvalDay(diff) result(result) ! ! dc_date_types#DC_DIFFTIME 型変数の日時を日数に換算して ! 倍精度実数型変数で返します. (例えば 12 時間は 0.5 日と換算されます). ! ! 1 ヶ月は dc_date_types#CYCLIC_MDAYS と換算します. ! use dc_types, only: DP use dc_date, only: Eval use dc_date_types, only: DC_DIFFTIME, CYCLIC_MDAYS implicit none real(DP):: result type(DC_DIFFTIME), intent(in):: diff integer :: day, mon real(DP):: sec continue call Eval(diff, mon=mon, day=day, sec=sec) result = real(int(mon * CYCLIC_MDAYS) + day, DP) + sec / diff % day_seconds end function DCDiffTimeEvalDay function DCDateTimeEvalHour(time) result(result) ! ! dc_date_types#DC_DATETIME 型変数の日時を時間に換算して ! 倍精度実数型変数で返します. ! (例えば 2 日は 48 時間に, 30 分 は 0.5 時間と換算されます). ! use dc_types, only: DP use dc_date, only: Eval use dc_date_types, only: DC_DATETIME, HOUR_SECONDS implicit none real(DP):: result type(DC_DATETIME), intent(in):: time integer :: day real(DP):: sec continue call Eval(time, day=day, sec=sec) result = (real(day, DP) * time % day_seconds + sec) / HOUR_SECONDS end function DCDateTimeEvalHour function DCDiffTimeEvalHour(diff) result(result) ! ! dc_date_types#DC_DIFFTIME 型変数の日時を時間に換算して ! 倍精度実数型変数で返します. ! (例えば 2 日は 48 時間に, 30 分 は 0.5 時間と換算されます). ! ! 1 ヶ月は dc_date_types#CYCLIC_MDAYS と換算します. ! use dc_types, only: DP use dc_date, only: Eval use dc_date_types, only: DC_DIFFTIME, HOUR_SECONDS, CYCLIC_MDAYS implicit none real(DP):: result type(DC_DIFFTIME), intent(in):: diff integer :: mon, day real(DP):: sec continue call Eval(diff, mon=mon, day=day, sec=sec) result = ( real(int(mon * CYCLIC_MDAYS) + day, DP) & & * diff % day_seconds + sec) / HOUR_SECONDS end function DCDiffTimeEvalHour function DCDateTimeEvalMin(time) result(result) ! ! dc_date_types#DC_DATETIME 型変数の日時を分に換算して ! 倍精度実数型変数で返します. ! (例えば 1 日は 3600 分に, 30 秒 は 0.5 分と換算されます). ! use dc_types, only: DP use dc_date, only: Eval use dc_date_types, only: DC_DATETIME, MIN_SECONDS implicit none real(DP):: result type(DC_DATETIME), intent(in):: time integer :: day real(DP):: sec continue call Eval(time, day=day, sec=sec) result = (real(day, DP) * time % day_seconds + sec) / MIN_SECONDS end function DCDateTimeEvalMin function DCDiffTimeEvalMin(diff) result(result) ! ! dc_date_types#DC_DIFFTIME 型変数の日時を分に換算して ! 倍精度実数型変数で返します. ! (例えば 1 日は 3600 分に, 30 秒 は 0.5 分と換算されます). ! ! 1 ヶ月は dc_date_types#CYCLIC_MDAYS と換算します. ! use dc_types, only: DP use dc_date, only: Eval use dc_date_types, only: DC_DIFFTIME, MIN_SECONDS, CYCLIC_MDAYS implicit none real(DP):: result type(DC_DIFFTIME), intent(in):: diff integer :: mon, day real(DP):: sec continue call Eval(diff, mon=mon, day=day, sec=sec) result = (real(int(mon * CYCLIC_MDAYS) + day, DP) & & * diff % day_seconds + sec) / MIN_SECONDS end function DCDiffTimeEvalMin function DCDateTimeEvalSec(time) result(result) ! ! dc_date_types#DC_DATETIME 型変数の日時を秒に換算して ! 倍精度実数型変数で返します. ! ! 年の要素は無視されます. すなわち, 1999-01-01 が格納された time と ! 2007-01-01 が格納された time からは同じ値が返ります. ! (これはもしかすると望ましく無い動作かもしれません). ! use dc_types, only: DP use dc_date, only: Eval use dc_date_types, only: DC_DATETIME implicit none real(DP):: result type(DC_DATETIME), intent(in):: time integer :: day real(DP):: sec continue call Eval(time, day=day, sec=sec) result = real(day, DP) * time % day_seconds + sec end function DCDateTimeEvalSec function DCDiffTimeEvalSec(diff) result(result) ! ! dc_date_types#DC_DIFFTIME 型変数の日時を秒に換算して ! 倍精度実数型変数で返します. ! ! 1 ヶ月は dc_date_types#CYCLIC_MDAYS と換算します. ! use dc_types, only: DP use dc_date, only: Eval use dc_date_types, only: DC_DIFFTIME, CYCLIC_MDAYS implicit none real(DP):: result type(DC_DIFFTIME), intent(in):: diff integer :: mon, day real(DP):: sec continue call Eval(diff, mon=mon, day=day, sec=sec) result = real(int(mon * CYCLIC_MDAYS) + day, DP) * diff % day_seconds + sec end function DCDiffTimeEvalSec function DCDateTimeEvalByUnit(time, unit) result(result) ! ! dc_date_types#DC_DATETIME 型変数の日時を *unit* の単位 ! に換算して倍精度実数型変数で返します. *unit* には ! 日 dc_date_types#UNIT_DAY, 時 dc_date_types#UNIT_HOUR, ! 分 dc_date_types#UNIT_MIN, 秒 dc_date_types#UNIT_SEC ! を与えることが可能です. これらに該当しない文字列を *unit* ! に与えた場合 0.0 が返ります. ! use dc_types, only: DP, TOKEN use dc_date, only: EvalSec, EvalMin, EvalHour, EvalDay, dcdate_parse_unit use dc_date_types, only: DC_DATETIME, & & UNIT_DAY, UNIT_HOUR, UNIT_MIN, UNIT_SEC implicit none real(DP):: result type(DC_DATETIME), intent(in):: time character(*), intent(in):: unit character(TOKEN) :: unitl continue unitl = dcdate_parse_unit(unit) if (trim(unitl) == trim(UNIT_SEC(1))) then result = EvalSec(time) elseif (trim(unitl) == trim(UNIT_MIN(1))) then result = EvalMin(time) elseif (trim(unitl) == trim(UNIT_HOUR(1))) then result = EvalHour(time) elseif (trim(unitl) == trim(UNIT_DAY(1))) then result = EvalDay(time) else result = 0.0_DP end if end function DCDateTimeEvalByUnit function DCDiffTimeEvalByUnit(diff, unit) result(result) ! ! dc_date_types#DC_DIFFTIME 型変数の日時を *unit* の単位 ! に換算して倍精度実数型変数で返します. *unit* には ! 日 dc_date_types#UNIT_DAY, 時 dc_date_types#UNIT_HOUR, ! 分 dc_date_types#UNIT_MIN, 秒 dc_date_types#UNIT_SEC ! を与えることが可能です. これらに該当しない文字列を *unit* ! に与えた場合 0.0 が返ります. ! use dc_types, only: DP, TOKEN use dc_date, only: EvalSec, EvalMin, EvalHour, EvalDay, dcdate_parse_unit use dc_date_types, only: DC_DIFFTIME, & & UNIT_DAY, UNIT_HOUR, UNIT_MIN, UNIT_SEC implicit none real(DP):: result type(DC_DIFFTIME), intent(in):: diff character(*), intent(in):: unit character(TOKEN) :: unitl continue unitl = dcdate_parse_unit(unit) if (trim(unitl) == trim(UNIT_SEC(1))) then result = EvalSec(diff) elseif (trim(unitl) == trim(UNIT_MIN(1))) then result = EvalMin(diff) elseif (trim(unitl) == trim(UNIT_HOUR(1))) then result = EvalHour(diff) elseif (trim(unitl) == trim(UNIT_DAY(1))) then result = EvalDay(diff) else result = 0.0_DP end if end function DCDiffTimeEvalByUnit !!$subroutine DCDateTimeEval0(time, mon, day, sec) !!$ ! !!$ ! dc_date_types#DC_DATETIME 型変数の *time* を !!$ ! 月 *mon*, 日 *day*, 秒 *sec* に変換して返す. !!$ ! !!$ use dc_types, only: DP !!$ use dc_date_types, only: DC_DATETIME, & !!$ & CYCLIC_MDAYS, CAL_NOLEAP, CAL_JULIAN, CAL_CYCLIC, & !!$ & FOUR_YEARS, FOUR_CENTURY !!$ use dc_trace, only: BeginSub, EndSub !!$ implicit none !!$ type(DC_DATETIME), intent(in):: time !!$ integer, intent(out):: mon, day !!$ real(DP), intent(out):: sec !!$ integer:: year, month !!$ character(*), parameter :: subname = 'DCDateTimeEval0' !!$continue !!$ call BeginSub(subname) !!$ sec = time%sec !!$ if (time % caltype == CAL_CYCLIC) then !!$ day = modulo(dble(time%day - 1), CYCLIC_MDAYS) + 1 !!$ mon = (time%day - 1) / CYCLIC_MDAYS !!$ goto 999 !!$ endif !!$ if (time % caltype == CAL_NOLEAP) then !!$ day = modulo(time%day - 91, 365) !!$ year = (time%day - 91 - day) / 365 !!$ else !!$ if (time % caltype == CAL_JULIAN .or. time%day < 640196) then !!$ day = modulo(time%day - 92, FOUR_YEARS) !!$ year = (time%day - 92 - day) / FOUR_YEARS * 4 !!$ else !!$ day = modulo(time%day - 94, FOUR_CENTURY) !!$ year = (time%day - 94 - day) / FOUR_CENTURY * 400 !!$ if (day == FOUR_CENTURY - 1) then !!$ year = year + 300 !!$ day = 36525 !!$ else !!$ year = year + day / 36524 * 100 !!$ day = modulo(day, 36524) !!$ endif !!$ year = year + day / FOUR_YEARS * 4 !!$ day = modulo(day, FOUR_YEARS) !!$ endif !!$ if (day == FOUR_YEARS - 1) then !!$ year = year + 3 !!$ day = 365 !!$ else !!$ year = year + day / 365 !!$ day = modulo(day, 365) !!$ endif !!$ endif !!$ day = day * 10 + 922 !!$ month = day / 306 !!$ mon = mod(month - 1, 12) + 1 !!$ year = year + (month - mon) / 12 !!$ day = mod(day, 306) / 10 + 1 !!$999 continue !!$ call EndSub(subname, 'mon=<%d>, day=<%d>, sec=<%f>',& !!$ & i=(/mon, day/), d=(/sec/)) !!$end subroutine DCDateTimeEval0