From 43957ce0d08919d045bdb65c909b9a6f83d53161 Mon Sep 17 00:00:00 2001
From: Florian Prill <florian.prill@dwd.de>
Date: Tue, 18 Dec 2018 11:36:44 +0100
Subject: [PATCH] create operators for t_timedelta.
---
src/libmtime_hl.f90 | 163 ++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 163 insertions(+)
diff --git a/src/libmtime_hl.f90 b/src/libmtime_hl.f90
index 95b2cd29..4808629c 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)
--
GitLab