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

Needs some debugging

parent cc6a3cf8
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
src/libmtime_hl.f90
+ 8
− 8
View file @ 2e4c520d
......@@ -305,13 +305,13 @@ MODULE mtime_hl
INTEGER(c_int64_t) :: eventId
CHARACTER(len=max_eventname_str_len) :: eventName
TYPE(t_datetime) :: eventReferenceDateTime
TYPE(datetime) :: eventReferenceDateTime
TYPE(t_datetime) :: eventFirstDateTime
TYPE(t_datetime) :: eventLastDateTime
TYPE(datetime) :: eventFirstDateTime
TYPE(datetime) :: eventLastDateTime
TYPE(t_timedelta) :: eventInterval
TYPE(t_timedelta) :: eventOffset
TYPE(timedelta) :: eventInterval
TYPE(timedelta) :: eventOffset
LOGICAL :: neverTriggerEvent
......@@ -330,9 +330,9 @@ MODULE mtime_hl
! Alas, t_event contains POINTERs (apart from their date
! information these also have an allocation status):
TYPE(t_datetime) :: eventsLastEvaluationDateTime
TYPE(t_datetime) :: triggerNextEventDateTime
TYPE(t_datetime) :: triggeredPreviousEventDateTime
TYPE(datetime) :: eventsLastEvaluationDateTime
TYPE(datetime) :: triggerNextEventDateTime
TYPE(datetime) :: triggeredPreviousEventDateTime
CONTAINS
......
src/mtime_t_event.inc
+ 122
− 159
View file @ 2e4c520d
......@@ -15,26 +15,39 @@
CHARACTER(len=4) :: zeroOffset = "PT0S"
TYPE(t_datetime) :: tmp_dt
TYPE(t_timedelta) :: tmp_td
TYPE(timedelta) :: intvl
NULLIFY(t_event_assign_raw%nextEventInGroup)
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)
tmp_dt = t_datetime(referenceDate)
t_event_assign_raw%eventReferenceDateTime = tmp_dt%dt
tmp_dt = t_datetime(firstDate)
t_event_assign_raw%eventFirstDateTime = tmp_dt%dt
tmp_dt = t_datetime(lastDate)
t_event_assign_raw%eventLastDateTime = tmp_dt%dt
tmp_td = t_timedelta(interval)
t_event_assign_raw%eventInterval = tmp_td%td
IF (PRESENT(offset)) THEN
t_event_assign_raw%eventOffset = t_timedelta(offset)
tmp_td = t_timedelta(offset)
ELSE
t_event_assign_raw%eventOffset = t_timedelta(zeroOffset)
tmp_td = t_timedelta(zeroOffset)
ENDIF
t_event_assign_raw%triggeredPreviousEventDateTime = t_event_assign_raw%getEventFirstTriggerDateTime()
t_event_assign_raw%triggerNextEventDateTime = t_event_assign_raw%getEventFirstTriggerDateTime()
ASSOCIATE( intvl => t_event_assign_raw%eventInterval%td )
t_event_assign_raw%neverTriggerEvent = &
& (intvl%year == 0_c_int64_t) .AND. &
& ALL([intvl%month, intvl%day, intvl%hour, intvl%minute, intvl%second, intvl%ms] == 0)
END ASSOCIATE
t_event_assign_raw%eventOffset = tmp_td%td
tmp_dt = t_event_assign_raw%getEventFirstTriggerDateTime()
t_event_assign_raw%triggeredPreviousEventDateTime = tmp_dt%dt
tmp_dt = t_event_assign_raw%getEventFirstTriggerDateTime()
t_event_assign_raw%triggerNextEventDateTime = tmp_dt%dt
! if _> copy
intvl = t_event_assign_raw%eventInterval
t_event_assign_raw%neverTriggerEvent = &
& (intvl%year == 0_c_int64_t) .AND. &
& ALL([intvl%month, intvl%day, intvl%hour, intvl%minute, intvl%second, intvl%ms] == 0)
t_event_assign_raw%triggerCurrentEvent = .FALSE.
t_event_assign_raw%eventisFirstInDay = .FALSE.
......@@ -59,26 +72,34 @@
CHARACTER(len=4) :: zeroOffset = "PT0S"
TYPE(t_datetime) :: tmp_dt
TYPE(t_timedelta) :: tmp_td
TYPE(timedelta) :: intvl
NULLIFY(t_event_assign_types%nextEventInGroup)
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
t_event_assign_types%eventReferenceDateTime = referenceDate%dt
t_event_assign_types%eventFirstDateTime = firstDate%dt
t_event_assign_types%eventLastDateTime = lastDate%dt
t_event_assign_types%eventInterval = interval%td
IF (PRESENT(offset)) THEN
t_event_assign_types%eventOffset = offset
t_event_assign_types%eventOffset = offset%td
ELSE
t_event_assign_types%eventOffset = t_timedelta(zeroOffset)
tmp_td = t_timedelta(zeroOffset)
t_event_assign_types%eventOffset = tmp_td%td
ENDIF
t_event_assign_types%triggeredPreviousEventDateTime = t_event_assign_types%getEventFirstTriggerDateTime()
t_event_assign_types%triggerNextEventDateTime = t_event_assign_types%getEventFirstTriggerDateTime()
tmp_dt = t_event_assign_types%getEventFirstTriggerDateTime()
t_event_assign_types%triggeredPreviousEventDateTime = tmp_dt%dt
tmp_dt = t_event_assign_types%getEventFirstTriggerDateTime()
t_event_assign_types%triggerNextEventDateTime = tmp_dt%dt
ASSOCIATE( intvl => t_event_assign_types%eventInterval%td )
t_event_assign_types%neverTriggerEvent = &
& (intvl%year == 0_c_int64_t) .AND. &
& ALL([intvl%month, intvl%day, intvl%hour, intvl%minute, intvl%second, intvl%ms] == 0)
END ASSOCIATE
intvl = t_event_assign_types%eventInterval
t_event_assign_types%neverTriggerEvent = &
& (intvl%year == 0_c_int64_t) .AND. &
& ALL([intvl%month, intvl%day, intvl%hour, intvl%minute, intvl%second, intvl%ms] == 0)
t_event_assign_types%triggerCurrentEvent = .FALSE.
t_event_assign_types%eventisFirstInDay = .FALSE.
......@@ -102,27 +123,23 @@
CLASS(t_event), INTENT(IN) :: this
TYPE(t_datetime) :: result_dt
!
TYPE(c_ptr) :: c_pointer,tmp_evFirstDateTime, tmp_evOffset, tmp_evInterval, &
& tmp_evReferenceDateTime
TYPE(datetime), TARGET :: tmp_evFirstDateTime, tmp_evReferenceDateTime
TYPE(timedelta), TARGET :: tmp_evOffset, tmp_evInterval
TYPE(c_ptr) :: c_pointer
TYPE(datetime), POINTER :: tmp_dt
tmp_evFirstDateTime = this%eventFirstDateTime%get_c_pointer()
tmp_evOffset = this%eventOffset%get_c_pointer()
tmp_evInterval = this%eventInterval%get_c_pointer()
tmp_evReferenceDateTime = this%eventReferenceDateTime%get_c_pointer()
tmp_evFirstDateTime = this%eventFirstDateTime
tmp_evOffset = this%eventOffset
tmp_evInterval = this%eventInterval
tmp_evReferenceDateTime = this%eventReferenceDateTime
tmp_evFirstDateTime = this%eventFirstDateTime
c_pointer = this%eventFirstDateTime%get_c_pointer()
c_pointer = my_geteventfirsttriggerdatetime(tmp_evFirstDateTime, tmp_evInterval, tmp_evOffset, &
& tmp_evReferenceDateTime, c_pointer)
c_pointer = my_geteventfirsttriggerdatetime(C_LOC(tmp_evFirstDateTime), C_LOC(tmp_evInterval), C_LOC(tmp_evOffset), &
& C_LOC(tmp_evReferenceDateTime), c_pointer)
CALL C_F_POINTER(c_pointer, tmp_dt)
result_dt%dt = tmp_dt
IF (C_ASSOCIATED(c_pointer)) CALL my_deallocatedatetime(c_pointer)
IF (C_ASSOCIATED(tmp_evFirstDateTime)) CALL my_deallocatedatetime(tmp_evFirstDateTime)
IF (C_ASSOCIATED(tmp_evOffset)) CALL my_deallocatetimedelta(tmp_evOffset)
IF (C_ASSOCIATED(tmp_evInterval)) CALL my_deallocatetimedelta(tmp_evInterval)
IF (C_ASSOCIATED(tmp_evReferenceDateTime)) CALL my_deallocatedatetime(tmp_evReferenceDateTime)
END FUNCTION t_event_getEventFirstTriggerDateTime
......@@ -153,19 +170,19 @@
FUNCTION t_event_getFirstDatetime (this) RESULT(res)
TYPE(t_datetime) :: res
CLASS(t_event) :: this
res = this%eventFirstDateTime
res%dt = 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
res%td = 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
res%dt = this%eventLastDateTime
END FUNCTION t_event_getLastDatetime
FUNCTION t_event_getNextOccurrenceDatetime(this, query_start_dt) RESULT(res)
......@@ -173,90 +190,72 @@
CLASS(t_event) :: this
TYPE(t_datetime), INTENT(IN), OPTIONAL :: query_start_dt
!
TYPE(datetime), POINTER :: dt_tmp
TYPE(c_ptr) :: tmp_dt, tmp_evLastDateTime, tmp_evInterval
TYPE(c_ptr) :: event_triggerNextEventDateTime, c_pointer1
LOGICAL(c_bool) :: event_nextEventIsFirst
res = this%triggerNextEventDateTime
TYPE(datetime), TARGET :: tmp_dt, tmp_evLastDateTime
TYPE(timedelta), TARGET :: tmp_evInterval
TYPE(datetime), TARGET :: event_triggerNextEventDateTime
LOGICAL(c_bool) :: event_nextEventIsFirst
TYPE(c_ptr) :: c_pointer
TYPE(datetime), POINTER :: dt_tmp
IF (PRESENT(query_start_dt)) THEN
! if a start for our query is given, invoke
! "my_gettriggernexteventatdatetime":
! --- copy-in:
c_pointer1 = res%get_c_pointer()
tmp_dt = query_start_dt%get_c_pointer()
tmp_evLastDateTime = this%eventLastDateTime%get_c_pointer()
tmp_evInterval = this%eventInterval%get_c_pointer()
tmp_dt = query_start_dt%dt
tmp_evLastDateTime = this%eventLastDateTime
tmp_evInterval = this%eventInterval
event_nextEventIsFirst = this%nextEventIsFirst
event_triggerNextEventDateTime = c_null_ptr
event_triggerNextEventDateTime = this%triggerNextEventDateTime%get_c_pointer()
event_triggerNextEventDateTime = this%triggerNextEventDateTime
! --- call C routine:
CALL my_gettriggernexteventatdatetimeraw( &
& tmp_evLastDateTime, event_nextEventIsFirst, &
& event_triggerNextEventDateTime, tmp_evInterval, &
& tmp_dt, c_pointer1)
! --- copy-out:
CALL C_F_POINTER(c_pointer1, dt_tmp)
res%dt = dt_tmp
CALL my_gettriggernexteventatdatetimeraw( &
& C_LOC(tmp_evLastDateTime), event_nextEventIsFirst, &
& C_LOC(event_triggerNextEventDateTime), C_LOC(tmp_evInterval), &
& C_LOC(tmp_dt), c_pointer)
IF (C_ASSOCIATED(event_triggerNextEventDateTime)) THEN
CALL C_F_POINTER(event_triggerNextEventDateTime, dt_tmp)
this%triggerNextEventDateTime%dt = dt_tmp
END IF
CALL C_F_POINTER(c_pointer, dt_tmp)
this%triggerNextEventDateTime = dt_tmp
! --- clean up:
CALL my_deallocatedatetime(tmp_dt)
IF (C_ASSOCIATED(tmp_evLastDateTime)) CALL my_deallocatedatetime(tmp_evLastDateTime)
IF (C_ASSOCIATED(tmp_evInterval)) CALL my_deallocatetimedelta(tmp_evInterval)
IF (C_ASSOCIATED(event_triggerNextEventDateTime )) &
& CALL my_deallocatedatetime(event_triggerNextEventDateTime )
CALL my_deallocatedatetime(c_pointer1)
END IF
res%dt = 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
res%dt = this%triggeredPreviousEventDateTime
END FUNCTION t_event_getPrevOccurrenceDatetime
FUNCTION t_event_is_active(this, my_datetime, plus_slack, minus_slack) result(ret)
CLASS(t_event), TARGET :: this
TYPE(t_datetime) :: my_datetime
TYPE(t_timedelta), OPTIONAL :: plus_slack
TYPE(t_timedelta), OPTIONAL :: minus_slack
TYPE(c_ptr) :: tmp_dt, tmp_plus, tmp_minus, tmp_evFirstDateTime, tmp_evLastDateTime, tmp_evInterval
LOGICAL(c_bool) :: event_neverTriggerEvent, event_triggerCurrentEvent, event_eventisFirstInDay, &
event_eventisFirstInMonth, event_eventisFirstInYear, event_eventisLastInDay, &
event_eventisLastInMonth, event_eventisLastInYear, event_nextEventIsFirst, &
event_lastEventWasFinal, ret
TYPE(c_ptr) :: event_triggerNextEventDateTime, &
event_eventsLastEvaluationDateTime, &
event_triggeredPreviousEventDateTime
TYPE(datetime), POINTER :: dt_tmp
! --- copy-in:
TYPE(datetime), TARGET :: event_triggerNextEventDateTime, &
& event_eventsLastEvaluationDateTime, &
& event_triggeredPreviousEventDateTime
TYPE(datetime), TARGET :: tmp_dt, tmp_evFirstDateTime, tmp_evLastDateTime
TYPE(timedelta), TARGET :: tmp_plus, tmp_minus, tmp_evInterval
tmp_dt = my_datetime%get_c_pointer()
tmp_evFirstDateTime = this%eventFirstDateTime%get_c_pointer()
tmp_evLastDateTime = this%eventLastDateTime%get_c_pointer()
tmp_evInterval = this%eventInterval%get_c_pointer()
tmp_dt = my_datetime%dt
tmp_evFirstDateTime = this%eventFirstDateTime
tmp_evLastDateTime = this%eventLastDateTime
tmp_evInterval = this%eventInterval
tmp_plus = c_null_ptr
tmp_minus = c_null_ptr
IF (PRESENT(plus_slack)) tmp_plus = plus_slack%get_c_pointer()
IF (PRESENT(minus_slack)) tmp_minus = minus_slack%get_c_pointer()
IF (PRESENT(plus_slack)) tmp_plus = plus_slack%td
IF (PRESENT(minus_slack)) tmp_minus = minus_slack%td
event_neverTriggerEvent = this%neverTriggerEvent
event_triggerCurrentEvent = this%triggerCurrentEvent
......@@ -269,37 +268,30 @@
event_nextEventIsFirst = this%nextEventIsFirst
event_lastEventWasFinal = this%lastEventWasFinal
event_triggerNextEventDateTime = c_null_ptr
event_eventsLastEvaluationDateTime = c_null_ptr
event_triggeredPreviousEventDateTime = c_null_ptr
event_triggerNextEventDateTime = this%triggerNextEventDateTime%get_c_pointer()
event_eventsLastEvaluationDateTime = this%eventsLastEvaluationDateTime%get_c_pointer()
event_triggeredPreviousEventDateTime = this%triggeredPreviousEventDateTime%get_c_pointer()
! --- call C routine:
ret = my_isCurrentEventActiveRaw(tmp_dt, & ! in
& tmp_evFirstDateTime, & ! in
& tmp_evLastDateTime, & ! in
& tmp_evInterval, & ! in
& tmp_plus, & ! in
& tmp_minus, & ! in
& event_neverTriggerEvent, & ! inout
& event_triggerCurrentEvent, & ! inout
& event_eventisFirstInDay, & ! inout
& event_eventisFirstInMonth, & ! inout
& event_eventisFirstInYear, & ! inout
& event_eventisLastInDay, & ! inout
& event_eventisLastInMonth, & ! inout
& event_eventisLastInYear, & ! inout
& event_nextEventIsFirst, & ! inout
& event_lastEventWasFinal, & ! inout
& event_eventsLastEvaluationDateTime, & ! inout
& event_triggerNextEventDateTime, & ! inout
& event_triggeredPreviousEventDateTime) ! inout
! --- copy-out:
event_triggerNextEventDateTime = this%triggerNextEventDateTime
event_eventsLastEvaluationDateTime = this%eventsLastEvaluationDateTime
event_triggeredPreviousEventDateTime = this%triggeredPreviousEventDateTime
ret = my_isCurrentEventActiveRaw(C_LOC(tmp_dt), & ! in
& C_LOC(tmp_evFirstDateTime), & ! in
& C_LOC(tmp_evLastDateTime), & ! in
& C_LOC(tmp_evInterval), & ! in
& C_LOC(tmp_plus), & ! in
& C_LOC(tmp_minus), & ! in
& event_neverTriggerEvent, & ! inout
& event_triggerCurrentEvent, & ! inout
& event_eventisFirstInDay, & ! inout
& event_eventisFirstInMonth, & ! inout
& event_eventisFirstInYear, & ! inout
& event_eventisLastInDay, & ! inout
& event_eventisLastInMonth, & ! inout
& event_eventisLastInYear, & ! inout
& event_nextEventIsFirst, & ! inout
& event_lastEventWasFinal, & ! inout
& C_LOC(event_eventsLastEvaluationDateTime), & ! inout
& C_LOC(event_triggerNextEventDateTime), & ! inout
& C_LOC(event_triggeredPreviousEventDateTime)) ! inout
this%neverTriggerEvent = event_neverTriggerEvent
this%triggerCurrentEvent = event_triggerCurrentEvent
......@@ -312,35 +304,6 @@
this%nextEventIsFirst = event_nextEventIsFirst
this%lastEventWasFinal = event_lastEventWasFinal
IF (C_ASSOCIATED(event_triggerNextEventDateTime)) THEN
CALL C_F_POINTER(event_triggerNextEventDateTime, dt_tmp)
this%triggerNextEventDateTime%dt = dt_tmp
END IF
IF (C_ASSOCIATED(event_eventsLastEvaluationDateTime)) THEN
CALL C_F_POINTER(event_eventsLastEvaluationDateTime, dt_tmp)
this%eventsLastEvaluationDateTime%dt = dt_tmp
END IF
IF (C_ASSOCIATED(event_triggeredPreviousEventDateTime)) THEN
CALL C_F_POINTER(event_triggeredPreviousEventDateTime, dt_tmp)
this%triggeredPreviousEventDateTime%dt = dt_tmp
END IF
! --- clean up:
CALL my_deallocatedatetime(tmp_dt)
IF (C_ASSOCIATED(tmp_plus)) CALL my_deallocatetimedelta(tmp_plus)
IF (C_ASSOCIATED(tmp_minus)) CALL my_deallocatetimedelta(tmp_minus)
IF (C_ASSOCIATED(tmp_evFirstDateTime)) CALL my_deallocatedatetime(tmp_evFirstDateTime)
IF (C_ASSOCIATED(tmp_evLastDateTime)) CALL my_deallocatedatetime(tmp_evLastDateTime)
IF (C_ASSOCIATED(tmp_evInterval)) CALL my_deallocatetimedelta(tmp_evInterval)
IF (C_ASSOCIATED(event_triggerNextEventDateTime )) &
& CALL my_deallocatedatetime(event_triggerNextEventDateTime )
IF (C_ASSOCIATED(event_eventsLastEvaluationDateTime )) &
& CALL my_deallocatedatetime(event_eventsLastEvaluationDateTime )
IF (C_ASSOCIATED(event_triggeredPreviousEventDateTime)) &
& CALL my_deallocatedatetime(event_triggeredPreviousEventDateTime)
END FUNCTION t_event_is_active
! ================================================================================
......
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