From 9b380489a4084097380b18f58bb2116613f891ee Mon Sep 17 00:00:00 2001
From: Jeffrey Armstrong <jeff@approximatrix.com>
Date: Thu, 29 Oct 2020 16:10:53 -0400
Subject: Implemented the C example driver program in Fortran.  Updates to name
 routines to read rather than write when appropriate.  Minor callback fixes.

---
 src/examples/basic.f90  |  30 ++++++++++++
 src/examples/driver.f90 | 127 ++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 157 insertions(+)
 create mode 100644 src/examples/basic.f90
 create mode 100644 src/examples/driver.f90

(limited to 'src/examples')

diff --git a/src/examples/basic.f90 b/src/examples/basic.f90
new file mode 100644
index 0000000..ee69d39
--- /dev/null
+++ b/src/examples/basic.f90
@@ -0,0 +1,30 @@
+program main
+    use iso_c_binding
+    use clp
+    use clp_constants
+    implicit none
+
+        integer :: ret
+
+        type(c_ptr) :: lp
+        real(8), dimension(0:4) :: obj
+        real(8), dimension(0:4) :: row1
+
+        lp = Clp_newModel()
+
+        call Clp_resize(lp,4,4)
+
+!        row1(0) = 0; row1(1) = 1;  row1(2) = 1; row1(3) = 1; ret = add_constraint(lp,row1,LE,100.0_8);
+
+!        write (*,*) Clp_VersionMajor()
+!        write (*,*) Clp_VersionMinor()
+!        write (*,*) Clp_VersionRelease()
+
+
+        write (*,*) Clp_numberRows(lp)
+        write (*,*) Clp_numberColumns(lp)
+
+!        call Clp_printModel(lp,"name"//c_null_char) ! seems to be broken when model is not defined
+
+        call Clp_deleteModel(lp)
+end
diff --git a/src/examples/driver.f90 b/src/examples/driver.f90
new file mode 100644
index 0000000..afcaee5
--- /dev/null
+++ b/src/examples/driver.f90
@@ -0,0 +1,127 @@
+program driver
+use clp
+use iso_c_binding
+implicit none
+
+    type(c_ptr)::model
+    integer::status
+    character(len=8)::arg
+    
+    character(len=512)::sample
+    character(len=80)::problemName
+    
+    model = clp_newmodel()
+    
+    call Clp_Registercallback(model, callback)
+    
+    if(command_argument_count() >= 1) then
+        call get_command_argument(1, sample)
+    else
+        sample = "data/p0033.mps"
+    end if
+    status = clp_readMps(model, trim(sample), 1, 0)
+
+    if(status /= 0) then
+        Print *, "Bad readMps "//trim(sample)
+        stop
+    end if
+
+    if(command_argument_count() == 2) then
+        call get_command_argument(2, arg)
+        if(arg == 'primal') then
+            status = Clp_initialPrimalSolve(model)
+        else
+            status = Clp_initialDualSolve(model)
+        end if
+    else
+        status = Clp_initialDualSolve(model)
+    end if
+    
+    call Clp_Problemname(model, problemName)
+    
+    Print *, "Model "//trim(problemName)//" has ", &
+             Clp_numberRows(model), " rows and ", &
+             Clp_numberColumns(model), " columns"
+    
+    ! Proceed past stop to print solution
+    !stop
+    
+    call output_solution(model)
+    
+contains 
+
+    subroutine callback(model, msg, dbls, ints, strings)
+    use iso_c_binding
+    use clp_constants
+    implicit none
+        
+        type(c_ptr) :: model
+        integer :: msg
+        real(kind=c_double), dimension(:), pointer :: dbls
+        integer(kind=c_int), dimension(:), pointer :: ints
+        character(len=clp_default_message_len), dimension(:), pointer :: strings
+        
+        integer::i
+        
+        select case(msg)
+        
+            case (1000002)
+                ! Coin0002
+                Print *, "Name of problem is "//trim(strings(1))
+                Write(*, 100, advance='no') "row", ints(1)
+                Write(*, 100, advance='no') "col", ints(2)
+                Write(*, 100) " el", ints(3)
+100             Format(1X,A3,1X,I5)
+
+            case(5)
+                ! Clp0005
+                do i = 1, 3
+                    Write(*, '(1X, I6,1X, F13.6)') ints(i), dbls(i)
+                end do
+            
+        end select
+        
+    end subroutine callback
+
+    subroutine output_solution(model)
+    use clp
+    use iso_c_binding
+    implicit none
+    
+        type(c_ptr):: model
+        integer::numberColumns, icolumn
+        real(kind=c_double), dimension(:), pointer::columnPrimal, columnDual
+        real(kind=c_double), dimension(:), pointer::columnLower, columnUpper
+        real(kind=c_double), dimension(:), pointer::columnObjective
+        
+        real(kind=8)::v
+        character(len=20)::cname
+        
+        numberColumns = Clp_NumberColumns(model)
+        
+        columnPrimal => Clp_PrimalColumnSolution(model)
+        columnDual => Clp_DualColumnSolution(model)
+        columnLower => Clp_ColumnLower(model)
+        columnUpper => Clp_ColumnUpper(model)
+        columnObjective => Clp_Objective(model)
+        
+        write(*, '(14X, 5A13)') "Primal", "Dual", "Lower", "Upper", "Cost"
+        
+        do icolumn = 0, numberColumns-1
+            v = columnPrimal(icolumn)
+            if(v > 1.0E-8 .or. v < -1.0E-8) then
+                call clp_columnName(model, icolumn, cname)
+            
+                write(*, '(I6, 1X, A7, 5F13.6)') icolumn, cname, &
+                                             columnPrimal(icolumn), &
+                                             columnDual(icolumn), &
+                                             columnLower(icolumn), &
+                                             columnUpper(icolumn), &
+                                             columnObjective(icolumn)
+                                             
+            end if
+        end do
+        
+    end subroutine output_solution
+end program driver
+    
\ No newline at end of file
-- 
cgit v1.2.3