libvhcall-fortran  2.13.0
sample.f
2  INTEGER(8) :: handle
3  INTEGER(8) :: sym
4  INTEGER(8) :: ca, ca2
5  INTEGER(8) :: retval
6  INTEGER :: ir
7  CHARACTER(10) :: str = "Hello"
8  REAL :: val(2,2,3)
9  data val / 1.0,2.0,3.0,4.0,5.0,6.0,7.0,8.0,9.0,10.0,11.0,12.0 /
10  handle = fvhcall_install('./libvhcall.so')
11  ! Case of subroutine(1)
12  sym = fvhcall_find(handle,'VH_SBR1')
13  ca = fvhcall_args_alloc()
14  ir = fvhcall_args_set(ca, fvhcall_intent_inout, 1, str)
15  ir = fvhcall_args_set(ca, fvhcall_intent_in, 2, 10)
16  WRITE(*,*)"VH subroutine INPUT(1) > ",str
17  ir = fvhcall_invoke_with_args(sym, ca)
18  IF (ir==1) THEN
19  WRITE(*,*)"Fail to invoke subroutine"
20  stop(1)
21  ENDIF
22  WRITE(*,*)"VH subroutine OUTPUT(1) > ",str
23  ! Case of subroutine(2)
24  sym = fvhcall_find(handle,'VH_SBR2')
25  ca2 = fvhcall_args_alloc_num(4)
26  ir = fvhcall_args_set(ca2, fvhcall_intent_inout, 1, val)
27  ir = fvhcall_args_set(ca2, fvhcall_intent_in, 2, 2)
28  ! 3rd argument is optional
29  ! IR = FVHCALL_ARGS_SET(CA, FVHCALL_INTENT_IN, 3, 2)
30  ir = fvhcall_args_set(ca2, fvhcall_intent_in, 4, 3)
31  WRITE(*,*)"VH subroutine INPUT(2) > ",val
32  ir = fvhcall_invoke_with_args(sym, ca2)
33  IF (ir==1) THEN
34  WRITE(*,*)"Fail to invoke subroutine"
35  stop(1)
36  ENDIF
37  WRITE(*,*)"VH subroutine OUTPUT(2) > ",val
38  CALL fvhcall_args_free(ca2)
39  ! Case of function
40  sym = fvhcall_find(handle,'VH_MOD::VH_FUNC')
41  CALL fvhcall_args_clear(ca)
42  ir = fvhcall_invoke_with_args(sym, ca, retval)
43  IF (ir==1) THEN
44  WRITE(*,*)"Fail to invoke function"
45  stop(1)
46  ENDIF
47  WRITE(*,*)"VH function return ",retval
48  CALL fvhcall_args_free(ca)
49  ir = fvhcall_uninstall(handle)
50  stop
51  END