From 537b8b0060f6dfe12cbdad572299575a5c41b23e Mon Sep 17 00:00:00 2001 From: Wim Haeck Date: Wed, 25 Oct 2023 16:21:54 -0600 Subject: [PATCH] Adding the necessary logic to read background rmatrix elements --- ReleaseNotes.md | 1 + src/moder.f90 | 31 +++++++++------- src/samm.f90 | 95 +++++++++++++++++++++++++++++++++++++++++++++++-- 3 files changed, 113 insertions(+), 14 deletions(-) diff --git a/ReleaseNotes.md b/ReleaseNotes.md index 5a3ed6c0..816ef26e 100644 --- a/ReleaseNotes.md +++ b/ReleaseNotes.md @@ -5,6 +5,7 @@ Given here are some release notes for NJOY2016. Each release is made through a f This update fixes the following issues: - Fix an issue in ACER for thermal scattering leading to energy values being out of order when plotting the coherent elastic scattering cross section (this issue only affects plots, the thermal scattering ACE files do not change). - Increased allocation of an array in LEAPR to accommodate ENDF/B-VIII.1 thermal scattering evaluations and added a check to avoid an infinite loop when using a very fine beta grid. In addition, LEAPR will now warn the user about potential excessive calculation times and print out progression in the phonon expansion sum when the phonon expansion order is large. + - Added logic to MODER and RECONR to read background R-matrix element information fro LRF=7 resonance parameter data. - Fixing a few thing related to intel compiler warnings and errors. ## [NJOY2016.72](https://github.com/njoy/NJOY2016/pull/308) diff --git a/src/moder.f90 b/src/moder.f90 index dea0c478..36de6e58 100644 --- a/src/moder.f90 +++ b/src/moder.f90 @@ -693,18 +693,25 @@ subroutine file2a(nin,nout,nscr,a) call moreio(nin,nout,nscr,a,nb,nw) enddo if (kbk.gt.0) then - call listio(nin,nout,nscr,a,nb,nw) - lbk=n1h - if (lbk.eq.1) then - call tab1io(nin,nout,nscr,a,nb,nw) - do while (nb.ne.0) - call moreio(nin,nout,nscr,a,nb,nw) - enddo - call tab1io(nin,nout,nscr,a,nb,nw) - do while (nb.ne.0) - call moreio(nin,nout,nscr,a,nb,nw) - enddo - endif + do l=1,kbk + call contio(nin,nout,nscr,a,nb,nw) + lbk=l2h + if (lbk.eq.1) then + call tab1io(nin,nout,nscr,a,nb,nw) + do while (nb.ne.0) + call moreio(nin,nout,nscr,a,nb,nw) + enddo + call tab1io(nin,nout,nscr,a,nb,nw) + do while (nb.ne.0) + call moreio(nin,nout,nscr,a,nb,nw) + enddo + else if (lbk.eq.2.or.lbk.eq.3) then + call listio(nin,nout,nscr,a,nb,nw) + do while (nb.ne.0) + call moreio(nin,nout,nscr,a,nb,nw) + enddo + endif + enddo endif if (kps.eq.1)then call listio(nin,nout,nscr,a,nb,nw) diff --git a/src/samm.f90 b/src/samm.f90 index 2fc77064..3d2a2935 100644 --- a/src/samm.f90 +++ b/src/samm.f90 @@ -181,6 +181,7 @@ subroutine s2sammy(nin,res,maxres,mmtres,nmtres) integer::jnow,nb,nw,lfw,nis,i,lru,lrf,nro,naps,mode,lrx,kf,ki integer::nls,ner,j,ng,is,ll,iis,kchan,kpp,kres,kpar,jj,nrs,igroup integer::nch,ich,iso,ier,ipp,kk,kki,kkf + integer::kbk,lbk real(kr)::spin,parity,parl,capj,capjmx,gamf,gamf2,el,e1,e2,gamx real(kr),dimension(2)::s real(kr),parameter::zero=0 @@ -514,12 +515,23 @@ subroutine s2sammy(nin,res,maxres,mmtres,nmtres) kres=0 kpar=0 do igroup=1,ngroup + + !--read particle pair information call listio(nin,0,0,res(jnow),nb,nw) jnow=jnow+nw + do while (nb.ne.0) + call moreio(nin,0,0,res(jj),nb,nw) + jj=jj+nw + if (jj.gt.maxres) call error('s2sammy',& + 'res storage exceeded',' ') + enddo + kbk=l1h nch=n2h ich=nch-1 nchan(igroup,ier)=ich if (ich.gt.kchan) kchan=ich + + !--read resonance parameters call listio(nin,0,0,res(jnow),nb,nw) jj=jnow+nw do while (nb.ne.0) @@ -531,6 +543,41 @@ subroutine s2sammy(nin,res,maxres,mmtres,nmtres) nrs=nint(res(jnow+3)) kpar=kpar+nrs*(ich+2) kres=kres+nrs + + !--read background rmatrix elements + if (kbk.gt.0) then + do i=1,kbk + call contio(nin,0,0,res(jnow),nb,nw) + lbk=l2h + if (lbk.eq.1) then + call tab1io(nin,0,0,res(jj),nb,nw) + jj=jnow+nw + do while (nb.ne.0) + call moreio(nin,0,0,res(jj),nb,nw) + jj=jj+nw + if (jj.gt.maxres) call error('s2sammy',& + 'res storage exceeded',' ') + enddo + call tab1io(nin,0,0,res(jj),nb,nw) + jj=jnow+nw + do while (nb.ne.0) + call moreio(nin,0,0,res(jj),nb,nw) + jj=jj+nw + if (jj.gt.maxres) call error('s2sammy',& + 'res storage exceeded',' ') + enddo + else if (lbk.eq.2.or.lbk.eq.3) then + call listio(nin,0,0,res(jj),nb,nw) + jj=jnow+nw + do while (nb.ne.0) + call moreio(nin,0,0,res(jj),nb,nw) + jj=jj+nw + if (jj.gt.maxres) call error('s2sammy',& + 'res storage exceeded',' ') + enddo + endif + enddo + endif enddo if (kpar.gt.npar) npar=kpar if (kchan.gt.mchan) mchan=kchan @@ -573,6 +620,7 @@ subroutine rdsammy(nin,ier,jnow,nro,naps,mode,el,eh,& ! internals integer::nb,nw,nls,is,ng,ll,iis,i,ires,jj,nrs,llll,ig,igxm,lrx integer::j,ndig,kres,igroup,ichp1,ichan,ix,ich,ippx,igamma,l,nx,ires1 + integer::kbk,lbk real(kr)::pari,parl,capj,capjmx,c,awri,apl,aptru,apeff,spinjj real(kr)::gamf,gamf2,s1,s2,hw,ehalf,ell,x,gamx,qx real(kr),dimension(:),allocatable::a @@ -761,7 +809,7 @@ subroutine rdsammy(nin,ier,jnow,nro,naps,mode,el,eh,& gamma(1,ires,ier)=res(jj+3) gamgam(ires,ier)=res(jj+4) gamf=res(jj+5) - gamf=gamf*(-1)**ires + gamf=gamf*(-1)**ires gamx=0 if (lrx.gt.0) gamx=res(jj+2)-res(jj+3)-res(jj+4)-res(jj+5) if (gamx.lt.1.e-7_kr) gamx=0 @@ -1023,8 +1071,16 @@ subroutine rdsammy(nin,ier,jnow,nro,naps,mode,el,eh,& !--read the spin group information call listio(nin,0,0,res(jnow),nb,nw) + jj=jnow+nw + do while (nb.ne.0) + call moreio(nin,0,0,res(jj),nb,nw) + jj=jj+nw + if (jj.gt.maxres) call error('rdsammy',& + 'res storage exceeded',' ') + enddo sspin(igroup,ier)=c1h parity(igroup,ier)=c2h + kbk=l1h ichp1=n2h ichan=ichp1-1 ix=0 @@ -1057,7 +1113,7 @@ subroutine rdsammy(nin,ier,jnow,nro,naps,mode,el,eh,& if (jj.gt.maxres) call error('rdsammy',& 'res storage exceeded',' ') enddo - nresg(igroup,ier)=nint(res(jnow+3)) + nresg(igroup,ier)=l2h if (nresg(igroup,ier).gt.0) then jj=jnow+6 nx=6 @@ -1112,6 +1168,41 @@ subroutine rdsammy(nin,ier,jnow,nro,naps,mode,el,eh,& jj=jj+nx enddo endif + + !--read background rmatrix elements + if (kbk.gt.0) then + do l=1,kbk + call contio(nin,0,0,res(jnow),nb,nw) + lbk=l2h + if (lbk.eq.1) then + call tab1io(nin,0,0,res(jnow),nb,nw) + jj=jnow+nw + do while (nb.ne.0) + call moreio(nin,0,0,res(jj),nb,nw) + jj=jj+nw + if (jj.gt.maxres) call error('rdsammy',& + 'res storage exceeded',' ') + enddo + call tab1io(nin,0,0,res(jnow),nb,nw) + jj=jnow+nw + do while (nb.ne.0) + call moreio(nin,0,0,res(jj),nb,nw) + jj=jj+nw + if (jj.gt.maxres) call error('rdsammy',& + 'res storage exceeded',' ') + enddo + else if (lbk.eq.2.or.lbk.eq.3) then + call listio(nin,0,0,res(jnow),nb,nw) + jj=jnow+nw + do while (nb.ne.0) + call moreio(nin,0,0,res(jj),nb,nw) + jj=jj+nw + if (jj.gt.maxres) call error('rdsammy',& + 'res storage exceeded',' ') + enddo + endif + enddo + endif enddo if (ngroupm(ier).gt.1) then do igroup=2,ngroupm(ier)