1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
|
module clp_interface_utils
implicit none
interface
function c_string_length(cstr) bind(c, name="strlen")
use iso_c_binding
implicit none
type(c_ptr), value::cstr
integer(kind=c_size_t)::c_string_length
end function c_string_length
function c_allocate(b) bind(c, name="malloc")
use iso_c_binding
implicit none
integer(kind=c_size_t), value::b
type(c_ptr)::c_allocate
end function c_allocate
subroutine c_free(p) bind(c, name="free")
use iso_c_binding, only: c_ptr
implicit none
type(c_ptr), value::p
end subroutine c_free
end interface
contains
subroutine populate_fortran_string(cstr, fstr)
use iso_c_binding
implicit none
type(c_ptr), intent(in)::cstr
character(len=*), intent(out)::fstr
character(kind=c_char), dimension(:), pointer::cstr_fpointer
integer::i, n
! Clear the return string
fstr = " "
if(c_associated(cstr)) then
! Obtain a Fortran pointer
call c_f_pointer(cstr, cstr_fpointer, (/ 1 /))
! Calculate the max number of characters to copy
n = min(int(c_string_length(cstr), 4), len(fstr))
! Copy...
do i = 1, n
fstr(i:i) = cstr_fpointer(i)
end do
end if
end subroutine populate_fortran_string
function allocate_and_populate_c_string(fstr) result(c_str_ptr)
use iso_c_binding
implicit none
type(c_ptr)::c_str_ptr
character(len=*), intent(in)::fstr
character(kind=c_char), dimension(:), pointer::cstr
integer::i, n
n = len_trim(fstr)
c_str_ptr = c_allocate(int(n+1, kind=c_size_t))
if(c_associated(c_str_ptr)) then
call c_f_pointer(c_str_ptr, cstr, (/ 1 /))
cstr = c_null_char
do i=1, n
cstr(i) = fstr(i:i)
end do
end if
end function allocate_and_populate_c_string
end module clp_interface_utils
|
