Fix/heatr moreio

ReleaseNotes.md

@@ -1,6 +1,12 @@
 # Release Notes—NJOY2016
 Given here are some release notes for NJOY2016. Each release is made through a formal [Pull Request](https://github.com/njoy/NJOY2016/pulls) made on GitHub. There are links in this document that point to each of those Pull Requests, where you can see in great details the changes that were made. Often the Pull Requests are made in response to an [issue](https://github.com/njoy/NJOY2016/issues). In such cases, links to those issues are also given.
 
+## [NJOY2016.70](https://github.com/njoy/NJOY2016/pull/xxx)
+This update fixes a number of minor issues:
+  - Fixed an issue in HEATR when reading evaluations with large multiplicity tables in MF6.
+
+A few compiler warnings have been resolved as well (unused variables). For source files that were corrected in this way, the remaining warnings relate to equality comparisons for real values, unused dummy arguments in subroutines and potential 0 indices into arrays (in all cases, if statements prevented this from happening).
+
 ## [NJOY2016.69](https://github.com/njoy/NJOY2016/pull/281)
 This update fixes a number of minor issues:
   - PURR now writes Bondarenko data obtained from the probability tables to MF2 MT152 instead of the Bondarenko data obtained from the direct sampled cross sections (for very low dilutions, the Bondarenko data obtained using these two methods does not align, with the direct sampled data leading to extremely low P1 values). When comparing with the Bondarenko data at low dilutions obtained with UNRESR, the Bondarenko data obtained from the probability table directly seems to be the best.

src/acepn.f90

@@ -48,7 +48,7 @@ subroutine acephn(nendf,npend,nace,ndir,matd,tempd,iprint,mcnpx,&
    integer::nneut,nphot,nprot,ndeut,ntrit,nhe3,nhe4
    integer::k,ia,iaa,nk,ik,lly,izai,izap,law,jscr,nrr,npp
    integer::ll,lll,lep,ne,llh,lld,ie,np,ip,mtt,lct,ii
-   integer::icapt,jj,itype,it,jp,nr,il,llht,iie,lang,lleg,ileg
+   integer::icapt,jj,itype,it,jp,nr,il,llht,iie,lang
    integer::iint,nn,kk,m,intt,last,lf,jnt,ja,jb,ipp,irr
    integer::lee,lle,nd,na,ncyc,ng,ig,nnr,nnp,mf,mt
    integer::ipt,ntrp,pxs,phn,mtrp,tyrp,lsigp,sigp,landp,andp,ldlwp,dlwp
@@ -74,7 +74,6 @@ subroutine acephn(nendf,npend,nace,ndir,matd,tempd,iprint,mcnpx,&
    real(kr),parameter::eps=1.e-10_kr
    real(kr),parameter::zero=0
    real(kr),parameter::one=1
-   integer,parameter::ni=64
    character(66)::text
    emc2=amassn*amu*clight*clight/ev/emev
    tvn=1
@@ -1861,7 +1860,6 @@ subroutine phnfix(itype,nin,nout,ndir,iprint,nplot,mcnpx,suff,&
    real(kr),parameter::zero=0
 
    integer,parameter::ner=1
-   integer,parameter::nbw=1
 
    !--read type 1 ace format file
    call openz(nin,0)
@@ -2455,8 +2453,8 @@ subroutine phnout(itype,nout,ndir,mcnpx,hk,izn,awn)
    real(kr)::awn(16)
    character(70)::hk
    ! internals
-   integer::l,n,ne,ip,mftype,nr,li,ir,nn,ll,k,np,nw,nmu,nrr
-   integer::ii,lnw,law,kk,nern,lrec,j,i
+   integer::l,n,ne,ip,mftype,nr,nn,ll,k,np,nmu,nrr
+   integer::lnw,law,nern,lrec,j,i
    integer::ipt, ntrp, pxs, phn, mtrp, tyrp, lsigp, sigp, landp, andp, ldlwp, dlwp ! IXS
    integer::rlocator  ! locator index for reaction data
    integer::plocator  ! locator index for the particle IXS array

src/heatr.f90

@@ -272,7 +272,7 @@ subroutine heatr
         &'' auxiliary q values ................... '',1p,e12.4)') qa(1)
       if (nqa.gt.1) write(nsyso,'(40x,1p,e12.4)') (qa(i),i=2,nqa)
       if (nzq.ne.0) then
-         do i=1,nqa
+         do i=1,nqa 
             if (qa(i).ge.qtest) then
                nsh=0
                math=1
@@ -644,7 +644,13 @@ subroutine hinit(iold,nend4,nend6,nscr)
          ifc4=0
          ifc5=0
          ifc6=0
-         call listio(nendf,0,0,scr,nb,nw)
+         l=1
+         call listio(nendf,0,0,scr(l),nb,nw)
+         l=l+nw
+         do while (nb.ne.0)
+            call moreio(nendf,0,0,scr(l),nb,nw)
+            l=l+nw
+         enddo
          nply=nint(scr(4))
          if (lfc.eq.0) then
             allocate(cpoly(0:nply))
@@ -693,7 +699,7 @@ subroutine hinit(iold,nend4,nend6,nscr)
             qdel=0
             do i=1,nfc
                l=1
-               call tab1io(nendf,0,0,scr,nb,nw)
+               call tab1io(nendf,0,0,scr(l),nb,nw)
                do while (nb.ne.0)
                   l=l+nw
                   call moreio(nendf,0,0,scr(l),nb,nw)
@@ -810,9 +816,16 @@ subroutine hinit(iold,nend4,nend6,nscr)
             awrr=c2h+1
             ielem=mod(nint(c1h),1000)
             do ik=1,nk
-               call tab1io(nendf,nend6,0,scr,nb,nw)
+               l=1
+               call tab1io(nendf,nend6,0,scr(l),nb,nw)
+               l=l+nw
+               do while (nb.ne.0)
+                  call moreio(nendf,nend6,0,scr(l),nb,nw)
+                  l=l+nw
+               enddo
                nr=n1h
                zap=c1h
+               law=l2h
                if (nint(zap).eq.0) then
                   i6p=i6p+1
                   mt6yp(i6p)=mth
@@ -853,10 +866,6 @@ subroutine hinit(iold,nend4,nend6,nscr)
                   mt6no(ii6)=nk
                endif
                if (zap.eq.zero) mgam=10+mod(mgam,10)
-               law=l2h
-               do while (nb.ne.0)
-                  call moreio(nendf,nend6,0,scr,nb,nw)
-               enddo
                if (law.eq.6) then
                   call contio(nendf,nend6,0,scr,nb,nw)
                else if (law.eq.1.or.law.eq.2.or.law.eq.5) then
@@ -2311,7 +2320,13 @@ subroutine hgtyld(e,enext,idis,yld,mat,mf,mt,itape,a,na)
       call contio(itape,0,0,a,nb,nw)
       lnu=nint(a(4))
       if (mth.eq.455) then
-         call listio(itape,0,0,a,nb,nw)
+         loc=1
+         call listio(itape,0,0,a(loc),nb,nw)
+         loc=loc+nw
+         do while (nb.ne.0)
+            call moreio(itape,0,0,a(loc),nb,nw)
+            loc=loc+nw
+         enddo
          lnd=nint(a(5))
          if (lnd.ne.6.and.lnd.ne.8)&
            call error('hgtyld','illegal lnd, must be 6 or 8',' ')
@@ -2347,8 +2362,15 @@ subroutine hgtyld(e,enext,idis,yld,mat,mf,mt,itape,a,na)
             nr=nint(a(5))
             enext=a(7+2*nr)
          else
-            call listio(itape,0,0,a,nb,nw)
+            loc=1
+            call listio(itape,0,0,a(loc),nb,nw)
+            loc=loc+nw
             na=nw
+            do while (nb.ne.0)
+               call moreio(itape,0,0,a(loc),nb,nw)
+               loc=loc+nw
+               na=na+nw
+            enddo
             enext=emax
          endif
       endif
@@ -2778,6 +2800,11 @@ subroutine sixbar(e,ebar,yld,dame,nin,c,ncmax,nscr,b,nbmax,&
    do while (ik.lt.irec-1)
       ik=ik+1
       call tab1io(nin,0,0,c(l),nb,nw)
+      l=l+nw
+      do while (nb.ne.0)
+         call moreio(nin,0,0,c(l),nb,nw)
+         l=l+nw
+      enddo
       law=l2h
       call skip6(nin,0,0,c(l),law)
    enddo
@@ -2790,10 +2817,14 @@ subroutine sixbar(e,ebar,yld,dame,nin,c,ncmax,nscr,b,nbmax,&
   110 continue
    l=1
    call tab1io(nin,0,0,c(l),nb,nw)
+   l=l+nw
+   do while (nb.ne.0)
+      call moreio(nin,0,0,c(l),nb,nw)
+      l=l+nw
+   enddo
    zap=c1h
    awp=c2h
    law=l2h
-   l=l+nw
 
    !--error for awp=0. for non photons
    if (zap.ne.0.and.awp.eq.0) then
@@ -2802,10 +2833,6 @@ subroutine sixbar(e,ebar,yld,dame,nin,c,ncmax,nscr,b,nbmax,&
      call error('sixbar',strng,' ')
    endif
 
-   do while (nb.ne.0)
-      call moreio(nin,0,0,c(l),nb,nw)
-      l=l+nw
-   enddo
    iflag=0
    disc102=0
    if (zap.eq.zero) then
@@ -4721,7 +4748,13 @@ subroutine hconvr(nin,nout,nscr)
    lg=l2h
    g=1
    l2flg=1
-   call listio(nin,0,0,scr,nb,nw)
+   l=1
+   call listio(nin,0,0,scr(l),nb,nw)
+   l=l+nw
+   do while (nb.ne.0)
+      call moreio(nin,0,0,scr(l),nb,nw)
+      l=l+nw
+   enddo
 
    !--set base value for mt0
    if (mth.ge.51.and.mth.le.91.and.mt0.ne.49) mt0=49

src/vers.f90

@@ -4,5 +4,5 @@ module version
    implicit none
    private
    character(8),public::vers='2016.69'
-   character(8),public::vday='07Feb22'
+   character(8),public::vday='xxXxx23'
 end module version