SimulationCore2/Redis/Redis_Interface.i90

# 1 "/home/admin/SimulationCore2/Redis/Redis_Interface.f90"
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