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

Modularized Fortran interface and added the event parts. Chnaged 

sequence of event struct.
parent 6fafb910
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
include/event_handling.h
+ 1
− 1
View file @ 9102a28f
......@@ -33,9 +33,9 @@ removeEventFromEventGroup(char* eventName, struct _eventGroup* eventGroupObj);
struct _event
{
char* eventName;
//Auto generated.
int64_t eventId;
char* eventName;
//Anchor date.
struct _datetime* eventReferenceDateTime;
......
src/libmtime.f90
+ 191
− 95
View file @ 9102a28f
......@@ -622,7 +622,7 @@ module mtime_julianday
integer, parameter :: max_julianday_str_len = 32
!
type, bind(c) :: julianday
integer(c_int64_t) :: year
integer(c_int64_t) :: day
integer(c_int64_t) :: ms
end type julianday
!
......@@ -681,121 +681,217 @@ end module mtime_julianday
!>
!!
!!___________________________________________________________________________________________________________
module libmtime
!
use, intrinsic :: iso_c_binding, only: c_int, c_int64_t, c_bool, c_ptr, c_char
module mtime_events
!
use mtime_calendar
use mtime_date
use mtime_time
use mtime_datetime
use mtime_timedelta
use, intrinsic :: iso_c_binding, only: c_int64_t, c_char, c_null_char, c_bool, c_ptr, c_loc, c_f_pointer
!
implicit none
!
public
!______________________________________________________________________________________________
! constants:
!
integer, parameter :: max_eventname_str_len = 132
integer, parameter :: max_groupname_str_len = 132
private
!
enum, bind(c)
enumerator :: failure = 0
enumerator :: datetime_match = 1
enumerator :: duration_match = 2
end enum
public :: max_eventname_str_len
public :: event
public :: newEvent
public :: deallocateEvent
public :: eventToString
!
!______________________________________________________________________________________________
! types:
type, bind(c) :: eventgroup
integer(c_int64_t) :: eventgroupid
type(c_ptr) :: eventgroupname
type(c_ptr) :: eventlist
end type eventgroup
integer, parameter :: max_eventname_str_len = 132
!
type, bind(c) :: event
type(c_ptr) :: eventname
integer(c_int64_t) :: eventid
type(c_ptr) :: eventreferencedatetime
type(c_ptr) :: eventfirstdatetime
type(c_ptr) :: eventlastdatetime
type(c_ptr) :: eventinterval
logical(c_bool) :: triggercurrentevent
type(c_ptr) :: triggernexteventdatetime
type(c_ptr) :: triggeredpreviouseventdatetime
integer(c_int64_t) :: eventId
type(c_ptr) :: eventName
type(c_ptr) :: eventReferenceDatetime
type(c_ptr) :: eventFirstDatetime
type(c_ptr) :: eventLastDatetime
type(c_ptr) :: eventInterval
logical(c_bool) :: triggerCurrentEvent
logical(c_bool) :: nextEventIsFirst
logical(c_bool) :: eventisFirstInDay
logical(c_bool) :: eventisFirstInMonth
logical(c_bool) :: eventisFirstInYear
logical(c_bool) :: eventisLastInDay
logical(c_bool) :: eventisLastInMonth
logical(c_bool) :: eventisLastInYear
type(c_ptr) :: triggerNextEventDateTime
type(c_ptr) :: triggeredPreviousEventDateTime
end type event
!_____________________________________________________________________________________________
!
interface
! event group routines:
!
! void deallocateeventgroup(struct _eventgroup* eventgroup);
subroutine deallocateeventgroup(eventgroup) bind(c)
import :: c_ptr
type(c_ptr), value :: eventgroup
end subroutine deallocateeventgroup
!
! void deallocateevent(struct _event* event);
subroutine deallocateevent(event) bind(c)
import :: c_ptr
type(c_ptr), value :: event
end subroutine deallocateevent
!
! void setevent(struct _event* event);
subroutine setevent(event) bind(c)
function my_newevent(name, referenceDate, firstdate, lastDate, interval) result(c_pointer) bind(c, name='newEvent')
import :: c_char, c_ptr
type(c_ptr) :: c_pointer
character(c_char), dimension(*) :: name
character(c_char), dimension(*) :: referenceDate
character(c_char), dimension(*) :: firstDate
character(c_char), dimension(*) :: lastDate
character(c_char), dimension(*) :: interval
end function my_newevent
!
subroutine my_deallocateevent(ev) bind(c,name='deallocateEvent')
import :: c_ptr
type(c_ptr), value :: event
end subroutine setevent
type(c_ptr), value :: ev
end subroutine my_deallocateevent
!
! char* eventtostring(struct _event* event, char* string);
function eventtostring(event, string) bind(c)
function my_eventtostring(my_event, string) result(string_ptr) bind(c, name='eventToString')
import :: c_ptr, c_char
type(c_ptr) :: eventtostring
type(c_ptr), value :: event
type(c_ptr) :: string_ptr
type(c_ptr), value :: my_event
character(c_char), dimension(*) :: string
end function eventtostring
!
! void deallocateeventlist(struct _eventlist* list);
subroutine deallocateeventlist(list) bind(c)
import :: c_ptr
type(c_ptr), value :: list
end subroutine deallocateeventlist
end function my_eventtostring
!
! void deallocatenode(struct _node* node);
subroutine deallocatenode(node) bind(c)
import :: c_ptr
type(c_ptr), value :: node
end subroutine deallocatenode
end interface
!
contains
!
function newEvent(name, referenceDate, firstdate, lastDate, interval) result(ret_event)
type(event), pointer :: ret_event
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
type(c_ptr) :: c_pointer
c_pointer = my_newevent(trim(name)//c_null_char, &
& trim(referenceDate)//c_null_char, &
& trim(firstDate)//c_null_char, &
& trim(lastDate)//c_null_char, &
& trim(interval)//c_null_char)
call c_f_pointer(c_pointer, ret_event)
end function newEvent
!
subroutine deallocateEvent(my_event)
type(event), pointer :: my_event
call my_deallocateevent(c_loc(my_event))
my_event => null()
end subroutine deallocateEvent
!
subroutine eventToString(my_event, string)
type(event), pointer :: my_event
character(len=max_eventname_str_len) :: string
type(c_ptr) :: dummy_ptr
integer :: i
dummy_ptr = my_eventtostring(c_loc(my_event), string)
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)) = ' '
end subroutine eventToString
!
end module mtime_events
!>
!!
!!___________________________________________________________________________________________________________
module mtime_eventgroups
!
use, intrinsic :: iso_c_binding, only: c_int64_t, c_ptr, c_char, c_null_char, c_bool, c_loc, c_f_pointer
!
use mtime_events
!
implicit none
!
private
!
public :: max_groupname_str_len
public :: eventgroup
public :: newEventGroup
public :: deallocateEventGroup
public :: addEventToEventGroup
public :: removeEventFromEventGroup
!
integer, parameter :: max_groupname_str_len = 132
!
type, bind(c) :: eventgroup
integer(c_int64_t) :: eventGroupId;
type(c_ptr) :: eventGroupName;
type(c_ptr) :: eventList
end type eventgroup
!
interface
!
! void deallocate_iso8601_datetime(struct iso8601_datetime* iso8601_datetime);
subroutine deallocate_iso8601_datetime(iso8601_datetime) bind(c)
import :: c_ptr
type(c_ptr), value :: iso8601_datetime
end subroutine deallocate_iso8601_datetime
function my_neweventgroup(name) result(c_pointer) bind(c, name='newEventGroup')
import :: c_char, c_ptr
type(c_ptr) :: c_pointer
character(c_char), dimension(*) :: name
end function my_neweventgroup
!
! void deallocate_iso8601_duration(struct iso8601_duration* iso8601_duration);
subroutine deallocate_iso8601_duration(iso8601_duration) bind(c)
subroutine my_deallocateeventgroup(evgrp) bind(c,name='deallocateEventGroup')
import :: c_ptr
type(c_ptr), value :: iso8601_duration
end subroutine deallocate_iso8601_duration
! status verify_string_datetime(const char* test_string, struct iso8601_datetime* dummy_isodt);
function verify_string_datetime(test_string, dummy_isodt) bind(c)
import :: c_int, c_char, c_ptr
integer(c_int) :: verify_string_datetime
character(c_char), dimension(*) :: test_string
type(c_ptr), value :: dummy_isodt
end function verify_string_datetime
! status verify_string_duration(const char* test_string, struct iso8601_duration* dummy_isod);
function verify_string_duration(test_string, dummy_isod) bind(c)
import :: c_int, c_char, c_ptr
integer(c_int) :: verify_string_duration
character(c_char), dimension(*) :: test_string
type(c_ptr), value :: dummy_isod
end function verify_string_duration
type(c_ptr), value :: evgrp
end subroutine my_deallocateeventgroup
!
function my_addeventtoeventgroup(my_event, my_eventgroup) result(ret) bind(c, name='addNewEventtoEventGroup')
import :: c_bool, c_ptr
logical(c_bool) :: ret
type(c_ptr), value :: my_event
type(c_ptr), value :: my_eventgroup
end function my_addeventtoeventgroup
!
function my_removeeventfromeventgroup(evname, evgrp) result(ret) bind(c, name='removeEventFromEventGroup')
import :: c_bool, c_char, c_ptr
logical(c_bool) :: ret
character(c_char), dimension(*) :: evname
type(c_ptr), value :: evgrp
end function my_removeeventfromeventgroup
!
end interface
!
contains
!
function newEventGroup(name) result(ret_eventgroup)
type(eventgroup), pointer :: ret_eventgroup
character(len=*), intent(in) :: name
type(c_ptr) :: c_pointer
c_pointer = my_neweventgroup(trim(name)//c_null_char)
call c_f_pointer(c_pointer, ret_eventgroup)
end function newEventGroup
!
subroutine deallocateEventGroup(my_eventgroup)
type(eventgroup), pointer :: my_eventgroup
call my_deallocateeventgroup(c_loc(my_eventgroup))
my_eventgroup => null()
end subroutine deallocateEventGroup
!
function addEventToEventGroup(my_event, my_eventGroup) result(ret)
logical :: ret
type(event), pointer :: my_event
type(eventgroup), pointer :: my_eventgroup
ret = my_addeventtoeventgroup(c_loc(my_event), c_loc(my_eventgroup))
end function addEventToEventGroup
!
function removeEventfromEventGroup(my_name, my_eventGroup) result(ret)
logical :: ret
character(len=*), intent(in) :: my_name
type(eventgroup), pointer :: my_eventgroup
ret = my_removeeventfromeventgroup(trim(my_name)//c_null_char, c_loc(my_eventgroup))
end function removeEventFromEventGroup
!
end module mtime_eventgroups
!>
!!
!!___________________________________________________________________________________________________________
module libmtime
!
use, intrinsic :: iso_c_binding, only: c_int, c_int64_t, c_bool, c_ptr, c_char
!
use mtime_calendar
use mtime_date
use mtime_time
use mtime_datetime
use mtime_timedelta
use mtime_events
use mtime_eventgroups
!
implicit none
!
public
!______________________________________________________________________________________________
! constants:
!
enum, bind(c)
enumerator :: failure = 0
enumerator :: datetime_match = 1
enumerator :: duration_match = 2
end enum
!
end module libmtime
test/example.f90
+ 27
− 0
View file @ 9102a28f
......@@ -88,4 +88,31 @@ program example
call resetCalendar()
call event_tests
contains
subroutine event_tests
type(eventgroup), pointer :: outputEventGroup
type(event), pointer :: outputEvent
type(event), pointer :: checkpointEvent
type(event), pointer :: restartEvent
logical :: lret
outputEventGroup => newEventGroup('output driver')
outputEvent => newEvent('output', '2000-01-01T00:00:00', '2010-01-01T00:00:00', '2013-01-01T00:00:00', 'PT06H')
lret = addEventToEventGroup(outputEvent, outputEventGroup)
checkpointEvent => newEvent('checkpoint', '2000-01-01T00:00:00', '2010-01-01T00:00:00', '2013-01-01T00:00:00', 'P05D')
lret = addEventToEventGroup(checkpointEvent, outputEventGroup)
restartEvent => newEvent('output', '2000-01-01T00:00:00', '2010-01-01T00:00:00', '2013-01-01T00:00:00', 'P01M')
lret = addEventToEventGroup(restartEvent, outputEventGroup)
call deallocateEventGroup(outputEventGroup)
end subroutine event_tests
end program example
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