From 0522e832700cab5bbf7eeea413d93d68041b9405 Mon Sep 17 00:00:00 2001 From: Jeffrey Armstrong Date: Thu, 15 Oct 2020 12:21:00 -0400 Subject: Added utilty module for converting to/from C strings. Added some procedures to interface with C routines that accept/return strings. --- src/clp.f90 | 56 ++++++++++++++++++++++++++--- src/clp_interface_utils.f90 | 85 +++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 136 insertions(+), 5 deletions(-) create mode 100644 src/clp_interface_utils.f90 (limited to 'src') diff --git a/src/clp.f90 b/src/clp.f90 index 1e29aae..b6c90bb 100644 --- a/src/clp.f90 +++ b/src/clp.f90 @@ -1,10 +1,13 @@ module clp use iso_c_binding implicit none + interface - function Clp_Version() bind(C,name="Clp_Version") + + ! Version Routines + function Clp_Version_C() bind(C,name="Clp_Version") use iso_c_binding - type(c_ptr) :: Clp_Version + type(c_ptr) :: Clp_Version_C end function function Clp_VersionMajor() bind(C,name="Clp_VersionMajor") use iso_c_binding @@ -18,6 +21,8 @@ module clp use iso_c_binding integer(c_int) :: Clp_VersionRelease end function + + ! Model management function Clp_newModel() bind(C,name="Clp_newModel") use iso_c_binding type(c_ptr) :: Clp_newModel @@ -26,6 +31,8 @@ module clp use iso_c_binding type(c_ptr), value :: model end subroutine + + ! Solver management function ClpSolve_new() bind(C,name="ClpSolve_new") use iso_c_binding type(c_ptr) :: ClpSolve_new @@ -34,6 +41,8 @@ module clp use iso_c_binding type(c_ptr), value :: solve end subroutine + + subroutine Clp_loadProblem(model,numcols,numrows,start, & index,value,collb,colub,obj,rowlb,rowub) bind(C,name="Clp_loadProblem") use iso_c_binding @@ -58,14 +67,16 @@ module clp type(c_ptr), value :: column real(c_double) :: element(*) end subroutine - function Clp_readMps(model,filename,keepNames,ignoreErrors) bind(C,name="Clp_readMps") + + function Clp_readMps_C(model,filename,keepNames,ignoreErrors) bind(C,name="Clp_readMps") use iso_c_binding type(c_ptr), value :: model - character(c_char) :: filename(*) + type(c_ptr), value :: filename integer(c_int), value ::keepNames integer(c_int), value ::ignoreErrors - integer(c_int) :: Clp_readMps + integer(c_int) :: Clp_readMps_C end function + subroutine Clp_copyInIntegerInformation(model,information) bind(C,name="Clp_copyInIntegerInformation") use iso_c_binding type(c_ptr), value :: model @@ -916,4 +927,39 @@ module clp integer(c_int), value ::value end subroutine end interface + +contains + + subroutine Clp_Version(s) + use clp_interface_utils, only: populate_fortran_string + implicit none + + character(len=*), intent(out)::s + + call populate_fortran_string(Clp_Version_C(), s) + + end subroutine Clp_Version + + function Clp_readMps(model,filename,keepNames,ignoreErrors) + use clp_interface_utils + use iso_c_binding + implicit none + + type(c_ptr)::model + character(len=*)::filename + + integer, intent(in)::keepNames + integer, intent(in)::ignoreErrors + integer::Clp_readMps + type(c_ptr)::c_filename + + c_filename = allocate_and_populate_c_string(filename) + + Clp_readMps = Clp_readMps_C(model, c_filename, keepNames, ignoreErrors) + + call c_free(c_filename) + + end function Clp_readMps + + end module clp 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 -- cgit v1.2.3