From 45532c4c42281125420cfe83409f20b17a7825a1 Mon Sep 17 00:00:00 2001
From: Sergey Kosukhin <sergey.kosukhin@mpimet.mpg.de>
Date: Thu, 16 Jan 2025 10:20:39 +0100
Subject: [PATCH] Remove the Fortran high-level interface source files
---
src/libmtime_hl.f90 | 408 -----------------------------------
src/mtime_t_datetime.inc | 292 -------------------------
src/mtime_t_event.inc | 156 --------------
src/mtime_t_juliandelta.inc | 30 ---
src/mtime_t_timedelta.inc | 417 ------------------------------------
5 files changed, 1303 deletions(-)
delete mode 100644 src/libmtime_hl.f90
delete mode 100644 src/mtime_t_datetime.inc
delete mode 100644 src/mtime_t_event.inc
delete mode 100644 src/mtime_t_juliandelta.inc
delete mode 100644 src/mtime_t_timedelta.inc
diff --git a/src/libmtime_hl.f90 b/src/libmtime_hl.f90
deleted file mode 100644
index 2dbb78de..00000000
--- a/src/libmtime_hl.f90
+++ /dev/null
@@ -1,408 +0,0 @@
-!! Copyright (c) 2013-2024 MPI-M, Luis Kornblueh, Rahul Sinha and DWD, Florian Prill. All rights reserved.
-!!
-!! SPDX-License-Identifier: BSD-3-Clause
-!!
-!TODO: extract internal c binding routines (my_...) from libmtime.f90 into extra module
-! and derive old and new interface out of this
-
-!> @file libmtime_hl.f90
-!!
-!! @brief Providing a high level interface for the Fortran language bindings of libmtime.
-!!
-!! The mtime library - at least in its first release - heavily uses
-!! pointers for passing arguments to functions. This design causes
-!! several inconveniences on the application side, e.g. the need for
-!! explicit deallocation. Besides, the standard interface of the mtime
-!! library provides numerous functions which are well suited for an
-!! object-oriented implementation.
-!!
-!! This wrapper module attempts to provide the mtime functionality
-!! with stack-based data structures. It does not refactor the libmtime
-!! library itself but hides its allocate-deallocate code within
-!! type-bound procedures.
-!!
-!! @author Luis Kornblueh, Max Planck Institute for Meteorology
-!! @author Florian Prill, DWD
-!! @author J.F. Engels, DKRZ
-!!
-!! TODOs:
-!! - Event: Wrappers for event functionality; direct use of c-bindings
-!! - Get rid of use of old mtime library
-!! - Expand examples_hl by event wrapper calls
-!! - Make December'18 branch compile, link and run basic test
-!! - Merge recent changes in ICON into our December'18 branch
-!! - Remove old mtime Fortran library
-!! - Change mtime C source, use stack variables
-!!
-!! @defgroup FortranHLBindings libmtime high-level Fortran language bindings
-!! @{
-!!
-MODULE mtime_hl
-
- USE, INTRINSIC :: ISO_C_BINDING, ONLY: &
- & c_associated, c_char, c_double, c_f_pointer, c_int, c_int32_t, &
- & c_int64_t, c_loc, c_null_char, c_ptr
- USE mtime_constants, ONLY: &
- & max_datetime_str_len, max_event_str_len, max_eventname_str_len, &
- & max_groupname_str_len, max_timedelta_str_len
- USE mtime_error_handling
- USE mtime_c_bindings, ONLY: &
- & date, datetime, divisionquotienttimespan, handle_errno, julianday, &
- & juliandelta, time, timedelta
- USE mtime_c_bindings, ONLY: &
- & my_addtimedeltatodatetime, my_comparedatetime, my_datetimetostring, &
- & my_datetoposixstring, my_deallocatedatetime, my_deallocatejuliandelta, &
- & my_deallocatetimedelta, my_elementwisescalarmultiplytimedelta, &
- & my_elementwisescalarmultiplytimedeltadp, my_getdayofyearfromdatetime, &
- & my_getjuliandayfromdatetime, my_getnoofdaysinmonthdatetime, &
- & my_getnoofdaysinyeardatetime, my_getnoofsecondselapsedindaydatetime, &
- & my_getnoofsecondselapsedinmonthdatetime, my_gettimedeltafromdate, &
- & my_newdatetime, my_newjuliandelta, my_newrawdatetime, &
- & my_newrawtimedelta, my_newtimedeltafromstring, my_timedeltatostring
- USE mtime, ONLY: &
- & OPERATOR(*), OPERATOR(/=), OPERATOR(<), OPERATOR(<=), OPERATOR(==), &
- & OPERATOR(>), OPERATOR(>=), deallocateDatetime, deallocateJulianDay, &
- & deallocateJulianDelta, deallocateTimedelta, &
- & divideDatetimeDifferenceInSeconds, divideTimeDeltaInSeconds, &
- & getDatetimeFromJulianDay, getPTStringFromMS, &
- & getTotalMilliSecondsTimeDelta, getTotalSecondsTimeDelta, newDatetime, &
- & newJulianDay, newJuliandelta, newTimedelta, timeDeltaToJulianDelta
-
- IMPLICIT NONE
-
-#ifndef __NVCOMPILER
-
- PUBLIC :: t_datetime, t_timedelta, t_juliandelta, t_julianday, t_event, t_eventGroup
- PUBLIC :: t_timedeltaFromMilliseconds
- PUBLIC :: t_timedeltaFromSeconds
- PUBLIC :: min, max
- PUBLIC :: OPERATOR(*)
-
- !
- ! TODO: simply repeat the implementation of "divisionquotienttimespan" in
- ! order to disentangle the mtime_hl and the mtime Fortran modules.
- !
- !PUBLIC :: divisionquotienttimespan
-
- !> NOTE / TODO:
- !
- ! Why does this wrapper module *not* implement the assignment
- ! operator? - Lenghty answer:
- !
- ! The fundamental question is: Why do our "t_datetime",
- ! "t_timedelta", "t_xxx" types need assignment operators which
- ! apply "pointer magic"? Couldn't we simply copy the stack
- ! variables?
- !
- ! Here's why this is important: Since we are dealing with stack
- ! variables, these might be implicitly initialized with default
- ! values, causing problems with our "pointer magic". Imagine that
- ! in our application code we have a derived type as follows:
- !
- ! TYPE(mytype)
- ! [...]
- ! TYPE(t_datetime) :: mtime_date
- ! END TYPE
- !
- ! where "mtime_date" is an mtime datetime variable which is
- ! usually not used and therefore not explicitly initialized by
- ! the user. Now, when we have this operation:
- !
- ! TYPE(mytype) :: tmp_a, tmp_b
- ! tmp_a = tmp_b
- !
- ! then the application code crashes, because the assign operator
- ! of "t_datetime" attempts to create an mtime "datetime" pointer
- ! based on the uninitializd "tmp_b%dt".
- !
-
- !> Wrapper class for "mtime" data type "datetime".
- !
- TYPE t_datetime
-
- !private
-
- !> wrapped datatype of the standard mtime interface
- TYPE(datetime) :: dt = datetime(date(year=0_c_int64_t, month=0_c_int, day=0_c_int),&
- & time(hour=0_c_int, minute=0_c_int, second=0_c_int, ms=0_c_int))
-
- CONTAINS
-
- ! --- conversions
-
- PROCEDURE :: t_datetime_toString
- PROCEDURE :: t_datetime_to_posix_string
- GENERIC :: toString => t_datetime_toString, t_datetime_to_posix_string
-
- PROCEDURE :: toJulianDay => t_datetime_toJulianDay
-
- ! --- inquire components
-
- PROCEDURE :: getDay => t_datetime_getDay
-
- ! --- derived quantities
-
- PROCEDURE :: daysInEntireMonth => t_datetime_daysInEntireMonth
- PROCEDURE :: daysInEntireYear => t_datetime_daysInEntireYear
- PROCEDURE :: elapsedDaysInYear => t_datetime_elapsedDaysInYear
- PROCEDURE :: elapsedSecondsInMonth => t_datetime_elapsedSecondsInMonth
- PROCEDURE :: elapsedSecondsInDay => t_datetime_elapsedSecondsInDay
-
- ! --- overloaded operators
-
- 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 :: get_c_pointer => t_datetime_get_c_pointer
-
- 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
-
- INTERFACE t_datetime
- MODULE PROCEDURE t_datetime_assign_string
- MODULE PROCEDURE t_datetime_assign_raw
- END INTERFACE t_datetime
-
- !> Wrapper class for "mtime" data type "timedelta".
- !
- TYPE t_timedelta
-
- !private
-
- !> wrapped datatype of the standard mtime interface
- TYPE(timedelta) :: td = timedelta(flag_std_form=0_c_int, sign='+', year=0_c_int64_t, &
- & month=0_c_int, day=0_c_int, hour=0_c_int, &
- & minute=0_c_int, second=0_c_int, ms=0_c_int)
-
- CONTAINS
-
- ! --- conversions
-
- PROCEDURE :: toString => t_timedelta_toString
- PROCEDURE :: toJulianDelta => t_timedelta_toJulianDelta
-
- ! --- inquire components
-
- ! todo: [...]
-
- ! --- derived quantities
-
- PROCEDURE :: toSeconds => t_timedelta_toSeconds
-
- ! t_timedelta_toMilliSeconds: todo: It would be convenient to have
- ! the reference date for this function as an optional argument;
- ! only in case of "non-well-definedness" an error should be
- ! thrown.
- PROCEDURE :: toMilliSeconds => t_timedelta_toMilliSeconds
-
- PROCEDURE :: divideInSecondsBy => t_timedelta_divideInSecondsBy
-
- ! --- overloaded operators
-
- ! note: the "+", "-" operators are not well-defined for timedelta
- ! objects!
-
- 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 :: get_c_pointer => t_timedelta_get_c_pointer
-
- 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
- MODULE PROCEDURE t_timedelta_assign_string
- END INTERFACE t_timedelta
-
- INTERFACE t_timedeltaFromMilliseconds
- MODULE PROCEDURE t_timedelta_assign_ms
- MODULE PROCEDURE t_timedelta_assign_ms_i8
- END INTERFACE t_timedeltaFromMilliseconds
-
- INTERFACE t_timedeltaFromSeconds
- MODULE PROCEDURE t_timedelta_assign_sec
- MODULE PROCEDURE t_timedelta_assign_sec_i8
- 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 min
- MODULE PROCEDURE t_datetime_min
- END INTERFACE min
-
- INTERFACE max
- MODULE PROCEDURE t_datetime_max
- END INTERFACE max
-
- TYPE t_julianday
-
- !private
-
- !> wrapped datatype of the standard mtime interface
- TYPE(julianday) :: jd
-
- CONTAINS
-
- ! --- conversions
-
- PROCEDURE :: toDateTime => t_julianday_toDateTime
-
- ! --- inquire components
-
- PROCEDURE :: getDay => t_julianDay_getDay
- PROCEDURE :: getFractionOfDayInMS => t_julianday_getFractionOfDayInMS
-
- END TYPE t_julianday
-
- !> Wrapper class for "mtime" data type "juliandelta".
- !
- TYPE t_juliandelta
-
- !private
-
- !> wrapped datatype of the standard mtime interface
- TYPE(juliandelta) :: jd
-
- END TYPE t_juliandelta
-
- INTERFACE t_juliandelta
- MODULE PROCEDURE t_juliandelta_assign_raw
- END INTERFACE t_juliandelta
-
- TYPE t_event
-
- !private
- ! FIXME (some day in the future): This derived type should not specify both -
- ! the linked list element and the element itself.
- TYPE(t_event), POINTER :: nextEventInGroup
-
- INTEGER(c_int64_t) :: eventId
- CHARACTER(len=max_eventname_str_len) :: eventName
-
- TYPE(t_datetime) :: eventsLastEvaluationDateTime
- TYPE(t_datetime) :: eventReferenceDateTime
-
- TYPE(t_datetime) :: eventFirstDateTime
- TYPE(t_datetime) :: eventLastDateTime
-
- TYPE(t_timedelta) :: eventInterval
- TYPE(t_timedelta) :: eventOffset
-
- LOGICAL :: neverTriggerEvent
-
- LOGICAL :: triggerCurrentEvent
-
- LOGICAL :: nextEventIsFirst
- LOGICAL :: lastEventWasFinal
-
- LOGICAL :: eventisFirstInDay
- LOGICAL :: eventisFirstInMonth
- LOGICAL :: eventisFirstInYear
- LOGICAL :: eventisLastInDay
- LOGICAL :: eventisLastInMonth
- LOGICAL :: eventisLastInYear
-
- TYPE(t_datetime) :: triggerNextEventDateTime
- TYPE(t_datetime) :: triggeredPreviousEventDateTime
-
- CONTAINS
-
- !> TODO: implement isAvtive ....
- ! PROCEDURE :: trigger => t_event_trigger
- PROCEDURE :: getFirstDatetime => t_event_getFirstDatetime
- PROCEDURE :: getInterval => t_event_getInterval
- PROCEDURE :: getLastDatetime => t_event_getLastDatetime
- PROCEDURE :: getNextOccurrenceDatetime => t_event_getNextOccurrenceDatetime
- PROCEDURE :: getPrevOccurrenceDatetime => t_event_getPrevOccurrenceDatetime
-
- PROCEDURE :: getName => t_event_getName
- PROCEDURE :: nextEvent => t_event_next_event
-
- END TYPE t_event
-
- INTERFACE t_event
- MODULE PROCEDURE t_event_assign_raw
- MODULE PROCEDURE t_event_assign_types
- END INTERFACE t_event
-
- TYPE t_eventGroup
-
- !private
-
- INTEGER(c_int64_t) :: event_group_id
- CHARACTER(len=max_groupname_str_len) :: event_group_name
- TYPE(t_event), POINTER :: first_event_in_group
- TYPE(t_event), POINTER :: last_event_in_group
-
- CONTAINS
-
- PROCEDURE :: append => t_eventGroup_addToGroup
-
- !> TODO: implement the removal of a event in a list
- !PROCEDURE :: remove => t_eventGroup_removeFromGroup
-
- ! --- inquire components
-
- PROCEDURE :: getID => t_eventGroup_getGroupId
- PROCEDURE :: getName => t_eventGroup_getGroupName
-
- ! --- derived quantities
-
- PROCEDURE :: getFirstEvent => t_eventGroup_getFirstEvent
-
- END TYPE t_eventGroup
-
- INTERFACE t_eventGroup
- MODULE PROCEDURE t_eventGroup_constructor
- END INTERFACE t_eventGroup
-
- INTEGER :: event_group_id = 0
- INTEGER :: event_id = 0
-
-CONTAINS
-
-#include "mtime_t_datetime.inc"
-#include "mtime_t_timedelta.inc"
-#include "mtime_t_juliandelta.inc"
-#include "mtime_t_event.inc"
-
-#endif
-
-END MODULE mtime_hl
-!>
-!! @}
diff --git a/src/mtime_t_datetime.inc b/src/mtime_t_datetime.inc
deleted file mode 100644
index 58ca33b8..00000000
--- a/src/mtime_t_datetime.inc
+++ /dev/null
@@ -1,292 +0,0 @@
-!! Copyright (c) 2013-2024 MPI-M, Luis Kornblueh, Rahul Sinha and DWD, Florian Prill. All rights reserved.
-!!
-!! SPDX-License-Identifier: BSD-3-Clause
-!!
- ! ================================================================================
- ! datetime section:
- ! ================================================================================
-
- ! constructor for a datetime string
- !
- TYPE(t_datetime) FUNCTION t_datetime_assign_string(dt_string)
- CHARACTER(len=*), INTENT(in) :: dt_string
- TYPE(c_ptr) :: c_pointer
- TYPE(datetime), POINTER :: dt_tmp
- c_pointer = my_newdatetime(TRIM(ADJUSTL(dt_string))//c_null_char)
- CALL handle_errno(.NOT. C_ASSOCIATED(c_pointer), 4*100 + 1, &
- & __FILE__, &
- & __LINE__)
- CALL C_F_POINTER(c_pointer, dt_tmp)
- t_datetime_assign_string%dt = dt_tmp
- CALL my_deallocatedatetime(c_pointer)
- END FUNCTION t_datetime_assign_string
-
- ! constructor for a datetime
- !
- FUNCTION t_datetime_assign_raw(year, month, day, hour, minute, second, ms) RESULT(res)
- TYPE(t_datetime) :: res
-
- INTEGER(c_int64_t), INTENT(in) :: year
- INTEGER(c_int), INTENT(in) :: month, day, hour, minute, second, ms
-
- TYPE(datetime), POINTER :: dt_tmp
- TYPE(c_ptr) :: c_pointer
-
- c_pointer = my_newrawdatetime(year, month, day, hour, minute, second, ms)
- CALL handle_errno(.NOT. C_ASSOCIATED(c_pointer), 4*100 + 2, &
- & __FILE__, &
- & __LINE__)
- CALL C_F_POINTER(c_pointer, dt_tmp)
- res%dt = dt_tmp
- CALL my_deallocatedatetime(c_pointer)
- END FUNCTION t_datetime_assign_raw
-
- ! Returns t_datetime objects day
- !
- FUNCTION t_datetime_getDay(this)
- INTEGER :: t_datetime_getDay
- CLASS(t_datetime) :: this
- t_datetime_getDay = this%dt%date%day
- END FUNCTION t_datetime_getDay
-
- ! Convert t_datetime object to string.
- !
- FUNCTION t_datetime_toString(this) RESULT(string)
- CHARACTER(len=max_datetime_str_len) :: string
- CLASS(t_datetime) :: this
- TYPE(c_ptr) :: c_pointer, dummy_ptr
- INTEGER :: i
-
- string = ""
-
- c_pointer = this%get_c_pointer()
- CALL handle_errno(.NOT. C_ASSOCIATED(c_pointer), 0*100 + 2, &
- & __FILE__, &
- & __LINE__)
- dummy_ptr = my_datetimetostring(c_pointer, string)
- CALL handle_errno(.NOT. C_ASSOCIATED(dummy_ptr), 4*100 + 6, &
- & __FILE__, &
- & __LINE__)
-
- char_loop: DO i = 1, LEN(string)
- IF (string(i:i) == c_null_char) EXIT char_loop
- END DO char_loop
- string(i:LEN(string)) = ' '
-
- CALL my_deallocatedatetime(c_pointer)
- END FUNCTION t_datetime_toString
-
- ! Convert t_datetime object to string.
- !
- FUNCTION t_datetime_to_posix_string(this, format_string) RESULT(string)
- CHARACTER(len=max_datetime_str_len) :: string
- CHARACTER(len=*), INTENT(in) :: format_string
- CLASS(t_datetime) :: this
- INTEGER :: i
- TYPE(c_ptr) :: c_pointer, dummy_ptr
-
- string = ""
- c_pointer = this%get_c_pointer()
- dummy_ptr = my_datetoposixstring(c_pointer, string, format_string)
- CALL handle_errno(.NOT. C_ASSOCIATED(dummy_ptr), 2*100 + 8, &
- & __FILE__, &
- & __LINE__)
- char_loop: DO i = 1, LEN(string)
- IF (string(i:i) == c_null_char) EXIT char_loop
- END DO char_loop
- string(i:LEN(string)) = ' '
-
- CALL my_deallocatedatetime(c_pointer)
- END FUNCTION t_datetime_to_posix_string
-
- FUNCTION t_datetime_toJulianDay(this) RESULT(jd)
- CLASS(t_datetime), INTENT(in) :: this
- TYPE(t_julianday), TARGET :: jd
- TYPE(c_ptr) :: c_pointer, dummy_ptr
- c_pointer = this%get_c_pointer()
- jd = t_julianday(julianday(0, 0))
- dummy_ptr = my_getjuliandayfromdatetime(c_pointer, C_LOC(jd%jd))
- CALL handle_errno(.NOT. C_ASSOCIATED(dummy_ptr), 0*100 + 2, &
- & __FILE__, &
- & __LINE__)
- CALL my_deallocatedatetime(c_pointer)
- END FUNCTION t_datetime_toJulianDay
-
- ! Addition of time interval to datetime object.
- !
- FUNCTION t_datetime_add_timedelta(this, td) RESULT(dt_td_sum)
- TYPE(t_datetime) :: dt_td_sum
- CLASS(t_datetime), INTENT(in) :: this
- CLASS(t_timedelta), INTENT(in) :: td
- TYPE(datetime), POINTER :: dt_tmp
-
- TYPE(c_ptr) :: c_pointer1, c_pointer2, dummy_ptr
- c_pointer1 = this%get_c_pointer()
- c_pointer2 = td%get_c_pointer()
-
- dummy_ptr = my_addtimedeltatodatetime(c_pointer1, c_pointer2, c_pointer1)
- CALL handle_errno(.NOT. C_ASSOCIATED(dummy_ptr), 0*100 + 2, &
- & __FILE__, &
- & __LINE__)
- CALL C_F_POINTER(c_pointer1, dt_tmp)
- dt_td_sum%dt = dt_tmp
- CALL my_deallocatedatetime(c_pointer1)
- CALL my_deallocatedatetime(c_pointer2)
- END FUNCTION t_datetime_add_timedelta
-
- ! Subtraction of time interval to datetime object.
- !
- FUNCTION t_datetime_sub_timedelta(this, td) RESULT(dt_td_sum)
- TYPE(t_datetime) :: dt_td_sum
- CLASS(t_datetime), INTENT(in) :: this
- TYPE(t_timedelta), INTENT(in) :: td
- TYPE(t_timedelta) :: td_tmp
- TYPE(datetime), POINTER :: dt_tmp
- TYPE(c_ptr) :: c_pointer1, c_pointer2, dummy_ptr
-
- td_tmp = td
- IF (td_tmp%td%sign == "+") THEN
- td_tmp%td%sign = "-"
- ELSE
- td_tmp%td%sign = "+"
- END IF
-
- c_pointer1 = this%get_c_pointer()
- c_pointer2 = td_tmp%get_c_pointer()
-
- dummy_ptr = my_addtimedeltatodatetime(c_pointer1, c_pointer2, c_pointer1)
- CALL handle_errno(.NOT. C_ASSOCIATED(dummy_ptr), 0*100 + 2, &
- & __FILE__, &
- & __LINE__)
- CALL C_F_POINTER(c_pointer1, dt_tmp)
- dt_td_sum%dt = dt_tmp
- CALL my_deallocatedatetime(c_pointer1)
- CALL my_deallocatedatetime(c_pointer2)
- END FUNCTION t_datetime_sub_timedelta
-
- ! Subtraction of two dates.
- !
- FUNCTION t_datetime_sub_datetime(this, dt) RESULT(dt_dt_diff)
- TYPE(t_timedelta), TARGET :: dt_dt_diff
- CLASS(t_datetime), INTENT(in), TARGET :: this
- CLASS(t_datetime), INTENT(in), TARGET :: dt
- TYPE(c_ptr) :: dummy_ptr
- dummy_ptr = my_gettimedeltafromdate(C_LOC(this%dt), C_LOC(dt%dt), C_LOC(dt_dt_diff%td))
- END FUNCTION t_datetime_sub_datetime
-
- ! Overloaded operator: test for equivalence.
- !
-#ifndef MTIME_PURE_IF_C_LOC_IS_PURE
-# if defined(__NEC__) || (defined(NAGFOR) && __NAG_COMPILER_RELEASE <= 71)
-! NEC and older versions of NAG do not consider C_LOC as PURE
-# define MTIME_PURE_IF_C_LOC_IS_PURE
-# else
-# define MTIME_PURE_IF_C_LOC_IS_PURE PURE
-# endif
-#endif
- MTIME_PURE_IF_C_LOC_IS_PURE LOGICAL FUNCTION t_datetime_equal(this, dt) RESULT(eq)
- CLASS(t_datetime), INTENT(in), TARGET :: this
- CLASS(t_datetime), INTENT(in), TARGET :: dt
- INTEGER(c_int) :: ret
- ret = my_comparedatetime(C_LOC(this%dt), C_LOC(dt%dt))
- IF (ret == 0) THEN
- eq = .TRUE.
- ELSE
- eq = .FALSE.
- END IF
- END FUNCTION t_datetime_equal
-
- MTIME_PURE_IF_C_LOC_IS_PURE LOGICAL FUNCTION t_datetime_not_equal(this, dt)
- CLASS(t_datetime), INTENT(in) :: this
- CLASS(t_datetime), INTENT(in) :: dt
- t_datetime_not_equal = .NOT. (this%dt == dt%dt)
- END FUNCTION t_datetime_not_equal
-
- MTIME_PURE_IF_C_LOC_IS_PURE LOGICAL FUNCTION t_datetime_less_than(this, dt) RESULT(lt)
- CLASS(t_datetime), INTENT(in), TARGET :: this
- CLASS(t_datetime), INTENT(in), TARGET :: dt
- INTEGER(c_int) :: ret
- ret = my_comparedatetime(C_LOC(this%dt), C_LOC(dt%dt))
- IF (ret == -1) THEN
- lt = .TRUE.
- ELSE
- lt = .FALSE.
- END IF
- END FUNCTION t_datetime_less_than
-
- MTIME_PURE_IF_C_LOC_IS_PURE LOGICAL FUNCTION t_datetime_greater_than(this, dt) RESULT(gt)
- CLASS(t_datetime), INTENT(in), TARGET :: this
- CLASS(t_datetime), INTENT(in), TARGET :: dt
- INTEGER(c_int) :: ret
- ret = my_comparedatetime(C_LOC(this%dt), C_LOC(dt%dt))
- IF (ret == 1) THEN
- gt = .TRUE.
- ELSE
- gt = .FALSE.
- END IF
- END FUNCTION t_datetime_greater_than
-
- MTIME_PURE_IF_C_LOC_IS_PURE LOGICAL FUNCTION t_datetime_less_or_equal(this, dt)
- CLASS(t_datetime), INTENT(in) :: this
- CLASS(t_datetime), INTENT(in) :: dt
- t_datetime_less_or_equal = .NOT. (this > dt)
- END FUNCTION t_datetime_less_or_equal
-
- MTIME_PURE_IF_C_LOC_IS_PURE LOGICAL FUNCTION t_datetime_greater_or_equal(this, dt)
- CLASS(t_datetime), INTENT(in) :: this
- CLASS(t_datetime), INTENT(in) :: dt
- t_datetime_greater_or_equal = .NOT. (this < dt)
- END FUNCTION t_datetime_greater_or_equal
-
- FUNCTION t_datetime_daysInEntireMonth(this)
- CLASS(t_datetime), INTENT(in), TARGET :: this
- INTEGER(c_int) :: t_datetime_daysInEntireMonth
- t_datetime_daysInEntireMonth = my_getnoofdaysinmonthdatetime(C_LOC(this%dt))
- CALL handle_errno(t_datetime_daysInEntireMonth == 0, 4*100 + 15, &
- & __FILE__, __LINE__)
- END FUNCTION t_datetime_daysInEntireMonth
-
- FUNCTION t_datetime_daysInEntireYear(this)
- CLASS(t_datetime), INTENT(in), TARGET :: this
- INTEGER(c_int) :: t_datetime_daysInEntireYear
- t_datetime_daysInEntireYear = my_getnoofdaysinyeardatetime(C_LOC(this%dt))
- CALL handle_errno(t_datetime_daysInEntireYear == 0, 4*100 + 16, &
- & __FILE__, __LINE__)
- END FUNCTION t_datetime_daysInEntireYear
-
- FUNCTION t_datetime_elapsedDaysInYear(this)
- CLASS(t_datetime), INTENT(in), TARGET :: this
- INTEGER(c_int) :: t_datetime_elapsedDaysInYear
-
- t_datetime_elapsedDaysInYear = my_getdayofyearfromdatetime(C_LOC(this%dt))
- CALL handle_errno(t_datetime_elapsedDaysInYear == 0, 4*100 + 17, &
- & __FILE__, __LINE__)
- END FUNCTION t_datetime_elapsedDaysInYear
-
- FUNCTION t_datetime_elapsedSecondsInMonth(this)
- CLASS(t_datetime), INTENT(in), TARGET :: this
- INTEGER(c_int64_t) :: t_datetime_elapsedSecondsInMonth
- t_datetime_elapsedSecondsInMonth = my_getnoofsecondselapsedinmonthdatetime(C_LOC(this%dt))
- CALL handle_errno(t_datetime_elapsedSecondsInMonth == -1, 4*100 + 18, &
- & __FILE__, __LINE__)
- END FUNCTION t_datetime_elapsedSecondsInMonth
-
- FUNCTION t_datetime_elapsedSecondsInDay(this)
- CLASS(t_datetime), INTENT(in), TARGET :: this
- INTEGER(c_int64_t) :: t_datetime_elapsedSecondsInDay
-
- t_datetime_elapsedSecondsInDay = my_getnoofsecondselapsedindaydatetime(C_LOC(this%dt))
- CALL handle_errno(t_datetime_elapsedSecondsInDay == -1, 4*100 + 19, &
- & __FILE__, __LINE__)
- END FUNCTION t_datetime_elapsedSecondsInDay
-
- FUNCTION t_datetime_get_c_pointer(this) RESULT(c_pointer)
- TYPE(c_ptr) :: c_pointer
- CLASS(t_datetime) :: this
- c_pointer = my_newrawdatetime(INT(this%dt%date%year, c_int64_t), this%dt%date%month, &
- & this%dt%date%day, this%dt%time%hour, this%dt%time%minute, &
- & this%dt%time%second, this%dt%time%ms)
- CALL handle_errno((.NOT. C_ASSOCIATED(c_pointer)), 4*100 + 3, &
- & __FILE__, &
- & __LINE__)
- END FUNCTION t_datetime_get_c_pointer
diff --git a/src/mtime_t_event.inc b/src/mtime_t_event.inc
deleted file mode 100644
index 99914802..00000000
--- a/src/mtime_t_event.inc
+++ /dev/null
@@ -1,156 +0,0 @@
-!! Copyright (c) 2013-2024 MPI-M, Luis Kornblueh, Rahul Sinha and DWD, Florian Prill. All rights reserved.
-!!
-!! SPDX-License-Identifier: BSD-3-Clause
-!!
- ! ================================================================================
- ! event section:
- ! ================================================================================
-
- ! generic assignment for constructors
- !
- FUNCTION t_event_assign_raw(name, referenceDate, firstdate, lastDate, interval, offset)
- TYPE(t_event) :: t_event_assign_raw
- CHARACTER(len=*), INTENT(in) :: name
- CHARACTER(len=*), INTENT(in) :: referenceDate
- CHARACTER(len=*), INTENT(in) :: firstDate
- CHARACTER(len=*), INTENT(in) :: lastDate
- CHARACTER(len=*), INTENT(in) :: interval
- CHARACTER(len=*), INTENT(in), OPTIONAL :: offset
-
- CHARACTER(len=4) :: zeroOffset = "PT0S"
-
- t_event_assign_raw%eventName = name
- t_event_assign_raw%eventReferenceDateTime = t_datetime(referenceDate)
- t_event_assign_raw%eventFirstDateTime = t_datetime(firstDate)
- t_event_assign_raw%eventLastDateTime = t_datetime(lastDate)
- t_event_assign_raw%eventInterval = t_timedelta(interval)
- IF (PRESENT(offset)) THEN
- t_event_assign_raw%eventOffset = t_timedelta(offset)
- ELSE
- t_event_assign_raw%eventOffset = t_timedelta(zeroOffset)
- END IF
-
- END FUNCTION t_event_assign_raw
-
- FUNCTION t_event_assign_types(name, referenceDate, firstdate, lastDate, interval, offset)
- TYPE(t_event) :: t_event_assign_types
- CHARACTER(len=*), INTENT(in) :: name
- TYPE(t_datetime), INTENT(in) :: referenceDate
- TYPE(t_datetime), INTENT(in) :: firstDate
- TYPE(t_datetime), INTENT(in) :: lastDate
- TYPE(t_timedelta), INTENT(in) :: interval
- TYPE(t_timedelta), INTENT(in), OPTIONAL :: offset
-
- CHARACTER(len=4) :: zeroOffset = "PT0S"
-
- t_event_assign_types%eventName = name
- t_event_assign_types%eventReferenceDateTime = referenceDate
- t_event_assign_types%eventFirstDateTime = firstDate
- t_event_assign_types%eventLastDateTime = lastDate
- t_event_assign_types%eventInterval = interval
- IF (PRESENT(offset)) THEN
- t_event_assign_types%eventOffset = offset
- ELSE
- t_event_assign_types%eventOffset = t_timedelta(zeroOffset)
- END IF
-
- END FUNCTION t_event_assign_types
-
- ! Iterate to next event in event group.
- !
- ! @return NULL() if no next event available.
- FUNCTION t_event_next_event(this)
- TYPE(t_event), POINTER :: t_event_next_event
- CLASS(t_event) :: this
- t_event_next_event => NULL()
- IF (ASSOCIATED(this%nextEventInGroup)) THEN
- t_event_next_event => this%nextEventInGroup
- END IF
- END FUNCTION t_event_next_event
-
- FUNCTION t_event_getId(this) RESULT(res)
- INTEGER(c_int64_t) :: res
- CLASS(t_event) :: this
- res = this%eventId
- END FUNCTION t_event_getId
-
- FUNCTION t_event_getName(this) RESULT(res)
- CHARACTER(len=max_event_str_len) :: res
- CLASS(t_event) :: this
- res = this%eventName
- END FUNCTION t_event_getName
-
- FUNCTION t_event_getFirstDatetime(this) RESULT(res)
- TYPE(t_datetime) :: res
- CLASS(t_event) :: this
- res = this%eventFirstDateTime
- END FUNCTION t_event_getFirstDatetime
-
- FUNCTION t_event_getInterval(this) RESULT(res)
- TYPE(t_timedelta) :: res
- CLASS(t_event) :: this
- res = this%eventInterval
- END FUNCTION t_event_getInterval
-
- FUNCTION t_event_getLastDatetime(this) RESULT(res)
- TYPE(t_datetime) :: res
- CLASS(t_event) :: this
- res = this%eventLastDateTime
- END FUNCTION t_event_getLastDatetime
-
- FUNCTION t_event_getNextOccurrenceDatetime(this) RESULT(res)
- TYPE(t_datetime) :: res
- CLASS(t_event) :: this
- res = this%triggerNextEventDateTime
- END FUNCTION t_event_getNextOccurrenceDatetime
-
- FUNCTION t_event_getPrevOccurrenceDatetime(this) RESULT(res)
- TYPE(t_datetime) :: res
- CLASS(t_event) :: this
- res = this%triggeredPreviousEventDateTime
- END FUNCTION t_event_getPrevOccurrenceDatetime
-
- ! ================================================================================
- ! event group section:
- ! ================================================================================
-
- FUNCTION t_eventGroup_constructor(name) RESULT(this_event_group)
- TYPE(t_eventGroup) :: this_event_group
- CHARACTER(len=*), INTENT(in) :: name
- event_group_id = event_group_id + 1
- this_event_group%event_group_id = event_group_id
- this_event_group%event_group_name = name
- this_event_group%first_event_in_group => NULL()
- this_event_group%last_event_in_group => NULL()
- END FUNCTION t_eventGroup_constructor
-
- SUBROUTINE t_eventGroup_addToGroup(this, event_to_add)
- CLASS(t_eventGroup) :: this
- TYPE(t_event), TARGET :: event_to_add
- IF (.NOT. ASSOCIATED(this%last_event_in_group)) THEN
- this%first_event_in_group => event_to_add
- NULLIFY (this%first_event_in_group%nextEventInGroup)
- ELSE
- this%last_event_in_group%nextEventInGroup => event_to_add
- NULLIFY (event_to_add%nextEventInGroup)
- END IF
- this%last_event_in_group => event_to_add
- END SUBROUTINE t_eventGroup_addToGroup
-
- FUNCTION t_eventGroup_getGroupId(this) RESULT(group_id)
- INTEGER(c_int64_t) :: group_id
- CLASS(t_eventGroup) ::this
- group_id = this%event_group_id
- END FUNCTION t_eventGroup_getGroupId
-
- FUNCTION t_eventGroup_getGroupName(this) RESULT(name)
- CHARACTER(len=max_groupname_str_len) :: name
- CLASS(t_eventGroup) :: this
- name = this%event_group_name
- END FUNCTION t_eventGroup_getGroupName
-
- FUNCTION t_eventGroup_getFirstEvent(this) RESULT(event_ptr)
- TYPE(t_event), POINTER :: event_ptr
- CLASS(t_eventGroup) :: this
- event_ptr => this%first_event_in_group
- END FUNCTION t_eventGroup_getFirstEvent
diff --git a/src/mtime_t_juliandelta.inc b/src/mtime_t_juliandelta.inc
deleted file mode 100644
index 8506a798..00000000
--- a/src/mtime_t_juliandelta.inc
+++ /dev/null
@@ -1,30 +0,0 @@
-!! Copyright (c) 2013-2024 MPI-M, Luis Kornblueh, Rahul Sinha and DWD, Florian Prill. All rights reserved.
-!!
-!! SPDX-License-Identifier: BSD-3-Clause
-!!
- ! ================================================================================
- ! juliandelta section:
- ! ================================================================================
-
- ! generic assignment for constructors
- !
- 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(c_ptr) :: c_pointer
- TYPE(juliandelta), POINTER :: jd_tmp
-
- c_pointer = my_newjuliandelta(sign, day, ms)
- !print *,sign, c_pointer
- IF (.NOT. C_ASSOCIATED(c_pointer)) THEN
- CALL handle_errno(1*100 + 1, __FILE__, __LINE__)
- t_juliandelta_assign_raw%jd%sign = 'L'
- ELSE
- CALL C_F_POINTER(c_pointer, jd_tmp)
- t_juliandelta_assign_raw%jd = jd_tmp
- t_juliandelta_assign_raw%jd%sign = jd_tmp%sign
- CALL my_deallocatejuliandelta(c_pointer)
- END IF
- END FUNCTION t_juliandelta_assign_raw
diff --git a/src/mtime_t_timedelta.inc b/src/mtime_t_timedelta.inc
deleted file mode 100644
index 6aaaaeeb..00000000
--- a/src/mtime_t_timedelta.inc
+++ /dev/null
@@ -1,417 +0,0 @@
-!! Copyright (c) 2013-2024 MPI-M, Luis Kornblueh, Rahul Sinha and DWD, Florian Prill. All rights reserved.
-!!
-!! SPDX-License-Identifier: BSD-3-Clause
-!!
- ! ================================================================================
- ! timedelta section:
- ! ================================================================================
-
-! ToDo: Most of this file needs to be renovated for NOT USE mtime.
-
- ! constructor for timedelta string
- !
- TYPE(t_timedelta) FUNCTION t_timedelta_assign_string(td_string) !OK-tested
- CHARACTER(len=*), INTENT(in) :: td_string
- TYPE(timedelta), POINTER :: td_tmp
- TYPE(c_ptr) :: c_pointer
-
- c_pointer = my_newtimedeltafromstring(TRIM(ADJUSTL(td_string))//c_null_char)
- IF (.NOT. C_ASSOCIATED(c_pointer)) THEN
- CALL handle_errno(5*100 + 1, &
- & __FILE__, &
- & __LINE__)
- t_timedelta_assign_string%td%sign = '?'
- ELSE
- CALL C_F_POINTER(c_pointer, td_tmp)
- t_timedelta_assign_string%td = td_tmp
- t_timedelta_assign_string%td%sign = td_tmp%sign
- CALL my_deallocatetimedelta(c_pointer)
- END IF
- END FUNCTION t_timedelta_assign_string
-
- ! constructor for integer milliseconds (integer)
- !
- TYPE(t_timedelta) FUNCTION t_timedelta_assign_ms(td_ms)
- 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, c_int64_t), td_string, errno)
- CALL handle_errno(errno, &
- & __FILE__, &
- & __LINE__)
- td_tmp => newTimedelta(td_string, errno)
- 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)
- END FUNCTION t_timedelta_assign_ms
-
- ! constructor for integer milliseconds (integer)
- !
- TYPE(t_timedelta) FUNCTION t_timedelta_assign_ms_i8(td_ms)
- INTEGER(c_int64_t), INTENT(in) :: td_ms
- TYPE(timedelta), POINTER :: td_tmp
- CHARACTER(len=max_timedelta_str_len) :: td_string
- INTEGER :: errno
- CALL getPTStringFromMS(INT(td_ms, c_int64_t), td_string, errno)
- CALL handle_errno(errno, &
- & __FILE__, &
- & __LINE__)
- td_tmp => newTimedelta(td_string, errno)
- CALL handle_errno(errno, &
- & __FILE__, &
- & __LINE__)
- t_timedelta_assign_ms_i8%td = td_tmp
- t_timedelta_assign_ms_i8%td%sign = td_tmp%sign
- CALL deallocateTimedelta(td_tmp)
- END FUNCTION t_timedelta_assign_ms_i8
-
- ! constructor for integer seconds (integer)
- !
- 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
-
- ! constructor for integer seconds (integer)
- !
- TYPE(t_timedelta) FUNCTION t_timedelta_assign_sec_i8(td_sec)
- INTEGER(c_int64_t), INTENT(in) :: td_sec
- t_timedelta_assign_sec_i8 = t_timedelta_assign_ms_i8(td_sec*1000)
- END FUNCTION t_timedelta_assign_sec_i8
-
- 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__)
- NULLIFY (td_tmp2)
- td_tmp2 = td_tmp*lambda
- 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
- td_tmp => newTimedelta(this%td, errno)
- CALL handle_errno(errno, &
- & __FILE__, &
- & __LINE__)
- NULLIFY (td_tmp2)
- td_tmp2 = td_tmp*lambda
- 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) !OK-tested
- TYPE(t_timedelta), TARGET :: scaled_td
- INTEGER(c_int32_t), INTENT(in) :: lambda
- CLASS(t_timedelta), TARGET, INTENT(in) :: this
- TYPE(c_ptr) :: dummy_ptr
-
- dummy_ptr = my_elementwisescalarmultiplytimedelta(C_LOC(this%td), INT(lambda, c_int64_t), C_LOC(scaled_td%td))
- IF (.NOT. C_ASSOCIATED(dummy_ptr)) THEN
- CALL handle_errno(0*100 + 2, &
- & __FILE__, &
- & __LINE__)
- scaled_td%td%sign = '!'
- END IF
-
- 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
-
- scaled_td = t_timedelta_scalar_multiply_int(this, lambda)
- END FUNCTION t_timedelta_scalar_multiply_inv_int
-
- FUNCTION t_timedelta_scalar_multiply_real(this, lambda) RESULT(scaled_td) !OK-tested
- TYPE(t_timedelta), TARGET :: scaled_td
- REAL(c_double), INTENT(in) :: lambda
- CLASS(t_timedelta), TARGET, INTENT(in) :: this
- TYPE(c_ptr) :: dummy_ptr
-
- dummy_ptr = my_elementwisescalarmultiplytimedeltadp(C_LOC(this%td), lambda, C_LOC(scaled_td%td))
- IF (.NOT. C_ASSOCIATED(dummy_ptr)) THEN
- CALL handle_errno(0*100 + 2, &
- & __FILE__, &
- & __LINE__)
- scaled_td%td%sign = '!'
- END IF
-
- 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
-
- scaled_td = t_timedelta_scalar_multiply_real(this, lambda)
- END FUNCTION t_timedelta_scalar_multiply_inv_real
-
- ! Convert t_timedelta object to string.
- !
- FUNCTION t_timedelta_toString(this) RESULT(string)
- CHARACTER(len=max_timedelta_str_len) :: string
- CLASS(t_timedelta) :: this
- TYPE(c_ptr) :: c_pointer, dummy_ptr
- INTEGER :: i
-
- string = ""
-
- c_pointer = this%get_c_pointer()
- CALL handle_errno(.NOT. C_ASSOCIATED(c_pointer), 0*100 + 2, &
- & __FILE__, &
- & __LINE__)
- dummy_ptr = my_timedeltatostring(c_pointer, string)
- CALL handle_errno(.NOT. C_ASSOCIATED(dummy_ptr), 4*100 + 6, &
- & __FILE__, &
- & __LINE__)
-
- char_loop: DO i = 1, LEN(string)
- IF (string(i:i) == c_null_char) EXIT char_loop
- END DO char_loop
- string(i:LEN(string)) = ' '
-
- CALL my_deallocatetimedelta(c_pointer) !deallocate timedelta
- END FUNCTION t_timedelta_toString
-
- FUNCTION t_timedelta_divideInSecondsBy(this, divisor, referenceDateTime) RESULT(quotient)
- CLASS(t_timedelta), INTENT(in) :: this
- TYPE(t_timedelta), INTENT(in) :: divisor
- TYPE(t_datetime), INTENT(IN), OPTIONAL :: referenceDateTime
- TYPE(divisionquotienttimespan) :: quotient
- TYPE(timedelta), POINTER :: tmp_dividend
- TYPE(timedelta), POINTER :: tmp_divisor
- TYPE(datetime), POINTER :: tmp_ref, tmp_dt
- TYPE(t_datetime) :: dt_tmp
- INTEGER :: errno
-
- tmp_dividend => newTimedelta(this%td, errno)
- CALL handle_errno(errno, &
- & __FILE__, &
- & __LINE__)
- tmp_divisor => newTimedelta(divisor%td, errno)
- CALL handle_errno(errno, &
- & __FILE__, &
- & __LINE__)
- IF (PRESENT(referenceDateTime)) THEN
- tmp_ref => newDateTime(referenceDateTime%dt, errno)
- CALL handle_errno(errno, &
- & __FILE__, &
- & __LINE__)
- END IF
-
- CALL divideTimeDeltaInSeconds(tmp_dividend, tmp_divisor, quotient, errno)
-
- IF (errno /= no_error) THEN
- IF (.NOT. PRESENT(referenceDateTime)) THEN
- CALL handle_errno(errno, &
- & __FILE__, &
- & __LINE__)
- ELSE
- dt_tmp = referenceDateTime + this
- tmp_dt => newDateTime(dt_tmp%dt, errno)
- CALL handle_errno(errno, &
- & __FILE__, &
- & __LINE__)
- CALL divideDatetimeDifferenceInSeconds(tmp_dt, tmp_ref, &
- & tmp_divisor, quotient, errno)
- CALL handle_errno(errno, &
- & __FILE__, &
- & __LINE__)
-
- CALL deallocateDatetime(tmp_dt)
- END IF
- END IF
-
- CALL deallocateTimedelta(tmp_dividend)
- CALL deallocateTimedelta(tmp_divisor)
- IF (PRESENT(referenceDateTime)) THEN
- CALL deallocateDatetime(tmp_ref)
- END IF
- 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
-
- 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
-
- ms = getTotalMilliSecondsTimeDelta(this%td, td%dt)
- END FUNCTION t_timedelta_toMilliSeconds
-
- FUNCTION t_timedelta_toJulianDelta(this, dt) RESULT(jd)
- TYPE(t_juliandelta) :: jd
- CLASS(t_timedelta), INTENT(in) :: this
- TYPE(t_datetime), INTENT(in) :: dt
- TYPE(timedelta), POINTER :: td_tmp
- TYPE(datetime), POINTER :: dt_tmp
- TYPE(juliandelta), POINTER :: jd_tmp
- INTEGER :: errno
- td_tmp => newTimedelta(this%td, errno)
- CALL handle_errno(errno, &
- & __FILE__, &
- & __LINE__)
- dt_tmp => newDatetime(dt%dt, errno)
- CALL handle_errno(errno, &
- & __FILE__, &
- & __LINE__)
- jd_tmp => newJuliandelta('+', 0_c_int64_t, 0_c_int64_t, errno)
- CALL handle_errno(errno, &
- & __FILE__, &
- & __LINE__)
-
- CALL timeDeltaToJulianDelta(td_tmp, dt_tmp, jd_tmp)
- jd%jd = jd_tmp
-
- CALL deallocateTimedelta(td_tmp)
- CALL deallocateDatetime(dt_tmp)
- CALL deallocateJuliandelta(jd_tmp)
- END FUNCTION t_timedelta_toJulianDelta
-
- 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
-
- 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
-
- FUNCTION t_julianday_toDateTime(this) RESULT(res)
- TYPE(t_datetime) :: res
- CLASS(t_julianday) :: this
- TYPE(julianday), POINTER :: jd_tmp
- INTEGER :: errno
- TYPE(datetime), POINTER :: dt_tmp
-
- jd_tmp => newJulianDay(this%jd%day, this%jd%ms, errno)
- CALL handle_errno(errno, &
- & __FILE__, &
- & __LINE__)
- dt_tmp => newDatetime("1970-01-01T00:00:00", errno)
- CALL handle_errno(errno, &
- & __FILE__, &
- & __LINE__)
-
- CALL getDatetimeFromJulianDay(jd_tmp, dt_tmp, errno)
- CALL handle_errno(errno, &
- & __FILE__, &
- & __LINE__)
-
- res%dt = dt_tmp
- CALL deallocateJulianDay(jd_tmp)
- CALL deallocateDatetime(dt_tmp)
- END FUNCTION t_julianday_toDateTime
-
- FUNCTION t_datetime_min(a, b) RESULT(res)
- TYPE(t_datetime) :: a, b
- TYPE(t_datetime) :: res
-
- IF (a > b) THEN
- res = b
- ELSE
- res = a
- END IF
- END FUNCTION t_datetime_min
-
- FUNCTION t_datetime_max(a, b) RESULT(res)
- TYPE(t_datetime) :: a, b
- TYPE(t_datetime) :: res
-
- IF (a > b) THEN
- res = a
- ELSE
- res = b
- END IF
- END FUNCTION t_datetime_max
-
- FUNCTION t_timedelta_get_c_pointer(this) RESULT(c_pointer)
- TYPE(c_ptr) :: c_pointer
- CLASS(t_timedelta) :: this
- CHARACTER(c_char) ::c_sign
-
- c_sign = this%td%SIGN(1:1)
- c_pointer = my_newrawtimedelta(c_sign, INT(this%td%year, c_int64_t), this%td%month, this%td%day, &
- & this%td%hour, this%td%minute, this%td%second, this%td%ms)
- CALL handle_errno((.NOT. C_ASSOCIATED(c_pointer)), 5*100 + 2, &
- & __FILE__, &
- & __LINE__)
- END FUNCTION t_timedelta_get_c_pointer
--
GitLab