diff options
author | Jeffrey Armstrong <jeffrey.armstrong@approximatrix.com> | 2020-10-15 12:21:00 -0400 |
---|---|---|
committer | Jeffrey Armstrong <jeffrey.armstrong@approximatrix.com> | 2020-10-15 12:21:00 -0400 |
commit | 0522e832700cab5bbf7eeea413d93d68041b9405 (patch) | |
tree | 93de0033bcc185e93136938e88e68547b0478e47 /src/clp_interface_utils.f90 | |
parent | a5fcf00e55a94943c7fbe8f04775e3b986a829fc (diff) | |
download | clp_fortran-0522e832700cab5bbf7eeea413d93d68041b9405.tar.gz clp_fortran-0522e832700cab5bbf7eeea413d93d68041b9405.zip |
Added utilty module for converting to/from C strings. Added some procedures to interface with C routines that accept/return strings.
Diffstat (limited to 'src/clp_interface_utils.f90')
-rw-r--r-- | src/clp_interface_utils.f90 | 85 |
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 |