From 480726c7a04db36096151d0cc529c446ef3df97f Mon Sep 17 00:00:00 2001 From: Jeffrey Armstrong Date: Tue, 27 Oct 2020 12:57:40 -0400 Subject: Implemented more Fortran wrappers for functions that should return arrays as pointers. --- src/clp.f90 | 254 +++++++++++++++++++++++++++++++++++++++++++++++++++++------- 1 file changed, 228 insertions(+), 26 deletions(-) (limited to 'src') diff --git a/src/clp.f90 b/src/clp.f90 index c5442ac..427ec55 100644 --- a/src/clp.f90 +++ b/src/clp.f90 @@ -9,14 +9,17 @@ module clp use iso_c_binding type(c_ptr) :: Clp_Version_C end function + function Clp_VersionMajor() bind(C,name="Clp_VersionMajor") use iso_c_binding integer(c_int) :: Clp_VersionMajor end function + function Clp_VersionMinor() bind(C,name="Clp_VersionMinor") use iso_c_binding integer(c_int) :: Clp_VersionMinor end function + function Clp_VersionRelease() bind(C,name="Clp_VersionRelease") use iso_c_binding integer(c_int) :: Clp_VersionRelease @@ -27,6 +30,7 @@ module clp use iso_c_binding type(c_ptr) :: Clp_newModel end function + subroutine Clp_deleteModel(model) bind(C,name="Clp_deleteModel") use iso_c_binding type(c_ptr), value :: model @@ -37,6 +41,7 @@ module clp use iso_c_binding type(c_ptr) :: ClpSolve_new end function + subroutine ClpSolve_delete(solve) bind(C,name="ClpSolve_delete") use iso_c_binding type(c_ptr), value :: solve @@ -331,58 +336,66 @@ module clp real(c_double), value :: value end subroutine - function Clp_primalRowSolution(model) bind(C,name="Clp_primalRowSolution") + function Clp_primalRowSolution_C(model) bind(C,name="Clp_primalRowSolution") use iso_c_binding type(c_ptr), value :: model - type(c_ptr) :: Clp_primalRowSolution + type(c_ptr) :: Clp_primalRowSolution_C end function - function Clp_primalColumnSolution(model) bind(C,name="Clp_primalColumnSolution") + function Clp_primalColumnSolution_C(model) bind(C,name="Clp_primalColumnSolution") use iso_c_binding type(c_ptr), value :: model - type(c_ptr) :: Clp_primalColumnSolution + type(c_ptr) :: Clp_primalColumnSolution_C end function - function Clp_dualRowSolution(model) bind(C,name="Clp_dualRowSolution") + function Clp_dualRowSolution_C(model) bind(C,name="Clp_dualRowSolution") use iso_c_binding type(c_ptr), value :: model - type(c_ptr) :: Clp_dualRowSolution + type(c_ptr) :: Clp_dualRowSolution_C end function - function Clp_dualColumnSolution(model) bind(C,name="Clp_dualColumnSolution") + + function Clp_dualColumnSolution_C(model) bind(C,name="Clp_dualColumnSolution") use iso_c_binding type(c_ptr), value :: model - type(c_ptr) :: Clp_dualColumnSolution + type(c_ptr) :: Clp_dualColumnSolution_C end function - function Clp_rowLower(model) bind(C,name="Clp_rowLower") + + function Clp_rowLower_C(model) bind(C,name="Clp_rowLower") use iso_c_binding type(c_ptr), value :: model - type(c_ptr) :: Clp_rowLower + type(c_ptr) :: Clp_rowLower_C end function - function Clp_rowUpper(model) bind(C,name="Clp_rowUpper") + + function Clp_rowUpper_C(model) bind(C,name="Clp_rowUpper") use iso_c_binding type(c_ptr), value :: model - type(c_ptr) :: Clp_rowUpper + type(c_ptr) :: Clp_rowUpper_C end function - function Clp_objective(model) bind(C,name="Clp_objective") + + function Clp_objective_C(model) bind(C,name="Clp_objective") use iso_c_binding type(c_ptr), value :: model - type(c_ptr) :: Clp_objective + type(c_ptr) :: Clp_objective_C end function - function Clp_columnLower(model) bind(C,name="Clp_columnLower") + + function Clp_columnLower_C(model) bind(C,name="Clp_columnLower") use iso_c_binding type(c_ptr), value :: model - type(c_ptr) :: Clp_columnLower + type(c_ptr) :: Clp_columnLower_C end function - function Clp_columnUpper(model) bind(C,name="Clp_columnUpper") + + function Clp_columnUpper_C(model) bind(C,name="Clp_columnUpper") use iso_c_binding type(c_ptr), value :: model - type(c_ptr) :: Clp_columnUpper + type(c_ptr) :: Clp_columnUpper_C end function + function Clp_getNumElements(model) bind(C,name="Clp_getNumElements") use iso_c_binding type(c_ptr), value :: model integer(c_int) :: Clp_getNumElements end function + function Clp_getVectorStarts_C(model) bind(C,name="Clp_getVectorStarts") use iso_c_binding type(c_ptr), value :: model @@ -408,26 +421,31 @@ module clp type(c_ptr), value :: model real(c_double) :: Clp_objectiveValue end function - function Clp_integerInformation(model) bind(C,name="Clp_integerInformation") + + function Clp_integerInformation_C(model) bind(C,name="Clp_integerInformation") use iso_c_binding type(c_ptr), value :: model - type(c_ptr) :: Clp_integerInformation + type(c_ptr) :: Clp_integerInformation_C end function - function Clp_infeasibilityRay(model) bind(C,name="Clp_infeasibilityRay") + + function Clp_infeasibilityRay_C(model) bind(C,name="Clp_infeasibilityRay") use iso_c_binding type(c_ptr), value :: model - type(c_ptr) :: Clp_infeasibilityRay + type(c_ptr) :: Clp_infeasibilityRay_C end function - function Clp_unboundedRay(model) bind(C,name="Clp_unboundedRay") + + function Clp_unboundedRay_C(model) bind(C,name="Clp_unboundedRay") use iso_c_binding type(c_ptr), value :: model - type(c_ptr) :: Clp_unboundedRay + type(c_ptr) :: Clp_unboundedRay_C end function - subroutine Clp_freeRay(model,ray) bind(C,name="Clp_freeRay") + + subroutine Clp_freeRay_C(model,ray) bind(C,name="Clp_freeRay") use iso_c_binding type(c_ptr), value :: model - real(c_double) :: ray(*) + type(c_ptr), value :: ray end subroutine + function Clp_statusExists(model) bind(C,name="Clp_statusExists") use iso_c_binding type(c_ptr), value :: model @@ -1338,6 +1356,16 @@ contains end function Clp_getRowLower + function Clp_rowLower(model) + implicit none + + type(c_ptr) :: model + real(c_double), dimension(:), pointer :: Clp_rowLower + + Clp_rowLower => Clp_getRowLower(model) + + end function Clp_rowLower + function Clp_getRowUpper(model) result(res) use iso_c_binding implicit none @@ -1356,6 +1384,35 @@ contains end if end function Clp_getRowUpper + + function Clp_rowUpper(model) + implicit none + + type(c_ptr) :: model + real(c_double), dimension(:), pointer :: Clp_rowUpper + + Clp_rowUpper => Clp_getRowUpper(model) + + end function Clp_rowUpper + + function Clp_objective(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_objective_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_objective function Clp_getObjCoefficients(model) result(res) use iso_c_binding @@ -1395,6 +1452,16 @@ contains end function Clp_getColLower + function Clp_columnLower(model) + implicit none + + type(c_ptr) :: model + real(c_double), dimension(:), pointer :: Clp_columnLower + + Clp_columnLower => Clp_getColLower(model) + + end function Clp_columnLower + function Clp_getColUpper(model) result(res) use iso_c_binding implicit none @@ -1413,5 +1480,140 @@ contains end if end function Clp_getColUpper + + function Clp_columnUpper(model) + implicit none + + type(c_ptr) :: model + real(c_double), dimension(:), pointer :: Clp_columnUpper + + Clp_columnUpper => Clp_getColUpper(model) + + end function Clp_columnUpper + + function Clp_primalRowSolution(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_primalRowSolution_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_primalRowSolution + + function Clp_primalColumnSolution(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_primalColumnSolution_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_primalColumnSolution + + function Clp_dualRowSolution(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_dualRowSolution_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_dualRowSolution + + function Clp_dualColumnSolution(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_dualColumnSolution_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_dualColumnSolution + + function Clp_infeasibilityRay(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_infeasibilityRay_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_infeasibilityRay + + function Clp_unboundedRay(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_unboundedRay_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_unboundedRay + + subroutine Clp_freeRay(model, ray) + use iso_c_binding + implicit none + + type(c_ptr) :: model + real(c_double), dimension(:), pointer :: ray + + call Clp_freeRay_C(model, c_loc(ray)) + + end subroutine Clp_freeRay end module clp -- cgit v1.2.3