diff --git a/src/eventwrapper.f90 b/src/eventwrapper.f90
index cd4fd23ceebd79098bf51250eb9dc3d9403bc211..24fbd3b0831a44be6249f113972829f724643d3f 100644
--- a/src/eventwrapper.f90
+++ b/src/eventwrapper.f90
@@ -1,14 +1,14 @@
MODULE event_wrapper
-
+
!TODO: create type-bound procedures get_c_ptr for t_datetime and t_timedelta
implicit none
-
+
TYPE t_event
!private
- TYPE(t_event), POINTER :: nextEventInGroup
+ TYPE(t_event), POINTER :: nextEventInGroup
INTEGER(c_int64_t) :: eventId
CHARACTER(len=max_eventname_str_len) :: eventName
@@ -41,7 +41,7 @@ MODULE event_wrapper
CONTAINS
- !> TODO: implement isAvtive ....
+ !> TODO: implement isAvtive ....
! PROCEDURE :: trigger => t_event_trigger
PROCEDURE :: getFirstDatetime => t_event_getFirstDatetime
PROCEDURE :: getInterval => t_event_getInterval
@@ -53,7 +53,7 @@ MODULE event_wrapper
PROCEDURE :: nextEvent => t_event_next_event
PROCEDURE :: get_c_pointer => t_event_get_c_pointer
-
+
END TYPE t_event
INTERFACE t_event
@@ -67,30 +67,30 @@ CONTAINS
TYPE(c_ptr) :: c_pointer
TYPE(event), POINTER :: event_pointer
-
+
event_pointer => newEvent(! to fill)
-
+
event_pointer%nextEventInGroup = this%nextEventInGroup%get_c_pointer()
- event_pointer%eventId = this%eventId
- event_pointer%eventName = this%eventName
- event_pointer%eventsLastEvaluationDateTime = this%eventsLastEvaluationDateTime%get_c_pointer()
- event_pointer%eventReferenceDatetime = this%eventReferenceDatetime%get_c_pointer()
- event_pointer%eventFirstDatetime = this%eventFirstDatetime%get_c_pointer()
- event_pointer%eventLastDatetime = this%eventLastDatetime%get_c_pointer()
- event_pointer%eventInterval = this%eventInterval%get_c_pointer()
- event_pointer%triggerCurrentEvent = this%triggerCurrentEvent
- event_pointer%nextEventIsFirst = this%nextEventIsFirst
- event_pointer%eventisFirstInDay = this%eventisFirstInDay
- event_pointer%eventisFirstInMonth = this%eventisFirstInMonth
- event_pointer%eventisFirstInYear = this%eventisFirstInYear
- event_pointer%eventisLastInDay = this%eventisLastInDay
- event_pointer%eventisLastInMonth = this%eventisLastInMonth
- event_pointer%eventisLastInYear = this%eventisLastInYear
- event_pointer%triggerNextEventDateTime = this%triggerNextEventDateTime%get_c_pointer()
+ event_pointer%eventId = this%eventId
+ event_pointer%eventName = this%eventName
+ event_pointer%eventsLastEvaluationDateTime = this%eventsLastEvaluationDateTime%get_c_pointer()
+ event_pointer%eventReferenceDatetime = this%eventReferenceDatetime%get_c_pointer()
+ event_pointer%eventFirstDatetime = this%eventFirstDatetime%get_c_pointer()
+ event_pointer%eventLastDatetime = this%eventLastDatetime%get_c_pointer()
+ event_pointer%eventInterval = this%eventInterval%get_c_pointer()
+ event_pointer%triggerCurrentEvent = this%triggerCurrentEvent
+ event_pointer%nextEventIsFirst = this%nextEventIsFirst
+ event_pointer%eventisFirstInDay = this%eventisFirstInDay
+ event_pointer%eventisFirstInMonth = this%eventisFirstInMonth
+ event_pointer%eventisFirstInYear = this%eventisFirstInYear
+ event_pointer%eventisLastInDay = this%eventisLastInDay
+ event_pointer%eventisLastInMonth = this%eventisLastInMonth
+ event_pointer%eventisLastInYear = this%eventisLastInYear
+ event_pointer%triggerNextEventDateTime = this%triggerNextEventDateTime%get_c_pointer()
event_pointer%triggeredPreviousEventDateTime = this%triggeredPreviousEventDateTime%get_c_pointer()
c_pointer = C_LOC(event_pointer)
-
+
END FUNCTION t_event_get_c_pointer
function isCurrentEventActive(this, my_datetime, plus_slack, minus_slack) result(ret)
@@ -103,13 +103,13 @@ CONTAINS
type(c_ptr) :: this_ptr
type(c_ptr) :: my_datetime_ptr
type(c_ptr) :: plus_slack_ptr => c_null
- type(c_ptr) :: minus_slack_ptr => c_null
+ type(c_ptr) :: minus_slack_ptr => c_null
this_ptr = this%get_c_ptr()
my_datetime_ptr = my_Datetime%get_c_ptr()
-
+
if (present(plus_slack)) plus_slack_ptr = plus_slack%get_c_ptr()
- if (present(minus_slack)) minus_slack_ptr = minus_slack%get_c_ptr()
+ if (present(minus_slack)) minus_slack_ptr = minus_slack%get_c_ptr()
ret = my_isCurrentEventActive(this_ptr, my_datetime_ptr, &
& plus_slack_ptr, minus_slack_ptr)
@@ -118,7 +118,7 @@ CONTAINS
CALL my_deallocatedatetime(my_datetime_ptr)
IF (present(plus_slack) CALL deallocatetimedelta(plus_slack_ptr)
IF (present(minus_slack) CALL deallocatetimedelta(minus_slack_ptr)
-
+
end function isCurrentEventActive
END MODULE event_wrapper
diff --git a/src/libmtime_hl.f90 b/src/libmtime_hl.f90
index 76eb7f42dd5169ead12080d36175fbe7ec18e9ea..5661447b69174263e588bc59d02fc4429d34a292 100644
--- a/src/libmtime_hl.f90
+++ b/src/libmtime_hl.f90
@@ -19,7 +19,6 @@
!!
!! @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
!! @{
@@ -371,6 +370,11 @@ MODULE mtime_hl
MODULE PROCEDURE t_eventGroup_constructor
END INTERFACE t_eventGroup
+ INTERFACE handle_errno
+ MODULE PROCEDURE handle_errno1
+ MODULE PROCEDURE handle_errno2
+ END INTERFACE handle_errno
+
INTEGER :: event_group_id = 0
INTEGER :: event_id = 0
@@ -378,7 +382,7 @@ CONTAINS
!___________________________________________________________________________
! auxiliary routine: handle error code.
- SUBROUTINE handle_errno(errno, routine_str, lineno)
+ SUBROUTINE handle_errno1(errno, routine_str, lineno)
INTEGER, INTENT(IN) :: errno
INTEGER, INTENT(IN) :: lineno
CHARACTER(LEN=*), INTENT(IN) :: routine_str
@@ -388,7 +392,21 @@ CONTAINS
WRITE (error_str,'(a,a,i0)') TRIM(error_str), " :: line ", lineno
CALL finish_mtime(routine_str, error_str)
END IF
- END SUBROUTINE handle_errno
+ END SUBROUTINE handle_errno1
+
+
+ !___________________________________________________________________________
+ ! auxiliary routine: handle error code.
+ SUBROUTINE handle_errno2(lcond, errno, routine_str, lineno)
+ LOGICAL, INTENT(IN) :: lcond
+ INTEGER, INTENT(IN) :: errno
+ INTEGER, INTENT(IN) :: lineno
+
+ CHARACTER(LEN=*), INTENT(IN) :: routine_str
+ CHARACTER(len=max_mtime_error_str_len) :: error_str
+ if (lcond) call handle_errno1(errno, routine_str, lineno)
+ END SUBROUTINE handle_errno2
+
! ================================================================================
@@ -418,12 +436,14 @@ CONTAINS
!
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
INTEGER :: errno
- dt_tmp => newdatetime(dt_string, errno)
- CALL handle_errno(errno, __FILE__, __LINE__)
+ 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 deallocatedatetime(dt_tmp)
+ CALL my_deallocatedatetime(c_pointer)
END FUNCTION t_datetime_assign_string
! constructor for a datetime