diff options
| -rw-r--r-- | libClpFortran.dll.prj | 24 | ||||
| -rw-r--r-- | libClpFortran.prj | 5 | ||||
| -rw-r--r-- | src/clp.f90 | 25 | ||||
| -rw-r--r-- | src/clp_callback.f90 | 71 | ||||
| -rw-r--r-- | src/clp_constants.F90 | 3 |
5 files changed, 117 insertions, 11 deletions
diff --git a/libClpFortran.dll.prj b/libClpFortran.dll.prj index a004f9f..0fc6601 100644 --- a/libClpFortran.dll.prj +++ b/libClpFortran.dll.prj @@ -4,26 +4,31 @@ "Folders":[], "Name":"+src", "Files":[{ - "filename":".\\src\\clp.f90", + "filename":"src/clp.f90", "enabled":"1", "panel":1, "open":"1" },{ - "filename":".\\src\\clp_constants.F90", + "filename":"src/clp_callback.f90", "enabled":"1", "panel":1, "open":"1" },{ - "filename":".\\src\\clp_interface_utils.f90", + "filename":"src/clp_constants.F90", "enabled":"1", "panel":1, "open":"1" },{ - "filename":".\\src\\clp_types.f90", + "filename":"src/clp_interface_utils.f90", + "enabled":"1", + "panel":1, + "open":"1" + },{ + "filename":"src/clp_types.f90", "enabled":"1" }] }], - "Name":"+libClpFortran.dll (clp-dll\\libClpFortran.dll)", + "Name":"+libClpFortran.dll (clp-dll/libClpFortran.dll)", "Files":[] }, "Name":"libClpFortran.dll (clp-dll/libClpFortran.dll)", @@ -40,10 +45,10 @@ "File Options":{ "Library Directories":["Default Add-On Directory"], "Build Directory":"build", - "Module Directory":"clp-dll\\modules", + "Module Directory":"clp-dll/modules", "Include Directories":["Default Add-On Include Directory"] }, - "Target":"clp-dll\\libClpFortran.dll", + "Target":"clp-dll/libClpFortran.dll", "Fortran Options":{ "Use C Preprocessor":"false", "Runtime Diagnostics":"false", @@ -64,12 +69,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", diff --git a/libClpFortran.prj b/libClpFortran.prj index 8c4a184..f9c86c0 100644 --- a/libClpFortran.prj +++ b/libClpFortran.prj @@ -9,6 +9,11 @@ "panel":1, "open":"1" },{ + "filename":"src/clp_callback.f90", + "enabled":"1", + "panel":1, + "open":"1" + },{ "filename":"src/clp_constants.F90", "enabled":"1", "panel":1, 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 |