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