WIP: Event generic

This branch replaces the former, rather slow isCurrentEventActive query by a faster implementation based on large integer division using base 1200.

src/libmtime.f90

@@ -120,16 +120,18 @@ MODULE mtime_juliandelta
 
 CONTAINS
 
-  FUNCTION newJuliandelta(sign,day, ms, errno) RESULT(ret_juliandelta) !OK-TESTED.
+  FUNCTION newJuliandelta(dsign,day, ms, errno) RESULT(ret_juliandelta) !OK-TESTED.
     TYPE(juliandelta), POINTER :: ret_juliandelta
-    CHARACTER(c_char),  INTENT(in) :: sign
+    CHARACTER(len=*), INTENT(in) :: dsign
     INTEGER(c_int64_t), INTENT(in) :: day
     INTEGER(c_int64_t), INTENT(in) :: ms
     type(c_ptr)                    :: c_pointer
     integer, optional              :: errno
+    character(c_char) ::c_sign
 
     IF (PRESENT(errno)) errno = 0
-    c_pointer = my_newjuliandelta(sign,day, ms)
+    c_sign = dsign(1:1)
+    c_pointer = my_newjuliandelta(c_sign,day, ms)
     IF ((.NOT. c_associated(c_pointer)) .AND. PRESENT(errno)) errno = 1 * 100 + 1
     CALL c_f_pointer(c_pointer, ret_juliandelta)
   END FUNCTION newJuliandelta
@@ -2920,18 +2922,20 @@ contains
     integer,             optional          :: errno
     type(timedelta),     pointer, optional :: plus_slack
     type(timedelta),     pointer, optional :: minus_slack
-    integer :: tmp_errno
+    INTEGER :: res_errno, tmp_errno
 
     allocate(ret_event)
+    ret_event%ev_basic => NULL()
+    ret_event%ev_std   => NULL()
+
     ret_event%ev_basic => newBasicEvent(name, referenceDate, firstdate, &
-         &                              lastDate, interval, tmp_errno,  &
+         &                              lastDate, interval, res_errno,  &
          &                              plus_slack, minus_slack)
-    if (tmp_errno /= 0) then
-       ret_event%ev_std => newEvent(name, referenceDate, firstdate, lastDate, interval, errno=errno)
-       if (errno /= 0) then
+    if (res_errno /= 0) then
+       ret_event%ev_std => newEvent(name, referenceDate, firstdate, lastDate, interval, errno=tmp_errno)
+       if (tmp_errno /= 0) then
           deallocate(ret_event)
           ret_event => NULL()
-          if (present(errno))  errno = tmp_errno
        end if
     end if
 
@@ -2941,6 +2945,8 @@ contains
        if (present(plus_slack))   ret_event%plus_slack  => plus_slack
        if (present(minus_slack))  ret_event%minus_slack => minus_slack
     end if
+
+    IF (PRESENT(errno))  errno = res_errno
   end function newGenericEventWithDataTypes
 
   !>