diff options
| -rw-r--r-- | clp-example-using-dlls.prj | 16 | ||||
| -rw-r--r-- | clp-example.prj | 10 | ||||
| -rw-r--r-- | src/clp.f90 | 41 | ||||
| -rw-r--r-- | src/clp_callback.f90 | 11 | ||||
| -rw-r--r-- | src/examples/basic.f90 (renamed from src/main.f90) | 0 | ||||
| -rw-r--r-- | src/examples/driver.f90 | 127 |
6 files changed, 175 insertions, 30 deletions
diff --git a/clp-example-using-dlls.prj b/clp-example-using-dlls.prj index 539c1dc..bb50639 100644 --- a/clp-example-using-dlls.prj +++ b/clp-example-using-dlls.prj @@ -11,10 +11,11 @@ "Folders":[], "Name":"+src", "Files":[{ - "filename":".\\src\\main.f90", - "enabled":"1", - "panel":1, - "open":"1" + "filename":".\\src\\examples\\basic.f90", + "enabled":"0" + },{ + "filename":".\\src\\examples\\driver.f90", + "enabled":"1" }] }], "Name":"+clp-example-using-dlls (clp-dll\\example.exe)", @@ -58,19 +59,20 @@ }, "Build Dependencies":1, "Launch Options":{ + "Build Before Launch":"true", "Working Directory":"", "Launch Using MPI":"false", "Keep Console":"true", - "External Console":"false", + "Executable":"", "Command Line Arguments":"", - "Build Before Launch":"true" + "External Console":"false" }, "Build Options":{ "Makefile":"Makefile.example", "Auto Makefile":"true" }, "Linker Options":{ - "Static Linking Mode":7, + "Static Linking Mode":0, "Link MPI Library":"false", "Link LAPACK":0 } diff --git a/clp-example.prj b/clp-example.prj index 9497bd2..fd3ebe0 100644 --- a/clp-example.prj +++ b/clp-example.prj @@ -11,7 +11,10 @@ "Folders":[], "Name":"+src", "Files":[{ - "filename":".\\src\\main.f90", + "filename":".\\src\\examples\\basic.f90", + "enabled":"0" + },{ + "filename":".\\src\\examples\\driver.f90", "enabled":"1" }] }], @@ -56,12 +59,13 @@ }, "Build Dependencies":1, "Launch Options":{ + "Build Before Launch":"true", "Working Directory":"", "Launch Using MPI":"false", "Keep Console":"true", - "External Console":"false", + "Executable":"", "Command Line Arguments":"", - "Build Before Launch":"true" + "External Console":"false" }, "Build Options":{ "Makefile":"Makefile.example", diff --git a/src/clp.f90 b/src/clp.f90 index cd34b95..24fc769 100644 --- a/src/clp.f90 +++ b/src/clp.f90 @@ -1082,22 +1082,24 @@ contains end function Clp_SetProblemName - subroutine Clp_problemName(model,maxNumberCharacters,array) + subroutine Clp_problemName(model,array) use clp_interface_utils use iso_c_binding implicit none type(c_ptr) :: model - integer(c_int), intent(in) :: maxNumberCharacters - character(len=*) :: array + character(len=*), intent(out) :: array type(c_ptr)::c_array - c_array = allocate_and_populate_c_string(array) - - call Clp_problemName_C(model, maxNumberCharacters, c_array) + array = ' ' - call c_free(c_array) + c_array = c_allocate(int(len(array) + 1, kind=c_size_t)) + if(c_associated(c_array)) then + call Clp_problemName_C(model, len(array), c_array) + call populate_fortran_string(c_array, array) + call c_free(c_array) + end if end subroutine Clp_problemName @@ -1154,16 +1156,20 @@ contains type(c_ptr) :: model integer, intent(in)::iRow - character(*), intent(in) :: name - + character(*), intent(out) :: name + type(c_ptr) :: np - - np = allocate_and_populate_c_string(name) + + name = ' ' + + np = c_allocate(int(Clp_LengthNames(model)+1, kind=c_size_t)) if(c_associated(np)) then call Clp_rowName_C(model, int(iRow, kind=c_int), np) + call populate_fortran_string(np, name) call c_free(np) end if + end subroutine Clp_rowName subroutine Clp_columnName(model,iColumn,name) @@ -1173,13 +1179,16 @@ contains type(c_ptr) :: model integer, intent(in)::iColumn - character(*), intent(in) :: name - + character(*), intent(out) :: name + type(c_ptr) :: np - - np = allocate_and_populate_c_string(name) + + name = ' ' + + np = c_allocate(int(Clp_LengthNames(model)+1, kind=c_size_t)) if(c_associated(np)) then - call Clp_rowName_C(model, int(iColumn, kind=c_int), np) + call Clp_columnName_C(model, int(iColumn, kind=c_int), np) + call populate_fortran_string(np, name) call c_free(np) end if diff --git a/src/clp_callback.f90 b/src/clp_callback.f90 index d403be7..905d575 100644 --- a/src/clp_callback.f90 +++ b/src/clp_callback.f90 @@ -25,6 +25,7 @@ contains nString, vString) bind(C) use iso_c_binding use clp_constants + use clp_interface_utils implicit none type(c_ptr), value :: model @@ -34,8 +35,8 @@ contains real(kind=c_double), dimension(:), pointer :: fdouble integer(kind=c_int), dimension(:), pointer :: fint - character(len=clp_default_message_len), dimension(:), pointer :: fstrs - + character(len=clp_default_message_len), dimension(:), allocatable, target :: fstrs + character(len=clp_default_message_len), dimension(:), pointer :: fstr_pointer ! For converting C strings type(c_ptr), dimension(:), pointer :: c_strings integer::i @@ -55,14 +56,16 @@ contains do i = 1, nString call populate_fortran_string(c_strings(i), fstrs(i)) end do + + fstr_pointer => fstrs end if ! Now that Fortran arrays are built, call the Fortran callback if(associated(current_callback)) then - call current_callback(model, messageNumber, fdouble, fint, fstrs) + call current_callback(model, messageNumber, fdouble, fint, fstr_pointer) end if - if(associated(fstrs)) then + if(allocated(fstrs)) then deallocate(fstrs) end if diff --git a/src/main.f90 b/src/examples/basic.f90 index ee69d39..ee69d39 100644 --- a/src/main.f90 +++ b/src/examples/basic.f90 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 |