*DECK LIBEIR SUBROUTINE LIBEIR(MAXR,NEL,NMDEPL,ITNAM,ITZEA,KPAX,BPAX) * *----------------------------------------------------------------------- * *Purpose: * Read depletion data on input file. * *Copyright: * Copyright (C) 2002 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 and G. Marleau. * *Parameters: input * MAXR number of reaction types. * NEL number of isotopes on library. * NMDEPL names of reactions: * NMDEPL(1)='DECAY'; NMDEPL(2)='NFTOT'; * NMDEPL(3)='NG' ; NMDEPL(4)='N2N'; * etc. * *Parameters: output * 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. * *Comments: * INPUT FORMAT * CHAIN * [[ hnamson [ izea ] * [ [[ { DECAY constant | * reaction [energy] } ]] ] * [ { STABLE | * FROM [[ { DECAY | reaction } * [[ yield hnampar ]] ]] } ] * ]] * ENDCHAIN * *----------------------------------------------------------------------- * USE GANLIB IMPLICIT NONE *---- * SUBROUTINE ARGUMENTS *---- INTEGER MAXR,NEL,ITNAM(3,NEL),ITZEA(NEL),KPAX(NEL+MAXR,NEL) CHARACTER NMDEPL(MAXR)*8 REAL BPAX(NEL+MAXR,NEL) *---- * INPUT FILE PARAMETERS *---- CHARACTER TEXT12*12 INTEGER KNADPL(3) DOUBLE PRECISION DBLINP *---- * INTERNAL PARAMETERS * KFISSP : DRAGON FISSION PRODUCT FLAG = 2 * POSITION OF NFTOT IN NMDEPL *---- INTEGER KFISSP PARAMETER (KFISSP=2) INTEGER INDIC,NITMA,NDEPL,IEL,JEL,IDEPL,INTG,IREAC,ISOT,JREL,JDEPL REAL FLOTT,RRAT *---- * READ LIST OF ISOTOPES AND PROPERTIES *---- TEXT12=' ' CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DBLINP) IF(INDIC.NE.3.OR.TEXT12.NE.'CHAIN') > CALL XABORT('LIBEIR: KEYWORD CHAIN MISSING') NDEPL=0 CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DBLINP) DO 100 IEL=1,NEL *---- * EXIT IF ENDCHAIN READ *---- IF(TEXT12.EQ.'ENDCHAIN') GO TO 105 *---- * ISOTOPE NAME READ * IF NAME ALREADY EXISTS SELECT ISOTOPE NUMBER * IF NAME NOT DEFINED ADD TO ISOTOPE LIST *---- IF(INDIC.NE.3) > CALL XABORT('LIBEIR: ISOTOPE NAME HNAMSON MISSING') READ(TEXT12,'(3A4)') KNADPL(1),KNADPL(2),KNADPL(3) DO 110 JEL=1,NDEPL IF(KNADPL(1).EQ.ITNAM(1,JEL).AND. > KNADPL(2).EQ.ITNAM(2,JEL).AND. > KNADPL(3).EQ.ITNAM(3,JEL) ) THEN IDEPL=JEL GO TO 115 ENDIF 110 CONTINUE NDEPL=NDEPL+1 IF(NDEPL.GT.NEL) > CALL XABORT('LIBEIR: TO MANY ISOTOPES') IDEPL=NDEPL ITNAM(1,IDEPL)=KNADPL(1) ITNAM(2,IDEPL)=KNADPL(2) ITNAM(3,IDEPL)=KNADPL(3) 115 CONTINUE *---- * READ IZEA *---- 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 CONTINUE IF(INDIC.NE.3) CALL XABORT('LIBEIR: 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 CONTINUE IF(INDIC.NE.3) > CALL XABORT('LIBEIR: 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 *---- DO 150 JEL=1,NEL *---- * 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('LIBEIR: ISOTOPE NAME hnampar MISSING') *---- * ISOTOPE NAME READ * IF NAME ALREADY EXISTS SELECT ISOTOPE NUMBER * IF NAME NOT DEFINED ADD TO ISOTOPE LIST *---- READ(TEXT12,'(3A4)') KNADPL(1),KNADPL(2),KNADPL(3) DO 160 JREL=1,NDEPL IF(KNADPL(1).EQ.ITNAM(1,JREL).AND. > KNADPL(2).EQ.ITNAM(2,JREL).AND. > KNADPL(3).EQ.ITNAM(3,JREL) ) THEN JDEPL=JREL GO TO 165 ENDIF 160 CONTINUE NDEPL=NDEPL+1 IF(NDEPL.GT.NEL) CALL XABORT('LIBEIR: TO MANY ISOTOPES') JDEPL=NDEPL ITNAM(1,JDEPL)=KNADPL(1) ITNAM(2,JDEPL)=KNADPL(2) ITNAM(3,JDEPL)=KNADPL(3) 165 CONTINUE KPAX(IDEPL,JDEPL)=IREAC BPAX(IDEPL,JDEPL)=RRAT 150 CONTINUE CALL XABORT('LIBEIR: TO MANY PARENT ISOTOPES') ENDIF 140 CONTINUE ELSE IF(TEXT12.EQ.'STABLE') THEN DO 141 IREAC=1,MAXR IF(KPAX(NEL+IREAC,IDEPL).NE.0) KPAX(NEL+IREAC,IDEPL)=-9999 141 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('LIBEIR: INVALID INTEGER') ELSE IF(INDIC.EQ.2) THEN CALL REDGET(INDIC,INTG,FLOTT,TEXT12,DBLINP) ENDIF KPAX(NEL+IREAC,IDEPL)=1 BPAX(NEL+IREAC,IDEPL)=RRAT *---- * READ NEXT KEYWORD FOR THIS ISOTOPE *---- GO TO 120 ENDIF 170 CONTINUE ENDIF 100 CONTINUE IF(INDIC.NE.3.OR.TEXT12.NE.'ENDCHAIN') > CALL XABORT('LIBEIR: KEYWORD ENDCHAIN MISSING') 105 CONTINUE *---- * FIND FISSION PRODUCTS *---- DO 200 IEL=1,NDEPL DO 210 JEL=1,NDEPL IF(KPAX(JEL,IEL).EQ.KFISSP) KPAX(NEL+KFISSP,JEL)=-1 210 CONTINUE 200 CONTINUE *---- * RETURN FROM LIBEIR *---- RETURN END