diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/clp.f90 | 25 | ||||
| -rw-r--r-- | src/clp_callback.f90 | 71 | ||||
| -rw-r--r-- | src/clp_constants.F90 | 3 |
3 files changed, 97 insertions, 2 deletions
diff --git a/src/clp.f90 b/src/clp.f90 index 2c8692a..cd34b95 100644 --- a/src/clp.f90 +++ b/src/clp.f90 @@ -1,5 +1,7 @@ module clp use iso_c_binding + use clp_callback, only: fortran_cb + use clp_constants implicit none interface @@ -498,10 +500,10 @@ module clp use iso_c_binding type(c_ptr) :: model end subroutine - subroutine Clp_registerCallBack(model,userCallBack) bind(C,name="Clp_registerCallBack") + subroutine Clp_registerCallBack_C(model,userCallBack) bind(C,name="Clp_registerCallBack") use iso_c_binding type(c_ptr), value :: model - type(c_ptr), value :: userCallBack + type(c_funptr), value :: userCallBack end subroutine subroutine Clp_clearCallBack(model) bind(C,name="Clp_clearCallBack") use iso_c_binding @@ -1700,4 +1702,23 @@ contains end subroutine Clp_integerInformation + subroutine Clp_registerCallback(model, cb) + use iso_c_binding + use clp_callback + implicit none + + type(c_ptr) :: model + procedure(fortran_cb) :: cb + + if(associated(current_callback)) then + Write(*,*) "*** WARNING: Clp Fortran Library supports only a single callback" + Write(*,*) "*** Reassigning current callback" + end if + + current_callback => cb + + call Clp_Registercallback_C(model, c_funloc(Clp_boundCallbackInterface)) + + end subroutine Clp_registerCallback + end module clp diff --git a/src/clp_callback.f90 b/src/clp_callback.f90 new file mode 100644 index 0000000..d403be7 --- /dev/null +++ b/src/clp_callback.f90 @@ -0,0 +1,71 @@ +module clp_callback +use iso_c_binding +implicit none + + interface fortran_cb + subroutine fortran_cb(mdl, msg, dbls, ints, strings) + use iso_c_binding + use clp_constants + implicit none + type(c_ptr) :: mdl + 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 + end subroutine fortran_cb + end interface + + procedure(fortran_cb), pointer:: current_callback + +contains + + subroutine Clp_boundCallbackInterface(model, messageNumber, & + nDouble, vDouble, & + nInt, vInt, & + nString, vString) bind(C) + use iso_c_binding + use clp_constants + implicit none + + type(c_ptr), value :: model + integer(c_int), value :: messageNumber + integer(c_int), value :: nDouble, nInt, nString + type(c_ptr), value :: vDouble, vInt, vString + + real(kind=c_double), dimension(:), pointer :: fdouble + integer(kind=c_int), dimension(:), pointer :: fint + character(len=clp_default_message_len), dimension(:), pointer :: fstrs + + ! For converting C strings + type(c_ptr), dimension(:), pointer :: c_strings + integer::i + + if(nDouble > 0 .and. c_associated(vDouble)) then + call c_f_pointer(vDouble, fdouble, (/ nDouble /)) + end if + + if(nInt > 0 .and. c_associated(vInt)) then + call c_f_pointer(vInt, fint, (/ nInt /)) + end if + + if(nString > 0 .and. c_associated(vString)) then + allocate(fstrs(nString)) + fstrs = ' ' + call c_f_pointer(vString, c_strings, (/ nString /)) + do i = 1, nString + call populate_fortran_string(c_strings(i), fstrs(i)) + end do + 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) + end if + + if(associated(fstrs)) then + deallocate(fstrs) + end if + + end subroutine Clp_boundCallbackInterface + +end module clp_callback
\ No newline at end of file diff --git a/src/clp_constants.F90 b/src/clp_constants.F90 index 5a44089..5451bba 100644 --- a/src/clp_constants.F90 +++ b/src/clp_constants.F90 @@ -11,6 +11,9 @@ module clp_constants integer, parameter :: CoinBigIndex_t = c_long_long #endif + ! Default message string length + integer, parameter::clp_default_message_len = 128 + enum, bind(c) enumerator :: Status_isFree = 0 enumerator :: Status_basic |