aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJeffrey Armstrong <jeff@approximatrix.com>2020-10-27 12:03:57 -0400
committerJeffrey Armstrong <jeff@approximatrix.com>2020-10-27 12:03:57 -0400
commit973c015354c14aa6c7977a9906637f6570316530 (patch)
tree67fd190dc6ed8c60a2ec662001718df945c229c7
parentb1be8b0f5ff9d32756c98a7f7fa6d9023d124527 (diff)
downloadclp_fortran-973c015354c14aa6c7977a9906637f6570316530.tar.gz
clp_fortran-973c015354c14aa6c7977a9906637f6570316530.zip
Fixed interface functions that return C arrays to return Fortran pointers to arrays
-rw-r--r--libClpFortran.prj16
-rw-r--r--src/clp.f90337
-rw-r--r--src/clp_constants.F9014
-rw-r--r--src/clp_constants.f905
4 files changed, 328 insertions, 44 deletions
diff --git a/libClpFortran.prj b/libClpFortran.prj
index f000ad3..e47772e 100644
--- a/libClpFortran.prj
+++ b/libClpFortran.prj
@@ -4,16 +4,20 @@
"Folders":[],
"Name":"+src",
"Files":[{
- "filename":".\\src\\clp.f90",
- "enabled":"1"
+ "filename":"src/clp.f90",
+ "enabled":"1",
+ "panel":1,
+ "open":"1"
},{
- "filename":".\\src\\clp_constants.f90",
- "enabled":"1"
+ "filename":"src/clp_constants.F90",
+ "enabled":"1",
+ "panel":1,
+ "open":"1"
},{
- "filename":".\\src\\clp_interface_utils.f90",
+ "filename":"src/clp_interface_utils.f90",
"enabled":"1"
},{
- "filename":".\\src\\clp_types.f90",
+ "filename":"src/clp_types.f90",
"enabled":"1"
}]
}],
diff --git a/src/clp.f90 b/src/clp.f90
index 2590121..c5442ac 100644
--- a/src/clp.f90
+++ b/src/clp.f90
@@ -42,15 +42,15 @@ module clp
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
+ use clp_constants
type(c_ptr), value :: model
integer(c_int), value ::numcols
integer(c_int), value ::numrows
- type(c_ptr), value :: start
- type(c_ptr), value :: index
+ integer(CoinBigIndex_t) :: start(*)
+ integer(c_int) :: index(*)
real(c_double) :: value(*)
real(c_double) :: collb(*)
real(c_double) :: colub(*)
@@ -58,13 +58,15 @@ module clp
real(c_double) :: rowlb(*)
real(c_double) :: rowub(*)
end subroutine
+
subroutine Clp_loadQuadraticObjective(model,numberColumns, &
start,column,element) bind(C,name="Clp_loadQuadraticObjective")
use iso_c_binding
+ use clp_constants
type(c_ptr), value :: model
integer(c_int), value ::numberColumns
- type(c_ptr), value :: start
- type(c_ptr), value :: column
+ integer(CoinBigIndex_t) :: start(*)
+ integer(c_int) :: column(*)
real(c_double) :: element(*)
end subroutine
@@ -381,10 +383,10 @@ module clp
type(c_ptr), value :: model
integer(c_int) :: Clp_getNumElements
end function
- function Clp_getVectorStarts(model) bind(C,name="Clp_getVectorStarts")
+ function Clp_getVectorStarts_C(model) bind(C,name="Clp_getVectorStarts")
use iso_c_binding
type(c_ptr), value :: model
- type(c_ptr) :: Clp_getVectorStarts
+ type(c_ptr) :: Clp_getVectorStarts_C
end function
function Clp_getIndices(model) bind(C,name="Clp_getIndices")
use iso_c_binding
@@ -645,18 +647,21 @@ module clp
type(c_ptr), value :: model
integer(c_int) :: Clp_numberPrimalInfeasibilities
end function
- function Clp_saveModel(model,fileName) bind(C,name="Clp_saveModel")
+
+ function Clp_saveModel_C(model,fileName) bind(C,name="Clp_saveModel")
use iso_c_binding
type(c_ptr), value :: model
- character(c_char) :: fileName(*)
- integer(c_int) :: Clp_saveModel
+ type(c_ptr), value :: fileName
+ integer(c_int) :: Clp_saveModel_C
end function
- function Clp_restoreModel(model,fileName) bind(C,name="Clp_restoreModel")
+
+ function Clp_restoreModel_C(model,fileName) bind(C,name="Clp_restoreModel")
use iso_c_binding
type(c_ptr), value :: model
- character(c_char) :: fileName(*)
- integer(c_int) :: Clp_restoreModel
+ type(c_ptr), value :: fileName
+ integer(c_int) :: Clp_restoreModel_C
end function
+
subroutine Clp_checkSolution(model) bind(C,name="Clp_checkSolution")
use iso_c_binding
type(c_ptr), value :: model
@@ -721,66 +726,79 @@ module clp
type(c_ptr), value :: model
real(c_double), value :: objsen
end subroutine
- function Clp_getRowActivity(model) bind(C,name="Clp_getRowActivity")
+
+ function Clp_getRowActivity_C(model) bind(C,name="Clp_getRowActivity")
use iso_c_binding
type(c_ptr), value :: model
- type(c_ptr) :: Clp_getRowActivity
+ type(c_ptr) :: Clp_getRowActivity_C
end function
- function Clp_getColSolution(model) bind(C,name="Clp_getColSolution")
+
+ function Clp_getColSolution_C(model) bind(C,name="Clp_getColSolution")
use iso_c_binding
type(c_ptr), value :: model
- type(c_ptr) :: Clp_getColSolution
+ type(c_ptr) :: Clp_getColSolution_C
end function
+
subroutine Clp_setColSolution(model,input) bind(C,name="Clp_setColSolution")
use iso_c_binding
type(c_ptr), value :: model
real(c_double) :: input(*)
end subroutine
- function Clp_getRowPrice(model) bind(C,name="Clp_getRowPrice")
+
+ function Clp_getRowPrice_C(model) bind(C,name="Clp_getRowPrice")
use iso_c_binding
type(c_ptr), value :: model
- type(c_ptr) :: Clp_getRowPrice
+ type(c_ptr) :: Clp_getRowPrice_C
end function
- function Clp_getReducedCost(model) bind(C,name="Clp_getReducedCost")
+
+ function Clp_getReducedCost_C(model) bind(C,name="Clp_getReducedCost")
use iso_c_binding
type(c_ptr), value :: model
- type(c_ptr) :: Clp_getReducedCost
+ type(c_ptr) :: Clp_getReducedCost_C
end function
- function Clp_getRowLower(model) bind(C,name="Clp_getRowLower")
+
+ function Clp_getRowLower_C(model) bind(C,name="Clp_getRowLower")
use iso_c_binding
type(c_ptr), value :: model
- type(c_ptr) :: Clp_getRowLower
+ type(c_ptr) :: Clp_getRowLower_C
end function
- function Clp_getRowUpper(model) bind(C,name="Clp_getRowUpper")
+
+ function Clp_getRowUpper_C(model) bind(C,name="Clp_getRowUpper")
use iso_c_binding
type(c_ptr), value :: model
- type(c_ptr) :: Clp_getRowUpper
+ type(c_ptr) :: Clp_getRowUpper_C
end function
- function Clp_getObjCoefficients(model) bind(C,name="Clp_getObjCoefficients")
+
+ function Clp_getObjCoefficients_C(model) bind(C,name="Clp_getObjCoefficients")
use iso_c_binding
type(c_ptr), value :: model
- type(c_ptr) :: Clp_getObjCoefficients
+ type(c_ptr) :: Clp_getObjCoefficients_C
end function
- function Clp_getColLower(model) bind(C,name="Clp_getColLower")
+
+ function Clp_getColLower_C(model) bind(C,name="Clp_getColLower")
use iso_c_binding
type(c_ptr), value :: model
- type(c_ptr) :: Clp_getColLower
+ type(c_ptr) :: Clp_getColLower_C
end function
- function Clp_getColUpper(model) bind(C,name="Clp_getColUpper")
+
+ function Clp_getColUpper_C(model) bind(C,name="Clp_getColUpper")
use iso_c_binding
type(c_ptr), value :: model
- type(c_ptr) :: Clp_getColUpper
+ type(c_ptr) :: Clp_getColUpper_C
end function
+
function Clp_getObjValue(model) bind(C,name="Clp_getObjValue")
use iso_c_binding
type(c_ptr), value :: model
real(c_double) :: Clp_getObjValue
end function
- subroutine Clp_printModel(model,prefix) bind(C,name="Clp_printModel")
+
+ subroutine Clp_printModel_C(model,prefix) bind(C,name="Clp_printModel")
use iso_c_binding
type(c_ptr), value :: model
- character(c_char) :: prefix(*)
+ type(c_ptr), value :: prefix
end subroutine
+
function Clp_getSmallElementValue(model) bind(C,name="Clp_getSmallElementValue")
use iso_c_binding
type(c_ptr), value :: model
@@ -1142,5 +1160,258 @@ contains
end if
end subroutine Clp_columnName
+
+ function Clp_saveModel(model,fileName)
+ use iso_c_binding
+ use clp_interface_utils
+ implicit none
+
+ type(c_ptr) :: model
+ character(len=*) :: fileName
+ integer :: Clp_saveModel
+
+ type(c_ptr) :: fileName_C
+
+ Clp_saveModel = -1
+
+ fileName_C = allocate_and_populate_c_string(fileName)
+ if(c_associated(fileName_C)) then
+ Clp_saveModel = Clp_saveModel_C(model, fileName_C)
+ call c_free(fileName_C)
+ end if
+
+ end function Clp_saveModel
+
+ function Clp_restoreModel(model,fileName)
+ use iso_c_binding
+ use clp_interface_utils
+ implicit none
+
+ type(c_ptr) :: model
+ character(len=*) :: fileName
+ integer :: Clp_restoreModel
+
+ type(c_ptr) :: fileName_C
+
+ Clp_restoreModel = -1
+
+ fileName_C = allocate_and_populate_c_string(fileName)
+ if(c_associated(fileName_C)) then
+ Clp_restoreModel = Clp_restoreModel_C(model, fileName_C)
+ call c_free(fileName_C)
+ end if
+
+ end function Clp_restoreModel
+
+ subroutine Clp_printModel(model,prefix)
+ use iso_c_binding
+ use clp_interface_utils
+ implicit none
+
+ type(c_ptr) :: model
+ character(len=*) :: prefix
+
+ type(c_ptr) :: prefix_C
+
+ prefix_C = allocate_and_populate_c_string(prefix)
+ if(c_associated(prefix_C)) then
+ call Clp_printModel_C(model, prefix_C)
+ call c_free(prefix_C)
+ end if
+
+ end subroutine Clp_printModel
+
+ function Clp_getVectorStarts(model) result(starts)
+ use iso_c_binding
+ use clp_constants
+ implicit none
+
+ type(c_ptr) :: model
+ integer(kind=CoinBigIndex_t), dimension(:), pointer :: starts
+
+ type(c_ptr) :: c_res
+ integer::ncols
+
+ starts => null()
+
+ c_res = Clp_getVectorStarts_C(model)
+
+ if(c_associated(c_res)) then
+ ncols = Clp_Numbercolumns(model)
+ call c_f_pointer(c_res, starts, (/ ncols /))
+ end if
+
+ end function Clp_getVectorStarts
+
+ function Clp_getRowActivity(model) result(res)
+ use iso_c_binding
+ implicit none
+
+ type(c_ptr) :: model
+ real(c_double), dimension(:), pointer :: res
+ integer::nrows
+ type(c_ptr) :: c_res
+
+ res => null()
+
+ c_res = Clp_getRowActivity_C(model)
+ if(c_associated(c_res)) then
+ nrows = Clp_Numberrows(model)
+ call c_f_pointer(c_res, res, (/ nrows /))
+ end if
+
+ end function Clp_getRowActivity
+
+ function Clp_getColSolution(model) result(res)
+ use iso_c_binding
+ implicit none
+
+ type(c_ptr) :: model
+ real(c_double), dimension(:), pointer :: res
+ integer::ncols
+ type(c_ptr) :: c_res
+
+ res => null()
+
+ c_res = Clp_getColSolution_C(model)
+ if(c_associated(c_res)) then
+ ncols = Clp_Numbercolumns(model)
+ call c_f_pointer(c_res, res, (/ ncols /))
+ end if
+
+ end function Clp_getColSolution
+
+ function Clp_getRowPrice(model) result(res)
+ use iso_c_binding
+ implicit none
+
+ type(c_ptr) :: model
+ real(c_double), dimension(:), pointer :: res
+ integer::nrows
+ type(c_ptr) :: c_res
+
+ res => null()
+
+ c_res = Clp_getRowPrice_C(model)
+ if(c_associated(c_res)) then
+ nrows = Clp_Numberrows(model)
+ call c_f_pointer(c_res, res, (/ nrows /))
+ end if
+
+ end function Clp_getRowPrice
+
+ function Clp_getReducedCost(model) result(res)
+ use iso_c_binding
+ implicit none
+
+ type(c_ptr) :: model
+ real(c_double), dimension(:), pointer :: res
+ integer::ncols
+ type(c_ptr) :: c_res
+
+ res => null()
+
+ c_res = Clp_getReducedCost_C(model)
+ if(c_associated(c_res)) then
+ ncols = Clp_Numbercolumns(model)
+ call c_f_pointer(c_res, res, (/ ncols /))
+ end if
+
+ end function Clp_getReducedCost
+
+ function Clp_getRowLower(model) result(res)
+ use iso_c_binding
+ implicit none
+
+ type(c_ptr) :: model
+ real(c_double), dimension(:), pointer :: res
+ integer::nrows
+ type(c_ptr) :: c_res
+
+ res => null()
+
+ c_res = Clp_getRowLower_C(model)
+ if(c_associated(c_res)) then
+ nrows = Clp_Numberrows(model)
+ call c_f_pointer(c_res, res, (/ nrows /))
+ end if
+
+ end function Clp_getRowLower
+
+ function Clp_getRowUpper(model) result(res)
+ use iso_c_binding
+ implicit none
+
+ type(c_ptr) :: model
+ real(c_double), dimension(:), pointer :: res
+ integer::nrows
+ type(c_ptr) :: c_res
+
+ res => null()
+
+ c_res = Clp_getRowUpper_C(model)
+ if(c_associated(c_res)) then
+ nrows = Clp_Numberrows(model)
+ call c_f_pointer(c_res, res, (/ nrows /))
+ end if
+
+ end function Clp_getRowUpper
+
+ function Clp_getObjCoefficients(model) result(res)
+ use iso_c_binding
+ implicit none
+
+ type(c_ptr) :: model
+ real(c_double), dimension(:), pointer :: res
+ integer::ncols
+ type(c_ptr) :: c_res
+
+ res => null()
+
+ c_res = Clp_getObjCoefficients_C(model)
+ if(c_associated(c_res)) then
+ ncols = Clp_Numbercolumns(model)
+ call c_f_pointer(c_res, res, (/ ncols /))
+ end if
+
+ end function Clp_getObjCoefficients
+
+ function Clp_getColLower(model) result(res)
+ use iso_c_binding
+ implicit none
+
+ type(c_ptr) :: model
+ real(c_double), dimension(:), pointer :: res
+ integer::ncols
+ type(c_ptr) :: c_res
+
+ res => null()
+
+ c_res = Clp_getColLower_C(model)
+ if(c_associated(c_res)) then
+ ncols = Clp_Numbercolumns(model)
+ call c_f_pointer(c_res, res, (/ ncols /))
+ end if
+
+ end function Clp_getColLower
+
+ function Clp_getColUpper(model) result(res)
+ use iso_c_binding
+ implicit none
+
+ type(c_ptr) :: model
+ real(c_double), dimension(:), pointer :: res
+ integer::ncols
+ type(c_ptr) :: c_res
+
+ res => null()
+
+ c_res = Clp_getColUpper_C(model)
+ if(c_associated(c_res)) then
+ ncols = Clp_Numbercolumns(model)
+ call c_f_pointer(c_res, res, (/ ncols /))
+ end if
+
+ end function Clp_getColUpper
end module clp
diff --git a/src/clp_constants.F90 b/src/clp_constants.F90
new file mode 100644
index 0000000..bf7b285
--- /dev/null
+++ b/src/clp_constants.F90
@@ -0,0 +1,14 @@
+module clp_constants
+ use iso_c_binding
+ implicit none
+
+ ! The following definition is copied exactly from Coin_C_defines.h
+#if COIN_BIG_INDEX==0
+ integer, parameter :: CoinBigIndex_t = c_int
+#elif COIN_BIG_INDEX==1
+ integer, parameter :: CoinBigIndex_t = c_long
+#else
+ integer, parameter :: CoinBigIndex_t = c_long_long
+#endif
+
+end module clp_constants
diff --git a/src/clp_constants.f90 b/src/clp_constants.f90
deleted file mode 100644
index 49bff2c..0000000
--- a/src/clp_constants.f90
+++ /dev/null
@@ -1,5 +0,0 @@
-module clp_constants
- use iso_c_binding
- implicit none
-
-end module clp_constants