aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJeffrey Armstrong <jeffrey.armstrong@approximatrix.com>2020-10-15 12:21:00 -0400
committerJeffrey Armstrong <jeffrey.armstrong@approximatrix.com>2020-10-15 12:21:00 -0400
commit0522e832700cab5bbf7eeea413d93d68041b9405 (patch)
tree93de0033bcc185e93136938e88e68547b0478e47
parenta5fcf00e55a94943c7fbe8f04775e3b986a829fc (diff)
downloadclp_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.
-rw-r--r--libClpFortran.prj8
-rw-r--r--src/clp.f9056
-rw-r--r--src/clp_interface_utils.f9085
3 files changed, 142 insertions, 7 deletions
diff --git a/libClpFortran.prj b/libClpFortran.prj
index d100f44..f000ad3 100644
--- a/libClpFortran.prj
+++ b/libClpFortran.prj
@@ -10,6 +10,9 @@
"filename":".\\src\\clp_constants.f90",
"enabled":"1"
},{
+ "filename":".\\src\\clp_interface_utils.f90",
+ "enabled":"1"
+ },{
"filename":".\\src\\clp_types.f90",
"enabled":"1"
}]
@@ -55,12 +58,13 @@
},
"Build Dependencies":1,
"Launch Options":{
+ "Build Before Launch":"true",
"Working Directory":"",
"Launch Using MPI":"false",
"Keep Console":"true",
- "External Console":"false",
+ "Executable":"",
"Command Line Arguments":"",
- "Build Before Launch":"true"
+ "External Console":"false"
},
"Build Options":{
"Makefile":"Makefile",
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