diff options
Diffstat (limited to 'Donjon/src/PCREIR.f')
| -rw-r--r-- | Donjon/src/PCREIR.f | 211 |
1 files changed, 211 insertions, 0 deletions
diff --git a/Donjon/src/PCREIR.f b/Donjon/src/PCREIR.f new file mode 100644 index 0000000..514ae20 --- /dev/null +++ b/Donjon/src/PCREIR.f @@ -0,0 +1,211 @@ +*DECK PCREIR + SUBROUTINE PCREIR(NMDEPL,MD2,NEL,ITNAM,ITZEA,KPAX,BPAX) +* +*----------------------------------------------------------------------- +* +*Purpose: +* Read depletion data on input file. Based on LIBEIR.f routine in +* DRAGON. +* +*Copyright: +* Copyright (C) 2020 Ecole Polytechnique de Montreal +* This library is free software; you can redistribute it and/or +* modify it under the terms of the GNU Lesser General Public +* License as published by the Free Software Foundation; either +* version 2.1 of the License, or (at your option) any later version. +* +*Author(s): +* A. Hebert +* +*Parameters: input +* NMDEPL names of reactions: +* NMDEPL(1)='DECAY'; NMDEPL(2)='NFTOT'; +* NMDEPL(3)='NG' ; NMDEPL(4)='N2N'; +* etc +* MD2 dimension of arrays ITNAM, ITZEA, KPAX and BPAX +* +*Parameters: output +* NEL number of particularized isotopes including macro +* ITNAM reactive isotope names in chain +* ITZEA 6-digit nuclide identifier +* atomic number z*10000 (digits) + mass number a*10 + +* energy state (0 = ground state, 1 = first state, etc.) +* KPAX complete reaction type matrix +* BPAX complete branching ratio matrix +* +*----------------------------------------------------------------------- +* +*---- +* INPUT FORMAT +*---- +* CHAIN +* [[ hnamson [ izea ] +* [ [[ { DECAY constant | +* reaction [energy] } ]] ] +* [ { STABLE | +* FROM [[ { DECAY | reaction } +* [[ yield hnampar ]] ]] } ] +* ]] +* ENDCHAIN +* + IMPLICIT NONE +*---- +* SUBROUTINE ARGUMENTS +*---- + INTEGER, PARAMETER::MAXR=12 + INTEGER MD2,NEL,ITNAM(3,MD2),ITZEA(MD2),KPAX(MD2+MAXR,MD2) + CHARACTER NMDEPL(MAXR)*8 + REAL BPAX(MD2+MAXR,MD2) +*---- +* INPUT FILE PARAMETERS +*---- + CHARACTER TEXT12*12 + INTEGER KNADPL(2) + DOUBLE PRECISION DBLINP +*---- +* INTERNAL PARAMETERS +* KFISSP : FISSION PRODUCT FLAG = 2 (POSITION OF NFTOT IN NMDEPL) +*---- + INTEGER KFISSP + PARAMETER (KFISSP=2) + INTEGER INDIC,NITMA,IEL,JEL,IDEPL,INTG,IREAC,ISOT,JREL,JDEPL + REAL FLOTT,RRAT +* + NEL=0 + CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DBLINP) + 105 IF(INDIC.NE.3) CALL XABORT('PCREIR: CHARACTER DATA EXPECTED') +*---- +* EXIT IF ENDCHAIN READ +*---- + IF(TEXT12.EQ.'ENDCHAIN') GO TO 190 +*---- +* ISOTOPE NAME READ +* IF NAME ALREADY EXISTS SELECT ISOTOPE NUMBER +* IF NAME NOT DEFINED ADD TO ISOTOPE LIST +*---- + IDEPL=0 + READ(TEXT12,'(2A4)') KNADPL(1),KNADPL(2) + DO 110 JEL=1,NEL + IF(KNADPL(1).EQ.ITNAM(1,JEL).AND. + > KNADPL(2).EQ.ITNAM(2,JEL)) THEN + IDEPL=JEL + GO TO 115 + ENDIF + 110 CONTINUE + NEL=NEL+1 + IF(NEL.GT.MD2) CALL XABORT('PCREIR: MD2 OVERFLOW(1).') + IDEPL=NEL + ITNAM(1,NEL)=KNADPL(1) + ITNAM(2,NEL)=KNADPL(2) +*---- +* READ IZEA +*---- + 115 CALL REDGET(INDIC,INTG,FLOTT,TEXT12,DBLINP) + IF(INDIC.EQ.1) THEN + ITZEA(IDEPL)=INTG + CALL REDGET(INDIC,INTG,FLOTT,TEXT12,DBLINP) + ELSE + ITZEA(IDEPL)=0 + ENDIF +*---- +* LOOP OVER ALL PARAMETERS ASSOCIATED WITH SON ISOTOPES +*---- + 120 IF(INDIC.NE.3) CALL XABORT('PCREIR: REACTION TYPE EXPECTED FOR' + > //' ISOTOPE '//TEXT12) +*---- +* IF KEYWORD IS 'FROM' READ LIST OF PARENT NUCLIDES +*---- + IF(TEXT12.EQ.'FROM') THEN +*---- +* LOOP OVER ALL PARAMETERS ASSOCIATED WITH PARENT ISOTOPES +*---- + CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DBLINP) + 130 IF(INDIC.NE.3) CALL XABORT('PCREIR: REACTION TYPE EXPECTED.') + DO 140 IREAC=1,MAXR + RRAT=1.0 +*---- +* TEST IF KEYWORD IS A REACTION +*---- + IF(TEXT12.EQ.NMDEPL(IREAC)) THEN +*---- +* READ LIST OF YIELD AND PARENT ISOTOPES +*---- + JDEPL=0 + DO 150 JEL=1,MD2 +*---- +* IF YIELD ABSENT GO TO TEST FOR NEW REACTION TYPE +*---- + CALL REDGET(INDIC,ISOT,RRAT,TEXT12,DBLINP) + IF(INDIC.NE.2) GO TO 130 + CALL REDGET(INDIC,ISOT,FLOTT,TEXT12,DBLINP) + IF(INDIC.NE.3) + > CALL XABORT('PCREIR: ISOTOPE NAME hnampar MISSING') +*---- +* ISOTOPE NAME READ +* IF NAME ALREADY EXISTS SELECT ISOTOPE NUMBER +* IF NAME NOT DEFINED ADD TO ISOTOPE LIST +*---- + READ(TEXT12,'(2A4)') KNADPL(1),KNADPL(2) + DO 160 JREL=1,MD2 + IF(KNADPL(1).EQ.ITNAM(1,JREL).AND. + > KNADPL(2).EQ.ITNAM(2,JREL)) THEN + JDEPL=JREL + GO TO 165 + ENDIF + 160 CONTINUE + NEL=NEL+1 + IF(NEL.GT.MD2) CALL XABORT('PCREIR: MD2 OVERFLOW(2).') + JDEPL=NEL + ITNAM(1,NEL)=KNADPL(1) + ITNAM(2,NEL)=KNADPL(2) + 165 KPAX(IDEPL,JDEPL)=IREAC + BPAX(IDEPL,JDEPL)=RRAT + 150 CONTINUE + CALL XABORT('PCREIR: TO MANY PARENT ISOTOPES') + ENDIF + 140 CONTINUE + ELSE IF(TEXT12.EQ.'STABLE') THEN + DO 141 IREAC=1,MAXR + IF(KPAX(MD2+IREAC,IDEPL).NE.0) KPAX(MD2+IREAC,IDEPL)=-9999 + 141 CONTINUE + DO 142 IEL=1,MD2 + KPAX(IDEPL,IEL)=0 + 142 CONTINUE + CALL REDGET(INDIC,INTG,FLOTT,TEXT12,DBLINP) +*---- +* READ NEXT KEYWORD FOR THIS ISOTOPE +*---- + ELSE + DO 170 IREAC=1,MAXR + RRAT=0.0 + IF(TEXT12.EQ.NMDEPL(IREAC)) THEN + CALL REDGET(INDIC,ISOT,RRAT,TEXT12,DBLINP) + IF(INDIC.EQ.1) THEN + CALL XABORT('PCREIR: INVALID INTEGER') + ELSE IF(INDIC.EQ.2) THEN + CALL REDGET(INDIC,INTG,FLOTT,TEXT12,DBLINP) + ENDIF + KPAX(MD2+IREAC,IDEPL)=1 + BPAX(MD2+IREAC,IDEPL)=RRAT +*---- +* READ NEXT KEYWORD FOR THIS ISOTOPE +*---- + GO TO 120 + ENDIF + 170 CONTINUE + ENDIF + GO TO 105 +*---- +* FIND FISSION PRODUCTS +*---- + 190 DO 200 IEL=1,MD2 + DO 210 JEL=1,MD2 + IF(KPAX(JEL,IEL).EQ.KFISSP) KPAX(MD2+KFISSP,JEL)=-1 + 210 CONTINUE + 200 CONTINUE + IF(NEL.NE.MD2) CALL XABORT('PCREIR: INVALID VALUE OF MD2.') +*---- +* RETURN FROM PCREIR +*---- + RETURN + END |