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 use clp_interface_utils 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(:), 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 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 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, fstr_pointer) end if if(allocated(fstrs)) then deallocate(fstrs) end if end subroutine Clp_boundCallbackInterface end module clp_callback