From a42003fa8146d8c60bb42486e6818d23d27fb068 Mon Sep 17 00:00:00 2001 From: Wim Haeck Date: Tue, 18 Dec 2018 11:52:36 -0700 Subject: [PATCH 1/3] Added warnings when detecting NaN in sqrt in unresr due to negative background (issue #116) --- src/unresr.f90 | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/src/unresr.f90 b/src/unresr.f90 index 520dd57e..7540d8f6 100644 --- a/src/unresr.f90 +++ b/src/unresr.f90 @@ -899,8 +899,11 @@ subroutine unresl(ee,tt,sig0,nsig0,sigbkg,sigu,arry) real(kr),parameter::rc1=.123e0_kr real(kr),parameter::rc2=.08e0_kr real(kr),parameter::third=.333333333e0_kr + real(kr),parameter::zero=0 real(kr),parameter::one=1.e0_kr real(kr),parameter::small=1.e-8_kr + logical::noissue=.true. + character(60)::strng1,strng2 cwaven=sqrt(2*amassn*amu*ev)*1.e-12_kr/hbar @@ -941,6 +944,10 @@ subroutine unresl(ee,tt,sig0,nsig0,sigbkg,sigu,arry) sigbt=sigbkg(1)+spot+sint do is=1,nsig0 sigm(is)=sigbt+sig0(is) + if (sigm(is).lt.zero) then + call mess('unresl', 'Negative background xs in urr may cause issues',& + &'Check the evaluation') + endif enddo ispot=1 @@ -1103,6 +1110,11 @@ subroutine unresl(ee,tt,sig0,nsig0,sigbkg,sigu,arry) sti=gg(5)/del(itp) do is0=1,nsig0 beta=sigm(is0)/s0u + if (beta.lt.zero.and.abs(beta).lt.one.and.noissue) then + call mess('unresl','Square root of negative number detected',& + &'Probably caused by negative background xs in urr') + noissue=.false. + endif call ajku(beta,sti,xj,xk) if (mu.gt.0) xj=xj*qw(kf,mu) if (mu.gt.0) xk=xk*qw(kf,mu) From 6aeb05251ad9b423b3498caa481f3fe7eb2f926a Mon Sep 17 00:00:00 2001 From: Wim Haeck Date: Tue, 18 Dec 2018 11:53:30 -0700 Subject: [PATCH 2/3] Updated version and date --- src/vers.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/vers.f90 b/src/vers.f90 index c1f3f103..0b8ae58f 100644 --- a/src/vers.f90 +++ b/src/vers.f90 @@ -3,7 +3,7 @@ module version ! These values are updated during the NJOY revision-control process. implicit none private - character(8),public::vers='2016.47' - character(8),public::vday='20Nov18' + character(8),public::vers='2016.48' + character(8),public::vday='18Dec18' end module version From d57f787827dc29ae99276e46ef0c10a72dfb1377 Mon Sep 17 00:00:00 2001 From: Wim Haeck Date: Wed, 16 Jan 2019 15:38:51 -0700 Subject: [PATCH 3/3] Removed tabulation characters --- src/unresr.f90 | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/unresr.f90 b/src/unresr.f90 index 7540d8f6..008a077e 100644 --- a/src/unresr.f90 +++ b/src/unresr.f90 @@ -944,10 +944,10 @@ subroutine unresl(ee,tt,sig0,nsig0,sigbkg,sigu,arry) sigbt=sigbkg(1)+spot+sint do is=1,nsig0 sigm(is)=sigbt+sig0(is) - if (sigm(is).lt.zero) then + if (sigm(is).lt.zero) then call mess('unresl', 'Negative background xs in urr may cause issues',& - &'Check the evaluation') - endif + &'Check the evaluation') + endif enddo ispot=1 @@ -1110,11 +1110,11 @@ subroutine unresl(ee,tt,sig0,nsig0,sigbkg,sigu,arry) sti=gg(5)/del(itp) do is0=1,nsig0 beta=sigm(is0)/s0u - if (beta.lt.zero.and.abs(beta).lt.one.and.noissue) then - call mess('unresl','Square root of negative number detected',& - &'Probably caused by negative background xs in urr') - noissue=.false. - endif + if (beta.lt.zero.and.abs(beta).lt.one.and.noissue) then + call mess('unresl','Square root of negative number detected',& + &'Probably caused by negative background xs in urr') + noissue=.false. + endif call ajku(beta,sti,xj,xk) if (mu.gt.0) xj=xj*qw(kf,mu) if (mu.gt.0) xk=xk*qw(kf,mu)