libvhcall-fortran  2.11
sample.f
2  INTEGER(8) :: handle
3  INTEGER(8) :: sym
4  INTEGER(8) :: ca
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  ca = fvhcall_args_alloc()
26  ir = fvhcall_args_set(ca, fvhcall_intent_inout, 1, val)
27  ir = fvhcall_args_set(ca, fvhcall_intent_in, 2, 2)
28  ir = fvhcall_args_set(ca, fvhcall_intent_in, 3, 2)
29  ir = fvhcall_args_set(ca, fvhcall_intent_in, 4, 3)
30  WRITE(*,*)"VH subroutine INPUT(2) > ",val
31  ir = fvhcall_invoke_with_args(sym, ca)
32  IF (ir==1) THEN
33  WRITE(*,*)"Fail to invoke subroutine"
34  stop(1)
35  ENDIF
36  WRITE(*,*)"VH subroutine OUTPUT(2) > ",val
37  ! Case of function
38  sym = fvhcall_find(handle,'VH_MOD::VH_FUNC')
39  CALL fvhcall_args_clear(ca)
40  ir = fvhcall_invoke_with_args(sym, ca, retval)
41  IF (ir==1) THEN
42  WRITE(*,*)"Fail to invoke function"
43  stop(1)
44  ENDIF
45  WRITE(*,*)"VH function return ",retval
46  CALL fvhcall_args_free(ca)
47  ir = fvhcall_uninstall(handle)
48  stop
49  END