Merge branch '20-correct-a-ntot1-issue-in-spn-bivac-trivac-solutions' into 'main'

#20: Correct more issues in non-regression tests

See merge request dragon/5.1!36

6 files changed, 69 insertions, 14 deletions

diff --git a/Trivac/src/BIVSPS.f b/Trivac/src/BIVSPS.f
index e03ce67..ece519c 100755
--- a/Trivac/src/BIVSPS.f
+++ b/Trivac/src/BIVSPS.f
@@ -106,6 +106,8 @@
       WRITE(TEXT12,'(4HNTOT,I1)') MIN(IL-1,9)
       CALL LCMLEN(KPMACR,TEXT12,LENGT,ITYLCM)
       CALL LCMLEN(KPMACR,'NTOT1',LENGT1,ITYLCM)
+      IF((LENGT1.GT.0).AND.(NW.EQ.0)) CALL XABORT('BIVSPS: YOU MUST HA'
+     1 //'VE NW>0.')
       IF((IL.EQ.1).AND.(LENGT.NE.NBMIX)) CALL XABORT('BIVSPS: NO NTOT0'
      1 //' CROSS SECTIONS.')
       IF(MOD(IL-1,2).EQ.0) THEN
diff --git a/Trivac/src/MACD.f b/Trivac/src/MACD.f
index b9ce53b..d820b62 100755
--- a/Trivac/src/MACD.f
+++ b/Trivac/src/MACD.f
@@ -70,6 +70,8 @@
          NIFISS=1
          NDG=0
          NALBP=0
+         ILEAK=0
+         NW=0
          NSTEP=0
          IF(NENTRY.EQ.2) THEN
             IF((IENTRY(2).NE.1).AND.(IENTRY(2).NE.2)) CALL XABORT('MACD'
@@ -97,6 +99,8 @@
          NIFISS=IPAR(4)
          NDG=IPAR(7)
          NALBP=IPAR(8)
+         ILEAK=IPAR(9)
+         NW=IPAR(10)
          NSTEP=IPAR(11)
       ENDIF
 *----
@@ -178,7 +182,8 @@
          CALL REDGET(INDIC,NITMA,FLOTT,TEXT4,DFLOTT)
          IF((INDIC.NE.3).OR.(TEXT4.NE.'INPU')) CALL XABORT('MACD: INPU'
      1   //'T KEYWORD EXPECTED.')
-         CALL MACXSI(IPLIST,IND,NMIXT,NGRP,NDG,NL,IMPX,NBMIX,JND)
+         CALL MACXSI(IPLIST,IND,NMIXT,NGRP,NDG,NL,IMPX,NBMIX,ILEAK,NW,
+     1   JND)
          IF(ISTEP.GT.0) THEN
             IF(IMPX.GT.1) CALL LCMLIB(IPLIST)
             CALL LCMSIX(IPLIST,' ',2)
@@ -208,9 +213,28 @@
          IPAR(6)=0
          IPAR(7)=NDG
          IPAR(8)=NALBP
+         IPAR(9)=ILEAK
+         IPAR(10)=NW
          IPAR(11)=NSTEP
          CALL LCMPUT(IPLIST,'STATE-VECTOR',NSTATE,1,IPAR)
+         IF(IMPX.GT.0) WRITE(6,100) IMPX,(IPAR(I),I=1,10)
       ENDIF
       IF(IMPX.GT.1) CALL LCMLIB(IPLIST)
       RETURN
+*
+  100 FORMAT(/8H OPTIONS/8H -------/
+     1 7H IPRINT,I6,30H   (0=NO PRINT/1=SHORT/2=MORE)/
+     2 7H NGROUP,I6,28H   (NUMBER OF ENERGY GROUPS)/
+     3 7H NBMIX ,I6,39H   (NUMBER OF MIXTURES IN THE MACROLIB)/
+     4 7H NANISO,I6,34H   (MAXIMUM SCATTERING ANISOTROPY)/
+     5 7H NIFISS,I6,45H   (MAXIMUM NUMBER OF FISSILE ISOTOPES IN A M,
+     6 7HIXTURE)/
+     7 7H NEDMAC,I6,34H   (NUMBER OF CROSS SECTION EDITS)/
+     8 7H ITRANC,I6,45H   (0=NO TRANSPORT CORRECTION/1=APOLLO TYPE/2,
+     9 43H=RECOVER FROM LIBRARY/4=LEAKAGE CORRECTION)/
+     1 7H NLG   ,I6,39H   (NUMBER OF DELAYED PRECURSOR GROUPS)/
+     2 7H NALB  ,I6,31H   (NUMBER OF PHYSICAL ALBEDOS)/
+     3 7H ILEAK ,I6,40H   (1=DIFF AVAILABLE; 2=DIFFX AVAILABLE)/
+     4 7H NW    ,I6,45H   (=0/1: P1-WEIGHTED INFORMATION ABSENT/PRES,
+     5 4HENT))
       END
diff --git a/Trivac/src/MACXSI.f b/Trivac/src/MACXSI.f
index 6cfac6a..406cecb 100755
--- a/Trivac/src/MACXSI.f
+++ b/Trivac/src/MACXSI.f
@@ -1,5 +1,6 @@
 *DECK MACXSI
-      SUBROUTINE MACXSI (IPLIST,IND,NMIXT,NGRP,NDG,NL,IMPX,NBMIX,JND)
+      SUBROUTINE MACXSI (IPLIST,IND,NMIXT,NGRP,NDG,NL,IMPX,NBMIX,ILEAK,
+     1 NW,JND)
 *
 *-----------------------------------------------------------------------
 *
@@ -27,6 +28,8 @@
 *
 *Parameters: output
 * NBMIX   number of mixtures.
+* ILEAK   type of diffusion coefficient.
+* NW      weighting flag (=0/1: P1-weighted information absent/present).
 * JND     REDGET flag (=1 ';' encountered; =2 'STEP' encountered).
 *
 *-----------------------------------------------------------------------
@@ -36,7 +39,7 @@
 *  SUBROUTINE ARGUMENTS
 *----
       TYPE(C_PTR) IPLIST
-      INTEGER IND,NMIXT,NGRP,NDG,NL,IMPX,NBMIX,JND
+      INTEGER IND,NMIXT,NGRP,NDG,NL,IMPX,NBMIX,ILEAK,NW,JND
 *----
 *  LOCAL VARIABLES
 *----
@@ -138,7 +141,7 @@
          CALL LCMLEN(KPLIST,'FIXE',ILENGT,ITYLCM)
          IF(ILENGT.EQ.NMIXT) CALL LCMGET(KPLIST,'FIXE',S(1,JGR))
          DO 30 IL=1,NL
-         WRITE (CM,'(I2.2)') IL-1
+         WRITE(CM,'(I2.2)') IL-1
          CALL LCMLEN(KPLIST,'SCAT'//CM,ILENGT,ITYLCM)
          IF(ILENGT.GT.NMIXT*NL*NGRP*NGRP) THEN
             CALL XABORT('MACXSI: INVALID INPUT MACROLIB(2).')
@@ -316,7 +319,7 @@
       ENDIF
       IF(LSC) THEN
          DO 200 IL=1,NL
-         WRITE (CM,'(I2.2)') IL-1
+         WRITE(CM,'(I2.2)') IL-1
          IPOSDE=0
          DO 195 IBM=1,NMIXT
          J2=JGR
@@ -345,6 +348,14 @@
       IF(IMPX.GT.1) CALL LCMLIB(KPLIST)
   210 CONTINUE
 *----
+*  SET STATE-VECTOR FLAGS
+*----
+      NW=0
+      IF(LT1) NW=1
+      ILEAK=0
+      IF(LD) ILEAK=1
+      IF(LDX.OR.LDY.OR.LDZ) ILEAK=2
+*----
 *  SCRATCH STORAGE DEALLOCATION
 *----
       DEALLOCATE(TOTAL,TOTA1,ZNUG,CHI,NUSDL,CHDL,OVERV,DIFFX,DIFFY,
diff --git a/Trivac/src/OUTAUX.f b/Trivac/src/OUTAUX.f
index 64a2567..d3e1ed7 100755
--- a/Trivac/src/OUTAUX.f
+++ b/Trivac/src/OUTAUX.f
@@ -47,7 +47,7 @@
 *  SUBROUTINE ARGUMENTS
 *----
       TYPE(C_PTR) IPMAC1,IPMAC2
-      PARAMETER(NREAC=11)
+      PARAMETER(NREAC=12)
       INTEGER NBMIX,NL,NBFIS,NGRP,NEL,NUN,NALBP,NZS,NGCOND,MAT(NEL),
      1 IDL(NEL),IHOM(NEL),IGCOND(NGCOND),IMPX
       REAL VOL(NEL),EVECT(NUN,NGRP)
@@ -73,7 +73,7 @@
 *  DATA STATEMENT
 *----
       DATA HREAC/'NTOT0','SIGW00','NUSIGF','NFTOT','H-FACTOR',
-     1 'OVERV','DIFF','DIFFX','DIFFY','DIFFZ','C-FACTOR'/
+     1 'OVERV','DIFF','DIFFX','DIFFY','DIFFZ','NTOT1','C-FACTOR'/
 *----
 *  SCRATCH STORAGE ALLOCATION
 *   OUTR(IBM,NREAC+1): volume
@@ -511,8 +511,9 @@
       ELSE IF(LREAC(8)) THEN
          IDATA(9)=2
       ENDIF
-      IDATA(15)=0
+      IF(LREAC(11)) IDATA(10)=1
       CALL LCMPUT(IPMAC2,'STATE-VECTOR',NSTATE,1,IDATA)
+      IF(IMPX.GT.0) WRITE(6,550) IMPX,(IDATA(I),I=1,10)
 *----
 *  SCRATCH STORAGE DEALLOCATION
 *----
@@ -524,4 +525,19 @@
   520 FORMAT(/' G R O U P   : ',I3/1X,'IHOM',9A14)
   530 FORMAT(1X,I4,1P,9E14.5)
   540 FORMAT(/5H  SUM,1P,8E14.5)
+  550 FORMAT(/17H MACROLIB OPTIONS/17H ----------------/
+     1 7H IPRINT,I6,30H   (0=NO PRINT/1=SHORT/2=MORE)/
+     2 7H NGROUP,I6,28H   (NUMBER OF ENERGY GROUPS)/
+     3 7H NBMIX ,I6,39H   (NUMBER OF MIXTURES IN THE MACROLIB)/
+     4 7H NANISO,I6,34H   (MAXIMUM SCATTERING ANISOTROPY)/
+     5 7H NIFISS,I6,45H   (MAXIMUM NUMBER OF FISSILE ISOTOPES IN A M,
+     6 7HIXTURE)/
+     7 7H NEDMAC,I6,34H   (NUMBER OF CROSS SECTION EDITS)/
+     8 7H ITRANC,I6,45H   (0=NO TRANSPORT CORRECTION/1=APOLLO TYPE/2,
+     9 43H=RECOVER FROM LIBRARY/4=LEAKAGE CORRECTION)/
+     1 7H NLG   ,I6,39H   (NUMBER OF DELAYED PRECURSOR GROUPS)/
+     2 7H NALB  ,I6,31H   (NUMBER OF PHYSICAL ALBEDOS)/
+     3 7H ILEAK ,I6,40H   (1=DIFF AVAILABLE; 2=DIFFX AVAILABLE)/
+     4 7H NW    ,I6,45H   (=0/1: P1-WEIGHTED INFORMATION ABSENT/PRES,
+     5 4HENT))
       END
diff --git a/Trivac/src/TRIRCA.f b/Trivac/src/TRIRCA.f
index 8202f29..6c1b496 100755
--- a/Trivac/src/TRIRCA.f
+++ b/Trivac/src/TRIRCA.f
@@ -79,6 +79,8 @@
       WRITE(TEXT12,'(4HNTOT,I1)') MIN(IL-1,9)
       CALL LCMLEN(KPMACP,TEXT12,LENGT,ITYLCM)
       CALL LCMLEN(KPMACP,'NTOT1',LENGT1,ITYLCM)
+      IF((LENGT1.GT.0).AND.(NW.EQ.0)) CALL XABORT('TRIRCA: YOU MUST HA'
+     1 //'VE NW>0.')
       IF((IL.EQ.1).AND.(LENGT.NE.NBMIX)) CALL XABORT('TRIRCA: NO NTOT0'
      1 //' CROSS SECTIONS.')
       IF(MOD(IL-1,2).EQ.0) THEN
@@ -130,11 +132,9 @@
             ENDIF
             GO TO 100
          ELSE
-            IF(NW.EQ.0) THEN
-               CALL LCMGET(KPMACP,'NTOT0',SGD(1,2))
-            ELSE IF(LENGT.EQ.NBMIX) THEN
+            IF(LENGT.EQ.NBMIX) THEN
                CALL LCMGET(KPMACP,TEXT12,SGD(1,2))
-            ELSE IF((NW.GE.1).AND.(LENGT1.EQ.NBMIX)) THEN
+            ELSE IF(LENGT1.EQ.NBMIX) THEN
                CALL LCMGET(KPMACP,'NTOT1',SGD(1,2))
             ELSE
                CALL LCMGET(KPMACP,'NTOT0',SGD(1,2))
diff --git a/Trivac/src/TRIVAA.f b/Trivac/src/TRIVAA.f
index b1628c4..5189511 100755
--- a/Trivac/src/TRIVAA.f
+++ b/Trivac/src/TRIVAA.f
@@ -141,6 +141,7 @@
       NBFIS=IPAR(4)
       NALBP=IPAR(8)
       NW=IPAR(10)
+      NW2=0
       IF(IGP(4).GT.NBMIX) THEN
          WRITE(HSMG,'(46HTRIVAA: THE NUMBER OF MIXTURES IN THE TRACKING,
      1   2H (,I5,51H) IS GREATER THAN THE NUMBER OF MIXTURES IN THE MAC,
@@ -219,6 +220,7 @@
      1      //TEXT11//'. L_MACROLIB EXPECTED.')
          ENDIF
          CALL LCMGET(IPMACP,'STATE-VECTOR',IPAR)
+         NW2=IPAR(10)
          NSTEP=IPAR(11)
          IF((IPAR(1).NE.NGRP).OR.(IPAR(2).GT.NBMIX)) THEN
             WRITE(HSMG,'(43HTRIVAA: INCONSISTENT PERTURBATION MACROLIB ,
@@ -271,7 +273,7 @@
          ELSE
 *           SIMPLIFIED PN THEORY.
             CALL TRISPS(IPTRK,IPMACR,IPMACP,IPSYS,IMPX,NGRP,NEL,NLF,
-     1      NAN,NW,NBFIS,NALBP,LDIFF,IPR,MAT,VOL,NBMIX)
+     1      NAN,NW2,NBFIS,NALBP,LDIFF,IPR,MAT,VOL,NBMIX)
          ENDIF
       ELSE IF(NSTEP.GT.0) THEN
 *        ASSEMBLY OF PERTURBED SYSTEM MATRICES (WITH STEP DIRECTORIES).
@@ -288,7 +290,7 @@
          ELSE
 *           SIMPLIFIED PN THEORY.
             CALL TRISPS(IPTRK,IPMACR,KPMACR,KPSYS,IMPX,NGRP,NEL,NLF,
-     1      NAN,NW,NBFIS,NALBP,LDIFF,IPR,MAT,VOL,NBMIX)
+     1      NAN,NW2,NBFIS,NALBP,LDIFF,IPR,MAT,VOL,NBMIX)
          ENDIF
    50    CONTINUE
       ELSE