diff options
Diffstat (limited to 'Trivac/src/KINXSD.f')
| -rwxr-xr-x | Trivac/src/KINXSD.f | 172 |
1 files changed, 172 insertions, 0 deletions
diff --git a/Trivac/src/KINXSD.f b/Trivac/src/KINXSD.f new file mode 100755 index 0000000..a84f39a --- /dev/null +++ b/Trivac/src/KINXSD.f @@ -0,0 +1,172 @@ +*DECK KINXSD + SUBROUTINE KINXSD(IPMAC,NGR,NBM,NBFIS,NDG,EVL,DT,DNF,DNS,LNUD, + 1 LCHD,OVR,CHI,CHD,SGF,SGD) +* +*----------------------------------------------------------------------- +* +*Purpose: +* Recover the 1/v and fission properties from L_MACROLIB which will be +* used for assembling source and kinetics matrix systems. +* +*Copyright: +* Copyright (C) 2010 Ecole Polytechnique de Montreal. +* +*Author(s): A. Hebert +* +*Parameters: input +* IPMAC pointer to L_MACROLIB object. +* NGR number of energy groups. +* NBM number of material mixtures. +* NBFIS number of fissile isotopes. +* NDG number of delayed-neutron groups. +* EVL steady-state eigenvalue. +* DNF delayed neutron fractions (from module input). +* DNS delayed neutron spectrum (from module input). +* LNUD flag: =.true. if DNF provided from module input. +* LCHD flag: =.true. if DNS provided from module input. +* +*Parameters: output +* OVR reciprocal neutron velocities/DT. +* CHI steady-state fission spectrum. +* CHD delayed fission spectrum +* SGF nu*fission macroscopic x-sections/keff. +* SGD delayed nu*fission macroscopic x-sections/keff. +* +*----------------------------------------------------------------------- +* + USE GANLIB +*---- +* SUBROUTINE ARGUMENTS +*---- + TYPE(C_PTR) IPMAC + INTEGER NGR,NBM,NBFIS,NDG + REAL EVL,DT,DNF(NDG),DNS(NDG,NGR),OVR(NBM,NGR),CHI(NBM,NBFIS,NGR), + 1 CHD(NBM,NBFIS,NGR,NDG),SGF(NBM,NBFIS,NGR),SGD(NBM,NBFIS,NGR,NDG) + LOGICAL LNUD,LCHD +*---- +* LOCAL VARIABLES (AUTOMATIC ALLOCATION) +*---- + LOGICAL LFIS,LFISD + CHARACTER TEXT12*12 + TYPE(C_PTR) JPMAC,KPMAC +*---- +* PROCESS FISSION SPECTRUM TERMS. +*---- + CHI(:NBM,:NBFIS,:NGR)=0.0 + CHD(:NBM,:NBFIS,:NGR,:NDG)=0.0 + SGF(:NBM,:NBFIS,:NGR)=0.0 + SGD(:NBM,:NBFIS,:NGR,:NDG)=0.0 + JPMAC=LCMGID(IPMAC,'GROUP') + KPMAC=LCMGIL(JPMAC,1) + CALL LCMLEN(KPMAC,'CHI',LENGT,ITYLCM) + IF(LENGT.GT.0) THEN + IF(LENGT.NE.NBM*NBFIS) CALL XABORT('@KINXSD: INVALID LENGTH FO' + 1 //'R CHI INFORMATION.') + DO 10 IGR=1,NGR + KPMAC=LCMGIL(JPMAC,IGR) + CALL LCMGET(KPMAC,'CHI',CHI(1,1,IGR)) + 10 CONTINUE + ELSE + DO 22 IBM=1,NBM + DO 21 IFIS=1,NBFIS + CHI(IBM,IFIS,1)=1.0 + DO 20 IGR=2,NGR + CHI(IBM,IFIS,IGR)=0.0 + 20 CONTINUE + 21 CONTINUE + 22 CONTINUE + ENDIF + IF(LCHD) THEN + DO 33 IDEL=1,NDG + DO 32 IGR=1,NGR + DO 31 IFIS=1,NBFIS + DO 30 IBM=1,NBM + CHD(IBM,IFIS,IGR,IDEL)=DNS(IDEL,IGR) + 30 CONTINUE + 31 CONTINUE + 32 CONTINUE + 33 CONTINUE + ELSE + KPMAC=LCMGIL(JPMAC,1) + CALL LCMLEN(KPMAC,'CHI01',LENGT,ITYLCM) + IF(LENGT.GT.0) THEN + IF(LENGT.NE.NBM*NBFIS) CALL XABORT('@KINXSD: INVALID LENGTH ' + 1 //'FOR DELAYED CHI INFORMATION.') + DO 42 IDEL=1,NDG + WRITE(TEXT12,'(3HCHI,I2.2)') IDEL + DO 40 IGR=1,NGR + KPMAC=LCMGIL(JPMAC,IGR) + CALL LCMGET(KPMAC,TEXT12,CHD(1,1,IGR,IDEL)) + 40 CONTINUE + 42 CONTINUE + ELSE + CHD(:NBM,:NBFIS,:NGR,:NDG)=0.0 + ENDIF + ENDIF + LFIS=.FALSE. + LFISD=.FALSE. + DO 52 IGR=1,NGR + DO 51 IFIS=1,NBFIS + DO 50 IBM=1,NBM + LFIS=LFIS.OR.(CHI(IBM,IFIS,IGR).NE.0.0) + LFISD=LFISD.OR.(CHD(IBM,IFIS,IGR,1).NE.0.0) + 50 CONTINUE + 51 CONTINUE + 52 CONTINUE +* + DO 85 IGR=1,NGR + KPMAC=LCMGIL(JPMAC,IGR) +*---- +* PROCESS FISSION NUSIGF TERMS. +*---- + IF(LFIS) THEN + CALL LCMLEN(KPMAC,'NUSIGF',LENGT,ITYLCM) + IF(LENGT.NE.NBM*NBFIS) CALL XABORT('@KINXSD: INVALID LENGTH FO' + 1 //'R NUSIGF INFORMATION.') + IF(LENGT.GT.0) CALL LCMGET(KPMAC,'NUSIGF',SGF(1,1,IGR)) + ENDIF + IF(LNUD) THEN + DO 62 IDEL=1,NDG + DO 61 IFIS=1,NBFIS + DO 60 IBM=1,NBM + SGD(IBM,IFIS,IGR,IDEL)=SGF(IBM,IFIS,IGR)*DNF(IDEL) + 60 CONTINUE + 61 CONTINUE + 62 CONTINUE + ELSE IF(LFISD) THEN + DO 70 IDEL=1,NDG + WRITE(TEXT12,'(6HNUSIGF,I2.2)') IDEL + CALL LCMLEN(KPMAC,TEXT12,LENGT,ITYLCM) + IF(LENGT.NE.NBM*NBFIS) CALL XABORT('@KINXSD: INVALID LENGTH FO' + 1 //'R DELAYED NUSIGF INFORMATION.') + IF(LENGT.GT.0) CALL LCMGET(KPMAC,TEXT12,SGD(1,1,IGR,IDEL)) + 70 CONTINUE + ENDIF +*---- +* PROCESS 1/V TERMS. +*---- + CALL LCMLEN(KPMAC,'OVERV',LENGT,ITYLCM) + IF(LENGT.EQ.NBM)THEN + CALL LCMGET(KPMAC,'OVERV',OVR(1,IGR)) + ELSEIF(LENGT.EQ.0)THEN + CALL XABORT('@KINXSD: MISSING OVERV DATA.') + ELSE + CALL XABORT('@KINXSD: INVALID OVERV DATA.') + ENDIF + DO 80 IBM=1,NBM + OVR(IBM,IGR)=OVR(IBM,IGR)/DT + 80 CONTINUE + 85 CONTINUE +* + DO 93 IGR=1,NGR + DO 92 IFIS=1,NBFIS + DO 91 IBM=1,NBM + SGF(IBM,IFIS,IGR)=SGF(IBM,IFIS,IGR)/EVL + DO 90 IDEL=1,NDG + SGD(IBM,IFIS,IGR,IDEL)=SGD(IBM,IFIS,IGR,IDEL)/EVL + 90 CONTINUE + 91 CONTINUE + 92 CONTINUE + 93 CONTINUE + RETURN + END |