diff options
author | Jeffrey Armstrong <jeff@approximatrix.com> | 2020-10-27 12:03:57 -0400 |
---|---|---|
committer | Jeffrey Armstrong <jeff@approximatrix.com> | 2020-10-27 12:03:57 -0400 |
commit | 973c015354c14aa6c7977a9906637f6570316530 (patch) | |
tree | 67fd190dc6ed8c60a2ec662001718df945c229c7 | |
parent | b1be8b0f5ff9d32756c98a7f7fa6d9023d124527 (diff) | |
download | clp_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.prj | 16 | ||||
-rw-r--r-- | src/clp.f90 | 337 | ||||
-rw-r--r-- | src/clp_constants.F90 | 14 | ||||
-rw-r--r-- | src/clp_constants.f90 | 5 |
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 |