Merge branch '15-implement-new-option-fiss-in-module-out-of-trivac' into 'main'

#15: Implement new option FISS in module OUT: of Trivac

See merge request dragon/5.1!24

2 files changed, 69 insertions, 17 deletions

diff --git a/Trivac/src/OUT.f b/Trivac/src/OUT.f
index 7c1f2bb..fe344d0 100755
--- a/Trivac/src/OUT.f
+++ b/Trivac/src/OUT.f
@@ -72,8 +72,8 @@
       IF(NENTRY.LE.1) CALL XABORT('OUT: TWO PARAMETERS EXPECTED.')
       IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2)) CALL XABORT('OUT: LCM '
      1 //'OBJECT EXPECTED AT LHS.')
-      IF(JENTRY(1).NE.0) CALL XABORT('OUT: ENTRY IN CREATE MODE EXPECT'
-     1 //'ED.')
+      IF((JENTRY(1).NE.0).AND.(JENTRY(1).NE.1)) CALL XABORT('OUT: ENTR'
+     1 //'Y IN CREATE OR MODIFICATION MODE EXPECTED.')
       IF((JENTRY(2).NE.2).OR.((IENTRY(2).NE.1).AND.(IENTRY(2).NE.2)))
      1 CALL XABORT('OUT: LCM OBJECT IN READ-ONLY MODE EXPECTED AT RHS.')
       IPMAC2=KENTRY(1)
@@ -84,9 +84,25 @@
          CALL XABORT('OUT: SIGNATURE OF '//TEXT12//' IS '//HSIGN//
      1   '. L_FLUX EXPECTED.')
       ENDIF
-      HSIGN='L_MACROLIB'
-      CALL LCMPTC(IPMAC2,'SIGNATURE',12,HSIGN)
-      CALL LCMPTC(IPMAC2,'LINK.FLUX',12,TEXT12)
+      IF(JENTRY(1).EQ.0) THEN
+        HSIGN='L_MACROLIB'
+        CALL LCMPTC(IPMAC2,'SIGNATURE',12,HSIGN)
+        CALL LCMPTC(IPMAC2,'LINK.FLUX',12,TEXT12)
+      ELSE
+        CALL LCMGTC(IPMAC2,'SIGNATURE',12,HSIGN)
+        IF(HSIGN.NE.'L_MACROLIB') THEN
+          TEXT12=HENTRY(1)
+          CALL XABORT('OUT: SIGNATURE OF '//TEXT12//' IS '//HSIGN//
+     1    '. L_MACROLIB EXPECTED.')
+        ENDIF
+        IGP(:NSTATE)=0
+        CALL LCMGET(IPMAC2,'STATE-VECTOR',IGP)
+        NGRP=IGP(1)
+        NBMIX=IGP(2)
+        NL=IGP(3)
+        NBFIS=IGP(4)
+        NALBP=IGP(8)
+      ENDIF
 *----
 *  RECOVER IPGEOM, IPMAC1 AND IPTRK POINTERS.
 *----
diff --git a/Trivac/src/OUTDRV.f b/Trivac/src/OUTDRV.f
index f377715..2ca16e3 100755
--- a/Trivac/src/OUTDRV.f
+++ b/Trivac/src/OUTDRV.f
@@ -168,6 +168,42 @@
          EVECT(I,IGR)=EVECT(I,IGR)*REAL(ZNORM)
    70    CONTINUE
    80    CONTINUE
+      ELSE IF(TEXT4.EQ.'FISS') THEN
+*        NORMALIZATION TO A GIVEN FISSION SECONDARY NEUTRON PRODUCTION.
+         CALL REDGET (INDIC,NITMA,POWER,TEXT4,DFLOTT)
+         IF(INDIC.NE.2) CALL XABORT('OUTDRV: REAL DATA EXPECTED.')
+*        NORMALIZATION FACTOR FOR THE DIRECT FLUX.
+         ZNORM=0.0D0
+         JPMAC1=LCMGID(IPMAC1,'GROUP')
+         DO 100 IGR=1,NGRP
+         KPMAC1=LCMGIL(JPMAC1,IGR)
+         CALL LCMLEN(KPMAC1,'NUSIGF',LENGT,ITYLCM)
+         IF(LENGT.EQ.0) THEN
+            CALL LCMLIB(KPMAC1)
+            CALL XABORT('OUTDRV: NUSIGF RECORD MISSING IN MACROLIB.')
+         ENDIF
+         ALLOCATE(ZUFIS(NBMIX,NBFIS))
+         SGD(:NBMIX)=0.0
+         CALL LCMGET(KPMAC1,'NUSIGF',ZUFIS)
+         DO IBM=1,NBMIX
+            DO IFISS=1,NBFIS
+              SGD(IBM)=SGD(IBM)+ZUFIS(IBM,IFISS)
+            ENDDO
+         ENDDO
+         DEALLOCATE(ZUFIS)
+         DO 90 K=1,NEL
+         L=MAT(K)
+         IF((L.EQ.0).OR.(IDL(K).EQ.0)) GO TO 90
+         ZNORM=ZNORM+EVECT(IDL(K),IGR)*VOL(K)*SGD(L)
+   90    CONTINUE
+  100    CONTINUE
+         ZNORM=POWER/ZNORM
+         WRITE(6,300) ' DIRECT',ZNORM
+         DO 120 IGR=1,NGRP
+         DO 110 I=1,NUN
+         EVECT(I,IGR)=EVECT(I,IGR)*REAL(ZNORM)
+  110    CONTINUE
+  120    CONTINUE
       ELSE IF(TEXT4.EQ.'SOUR') THEN
 *        NORMALIZATION TO A GIVEN SOURCE INTENSITY.
          CALL REDGET (INDIC,NITMA,SNUMB,TEXT4,DFLOTT)
@@ -175,7 +211,7 @@
 *        NORMALIZATION FACTOR FOR THE DIRECT FLUX.
          ZNORM=0.0D0
          JPMAC1=LCMGID(IPMAC1,'GROUP')
-         DO 100 IGR=1,NGRP
+         DO 140 IGR=1,NGRP
          KPMAC1=LCMGIL(JPMAC1,IGR)
          CALL LCMLEN(KPMAC1,'FIXE',LENGT,ITYLCM)
          IF(LENGT.EQ.0) THEN
@@ -183,18 +219,18 @@
             CALL XABORT('OUTDRV: SOURCE RECORD MISSING IN MACROLIB.')
          ENDIF
          CALL LCMGET(KPMAC1,'FIXE',SGD)
-         DO 90 K=1,NEL
+         DO 130 K=1,NEL
          L=MAT(K)
          IF(L.GT.0) ZNORM=ZNORM+VOL(K)*SGD(L)
-   90    CONTINUE
-  100    CONTINUE
+  130    CONTINUE
+  140    CONTINUE
          ZNORM=SNUMB/ZNORM
          WRITE(6,305) ' DIRECT',ZNORM
-         DO 120 IGR=1,NGRP
-         DO 110 I=1,NUN
+         DO 160 IGR=1,NGRP
+         DO 150 I=1,NUN
          EVECT(I,IGR)=EVECT(I,IGR)*REAL(ZNORM)
-  110    CONTINUE
-  120    CONTINUE
+  150    CONTINUE
+  160    CONTINUE
       ELSE IF(TEXT4.EQ.'COND') THEN
          NGCOND=0
          CALL REDGET (INDIC,NITMA,FLOTT,TEXT4,DFLOTT)
@@ -210,12 +246,12 @@
            IGCOND(NGCOND)=NGRP
            GO TO 40
          ELSE IF(INDIC.EQ.1) THEN
-  130      IF(NITMA.GT.NGRP) NITMA=NGRP
+  170      IF(NITMA.GT.NGRP) NITMA=NGRP
            NGCOND=NGCOND+1
            IGCOND(NGCOND)=NITMA
            CALL REDGET (INDIC,NITMA,FLOTT,TEXT4,DFLOTT)
            IF(INDIC.EQ.1) THEN
-             GO TO 130
+             GO TO 170
            ELSE IF(INDIC.EQ.3) THEN
              GO TO 40
            ELSE
@@ -246,7 +282,7 @@
          CALL KDRCPU(TK2)
          TKR=TK2-TK1
          WRITE(6,310) TKR
-         GO TO 140
+         GO TO 180
       ELSE
          CALL XABORT('OUTDRV: '//TEXT4//' IS AN INVALID KEY WORD.')
       ENDIF
@@ -254,7 +290,7 @@
 *----
 *  SCRATCH STORAGE DEALLOCATION
 *----
-  140 DEALLOCATE(FLUXC,SGD,EVECT,IGCOND,IHOM)
+  180 DEALLOCATE(FLUXC,SGD,EVECT,IGCOND,IHOM)
       RETURN
 *
   300 FORMAT(/9H OUTDRV: ,A7,28H FLUX NORMALIZATION FACTOR =,1P,E13.5)