aboutsummaryrefslogtreecommitdiff
path: root/src/clp_interface_utils.f90
diff options
context:
space:
mode:
Diffstat (limited to 'src/clp_interface_utils.f90')
-rw-r--r--src/clp_interface_utils.f9085
1 files changed, 85 insertions, 0 deletions
diff --git a/src/clp_interface_utils.f90 b/src/clp_interface_utils.f90
new file mode 100644
index 0000000..a6c22c7
--- /dev/null
+++ b/src/clp_interface_utils.f90
@@ -0,0 +1,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