# 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 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