1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
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
|
