Skip to content

Commit

Permalink
Adding the necessary logic to read background rmatrix elements
Browse files Browse the repository at this point in the history
  • Loading branch information
@whaeck
whaeck committed Oct 25, 2023
1 parent 648f69b commit 537b8b0
Show file tree
Hide file tree
Showing 3 changed files with 113 additions and 14 deletions.
1 change: 1 addition & 0 deletions ReleaseNotes.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
31 changes: 19 additions & 12 deletions src/moder.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
95 changes: 93 additions & 2 deletions src/samm.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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)
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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)
Expand Down

0 comments on commit 537b8b0

Please sign in to comment.