diff --git a/src/libmtime_hl.f90 b/src/libmtime_hl.f90 index 95b2cd2927b33cf4b0d2a6386b4ab15b5d3a48e4..4808629c42fe759686b2f4e227e118a0d4287fce 100644 --- a/src/libmtime_hl.f90 +++ b/src/libmtime_hl.f90 @@ -10,6 +10,7 @@ !! module mtime_hl + USE, INTRINSIC :: iso_c_binding, ONLY: c_int32_t, c_int64_t, c_double use mtime implicit none @@ -19,6 +20,7 @@ module mtime_hl PUBLIC :: t_datetime, t_timedelta PUBLIC :: t_timedeltaFromMilliseconds PUBLIC :: min, max + PUBLIC :: OPERATOR(*) ! Re-export stuff from libmtime that is still needed PUBLIC :: divisionquotienttimespan @@ -81,8 +83,20 @@ module mtime_hl contains procedure :: assign_t_timedelta + procedure :: t_timedelta_divideInSecondsBy + procedure :: equal_datetime => t_timedelta_equal + procedure :: not_equal_datetime => t_timedelta_not_equal + procedure :: less_than_datetime => t_timedelta_less_than + procedure :: greater_than_datetime => t_timedelta_greater_than + procedure :: less_or_equal_datetime => t_timedelta_less_than_or_equal + procedure :: greater_or_equal_datetime => t_timedelta_greater_than_or_equal + + procedure :: scalar_multiply_long => t_timedelta_scalar_multiply_long + procedure :: scalar_multiply_int => t_timedelta_scalar_multiply_int + procedure :: scalar_multiply_real => t_timedelta_scalar_multiply_real + procedure :: t_timedelta_to_string generic :: divideInSecondsBy => t_timedelta_divideInSecondsBy @@ -91,6 +105,18 @@ module mtime_hl generic :: assignment(=) => assign_t_timedelta + ! note: the "+", "-" operators are not well-defined for timedelta + ! objects! + + generic :: operator(==) => equal_datetime + generic :: operator(/=) => not_equal_datetime + generic :: operator(<) => less_than_datetime + generic :: operator(>) => greater_than_datetime + generic :: operator(<=) => less_or_equal_datetime + generic :: operator(>=) => greater_or_equal_datetime + GENERIC :: OPERATOR(*) => scalar_multiply_long, scalar_multiply_int, & + & scalar_multiply_real + end type t_timedelta interface t_timedelta @@ -101,6 +127,12 @@ module mtime_hl MODULE PROCEDURE t_timedelta_assign_ms END INTERFACE t_timedeltaFromMilliseconds + INTERFACE OPERATOR(*) + MODULE PROCEDURE t_timedelta_scalar_multiply_inv_long + MODULE PROCEDURE t_timedelta_scalar_multiply_inv_int + MODULE PROCEDURE t_timedelta_scalar_multiply_inv_real + END INTERFACE OPERATOR(*) + interface min module procedure t_datetime_min @@ -326,6 +358,137 @@ contains call deallocatetimedelta(td_tmp) end function t_timedelta_assign_ms + + LOGICAL FUNCTION t_timedelta_equal(this, td) + CLASS (t_timedelta), INTENT(in) :: this + CLASS (t_timedelta), INTENT(in) :: td + t_timedelta_equal = (this%td == td%td) + END FUNCTION t_timedelta_equal + + LOGICAL FUNCTION t_timedelta_not_equal(this, td) + CLASS (t_timedelta), INTENT(in) :: this + CLASS (t_timedelta), INTENT(in) :: td + t_timedelta_not_equal = (this%td /= td%td) + END FUNCTION t_timedelta_not_equal + + LOGICAL FUNCTION t_timedelta_less_than(this, td) + CLASS (t_timedelta), INTENT(in) :: this + CLASS (t_timedelta), INTENT(in) :: td + t_timedelta_less_than = (this%td < td%td) + END FUNCTION t_timedelta_less_than + + LOGICAL FUNCTION t_timedelta_greater_than(this, td) + CLASS (t_timedelta), INTENT(in) :: this + CLASS (t_timedelta), INTENT(in) :: td + t_timedelta_greater_than = (this%td > td%td) + END FUNCTION t_timedelta_greater_than + + LOGICAL FUNCTION t_timedelta_less_than_or_equal(this, td) + CLASS (t_timedelta), INTENT(in) :: this + CLASS (t_timedelta), INTENT(in) :: td + t_timedelta_less_than_or_equal = (this%td <= td%td) + END FUNCTION t_timedelta_less_than_or_equal + + LOGICAL FUNCTION t_timedelta_greater_than_or_equal(this, td) + CLASS (t_timedelta), INTENT(in) :: this + CLASS (t_timedelta), INTENT(in) :: td + t_timedelta_greater_than_or_equal = (this%td >= td%td) + END FUNCTION t_timedelta_greater_than_or_equal + + + + FUNCTION t_timedelta_scalar_multiply_long (this, lambda) RESULT(scaled_td) + TYPE(t_timedelta), TARGET :: scaled_td + INTEGER(c_int64_t), INTENT(in) :: lambda + CLASS(t_timedelta), TARGET, INTENT(in) :: this + TYPE(timedelta), POINTER :: td_tmp, td_tmp2 + INTEGER :: errno + td_tmp => newtimedelta(this%td, errno) + CALL handle_errno(errno, __FILE__//"__LINE__") + td_tmp2 = td_tmp * lambda + scaled_td%td = td_tmp2 + scaled_td%td%sign = td_tmp2%sign + CALL deallocatetimedelta(td_tmp) + CALL deallocatetimedelta(td_tmp2) + END FUNCTION t_timedelta_scalar_multiply_long + + FUNCTION t_timedelta_scalar_multiply_inv_long(lambda, this) RESULT(scaled_td) + TYPE(t_timedelta), TARGET :: scaled_td + INTEGER(c_int64_t), INTENT(in) :: lambda + CLASS(t_timedelta), TARGET, INTENT(in) :: this + TYPE(timedelta), POINTER :: td_tmp, td_tmp2 + INTEGER :: errno + td_tmp => newtimedelta(this%td, errno) + CALL handle_errno(errno, __FILE__//"__LINE__") + td_tmp2 = td_tmp * lambda + scaled_td%td = td_tmp2 + scaled_td%td%sign = td_tmp2%sign + CALL deallocatetimedelta(td_tmp) + CALL deallocatetimedelta(td_tmp2) + END FUNCTION t_timedelta_scalar_multiply_inv_long + + FUNCTION t_timedelta_scalar_multiply_int (this, lambda) RESULT(scaled_td) + TYPE(t_timedelta), TARGET :: scaled_td + INTEGER(c_int32_t), INTENT(in) :: lambda + CLASS(t_timedelta), TARGET, INTENT(in) :: this + TYPE(timedelta), POINTER :: td_tmp, td_tmp2 + INTEGER :: errno + td_tmp => newtimedelta(this%td, errno) + CALL handle_errno(errno, __FILE__//"__LINE__") + td_tmp2 = td_tmp * lambda + scaled_td%td = td_tmp2 + scaled_td%td%sign = td_tmp2%sign + CALL deallocatetimedelta(td_tmp) + CALL deallocatetimedelta(td_tmp2) + END FUNCTION t_timedelta_scalar_multiply_int + + FUNCTION t_timedelta_scalar_multiply_inv_int(lambda, this) RESULT(scaled_td) + TYPE(t_timedelta), TARGET :: scaled_td + INTEGER(c_int32_t), INTENT(in) :: lambda + CLASS(t_timedelta), TARGET, INTENT(in) :: this + TYPE(timedelta), POINTER :: td_tmp, td_tmp2 + INTEGER :: errno + td_tmp => newtimedelta(this%td, errno) + CALL handle_errno(errno, __FILE__//"__LINE__") + td_tmp2 = td_tmp * lambda + scaled_td%td = td_tmp2 + scaled_td%td%sign = td_tmp2%sign + CALL deallocatetimedelta(td_tmp) + CALL deallocatetimedelta(td_tmp2) + END FUNCTION t_timedelta_scalar_multiply_inv_int + + FUNCTION t_timedelta_scalar_multiply_real (this, lambda) RESULT(scaled_td) + TYPE(t_timedelta), TARGET :: scaled_td + REAL(c_double), INTENT(in) :: lambda + CLASS(t_timedelta), TARGET, INTENT(in) :: this + TYPE(timedelta), POINTER :: td_tmp, td_tmp2 + INTEGER :: errno + td_tmp => newtimedelta(this%td, errno) + CALL handle_errno(errno, __FILE__//"__LINE__") + td_tmp2 = td_tmp * lambda + scaled_td%td = td_tmp2 + scaled_td%td%sign = td_tmp2%sign + CALL deallocatetimedelta(td_tmp) + CALL deallocatetimedelta(td_tmp2) + END FUNCTION t_timedelta_scalar_multiply_real + + FUNCTION t_timedelta_scalar_multiply_inv_real(lambda, this) RESULT(scaled_td) + TYPE(t_timedelta), TARGET :: scaled_td + REAL(c_double), INTENT(in) :: lambda + CLASS(t_timedelta), TARGET, INTENT(in) :: this + TYPE(timedelta), POINTER :: td_tmp, td_tmp2 + INTEGER :: errno + td_tmp => newtimedelta(this%td, errno) + CALL handle_errno(errno, __FILE__//"__LINE__") + td_tmp2 = td_tmp * lambda + scaled_td%td = td_tmp2 + scaled_td%td%sign = td_tmp2%sign + CALL deallocatetimedelta(td_tmp) + CALL deallocatetimedelta(td_tmp2) + END FUNCTION t_timedelta_scalar_multiply_inv_real + + + ! Convert t_timedelta object to string. ! function t_timedelta_to_string(this)