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

    End Interface

    contains

    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 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 setInput(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 = "in"//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 setInput

    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)
        c_string=c_null_ptr
        ! string = trim(string)
        ! print *,len_trim(string), "chars read."
        ! print *,string(1:l)
        ! getData2=string
    END SUBROUTINE getData

    SUBROUTINE getData2(string) !result(string)
        use iso_c_binding, only: c_char,c_ptr,c_f_pointer,c_null_ptr,c_loc
        ! character(:),allocatable :: getData2
        character(len=:,kind=c_char),allocatable :: string
        integer :: string_shape(1)
        type(c_ptr) :: c_string
        TYPE(FString), TARGET :: f_str
        integer::l
        ! print *,"reading data (getData2)"
        call getData_C_bystr(c_loc(f_str))
        ! CALL MOVE_ALLOC(f_str%item, string)
        string = trim(buffer)
        ! string = c_str
        ! len = int(c_len,kind=kind(len))
        ! string_shape(1) =  l! int(l,kind=kind(integer))
        ! if(.not. allocated(string)) allocate(character(l) :: string)
        ! call c_f_pointer(c_string, string, string_shape)
        ! c_string=c_null_ptr
        ! print *,len_trim(string), "chars read."
        ! print *,string(1:l)
    END SUBROUTINE getData2

    SUBROUTINE getData3(key,string)
        use iso_c_binding, only: c_char,c_ptr,c_f_pointer,c_null_ptr,c_loc
        ! character(:),allocatable :: getData2
        character(len=*) :: key
        character(len=:),allocatable :: string
        character(len=100) :: filename
        integer::iostat
        ! print *,"reading data (getData2)"
        filename = "/var/tmp/"//key
        call getData_C_byfile()
        open(unit=10, file=trim(filename)//".txt", status='old', action='read', iostat=iostat)
        if (iostat /= 0) then
            write(*, '(A)', advance='no') "Failed to open the file."
            stop
        end if
        ! Read the content of the file into the string
        read(10, '(A)', iostat=iostat) string
        if (iostat /= 0) then
            write(*, '(A)', advance='no') "Failed to read the file."
            stop
        end if
        
        ! Close the file
        close(10)
    END SUBROUTINE getData3
    
    SUBROUTINE set_fortran_string(fstring_ptr, length, str)  BIND(C, NAME='set_fortran_string')
      USE, INTRINSIC :: ISO_C_BINDING, ONLY: C_PTR, C_CHAR, C_INT, C_F_POINTER
      TYPE(C_PTR), INTENT(IN), VALUE :: fstring_ptr
      INTEGER(C_INT), INTENT(IN), VALUE :: length
      CHARACTER(KIND=C_CHAR), INTENT(IN) :: str(length)
      ! Fortran pointer to the object referenced by fstring_ptr that 
      ! holds the deferred length character component.
      TYPE(FString), POINTER :: f_str
      character(:),allocatable :: string
      INTEGER :: i
      integer :: string_shape(1)
      !****
      ! Associate the Fortran pointer with the object referenced by the 
      ! C address.
      string_shape(1) = length
      allocate(character(length) :: string)
      CALL C_F_POINTER(fstring_ptr, string,string_shape)
      ! Allocate the deferred length component to the given length.
    !   deallocate(f_str%item)
    !   ALLOCATE(CHARACTER(length) :: f_str%item)
      ! Copy over the data.
    !   FORALL (i=1:length) f_str%item(i:i) = str(i)
      buffer(1:length) = string(1:length)
      buffer(length+1:20000) = ' '
    END SUBROUTINE set_fortran_string

END Module RedisInterface