diff --git a/src/libmtime_hl.f90 b/src/libmtime_hl.f90
index 49856205ff774a0a8c817f9b71d3dd0fea03744d..359543ee38927c602ea40c19c243ea294872cbf2 100644
--- a/src/libmtime_hl.f90
+++ b/src/libmtime_hl.f90
@@ -4,26 +4,27 @@
!!
!! @author Luis Kornblueh, Max Planck Institute for Meteorology
!! @author Florian Prill, DWD
+!! @author Jan Frederik Engels, DKRZ
!!
!! @defgroup FortranBindings libmtime high level Fortran language bindings
!! @{
!!
module mtime_hl
- USE, INTRINSIC :: iso_c_binding, ONLY: c_int32_t, c_int64_t, c_double
+ use, intrinsic :: iso_c_binding, only: c_int32_t, c_int64_t, c_double
use mtime
implicit none
private
- PUBLIC :: t_datetime, t_timedelta, t_juliandelta
- PUBLIC :: t_timedeltaFromMilliseconds
- PUBLIC :: min, max
- PUBLIC :: OPERATOR(*)
+ public :: t_datetime, t_timedelta, t_juliandelta
+ public :: t_timedeltaFromMilliseconds
+ public :: min, max
+ public :: operator(*)
! Re-export stuff from libmtime that is still needed
- PUBLIC :: divisionquotienttimespan
+ public :: divisionquotienttimespan
integer, parameter :: i8 = selected_int_kind(14) !< at least 8 byte integer
@@ -39,35 +40,47 @@ module mtime_hl
contains
procedure :: assign_t_datetime
- procedure :: day => t_datetime_day
- procedure :: add_timedelta => t_datetime_add_timedelta
- procedure :: sub_timedelta => t_datetime_sub_timedelta
- procedure :: sub_datetime => t_datetime_sub_datetime
- procedure :: equal_datetime => t_datetime_equal
- procedure :: not_equal_datetime => t_datetime_not_equal
- procedure :: less_than_datetime => t_datetime_less_than
- procedure :: greater_than_datetime => t_datetime_greater_than
- procedure :: less_or_equal_datetime => t_datetime_less_or_equal
- procedure :: greater_or_equal_datetime => t_datetime_greater_or_equal
+ procedure :: day => t_datetime_day
+ procedure :: add_timedelta => t_datetime_add_timedelta
+ procedure :: sub_timedelta => t_datetime_sub_timedelta
+ procedure :: sub_datetime => t_datetime_sub_datetime
+ procedure :: equal_datetime => t_datetime_equal
+ procedure :: not_equal_datetime => t_datetime_not_equal
+ procedure :: less_than_datetime => t_datetime_less_than
+ procedure :: greater_than_datetime => t_datetime_greater_than
+ procedure :: less_or_equal_datetime => t_datetime_less_or_equal
+ procedure :: greater_or_equal_datetime => t_datetime_greater_or_equal
+
+ procedure :: days_in_this_month_datetime => t_datetime_days_in_this_month
+ procedure :: days_in_this_year_datetime => t_datetime_days_in_this_year
+ procedure :: day_of_year_datetime => t_datetime_day_of_year
+ procedure :: seconds_elapsed_in_month_datetime => t_datetime_seconds_elapsed_in_month
+ procedure :: seconds_elapsed_in_day_datetime => t_datetime_seconds_elapsed_in_day
procedure :: t_datetime_toString
procedure :: t_datetime_to_posix_string
procedure :: t_datetime_toJulianDay
- generic :: toString => t_datetime_toString, t_datetime_to_posix_string
- generic :: toJulianDay => t_datetime_toJulianDay
-
- generic :: assignment(=) => assign_t_datetime
- generic :: operator(+) => add_timedelta
- generic :: operator(-) => sub_timedelta
- generic :: operator(-) => sub_datetime
- 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 :: toString => t_datetime_toString, t_datetime_to_posix_string
+ generic :: toJulianDay => t_datetime_toJulianDay
+
+ generic :: daysInThisMonth => days_in_this_month_datetime
+ generic :: daysInThisYear => days_in_this_year_datetime
+ generic :: dayOfYear => day_of_year_datetime
+ generic :: secondsElapsedInMonth => seconds_elapsed_in_month_datetime
+ generic :: secondsElapsedInDay => seconds_elapsed_in_day_datetime
+
+ generic :: assignment(=) => assign_t_datetime
+ generic :: operator(+) => add_timedelta
+ generic :: operator(-) => sub_timedelta
+ generic :: operator(-) => sub_datetime
+ 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
end type t_datetime
@@ -121,7 +134,7 @@ module mtime_hl
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, &
+ generic :: operator(*) => scalar_multiply_long, scalar_multiply_int, &
& scalar_multiply_real
end type t_timedelta
@@ -131,19 +144,19 @@ module mtime_hl
module procedure t_timedelta_assign_string
end interface t_timedelta
- INTERFACE t_timedeltaFromMilliseconds
- MODULE PROCEDURE t_timedelta_assign_ms
- END INTERFACE t_timedeltaFromMilliseconds
+ interface t_timedeltaFromMilliseconds
+ module procedure t_timedelta_assign_ms
+ end interface t_timedeltaFromMilliseconds
- INTERFACE t_timedeltaFromSeconds
- MODULE PROCEDURE t_timedelta_assign_sec
- END INTERFACE t_timedeltaFromSeconds
+ interface t_timedeltaFromSeconds
+ module procedure t_timedelta_assign_sec
+ end interface t_timedeltaFromSeconds
- 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 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
@@ -167,14 +180,14 @@ module mtime_hl
!> Wrapper class for "mtime" data type "juliandelta".
!
- TYPE t_juliandelta
- PRIVATE
- TYPE(juliandelta) :: jd
- END TYPE t_juliandelta
+ type t_juliandelta
+ private
+ type(juliandelta) :: jd
+ end type t_juliandelta
- INTERFACE t_juliandelta
- MODULE PROCEDURE t_juliandelta_assign_raw
- END INTERFACE t_juliandelta
+ interface t_juliandelta
+ module procedure t_juliandelta_assign_raw
+ end interface t_juliandelta
@@ -182,17 +195,17 @@ contains
!___________________________________________________________________________
! auxiliary routine: handle error code.
- SUBROUTINE handle_errno(errno, routine_str, lineno)
- INTEGER, INTENT(IN) :: errno
- INTEGER, INTENT(IN) :: lineno
- CHARACTER(LEN=*), INTENT(IN) :: routine_str
- CHARACTER(len=max_mtime_error_str_len) :: error_str
- IF (errno /= no_error) THEN
- CALL mtime_strerror(errno, error_str)
- WRITE (error_str,'(a,a,i0)') TRIM(error_str), " :: line ", lineno
- CALL finish_mtime(routine_str, error_str)
- END IF
- END SUBROUTINE handle_errno
+ subroutine handle_errno(errno, routine_str, lineno)
+ integer, intent(IN) :: errno
+ integer, intent(IN) :: lineno
+ character(LEN=*), intent(IN) :: routine_str
+ character(len=max_mtime_error_str_len) :: error_str
+ if (errno /= no_error) then
+ call mtime_strerror(errno, error_str)
+ write (error_str,'(a,a,i0)') trim(error_str), " :: line ", lineno
+ call finish_mtime(routine_str, error_str)
+ end if
+ end subroutine handle_errno
!___________________________________________________________________________
@@ -204,9 +217,9 @@ contains
class(t_datetime), intent(out) :: to
class(t_datetime), intent(in) :: from
type(datetime), pointer :: dt_tmp
- INTEGER :: errno
+ integer :: errno
dt_tmp => newdatetime(from%dt, errno)
- CALL handle_errno(errno, __FILE__, __LINE__)
+ call handle_errno(errno, __FILE__, __LINE__)
to%dt = dt_tmp
call deallocatedatetime(dt_tmp)
end subroutine assign_t_datetime
@@ -216,9 +229,9 @@ contains
type(t_datetime) function t_datetime_assign_string(dt_string)
character(len=*), intent(in) :: dt_string
type(datetime), pointer :: dt_tmp
- INTEGER :: errno
+ integer :: errno
dt_tmp => newdatetime(dt_string, errno)
- CALL handle_errno(errno, __FILE__, __LINE__)
+ call handle_errno(errno, __FILE__, __LINE__)
t_datetime_assign_string%dt = dt_tmp
call deallocatedatetime(dt_tmp)
end function t_datetime_assign_string
@@ -239,10 +252,10 @@ contains
type(datetime), pointer :: dt_tmp
integer :: errno
dt_tmp => newdatetime(this%dt, errno)
- CALL handle_errno(errno, __FILE__, __LINE__)
- CALL datetimetostring(dt_tmp, t_datetime_toString, errno)
- CALL handle_errno(errno, __FILE__, __LINE__)
- CALL deallocatedatetime(dt_tmp)
+ call handle_errno(errno, __FILE__, __LINE__)
+ call datetimetostring(dt_tmp, t_datetime_toString, errno)
+ call handle_errno(errno, __FILE__, __LINE__)
+ call deallocatedatetime(dt_tmp)
end function t_datetime_toString
! Convert t_datetime object to string.
@@ -254,20 +267,20 @@ contains
type(datetime), pointer :: dt_tmp
integer :: errno
dt_tmp => newdatetime(this%dt, errno)
- CALL handle_errno(errno, __FILE__, __LINE__)
- CALL datetimetoposixstring(dt_tmp, t_datetime_to_posix_string, format_string, errno)
- CALL handle_errno(errno, __FILE__, __LINE__)
- CALL deallocatedatetime(dt_tmp)
+ call handle_errno(errno, __FILE__, __LINE__)
+ call datetimetoposixstring(dt_tmp, t_datetime_to_posix_string, format_string, errno)
+ call handle_errno(errno, __FILE__, __LINE__)
+ call deallocatedatetime(dt_tmp)
end function t_datetime_to_posix_string
- FUNCTION t_datetime_toJulianDay(this) RESULT(jd)
- CLASS(t_datetime), INTENT(in) :: this
- TYPE(t_julianday) :: jd
- INTEGER :: errno
+ function t_datetime_toJulianDay(this) result(jd)
+ class(t_datetime), intent(in) :: this
+ type(t_julianday) :: jd
+ integer :: errno
- CALL getJulianDayFromDatetime(this%dt, jd%jd, errno)
- CALL handle_errno(errno, __FILE__, __LINE__)
- END FUNCTION t_datetime_toJulianDay
+ call getJulianDayFromDatetime(this%dt, jd%jd, errno)
+ call handle_errno(errno, __FILE__, __LINE__)
+ end function t_datetime_toJulianDay
! Addition of time interval to datetime object.
!
@@ -277,11 +290,11 @@ contains
class (t_timedelta), intent(in) :: td
type(datetime), pointer :: dt_tmp
type(timedelta), pointer :: td_tmp
- INTEGER :: errno
+ integer :: errno
dt_tmp => newDatetime(this%dt, errno)
- CALL handle_errno(errno, __FILE__, __LINE__)
+ call handle_errno(errno, __FILE__, __LINE__)
td_tmp => newTimedelta(td%td, errno)
- CALL handle_errno(errno, __FILE__, __LINE__)
+ call handle_errno(errno, __FILE__, __LINE__)
dt_tmp = dt_tmp + td_tmp
dt_td_sum%dt = dt_tmp
call deallocateDatetime(dt_tmp)
@@ -296,11 +309,11 @@ contains
class (t_timedelta), intent(in) :: td
type(datetime), pointer :: dt_tmp
type(timedelta), pointer :: td_tmp
- INTEGER :: errno
+ integer :: errno
dt_tmp => newDatetime(this%dt, errno)
- CALL handle_errno(errno, __FILE__, __LINE__)
+ call handle_errno(errno, __FILE__, __LINE__)
td_tmp => newTimedelta(td%td, errno)
- CALL handle_errno(errno, __FILE__, __LINE__)
+ call handle_errno(errno, __FILE__, __LINE__)
if (td_tmp%sign == "+") then
td_tmp%sign = "-"
else
@@ -359,6 +372,45 @@ contains
t_datetime_greater_or_equal = (this%dt >= dt%dt)
end function t_datetime_greater_or_equal
+ function t_datetime_days_in_this_month(this)
+ class (t_datetime), intent(in) :: this
+ integer(c_int) :: t_datetime_days_in_this_month
+ integer :: errno
+ t_datetime_days_in_this_month = getNoOfDaysInMonthDateTime(this%dt, errno)
+ if (errno /= no_error) call handle_errno(errno, __FILE__, __LINE__)
+ end function t_datetime_days_in_this_month
+
+ function t_datetime_days_in_this_year(this)
+ class (t_datetime), intent(in) :: this
+ integer(c_int) :: t_datetime_days_in_this_year
+ integer :: errno
+ t_datetime_days_in_this_year = getNoOfDaysInYearDateTime(this%dt, errno)
+ if (errno /= no_error) call handle_errno(errno, __FILE__, __LINE__)
+ end function t_datetime_days_in_this_year
+
+ function t_datetime_day_of_year(this)
+ class (t_datetime), intent(in) :: this
+ integer(c_int) :: t_datetime_day_of_year
+ integer :: errno
+ t_datetime_day_of_year = getDayOfYearFromDateTime(this%dt, errno)
+ if (errno /= no_error) call handle_errno(errno, __FILE__, __LINE__)
+ end function t_datetime_day_of_year
+
+ function t_datetime_seconds_elapsed_in_month(this)
+ class (t_datetime), intent(in) :: this
+ integer(c_int64_t) :: t_datetime_seconds_elapsed_in_month
+ integer :: errno
+ t_datetime_seconds_elapsed_in_month = getNoOfSecondsElapsedInMonthDateTime(this%dt, errno)
+ if (errno /= no_error) call handle_errno(errno, __FILE__, __LINE__)
+ end function t_datetime_seconds_elapsed_in_month
+
+ function t_datetime_seconds_elapsed_in_day(this)
+ class (t_datetime), intent(in) :: this
+ integer(c_int64_t) :: t_datetime_seconds_elapsed_in_day
+ integer :: errno
+ t_datetime_seconds_elapsed_in_day = getNoOfSecondsElapsedInDayDateTime(this%dt, errno)
+ if (errno /= no_error) call handle_errno(errno, __FILE__, __LINE__)
+ end function t_datetime_seconds_elapsed_in_day
!___________________________________________________________________________
! timedelta section:
!
@@ -368,9 +420,9 @@ contains
class(t_timedelta), intent(out) :: to
class(t_timedelta), intent(in) :: from
type(timedelta), pointer :: td_tmp
- INTEGER :: errno
+ integer :: errno
td_tmp => newTimedelta(from%td, errno)
- CALL handle_errno(errno, __FILE__, __LINE__)
+ call handle_errno(errno, __FILE__, __LINE__)
to%td = td_tmp
to%td%sign = td_tmp%sign
call deallocateTimedelta(td_tmp)
@@ -381,10 +433,10 @@ contains
type(t_timedelta) function t_timedelta_assign_string(td_string)
character(len=*), intent(in) :: td_string
type(timedelta), pointer :: td_tmp
- INTEGER :: errno
+ integer :: errno
td_tmp => newtimedelta(td_string, errno)
- CALL handle_errno(errno, __FILE__, __LINE__)
- IF (.NOT. ASSOCIATED(td_tmp)) RETURN
+ call handle_errno(errno, __FILE__, __LINE__)
+ if (.not. associated(td_tmp)) return
t_timedelta_assign_string%td = td_tmp
t_timedelta_assign_string%td%sign = td_tmp%sign
call deallocatetimedelta(td_tmp)
@@ -396,11 +448,11 @@ contains
integer, intent(in) :: td_ms
type(timedelta), pointer :: td_tmp
character(len=max_timedelta_str_len) :: td_string
- INTEGER :: errno
- CALL getptstringfromms(INT(td_ms,i8), td_string, errno)
- CALL handle_errno(errno, __FILE__, __LINE__)
+ integer :: errno
+ call getptstringfromms(int(td_ms,i8), td_string, errno)
+ call handle_errno(errno, __FILE__, __LINE__)
td_tmp => newtimedelta(td_string, errno)
- CALL handle_errno(errno, __FILE__, __LINE__)
+ call handle_errno(errno, __FILE__, __LINE__)
t_timedelta_assign_ms%td = td_tmp
t_timedelta_assign_ms%td%sign = td_tmp%sign
call deallocatetimedelta(td_tmp)
@@ -408,163 +460,163 @@ contains
! constructor for integer seconds (integer)
!
- TYPE(t_timedelta) FUNCTION t_timedelta_assign_sec(td_sec)
- INTEGER, INTENT(in) :: td_sec
+ type(t_timedelta) function t_timedelta_assign_sec(td_sec)
+ integer, intent(in) :: td_sec
t_timedelta_assign_sec = t_timedelta_assign_ms(td_sec*1000)
- END FUNCTION t_timedelta_assign_sec
+ end function t_timedelta_assign_sec
- LOGICAL FUNCTION t_timedelta_equal(this, td)
- CLASS (t_timedelta), INTENT(in) :: this
- CLASS (t_timedelta), INTENT(in) :: td
+ 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
+ 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
+ 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
+ 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
+ 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
+ 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
+ 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
+ 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
+ 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
+ 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
+ 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
+ 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
+ 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__)
+ call handle_errno(errno, __FILE__, __LINE__)
td_tmp2 = td_tmp * lambda
- IF (ASSOCIATED(td_tmp2)) THEN
- CALL handle_errno(general_arithmetic_error, __FILE__, __LINE__)
- RETURN
- END IF
+ if (associated(td_tmp2)) then
+ call handle_errno(general_arithmetic_error, __FILE__, __LINE__)
+ return
+ end if
scaled_td%td = td_tmp2
scaled_td%td%sign = td_tmp2%sign
- IF (ASSOCIATED(td_tmp)) CALL deallocatetimedelta(td_tmp)
- IF (ASSOCIATED(td_tmp2)) 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
+ if (associated(td_tmp)) call deallocatetimedelta(td_tmp)
+ if (associated(td_tmp2)) 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__)
+ call handle_errno(errno, __FILE__, __LINE__)
td_tmp2 = td_tmp * lambda
- IF (ASSOCIATED(td_tmp2)) THEN
- CALL handle_errno(general_arithmetic_error, __FILE__, __LINE__)
- RETURN
- END IF
+ if (associated(td_tmp2)) then
+ call handle_errno(general_arithmetic_error, __FILE__, __LINE__)
+ return
+ end if
scaled_td%td = td_tmp2
scaled_td%td%sign = td_tmp2%sign
- IF (ASSOCIATED(td_tmp)) CALL deallocatetimedelta(td_tmp)
- IF (ASSOCIATED(td_tmp2)) 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
+ if (associated(td_tmp)) call deallocatetimedelta(td_tmp)
+ if (associated(td_tmp2)) 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__)
+ call handle_errno(errno, __FILE__, __LINE__)
td_tmp2 = td_tmp * lambda
- IF (ASSOCIATED(td_tmp2)) THEN
- CALL handle_errno(general_arithmetic_error, __FILE__, __LINE__)
- RETURN
- END IF
+ if (associated(td_tmp2)) then
+ call handle_errno(general_arithmetic_error, __FILE__, __LINE__)
+ return
+ end if
scaled_td%td = td_tmp2
scaled_td%td%sign = td_tmp2%sign
- IF (ASSOCIATED(td_tmp)) CALL deallocatetimedelta(td_tmp)
- IF (ASSOCIATED(td_tmp2)) 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
+ if (associated(td_tmp)) call deallocatetimedelta(td_tmp)
+ if (associated(td_tmp2)) 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__)
+ call handle_errno(errno, __FILE__, __LINE__)
td_tmp2 = td_tmp * lambda
- IF (ASSOCIATED(td_tmp2)) THEN
- CALL handle_errno(general_arithmetic_error, __FILE__, __LINE__)
- RETURN
- END IF
+ if (associated(td_tmp2)) then
+ call handle_errno(general_arithmetic_error, __FILE__, __LINE__)
+ return
+ end if
scaled_td%td = td_tmp2
scaled_td%td%sign = td_tmp2%sign
- IF (ASSOCIATED(td_tmp)) CALL deallocatetimedelta(td_tmp)
- IF (ASSOCIATED(td_tmp2)) 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
+ if (associated(td_tmp)) call deallocatetimedelta(td_tmp)
+ if (associated(td_tmp2)) 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__)
+ call handle_errno(errno, __FILE__, __LINE__)
td_tmp2 = td_tmp * lambda
- IF (ASSOCIATED(td_tmp2)) THEN
- CALL handle_errno(general_arithmetic_error, __FILE__, __LINE__)
- RETURN
- END IF
+ if (associated(td_tmp2)) then
+ call handle_errno(general_arithmetic_error, __FILE__, __LINE__)
+ return
+ end if
scaled_td%td = td_tmp2
scaled_td%td%sign = td_tmp2%sign
- IF (ASSOCIATED(td_tmp)) CALL deallocatetimedelta(td_tmp)
- IF (ASSOCIATED(td_tmp2)) 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
+ if (associated(td_tmp)) call deallocatetimedelta(td_tmp)
+ if (associated(td_tmp2)) 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__)
+ call handle_errno(errno, __FILE__, __LINE__)
td_tmp2 = td_tmp * lambda
- IF (ASSOCIATED(td_tmp2)) THEN
- CALL handle_errno(general_arithmetic_error, __FILE__, __LINE__)
- RETURN
- END IF
+ if (associated(td_tmp2)) then
+ call handle_errno(general_arithmetic_error, __FILE__, __LINE__)
+ return
+ end if
scaled_td%td = td_tmp2
scaled_td%td%sign = td_tmp2%sign
- IF (ASSOCIATED(td_tmp)) CALL deallocatetimedelta(td_tmp)
- IF (ASSOCIATED(td_tmp2)) CALL deallocatetimedelta(td_tmp2)
- END FUNCTION t_timedelta_scalar_multiply_inv_real
+ if (associated(td_tmp)) call deallocatetimedelta(td_tmp)
+ if (associated(td_tmp2)) call deallocatetimedelta(td_tmp2)
+ end function t_timedelta_scalar_multiply_inv_real
@@ -574,49 +626,49 @@ contains
character(len=max_timedelta_str_len) :: t_timedelta_toString
class (t_timedelta) :: this
type(timedelta), pointer :: td_tmp
- INTEGER :: errno
+ integer :: errno
td_tmp => newtimedelta(this%td, errno)
- CALL handle_errno(errno, __FILE__, __LINE__)
- CALL timedeltatostring(td_tmp, t_timedelta_toString, errno)
- CALL handle_errno(errno, __FILE__, __LINE__)
+ call handle_errno(errno, __FILE__, __LINE__)
+ call timedeltatostring(td_tmp, t_timedelta_toString, errno)
+ call handle_errno(errno, __FILE__, __LINE__)
call deallocatetimedelta(td_tmp)
end function t_timedelta_toString
function t_timedelta_divideInSecondsBy (this, divisor) result(quotient)
- CLASS(t_timedelta), INTENT(in) :: this
- TYPE(t_timedelta), INTENT(in) :: divisor
- TYPE(divisionquotienttimespan) :: quotient
+ class(t_timedelta), intent(in) :: this
+ type(t_timedelta), intent(in) :: divisor
+ type(divisionquotienttimespan) :: quotient
- CALL divideTimeDeltaInSeconds(this%td, divisor%td, quotient)
+ call divideTimeDeltaInSeconds(this%td, divisor%td, quotient)
end function t_timedelta_divideInSecondsBy
function t_timedelta_toSeconds (this, td) result(seconds)
- CLASS(t_timedelta), INTENT(in) :: this
- TYPE(t_datetime), INTENT(in) :: td
- INTEGER(c_int64_t) :: seconds
+ class(t_timedelta), intent(in) :: this
+ type(t_datetime), intent(in) :: td
+ integer(c_int64_t) :: seconds
seconds = getTotalSecondsTimeDelta(this%td, td%dt)
end function t_timedelta_toSeconds
function t_timedelta_toMilliSeconds (this, td) result(ms)
- CLASS(t_timedelta), INTENT(in) :: this
- TYPE(t_datetime), INTENT(in) :: td
- INTEGER(c_int64_t) :: ms
+ class(t_timedelta), intent(in) :: this
+ type(t_datetime), intent(in) :: td
+ integer(c_int64_t) :: ms
ms = getTotalMilliSecondsTimeDelta(this%td, td%dt)
end function t_timedelta_toMilliSeconds
- FUNCTION t_julianDay_getDay (this) result(d)
- CLASS(t_julianday), INTENT(in) :: this
- INTEGER(c_int64_t) :: d
+ function t_julianDay_getDay (this) result(d)
+ class(t_julianday), intent(in) :: this
+ integer(c_int64_t) :: d
d = this%jd%day
- END FUNCTION t_julianDay_getDay
+ end function t_julianDay_getDay
- FUNCTION t_julianday_getFractionOfDayInMS (this) result(ms)
- CLASS(t_julianday), INTENT(in) :: this
- INTEGER(c_int64_t) :: ms
+ function t_julianday_getFractionOfDayInMS (this) result(ms)
+ class(t_julianday), intent(in) :: this
+ integer(c_int64_t) :: ms
ms = this%jd%ms
- END FUNCTION t_julianday_getFractionOfDayInMS
+ end function t_julianday_getFractionOfDayInMS
function t_datetime_min(a,b) result(res)
type(t_datetime) :: a,b
@@ -641,19 +693,19 @@ contains
end function t_datetime_max
- FUNCTION t_juliandelta_assign_raw(sign,day, ms)
- TYPE(t_juliandelta) :: t_juliandelta_assign_raw
- CHARACTER(c_char), INTENT(in) :: sign
- INTEGER(c_int64_t), INTENT(in) :: day
- INTEGER(c_int64_t), INTENT(in) :: ms
- TYPE(juliandelta), POINTER :: jd_tmp
- INTEGER :: errno
+ function t_juliandelta_assign_raw(sign,day, ms)
+ type(t_juliandelta) :: t_juliandelta_assign_raw
+ character(c_char), intent(in) :: sign
+ integer(c_int64_t), intent(in) :: day
+ integer(c_int64_t), intent(in) :: ms
+ type(juliandelta), pointer :: jd_tmp
+ integer :: errno
jd_tmp => newJuliandelta(sign,day,ms, errno)
- CALL handle_errno(errno, __FILE__, __LINE__)
+ call handle_errno(errno, __FILE__, __LINE__)
t_juliandelta_assign_raw%jd = jd_tmp
t_juliandelta_assign_raw%jd%sign = jd_tmp%sign
- IF (ASSOCIATED(jd_tmp)) CALL deallocateJuliandelta(jd_tmp)
- END FUNCTION t_juliandelta_assign_raw
+ if (associated(jd_tmp)) call deallocateJuliandelta(jd_tmp)
+ end function t_juliandelta_assign_raw
end module mtime_hl