Simulation Core
Вы не можете выбрать более 25 тем Темы должны начинаться с буквы или цифры, могут содержать дефисы(-) и должны содержать не более 35 символов.
 
 
 
 
 
 

129 строки
4.7 KiB

  1. Module RedisInterface
  2. use iso_c_binding, only: c_char
  3. ! USE Kinds, ONLY: rk, ck
  4. TYPE FString
  5. CHARACTER(KIND=c_char,LEN=:),allocatable :: item
  6. END TYPE FString
  7. character(len=20000)::buffer
  8. Interface
  9. SUBROUTINE addnums(a, b) BIND(C,name='addnums')
  10. USE, INTRINSIC :: ISO_C_BINDING, ONLY: C_INT
  11. IMPLICIT NONE
  12. INTEGER(C_INT) :: a, b
  13. END SUBROUTINE addnums
  14. SUBROUTINE initConnection_C(address,port,password,datakey,status) BIND(C, name='initConnection')
  15. use iso_c_binding, only: c_char,c_int
  16. character(kind=c_char) :: address(*)
  17. integer(kind=c_int)::port,status
  18. character(kind=c_char) :: password(*),datakey(*)
  19. END SUBROUTINE initConnection_C
  20. SUBROUTINE setData_C(part,str) BIND(C,name='setData')
  21. use iso_c_binding, only: c_char
  22. character(kind=c_char) :: str(*)
  23. character(kind=c_char) :: part(*)
  24. END SUBROUTINE setData_C
  25. FUNCTION getData_C(len) BIND(C,name='getData')
  26. use iso_c_binding, only: c_ptr,c_int
  27. integer(kind=c_int)::len
  28. type(c_ptr) :: getData_C
  29. END FUNCTION getData_C
  30. SUBROUTINE getData_C_bystr(str) BIND(C,name='getData_bystr')
  31. use iso_c_binding, only: c_ptr,c_int,c_char
  32. type(c_ptr) :: str
  33. END SUBROUTINE getData_C_bystr
  34. SUBROUTINE getData_C_byfile() BIND(C,name='getData_byfile')
  35. END SUBROUTINE getData_C_byfile
  36. SUBROUTINE deallocateData() BIND(C, name='deallocData')
  37. END SUBROUTINE deallocateData
  38. SUBROUTINE listenToChannel_C() BIND(C,name='listenTochannel')
  39. END SUBROUTINE listenToChannel_C
  40. SUBROUTINE publishMessageToChannel_C(str) BIND(C,name='publishMessageToChannel')
  41. use iso_c_binding, only: c_char
  42. character(kind=c_char) :: str(*)
  43. END SUBROUTINE publishMessageToChannel_C
  44. End Interface
  45. contains
  46. SUBROUTINE initConnection(address,port,password, datakey,status)
  47. use iso_c_binding, only: c_null_char,c_char
  48. ! use json_module
  49. character(len=*) :: password,address,datakey
  50. integer::port,status
  51. character(len=:),allocatable::c_address,c_password,c_datakey
  52. c_datakey = datakey//c_null_char
  53. c_password = password//c_null_char
  54. c_address = address//c_null_char
  55. call initConnection_C(c_address,port,c_password,c_datakey,status)
  56. ! print *,"returned to initConnection"
  57. END SUBROUTINE initConnection
  58. SUBROUTINE setData(str)
  59. use SimulationVariables
  60. use iso_c_binding, only: c_null_char
  61. character(len=*):: str
  62. character(len=len_trim(str)+1)::c_str
  63. character(len=4)::part
  64. part = "out"//c_null_char
  65. c_str = str//c_null_char
  66. if(log_level>4) print *,"setting Data: ",len_trim(str)
  67. call setData_C(part,c_str)
  68. END SUBROUTINE setData
  69. SUBROUTINE getData(string,len)
  70. use iso_c_binding, only: c_char,c_ptr,c_f_pointer,c_null_ptr,c_int
  71. ! character(:),allocatable :: getData2
  72. character(:),allocatable :: string
  73. integer :: string_shape(1)
  74. integer(c_int):: len
  75. type(c_ptr) :: c_string
  76. integer::l
  77. l = 30000
  78. string_shape(1) = l!int(l,kind=kind(Integer))
  79. ! print *,"reading data l=",l
  80. if(.not. allocated(string)) then
  81. print *,"allocate string"
  82. allocate(character(l) :: string)
  83. endif
  84. len = l
  85. c_string = getData_C(len)
  86. ! print *,"data read. l=",l
  87. ! len = int(c_len,kind=kind(len))
  88. call c_f_pointer(c_string, string, string_shape)
  89. c_string=c_null_ptr
  90. ! string = trim(string)
  91. ! print *,len_trim(string), "chars read."
  92. ! print *,string(1:l)
  93. ! getData2=string
  94. END SUBROUTINE getData
  95. subroutine ListenToChannel()
  96. print *, "ListenToChannel"
  97. call listenToChannel_C()
  98. end subroutine ListenToChannel
  99. subroutine test() bind (C,name="test")
  100. print *, "test function in fortran."
  101. end subroutine test
  102. subroutine publishMessageToChannel(str)
  103. use SimulationVariables
  104. use iso_c_binding, only: c_null_char
  105. character(len=*):: str
  106. character(len=len_trim(str)+1)::c_str
  107. if(str .ne. 'ack') print *, "publishMessageToChannel: ", str
  108. c_str = str//c_null_char
  109. ! if(log_level>4) print *,"Sending message: ",len_trim(str)
  110. call publishMessageToChannel_C(c_str)
  111. end subroutine publishMessageToChannel
  112. END Module RedisInterface