diff options
Diffstat (limited to 'src/examples/driver.f90')
| -rw-r--r-- | src/examples/driver.f90 | 127 |
1 files changed, 127 insertions, 0 deletions
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 |