Fixed interface functions that return C arrays to return Fortran pointers to arrays

3 files changed, 318 insertions, 38 deletions

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