diff options
| -rw-r--r-- | libClpFortran.prj | 8 | ||||
| -rw-r--r-- | src/clp.f90 | 56 | ||||
| -rw-r--r-- | src/clp_interface_utils.f90 | 85 |
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 |