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 tags 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 @@
!!
!! @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
......
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