Skip to content
Snippets Groups Projects
Commit ee79fa27 authored by Luis Kornblueh's avatar Luis Kornblueh
Browse files

Add missing functions for distance to beginning of something

parent d1a41772
No related branches found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
Showing
with 293 additions and 241 deletions
src/libmtime_hl.f90
+ 293
− 241
View file @ ee79fa27
...@@ -4,26 +4,27 @@ ...@@ -4,26 +4,27 @@
!! !!
!! @author Luis Kornblueh, Max Planck Institute for Meteorology !! @author Luis Kornblueh, Max Planck Institute for Meteorology
!! @author Florian Prill, DWD !! @author Florian Prill, DWD
!! @author Jan Frederik Engels, DKRZ
!! !!
!! @defgroup FortranBindings libmtime high level Fortran language bindings !! @defgroup FortranBindings libmtime high level Fortran language bindings
!! @{ !! @{
!! !!
module mtime_hl 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 use mtime
implicit none implicit none
private private
PUBLIC :: t_datetime, t_timedelta, t_juliandelta public :: t_datetime, t_timedelta, t_juliandelta
PUBLIC :: t_timedeltaFromMilliseconds public :: t_timedeltaFromMilliseconds
PUBLIC :: min, max public :: min, max
PUBLIC :: OPERATOR(*) public :: operator(*)
! Re-export stuff from libmtime that is still needed ! 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 integer, parameter :: i8 = selected_int_kind(14) !< at least 8 byte integer
...@@ -39,35 +40,47 @@ module mtime_hl ...@@ -39,35 +40,47 @@ module mtime_hl
contains contains
procedure :: assign_t_datetime procedure :: assign_t_datetime
procedure :: day => t_datetime_day procedure :: day => t_datetime_day
procedure :: add_timedelta => t_datetime_add_timedelta procedure :: add_timedelta => t_datetime_add_timedelta
procedure :: sub_timedelta => t_datetime_sub_timedelta procedure :: sub_timedelta => t_datetime_sub_timedelta
procedure :: sub_datetime => t_datetime_sub_datetime procedure :: sub_datetime => t_datetime_sub_datetime
procedure :: equal_datetime => t_datetime_equal procedure :: equal_datetime => t_datetime_equal
procedure :: not_equal_datetime => t_datetime_not_equal procedure :: not_equal_datetime => t_datetime_not_equal
procedure :: less_than_datetime => t_datetime_less_than procedure :: less_than_datetime => t_datetime_less_than
procedure :: greater_than_datetime => t_datetime_greater_than procedure :: greater_than_datetime => t_datetime_greater_than
procedure :: less_or_equal_datetime => t_datetime_less_or_equal procedure :: less_or_equal_datetime => t_datetime_less_or_equal
procedure :: greater_or_equal_datetime => t_datetime_greater_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_toString
procedure :: t_datetime_to_posix_string procedure :: t_datetime_to_posix_string
procedure :: t_datetime_toJulianDay procedure :: t_datetime_toJulianDay
generic :: toString => t_datetime_toString, t_datetime_to_posix_string generic :: toString => t_datetime_toString, t_datetime_to_posix_string
generic :: toJulianDay => t_datetime_toJulianDay generic :: toJulianDay => t_datetime_toJulianDay
generic :: assignment(=) => assign_t_datetime generic :: daysInThisMonth => days_in_this_month_datetime
generic :: operator(+) => add_timedelta generic :: daysInThisYear => days_in_this_year_datetime
generic :: operator(-) => sub_timedelta generic :: dayOfYear => day_of_year_datetime
generic :: operator(-) => sub_datetime generic :: secondsElapsedInMonth => seconds_elapsed_in_month_datetime
generic :: operator(==) => equal_datetime generic :: secondsElapsedInDay => seconds_elapsed_in_day_datetime
generic :: operator(/=) => not_equal_datetime
generic :: operator(<) => less_than_datetime generic :: assignment(=) => assign_t_datetime
generic :: operator(>) => greater_than_datetime generic :: operator(+) => add_timedelta
generic :: operator(<=) => less_or_equal_datetime generic :: operator(-) => sub_timedelta
generic :: operator(>=) => greater_or_equal_datetime 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 end type t_datetime
...@@ -121,7 +134,7 @@ module mtime_hl ...@@ -121,7 +134,7 @@ module mtime_hl
generic :: operator(>) => greater_than_datetime generic :: operator(>) => greater_than_datetime
generic :: operator(<=) => less_or_equal_datetime generic :: operator(<=) => less_or_equal_datetime
generic :: operator(>=) => greater_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 & scalar_multiply_real
end type t_timedelta end type t_timedelta
...@@ -131,19 +144,19 @@ module mtime_hl ...@@ -131,19 +144,19 @@ module mtime_hl
module procedure t_timedelta_assign_string module procedure t_timedelta_assign_string
end interface t_timedelta end interface t_timedelta
INTERFACE t_timedeltaFromMilliseconds interface t_timedeltaFromMilliseconds
MODULE PROCEDURE t_timedelta_assign_ms module procedure t_timedelta_assign_ms
END INTERFACE t_timedeltaFromMilliseconds end interface t_timedeltaFromMilliseconds
INTERFACE t_timedeltaFromSeconds interface t_timedeltaFromSeconds
MODULE PROCEDURE t_timedelta_assign_sec module procedure t_timedelta_assign_sec
END INTERFACE t_timedeltaFromSeconds end interface t_timedeltaFromSeconds
INTERFACE OPERATOR(*) interface operator(*)
MODULE PROCEDURE t_timedelta_scalar_multiply_inv_long module procedure t_timedelta_scalar_multiply_inv_long
MODULE PROCEDURE t_timedelta_scalar_multiply_inv_int module procedure t_timedelta_scalar_multiply_inv_int
MODULE PROCEDURE t_timedelta_scalar_multiply_inv_real module procedure t_timedelta_scalar_multiply_inv_real
END INTERFACE OPERATOR(*) end interface operator(*)
interface min interface min
...@@ -167,14 +180,14 @@ module mtime_hl ...@@ -167,14 +180,14 @@ module mtime_hl
!> Wrapper class for "mtime" data type "juliandelta". !> Wrapper class for "mtime" data type "juliandelta".
! !
TYPE t_juliandelta type t_juliandelta
PRIVATE private
TYPE(juliandelta) :: jd type(juliandelta) :: jd
END TYPE t_juliandelta end type t_juliandelta
INTERFACE t_juliandelta interface t_juliandelta
MODULE PROCEDURE t_juliandelta_assign_raw module procedure t_juliandelta_assign_raw
END INTERFACE t_juliandelta end interface t_juliandelta
...@@ -182,17 +195,17 @@ contains ...@@ -182,17 +195,17 @@ contains
!___________________________________________________________________________ !___________________________________________________________________________
! auxiliary routine: handle error code. ! auxiliary routine: handle error code.
SUBROUTINE handle_errno(errno, routine_str, lineno) subroutine handle_errno(errno, routine_str, lineno)
INTEGER, INTENT(IN) :: errno integer, intent(IN) :: errno
INTEGER, INTENT(IN) :: lineno integer, intent(IN) :: lineno
CHARACTER(LEN=*), INTENT(IN) :: routine_str character(LEN=*), intent(IN) :: routine_str
CHARACTER(len=max_mtime_error_str_len) :: error_str character(len=max_mtime_error_str_len) :: error_str
IF (errno /= no_error) THEN if (errno /= no_error) then
CALL mtime_strerror(errno, error_str) call mtime_strerror(errno, error_str)
WRITE (error_str,'(a,a,i0)') TRIM(error_str), " :: line ", lineno write (error_str,'(a,a,i0)') trim(error_str), " :: line ", lineno
CALL finish_mtime(routine_str, error_str) call finish_mtime(routine_str, error_str)
END IF end if
END SUBROUTINE handle_errno end subroutine handle_errno
!___________________________________________________________________________ !___________________________________________________________________________
...@@ -204,9 +217,9 @@ contains ...@@ -204,9 +217,9 @@ contains
class(t_datetime), intent(out) :: to class(t_datetime), intent(out) :: to
class(t_datetime), intent(in) :: from class(t_datetime), intent(in) :: from
type(datetime), pointer :: dt_tmp type(datetime), pointer :: dt_tmp
INTEGER :: errno integer :: errno
dt_tmp => newdatetime(from%dt, errno) dt_tmp => newdatetime(from%dt, errno)
CALL handle_errno(errno, __FILE__, __LINE__) call handle_errno(errno, __FILE__, __LINE__)
to%dt = dt_tmp to%dt = dt_tmp
call deallocatedatetime(dt_tmp) call deallocatedatetime(dt_tmp)
end subroutine assign_t_datetime end subroutine assign_t_datetime
...@@ -216,9 +229,9 @@ contains ...@@ -216,9 +229,9 @@ contains
type(t_datetime) function t_datetime_assign_string(dt_string) type(t_datetime) function t_datetime_assign_string(dt_string)
character(len=*), intent(in) :: dt_string character(len=*), intent(in) :: dt_string
type(datetime), pointer :: dt_tmp type(datetime), pointer :: dt_tmp
INTEGER :: errno integer :: errno
dt_tmp => newdatetime(dt_string, 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 t_datetime_assign_string%dt = dt_tmp
call deallocatedatetime(dt_tmp) call deallocatedatetime(dt_tmp)
end function t_datetime_assign_string end function t_datetime_assign_string
...@@ -239,10 +252,10 @@ contains ...@@ -239,10 +252,10 @@ contains
type(datetime), pointer :: dt_tmp type(datetime), pointer :: dt_tmp
integer :: errno integer :: errno
dt_tmp => newdatetime(this%dt, errno) dt_tmp => newdatetime(this%dt, errno)
CALL handle_errno(errno, __FILE__, __LINE__) call handle_errno(errno, __FILE__, __LINE__)
CALL datetimetostring(dt_tmp, t_datetime_toString, errno) call datetimetostring(dt_tmp, t_datetime_toString, errno)
CALL handle_errno(errno, __FILE__, __LINE__) call handle_errno(errno, __FILE__, __LINE__)
CALL deallocatedatetime(dt_tmp) call deallocatedatetime(dt_tmp)
end function t_datetime_toString end function t_datetime_toString
! Convert t_datetime object to string. ! Convert t_datetime object to string.
...@@ -254,20 +267,20 @@ contains ...@@ -254,20 +267,20 @@ contains
type(datetime), pointer :: dt_tmp type(datetime), pointer :: dt_tmp
integer :: errno integer :: errno
dt_tmp => newdatetime(this%dt, errno) dt_tmp => newdatetime(this%dt, errno)
CALL handle_errno(errno, __FILE__, __LINE__) call handle_errno(errno, __FILE__, __LINE__)
CALL datetimetoposixstring(dt_tmp, t_datetime_to_posix_string, format_string, errno) call datetimetoposixstring(dt_tmp, t_datetime_to_posix_string, format_string, errno)
CALL handle_errno(errno, __FILE__, __LINE__) call handle_errno(errno, __FILE__, __LINE__)
CALL deallocatedatetime(dt_tmp) call deallocatedatetime(dt_tmp)
end function t_datetime_to_posix_string end function t_datetime_to_posix_string
FUNCTION t_datetime_toJulianDay(this) RESULT(jd) function t_datetime_toJulianDay(this) result(jd)
CLASS(t_datetime), INTENT(in) :: this class(t_datetime), intent(in) :: this
TYPE(t_julianday) :: jd type(t_julianday) :: jd
INTEGER :: errno integer :: errno
CALL getJulianDayFromDatetime(this%dt, jd%jd, errno) call getJulianDayFromDatetime(this%dt, jd%jd, errno)
CALL handle_errno(errno, __FILE__, __LINE__) call handle_errno(errno, __FILE__, __LINE__)
END FUNCTION t_datetime_toJulianDay end function t_datetime_toJulianDay
! Addition of time interval to datetime object. ! Addition of time interval to datetime object.
! !
...@@ -277,11 +290,11 @@ contains ...@@ -277,11 +290,11 @@ contains
class (t_timedelta), intent(in) :: td class (t_timedelta), intent(in) :: td
type(datetime), pointer :: dt_tmp type(datetime), pointer :: dt_tmp
type(timedelta), pointer :: td_tmp type(timedelta), pointer :: td_tmp
INTEGER :: errno integer :: errno
dt_tmp => newDatetime(this%dt, 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) 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_tmp = dt_tmp + td_tmp
dt_td_sum%dt = dt_tmp dt_td_sum%dt = dt_tmp
call deallocateDatetime(dt_tmp) call deallocateDatetime(dt_tmp)
...@@ -296,11 +309,11 @@ contains ...@@ -296,11 +309,11 @@ contains
class (t_timedelta), intent(in) :: td class (t_timedelta), intent(in) :: td
type(datetime), pointer :: dt_tmp type(datetime), pointer :: dt_tmp
type(timedelta), pointer :: td_tmp type(timedelta), pointer :: td_tmp
INTEGER :: errno integer :: errno
dt_tmp => newDatetime(this%dt, 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) td_tmp => newTimedelta(td%td, errno)
CALL handle_errno(errno, __FILE__, __LINE__) call handle_errno(errno, __FILE__, __LINE__)
if (td_tmp%sign == "+") then if (td_tmp%sign == "+") then
td_tmp%sign = "-" td_tmp%sign = "-"
else else
...@@ -359,6 +372,45 @@ contains ...@@ -359,6 +372,45 @@ contains
t_datetime_greater_or_equal = (this%dt >= dt%dt) t_datetime_greater_or_equal = (this%dt >= dt%dt)
end function t_datetime_greater_or_equal 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: ! timedelta section:
! !
...@@ -368,9 +420,9 @@ contains ...@@ -368,9 +420,9 @@ contains
class(t_timedelta), intent(out) :: to class(t_timedelta), intent(out) :: to
class(t_timedelta), intent(in) :: from class(t_timedelta), intent(in) :: from
type(timedelta), pointer :: td_tmp type(timedelta), pointer :: td_tmp
INTEGER :: errno integer :: errno
td_tmp => newTimedelta(from%td, 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 = td_tmp
to%td%sign = td_tmp%sign to%td%sign = td_tmp%sign
call deallocateTimedelta(td_tmp) call deallocateTimedelta(td_tmp)
...@@ -381,10 +433,10 @@ contains ...@@ -381,10 +433,10 @@ contains
type(t_timedelta) function t_timedelta_assign_string(td_string) type(t_timedelta) function t_timedelta_assign_string(td_string)
character(len=*), intent(in) :: td_string character(len=*), intent(in) :: td_string
type(timedelta), pointer :: td_tmp type(timedelta), pointer :: td_tmp
INTEGER :: errno integer :: errno
td_tmp => newtimedelta(td_string, errno) td_tmp => newtimedelta(td_string, errno)
CALL handle_errno(errno, __FILE__, __LINE__) call handle_errno(errno, __FILE__, __LINE__)
IF (.NOT. ASSOCIATED(td_tmp)) RETURN if (.not. associated(td_tmp)) return
t_timedelta_assign_string%td = td_tmp t_timedelta_assign_string%td = td_tmp
t_timedelta_assign_string%td%sign = td_tmp%sign t_timedelta_assign_string%td%sign = td_tmp%sign
call deallocatetimedelta(td_tmp) call deallocatetimedelta(td_tmp)
...@@ -396,11 +448,11 @@ contains ...@@ -396,11 +448,11 @@ contains
integer, intent(in) :: td_ms integer, intent(in) :: td_ms
type(timedelta), pointer :: td_tmp type(timedelta), pointer :: td_tmp
character(len=max_timedelta_str_len) :: td_string character(len=max_timedelta_str_len) :: td_string
INTEGER :: errno integer :: errno
CALL getptstringfromms(INT(td_ms,i8), td_string, errno) call getptstringfromms(int(td_ms,i8), td_string, errno)
CALL handle_errno(errno, __FILE__, __LINE__) call handle_errno(errno, __FILE__, __LINE__)
td_tmp => newtimedelta(td_string, errno) 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 = td_tmp
t_timedelta_assign_ms%td%sign = td_tmp%sign t_timedelta_assign_ms%td%sign = td_tmp%sign
call deallocatetimedelta(td_tmp) call deallocatetimedelta(td_tmp)
...@@ -408,163 +460,163 @@ contains ...@@ -408,163 +460,163 @@ contains
! constructor for integer seconds (integer) ! constructor for integer seconds (integer)
! !
TYPE(t_timedelta) FUNCTION t_timedelta_assign_sec(td_sec) type(t_timedelta) function t_timedelta_assign_sec(td_sec)
INTEGER, INTENT(in) :: td_sec integer, intent(in) :: td_sec
t_timedelta_assign_sec = t_timedelta_assign_ms(td_sec*1000) 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) logical function t_timedelta_equal(this, td)
CLASS (t_timedelta), INTENT(in) :: this class (t_timedelta), intent(in) :: this
CLASS (t_timedelta), INTENT(in) :: td class (t_timedelta), intent(in) :: td
t_timedelta_equal = (this%td == td%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) logical function t_timedelta_not_equal(this, td)
CLASS (t_timedelta), INTENT(in) :: this class (t_timedelta), intent(in) :: this
CLASS (t_timedelta), INTENT(in) :: td class (t_timedelta), intent(in) :: td
t_timedelta_not_equal = (this%td /= td%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) logical function t_timedelta_less_than(this, td)
CLASS (t_timedelta), INTENT(in) :: this class (t_timedelta), intent(in) :: this
CLASS (t_timedelta), INTENT(in) :: td class (t_timedelta), intent(in) :: td
t_timedelta_less_than = (this%td < td%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) logical function t_timedelta_greater_than(this, td)
CLASS (t_timedelta), INTENT(in) :: this class (t_timedelta), intent(in) :: this
CLASS (t_timedelta), INTENT(in) :: td class (t_timedelta), intent(in) :: td
t_timedelta_greater_than = (this%td > td%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) logical function t_timedelta_less_than_or_equal(this, td)
CLASS (t_timedelta), INTENT(in) :: this class (t_timedelta), intent(in) :: this
CLASS (t_timedelta), INTENT(in) :: td class (t_timedelta), intent(in) :: td
t_timedelta_less_than_or_equal = (this%td <= td%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) logical function t_timedelta_greater_than_or_equal(this, td)
CLASS (t_timedelta), INTENT(in) :: this class (t_timedelta), intent(in) :: this
CLASS (t_timedelta), INTENT(in) :: td class (t_timedelta), intent(in) :: td
t_timedelta_greater_than_or_equal = (this%td >= td%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) function t_timedelta_scalar_multiply_long (this, lambda) result(scaled_td)
TYPE(t_timedelta), TARGET :: scaled_td type(t_timedelta), target :: scaled_td
INTEGER(c_int64_t), INTENT(in) :: lambda integer(c_int64_t), intent(in) :: lambda
CLASS(t_timedelta), TARGET, INTENT(in) :: this class(t_timedelta), target, intent(in) :: this
TYPE(timedelta), POINTER :: td_tmp, td_tmp2 type(timedelta), pointer :: td_tmp, td_tmp2
INTEGER :: errno integer :: errno
td_tmp => newtimedelta(this%td, errno) td_tmp => newtimedelta(this%td, errno)
CALL handle_errno(errno, __FILE__, __LINE__) call handle_errno(errno, __FILE__, __LINE__)
td_tmp2 = td_tmp * lambda td_tmp2 = td_tmp * lambda
IF (ASSOCIATED(td_tmp2)) THEN if (associated(td_tmp2)) then
CALL handle_errno(general_arithmetic_error, __FILE__, __LINE__) call handle_errno(general_arithmetic_error, __FILE__, __LINE__)
RETURN return
END IF end if
scaled_td%td = td_tmp2 scaled_td%td = td_tmp2
scaled_td%td%sign = td_tmp2%sign scaled_td%td%sign = td_tmp2%sign
IF (ASSOCIATED(td_tmp)) CALL deallocatetimedelta(td_tmp) if (associated(td_tmp)) call deallocatetimedelta(td_tmp)
IF (ASSOCIATED(td_tmp2)) CALL deallocatetimedelta(td_tmp2) if (associated(td_tmp2)) call deallocatetimedelta(td_tmp2)
END FUNCTION t_timedelta_scalar_multiply_long end function t_timedelta_scalar_multiply_long
FUNCTION t_timedelta_scalar_multiply_inv_long(lambda, this) RESULT(scaled_td) function t_timedelta_scalar_multiply_inv_long(lambda, this) result(scaled_td)
TYPE(t_timedelta), TARGET :: scaled_td type(t_timedelta), target :: scaled_td
INTEGER(c_int64_t), INTENT(in) :: lambda integer(c_int64_t), intent(in) :: lambda
CLASS(t_timedelta), TARGET, INTENT(in) :: this class(t_timedelta), target, intent(in) :: this
TYPE(timedelta), POINTER :: td_tmp, td_tmp2 type(timedelta), pointer :: td_tmp, td_tmp2
INTEGER :: errno integer :: errno
td_tmp => newtimedelta(this%td, errno) td_tmp => newtimedelta(this%td, errno)
CALL handle_errno(errno, __FILE__, __LINE__) call handle_errno(errno, __FILE__, __LINE__)
td_tmp2 = td_tmp * lambda td_tmp2 = td_tmp * lambda
IF (ASSOCIATED(td_tmp2)) THEN if (associated(td_tmp2)) then
CALL handle_errno(general_arithmetic_error, __FILE__, __LINE__) call handle_errno(general_arithmetic_error, __FILE__, __LINE__)
RETURN return
END IF end if
scaled_td%td = td_tmp2 scaled_td%td = td_tmp2
scaled_td%td%sign = td_tmp2%sign scaled_td%td%sign = td_tmp2%sign
IF (ASSOCIATED(td_tmp)) CALL deallocatetimedelta(td_tmp) if (associated(td_tmp)) call deallocatetimedelta(td_tmp)
IF (ASSOCIATED(td_tmp2)) CALL deallocatetimedelta(td_tmp2) if (associated(td_tmp2)) call deallocatetimedelta(td_tmp2)
END FUNCTION t_timedelta_scalar_multiply_inv_long end function t_timedelta_scalar_multiply_inv_long
FUNCTION t_timedelta_scalar_multiply_int (this, lambda) RESULT(scaled_td) function t_timedelta_scalar_multiply_int (this, lambda) result(scaled_td)
TYPE(t_timedelta), TARGET :: scaled_td type(t_timedelta), target :: scaled_td
INTEGER(c_int32_t), INTENT(in) :: lambda integer(c_int32_t), intent(in) :: lambda
CLASS(t_timedelta), TARGET, INTENT(in) :: this class(t_timedelta), target, intent(in) :: this
TYPE(timedelta), POINTER :: td_tmp, td_tmp2 type(timedelta), pointer :: td_tmp, td_tmp2
INTEGER :: errno integer :: errno
td_tmp => newtimedelta(this%td, errno) td_tmp => newtimedelta(this%td, errno)
CALL handle_errno(errno, __FILE__, __LINE__) call handle_errno(errno, __FILE__, __LINE__)
td_tmp2 = td_tmp * lambda td_tmp2 = td_tmp * lambda
IF (ASSOCIATED(td_tmp2)) THEN if (associated(td_tmp2)) then
CALL handle_errno(general_arithmetic_error, __FILE__, __LINE__) call handle_errno(general_arithmetic_error, __FILE__, __LINE__)
RETURN return
END IF end if
scaled_td%td = td_tmp2 scaled_td%td = td_tmp2
scaled_td%td%sign = td_tmp2%sign scaled_td%td%sign = td_tmp2%sign
IF (ASSOCIATED(td_tmp)) CALL deallocatetimedelta(td_tmp) if (associated(td_tmp)) call deallocatetimedelta(td_tmp)
IF (ASSOCIATED(td_tmp2)) CALL deallocatetimedelta(td_tmp2) if (associated(td_tmp2)) call deallocatetimedelta(td_tmp2)
END FUNCTION t_timedelta_scalar_multiply_int end function t_timedelta_scalar_multiply_int
FUNCTION t_timedelta_scalar_multiply_inv_int(lambda, this) RESULT(scaled_td) function t_timedelta_scalar_multiply_inv_int(lambda, this) result(scaled_td)
TYPE(t_timedelta), TARGET :: scaled_td type(t_timedelta), target :: scaled_td
INTEGER(c_int32_t), INTENT(in) :: lambda integer(c_int32_t), intent(in) :: lambda
CLASS(t_timedelta), TARGET, INTENT(in) :: this class(t_timedelta), target, intent(in) :: this
TYPE(timedelta), POINTER :: td_tmp, td_tmp2 type(timedelta), pointer :: td_tmp, td_tmp2
INTEGER :: errno integer :: errno
td_tmp => newtimedelta(this%td, errno) td_tmp => newtimedelta(this%td, errno)
CALL handle_errno(errno, __FILE__, __LINE__) call handle_errno(errno, __FILE__, __LINE__)
td_tmp2 = td_tmp * lambda td_tmp2 = td_tmp * lambda
IF (ASSOCIATED(td_tmp2)) THEN if (associated(td_tmp2)) then
CALL handle_errno(general_arithmetic_error, __FILE__, __LINE__) call handle_errno(general_arithmetic_error, __FILE__, __LINE__)
RETURN return
END IF end if
scaled_td%td = td_tmp2 scaled_td%td = td_tmp2
scaled_td%td%sign = td_tmp2%sign scaled_td%td%sign = td_tmp2%sign
IF (ASSOCIATED(td_tmp)) CALL deallocatetimedelta(td_tmp) if (associated(td_tmp)) call deallocatetimedelta(td_tmp)
IF (ASSOCIATED(td_tmp2)) CALL deallocatetimedelta(td_tmp2) if (associated(td_tmp2)) call deallocatetimedelta(td_tmp2)
END FUNCTION t_timedelta_scalar_multiply_inv_int end function t_timedelta_scalar_multiply_inv_int
FUNCTION t_timedelta_scalar_multiply_real (this, lambda) RESULT(scaled_td) function t_timedelta_scalar_multiply_real (this, lambda) result(scaled_td)
TYPE(t_timedelta), TARGET :: scaled_td type(t_timedelta), target :: scaled_td
REAL(c_double), INTENT(in) :: lambda real(c_double), intent(in) :: lambda
CLASS(t_timedelta), TARGET, INTENT(in) :: this class(t_timedelta), target, intent(in) :: this
TYPE(timedelta), POINTER :: td_tmp, td_tmp2 type(timedelta), pointer :: td_tmp, td_tmp2
INTEGER :: errno integer :: errno
td_tmp => newtimedelta(this%td, errno) td_tmp => newtimedelta(this%td, errno)
CALL handle_errno(errno, __FILE__, __LINE__) call handle_errno(errno, __FILE__, __LINE__)
td_tmp2 = td_tmp * lambda td_tmp2 = td_tmp * lambda
IF (ASSOCIATED(td_tmp2)) THEN if (associated(td_tmp2)) then
CALL handle_errno(general_arithmetic_error, __FILE__, __LINE__) call handle_errno(general_arithmetic_error, __FILE__, __LINE__)
RETURN return
END IF end if
scaled_td%td = td_tmp2 scaled_td%td = td_tmp2
scaled_td%td%sign = td_tmp2%sign scaled_td%td%sign = td_tmp2%sign
IF (ASSOCIATED(td_tmp)) CALL deallocatetimedelta(td_tmp) if (associated(td_tmp)) call deallocatetimedelta(td_tmp)
IF (ASSOCIATED(td_tmp2)) CALL deallocatetimedelta(td_tmp2) if (associated(td_tmp2)) call deallocatetimedelta(td_tmp2)
END FUNCTION t_timedelta_scalar_multiply_real end function t_timedelta_scalar_multiply_real
FUNCTION t_timedelta_scalar_multiply_inv_real(lambda, this) RESULT(scaled_td) function t_timedelta_scalar_multiply_inv_real(lambda, this) result(scaled_td)
TYPE(t_timedelta), TARGET :: scaled_td type(t_timedelta), target :: scaled_td
REAL(c_double), INTENT(in) :: lambda real(c_double), intent(in) :: lambda
CLASS(t_timedelta), TARGET, INTENT(in) :: this class(t_timedelta), target, intent(in) :: this
TYPE(timedelta), POINTER :: td_tmp, td_tmp2 type(timedelta), pointer :: td_tmp, td_tmp2
INTEGER :: errno integer :: errno
td_tmp => newtimedelta(this%td, errno) td_tmp => newtimedelta(this%td, errno)
CALL handle_errno(errno, __FILE__, __LINE__) call handle_errno(errno, __FILE__, __LINE__)
td_tmp2 = td_tmp * lambda td_tmp2 = td_tmp * lambda
IF (ASSOCIATED(td_tmp2)) THEN if (associated(td_tmp2)) then
CALL handle_errno(general_arithmetic_error, __FILE__, __LINE__) call handle_errno(general_arithmetic_error, __FILE__, __LINE__)
RETURN return
END IF end if
scaled_td%td = td_tmp2 scaled_td%td = td_tmp2
scaled_td%td%sign = td_tmp2%sign scaled_td%td%sign = td_tmp2%sign
IF (ASSOCIATED(td_tmp)) CALL deallocatetimedelta(td_tmp) if (associated(td_tmp)) call deallocatetimedelta(td_tmp)
IF (ASSOCIATED(td_tmp2)) CALL deallocatetimedelta(td_tmp2) if (associated(td_tmp2)) call deallocatetimedelta(td_tmp2)
END FUNCTION t_timedelta_scalar_multiply_inv_real end function t_timedelta_scalar_multiply_inv_real
...@@ -574,49 +626,49 @@ contains ...@@ -574,49 +626,49 @@ contains
character(len=max_timedelta_str_len) :: t_timedelta_toString character(len=max_timedelta_str_len) :: t_timedelta_toString
class (t_timedelta) :: this class (t_timedelta) :: this
type(timedelta), pointer :: td_tmp type(timedelta), pointer :: td_tmp
INTEGER :: errno integer :: errno
td_tmp => newtimedelta(this%td, errno) td_tmp => newtimedelta(this%td, errno)
CALL handle_errno(errno, __FILE__, __LINE__) call handle_errno(errno, __FILE__, __LINE__)
CALL timedeltatostring(td_tmp, t_timedelta_toString, errno) call timedeltatostring(td_tmp, t_timedelta_toString, errno)
CALL handle_errno(errno, __FILE__, __LINE__) call handle_errno(errno, __FILE__, __LINE__)
call deallocatetimedelta(td_tmp) call deallocatetimedelta(td_tmp)
end function t_timedelta_toString end function t_timedelta_toString
function t_timedelta_divideInSecondsBy (this, divisor) result(quotient) function t_timedelta_divideInSecondsBy (this, divisor) result(quotient)
CLASS(t_timedelta), INTENT(in) :: this class(t_timedelta), intent(in) :: this
TYPE(t_timedelta), INTENT(in) :: divisor type(t_timedelta), intent(in) :: divisor
TYPE(divisionquotienttimespan) :: quotient type(divisionquotienttimespan) :: quotient
CALL divideTimeDeltaInSeconds(this%td, divisor%td, quotient) call divideTimeDeltaInSeconds(this%td, divisor%td, quotient)
end function t_timedelta_divideInSecondsBy end function t_timedelta_divideInSecondsBy
function t_timedelta_toSeconds (this, td) result(seconds) function t_timedelta_toSeconds (this, td) result(seconds)
CLASS(t_timedelta), INTENT(in) :: this class(t_timedelta), intent(in) :: this
TYPE(t_datetime), INTENT(in) :: td type(t_datetime), intent(in) :: td
INTEGER(c_int64_t) :: seconds integer(c_int64_t) :: seconds
seconds = getTotalSecondsTimeDelta(this%td, td%dt) seconds = getTotalSecondsTimeDelta(this%td, td%dt)
end function t_timedelta_toSeconds end function t_timedelta_toSeconds
function t_timedelta_toMilliSeconds (this, td) result(ms) function t_timedelta_toMilliSeconds (this, td) result(ms)
CLASS(t_timedelta), INTENT(in) :: this class(t_timedelta), intent(in) :: this
TYPE(t_datetime), INTENT(in) :: td type(t_datetime), intent(in) :: td
INTEGER(c_int64_t) :: ms integer(c_int64_t) :: ms
ms = getTotalMilliSecondsTimeDelta(this%td, td%dt) ms = getTotalMilliSecondsTimeDelta(this%td, td%dt)
end function t_timedelta_toMilliSeconds end function t_timedelta_toMilliSeconds
FUNCTION t_julianDay_getDay (this) result(d) function t_julianDay_getDay (this) result(d)
CLASS(t_julianday), INTENT(in) :: this class(t_julianday), intent(in) :: this
INTEGER(c_int64_t) :: d integer(c_int64_t) :: d
d = this%jd%day d = this%jd%day
END FUNCTION t_julianDay_getDay end function t_julianDay_getDay
FUNCTION t_julianday_getFractionOfDayInMS (this) result(ms) function t_julianday_getFractionOfDayInMS (this) result(ms)
CLASS(t_julianday), INTENT(in) :: this class(t_julianday), intent(in) :: this
INTEGER(c_int64_t) :: ms integer(c_int64_t) :: ms
ms = this%jd%ms ms = this%jd%ms
END FUNCTION t_julianday_getFractionOfDayInMS end function t_julianday_getFractionOfDayInMS
function t_datetime_min(a,b) result(res) function t_datetime_min(a,b) result(res)
type(t_datetime) :: a,b type(t_datetime) :: a,b
...@@ -641,19 +693,19 @@ contains ...@@ -641,19 +693,19 @@ contains
end function t_datetime_max end function t_datetime_max
FUNCTION t_juliandelta_assign_raw(sign,day, ms) function t_juliandelta_assign_raw(sign,day, ms)
TYPE(t_juliandelta) :: t_juliandelta_assign_raw type(t_juliandelta) :: t_juliandelta_assign_raw
CHARACTER(c_char), INTENT(in) :: sign character(c_char), intent(in) :: sign
INTEGER(c_int64_t), INTENT(in) :: day integer(c_int64_t), intent(in) :: day
INTEGER(c_int64_t), INTENT(in) :: ms integer(c_int64_t), intent(in) :: ms
TYPE(juliandelta), POINTER :: jd_tmp type(juliandelta), pointer :: jd_tmp
INTEGER :: errno integer :: errno
jd_tmp => newJuliandelta(sign,day,ms, 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 = jd_tmp
t_juliandelta_assign_raw%jd%sign = jd_tmp%sign t_juliandelta_assign_raw%jd%sign = jd_tmp%sign
IF (ASSOCIATED(jd_tmp)) CALL deallocateJuliandelta(jd_tmp) if (associated(jd_tmp)) call deallocateJuliandelta(jd_tmp)
END FUNCTION t_juliandelta_assign_raw end function t_juliandelta_assign_raw
end module mtime_hl end module mtime_hl
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment

Imprint | Privacy Policy