! Copyright (C) GFD Dennou Club, 2000.  All rights reserved

module dc_date

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

    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 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

        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

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

        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

    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

        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

    end interface

    interface Eval

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

        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

        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
    end interface

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

        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
    end interface

contains

    subroutine dcdate_normalize(day, sec)
        use dc_date_types, only: DAY_SECONDS
        integer, intent(inout):: day
        double precision, 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
    
    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

    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

    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

    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

    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

    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

    ! 月差を非整数倍すると近似的結果になるおそれがある
    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

    ! 月差を非整数倍すると近似的結果になるおそれがある
    type(DC_DIFFTIME) function dcdate_mul_df(factor, diff) result(result)
        use dc_date_types, only: CYCLIC_MDAYS
        double precision, 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

    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

    ! 近似的結果になるおそれがある
    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
        double precision:: 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

    ! 近似的結果になるおそれがある
    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
        double precision, intent(in):: factor
        double precision:: 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

    ! 月差を除算すると近似的結果になるおそれがある
    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

    ! 月差を除算すると近似的結果になるおそれがある
    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
        double precision:: 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

    ! 月差を除算すると近似的結果になるおそれがある
    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
        double precision, intent(in):: denominator
        double precision:: 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

    ! 月差と日時の混在する除算は近似的結果になるおそれがある
    double precision 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

    ! 月差と日時の混在する除算は近似的結果になるおそれがある
    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
        double precision:: 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

    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) / 60.0)
        endif
        if (present(sec)) then
            sec = mod(diff%sec, 60.0)
        endif
    end subroutine

end module