diff options
Diffstat (limited to 'Trivac/src')
| -rwxr-xr-x | Trivac/src/OUT.f | 26 | ||||
| -rwxr-xr-x | Trivac/src/OUTDRV.f | 60 |
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) |