Module RedisInterface use iso_c_binding, only: c_char ! USE Kinds, ONLY: rk, ck TYPE FString CHARACTER(KIND=c_char,LEN=:),allocatable :: item END TYPE FString character(len=20000)::buffer Interface SUBROUTINE addnums(a, b) BIND(C,name='addnums') USE, INTRINSIC :: ISO_C_BINDING, ONLY: C_INT IMPLICIT NONE INTEGER(C_INT) :: a, b END SUBROUTINE addnums SUBROUTINE initConnection_C(address,port,password,datakey,status) BIND(C, name='initConnection') use iso_c_binding, only: c_char,c_int character(kind=c_char) :: address(*) integer(kind=c_int)::port,status character(kind=c_char) :: password(*),datakey(*) END SUBROUTINE initConnection_C SUBROUTINE setData_C(part,str) BIND(C,name='setData') use iso_c_binding, only: c_char character(kind=c_char) :: str(*) character(kind=c_char) :: part(*) END SUBROUTINE setData_C FUNCTION getData_C(len) BIND(C,name='getData') use iso_c_binding, only: c_ptr,c_int integer(kind=c_int)::len type(c_ptr) :: getData_C END FUNCTION getData_C SUBROUTINE getData_C_bystr(str) BIND(C,name='getData_bystr') use iso_c_binding, only: c_ptr,c_int,c_char type(c_ptr) :: str END SUBROUTINE getData_C_bystr SUBROUTINE getData_C_byfile() BIND(C,name='getData_byfile') END SUBROUTINE getData_C_byfile SUBROUTINE deallocateData() BIND(C, name='deallocData') END SUBROUTINE deallocateData SUBROUTINE listenToChannel_C() BIND(C,name='listenTochannel') END SUBROUTINE listenToChannel_C SUBROUTINE publishMessageToChannel_C(str) BIND(C,name='publishMessageToChannel') use iso_c_binding, only: c_char character(kind=c_char) :: str(*) END SUBROUTINE publishMessageToChannel_C ! Fortran subroutine to deallocate the memory SUBROUTINE deallocate_c_string(c_pointer) BIND(C, NAME='free') use iso_c_binding, only: c_char,c_ptr ! IMPORT :: C_PTR TYPE(c_ptr) :: c_pointer ! No need for additional code here; the BIND attribute takes care of calling the C free function END SUBROUTINE deallocate_c_string SUBROUTINE getData2_C(result,len) BIND(C, name='getData2') USE ISO_C_BINDING, ONLY: C_PTR, C_INT TYPE(C_PTR),VALUE :: result INTEGER(C_INT) :: len END SUBROUTINE getData2_C End Interface contains ! Fortran subroutine to deallocate the memory ! SUBROUTINE deallocate_c_string(c_ptr) BIND(C, NAME='free') ! USE, INTRINSIC :: ISO_C_BINDING, ONLY: C_PTR, C_FUNPTR, C_F_POINTER ! IMPORT :: C_PTR, C_FUNPTR, C_F_POINTER ! TYPE(C_PTR), INTENT(IN) :: c_ptr ! TYPE(C_FUNPTR) :: free_func ! INTERFACE ! SUBROUTINE c_free(ptr) BIND(C, NAME='free') ! IMPORT :: C_PTR ! TYPE(C_PTR), VALUE :: ptr ! END SUBROUTINE c_free ! END INTERFACE ! free_func = C_FUNLOC(c_free) ! CALL C_F_POINTER(c_ptr, free_func) ! END SUBROUTINE deallocate_c_string SUBROUTINE initConnection(address,port,password, datakey,status) use iso_c_binding, only: c_null_char,c_char ! use json_module character(len=*) :: password,address,datakey integer::port,status character(len=:),allocatable::c_address,c_password,c_datakey c_datakey = datakey//c_null_char c_password = password//c_null_char c_address = address//c_null_char call initConnection_C(c_address,port,c_password,c_datakey,status) ! print *,"returned to initConnection" END SUBROUTINE initConnection SUBROUTINE setState(str) use SimulationVariables use iso_c_binding, only: c_null_char character(len=*):: str character(len=len_trim(str)+1)::c_str character(len=6)::part part = "state"//c_null_char c_str = str//c_null_char if(log_level>4) print *,"setting Data: ",len_trim(str) call setData_C(part,c_str) END SUBROUTINE setState SUBROUTINE setData(str) use SimulationVariables use iso_c_binding, only: c_null_char character(len=*):: str character(len=len_trim(str)+1)::c_str character(len=4)::part part = "out"//c_null_char c_str = str//c_null_char if(log_level>4) print *,"setting Data: ",len_trim(str) call setData_C(part,c_str) END SUBROUTINE setData SUBROUTINE getData(string,len) use iso_c_binding, only: c_char,c_ptr,c_f_pointer,c_null_ptr,c_int ! character(:),allocatable :: getData2 character(:),allocatable :: string integer :: string_shape(1) integer(c_int):: len type(c_ptr) :: c_string integer::l l = 30000 string_shape(1) = l!int(l,kind=kind(Integer)) ! print *,"reading data l=",l if(.not. allocated(string)) then print *,"allocate string" allocate(character(l) :: string) endif len = l c_string = getData_C(len) ! print *,"data read. l=",l ! len = int(c_len,kind=kind(len)) call c_f_pointer(c_string, string, string_shape) ! call deallocateData() c_string=c_null_ptr ! call deallocate_c_string(c_string) ! string = trim(string) ! print *,len_trim(string), "chars read." ! print *,string(1:l) ! getData2=string END SUBROUTINE getData ! SUBROUTINE getData2(string, len) ! USE ISO_C_BINDING, ONLY: C_PTR, C_INT,c_f_pointer ! CHARACTER(LEN=:), ALLOCATABLE :: string ! INTEGER :: len ! TYPE(C_PTR) :: c_string ! ! Allocate the buffer in Fortran ! ALLOCATE(CHARACTER(LEN=len) :: string) ! ! Call the C function to get the data ! ! CALL getData2_C(c_string) ! ! Copy the data from the C pointer to the Fortran string ! CALL C_F_POINTER(c_string, string, [len]) ! ! Deallocate the C pointer ! CALL deallocate_c_string(c_string) ! ! Trim the string to remove any padding ! string = TRIM(string) ! END SUBROUTINE getData2 subroutine ListenToChannel() print *, "ListenToChannel" call listenToChannel_C() end subroutine ListenToChannel subroutine test() bind (C,name="test") print *, "test function in fortran." end subroutine test subroutine publishMessageToChannel(str) use SimulationVariables use iso_c_binding, only: c_null_char character(len=*):: str character(len=len_trim(str)+1)::c_str if(str .ne. 'ack') then print *, "publishMessageToChannel: ", str endif c_str = str//c_null_char ! if(log_level>4) print *,"Sending message: ",len_trim(str) call publishMessageToChannel_C(c_str) end subroutine publishMessageToChannel END Module RedisInterface