diff --git a/src/minpack.f90 b/src/minpack.f90 index 94e0418..64d34b0 100644 --- a/src/minpack.f90 +++ b/src/minpack.f90 @@ -147,7 +147,10 @@ contains subroutine hybrj(fcn,n,x,fvec,fjac,ldfjac,xtol,maxfev,diag,mode, & factor,nprint,info,nfev,njev,r,lr,qtf,wa1,wa2, & wa3,wa4) - use const_and_precisions, only : zero, one, epsmch=>comp_eps + use const_and_precisions, only : zero, one, epsmch=>comp_eps + use, intrinsic :: ieee_exceptions, only : ieee_get_halting_mode, & + ieee_set_halting_mode, & + ieee_invalid ! arguments integer, intent(in) :: n, ldfjac, maxfev, mode, nprint, lr integer, intent(out) :: info, nfev, njev @@ -301,7 +304,7 @@ contains ! local variables integer :: i, iflag, iter, j, jm1, l, ncfail, ncsuc, nslow1, nslow2 integer, dimension(1) :: iwa - logical :: jeval, sing + logical :: jeval, sing, halt real(wp_) :: actred, delta, fnorm, fnorm1, pnorm, prered, & ratio, summ, temp, xnorm ! parameters @@ -316,6 +319,11 @@ contains real(wp_), intent(inout) :: fvec(n),fjac(ldfjac,n) end subroutine fcn end interface + + ! ignore NaN origiting from fcn calls + call ieee_get_halting_mode(ieee_invalid, halt) + call ieee_set_halting_mode(ieee_invalid, .false.) + ! info = 0 iflag = 0 @@ -582,6 +590,10 @@ contains if (iflag < 0) info = iflag iflag = 0 if (nprint > 0) call fcn(n,x,fvec,fjac,ldfjac,iflag) + + ! restore original mode + call ieee_set_halting_mode(ieee_invalid, halt) + end subroutine hybrj subroutine hybrj1mv(fcn,n,x,f0,fvec,fjac,ldfjac,tol,info,wa,lwa)