*DECK SCREIR
      SUBROUTINE SCREIR(MAXR,NEL,NMDEPL,MY1,MY2,MD1,MD2,INOMIS,ISOTS,
     > ADRY,NVTOT,VTOT,YLDS,DECAY,ITNAM,ITZEA,KPAX,BPAX)
*
*-----------------------------------------------------------------------
*
*Purpose:
* read depletion data on input file. Based on LIBEIR.f routine in
* DRAGON.
*
*Copyright:
* Copyright (C) 2014 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
* 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
* MY1     first dimension of matrix YLDS
* MY2     number of particularized fission products
* MD1     number of types of radioactive decay reactions
* MD2     number of isotopes in output tables
* INOMIS  names of isotopes in chain
* ISOTS   name of isotopes in output tables
* ADRY    indices of fissile isotopes (positive values) and fission
*         products (negative values) in array YLDS
* NVTOT   number of Saphyb calls
* VTOT    volume of updated core per Saphyb call
* YLDS    fission yields
* DECAY   radioactive decay constants
*
*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
*
*-----------------------------------------------------------------------
*
*----
*  INPUT FORMAT
*----
*    CHAIN
*    [[ hnamson [ izea ]
*      [ [[ reaction [energy] ]]  ]
*    [ { STABLE |
*       FROM  [[ { DECAY | reaction }
*          [[ yield hnampar ]] ]] } ]
*    ]]
*    ENDCHAIN
*
      IMPLICIT NONE
*----
*  SUBROUTINE ARGUMENTS
*----
      INTEGER MAXR,NEL,MY1,MY2,MD1,MD2,INOMIS(2,NEL),ISOTS(2,MD2),
     > ADRY(NEL),NVTOT,ITNAM(3,NEL),ITZEA(NEL),KPAX(NEL+MAXR,NEL)
      CHARACTER NMDEPL(MAXR)*8
      REAL BPAX(NEL+MAXR,NEL)
      DOUBLE PRECISION VTOT(NVTOT),YLDS(MY1,MY2,NVTOT),
     > DECAY(MD1,MD2,NVTOT)
*----
*  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)
      CHARACTER HSMG*131
      INTEGER INDIC,NITMA,I0,IEL,JEL,IDEPL,INTG,IREAC,ISOT,JREL,JDEPL,
     > ID2,IY1,IY2,IV
      REAL FLOTT,RRAT
      DOUBLE PRECISION ZN,ZD
*----
*  READ LIST OF ISOTOPES AND PROPERTIES
*----
      DO 70 IY1=1,MY1
        IEL=0
        DO I0=1,NEL
          IF(ADRY(I0).EQ.IY1) THEN
*           IEL is a fissile isotope
            IEL=I0
          ENDIF
        ENDDO
        IF(IEL.EQ.0) GO TO 70
        DO 60 IY2=1,MY2
          JEL=0
          DO I0=1,NEL
            IF(-ADRY(I0).EQ.IY2) THEN
*             JEL is a fission fragment
              JEL=I0
            ENDIF
          ENDDO
          IF(JEL.EQ.0) GO TO 60
          KPAX(JEL,IEL)=KFISSP
          ZN=0.0D0
          ZD=0.0D0
          DO IV=1,NVTOT
            ZN=ZN+YLDS(IY1,IY2,IV)*VTOT(IV)
            ZD=ZD+VTOT(IV)
          ENDDO
          BPAX(JEL,IEL)=REAL(ZN/ZD)
   60   CONTINUE
   70 CONTINUE
      DO 100 IEL=1,NEL
        TEXT12=' '
        WRITE(TEXT12,'(2A4)') INOMIS(1,IEL),INOMIS(2,IEL)
        READ(TEXT12,'(3A4)') (ITNAM(I0,IEL),I0=1,3)
        DO 90 ID2=1,MD2
          IF(ISOTS(1,ID2).EQ.ITNAM(1,IEL).AND.
     >       ISOTS(2,ID2).EQ.ITNAM(2,IEL)) THEN
            KPAX(NEL+1,IEL)=1
            BPAX(NEL+1,IEL)=0.0
            DO 80 I0=1,MD1
            ZN=0.0D0
            ZD=0.0D0
            DO IV=1,NVTOT
              ZN=ZN+DECAY(I0,ID2,IV)*VTOT(IV)
              ZD=ZD+VTOT(IV)
            ENDDO
   80       BPAX(NEL+1,IEL)=BPAX(NEL+1,IEL)+REAL(ZN/ZD)*1.0E8
            GO TO 100
          ENDIF
   90 CONTINUE
  100 CONTINUE
      CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DBLINP)
  105 IF(INDIC.NE.3) CALL XABORT('SCREIR: 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
      WRITE(HSMG,'(16HSCREIR: ISOTOPE ,2A4,24HIS MISSING AMONG PARTICU,
     > 34HLARIZED ISOTOPES OF THE SAPHYB(1).)') KNADPL(1),KNADPL(2)
      CALL XABORT(HSMG)
*----
*  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('SCREIR: 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('SCREIR: 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,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('SCREIR: 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,NEL
                IF(KNADPL(1).EQ.ITNAM(1,JREL).AND.
     >             KNADPL(2).EQ.ITNAM(2,JREL)) THEN
                  JDEPL=JREL
                  GO TO 165
                ENDIF
 160          CONTINUE
              WRITE(HSMG,'(16HSCREIR: ISOTOPE ,2A4,16HIS MISSING AMONG,
     >        42H PARTICULARIZED ISOTOPES OF THE SAPHYB(2).)')
     >        KNADPL(1),KNADPL(2)
              CALL XABORT(HSMG)
 165          KPAX(IDEPL,JDEPL)=IREAC
              BPAX(IDEPL,JDEPL)=RRAT
 150        CONTINUE
            CALL XABORT('SCREIR: TO MANY PARENT ISOTOPES')
          ENDIF
 140    CONTINUE
      ELSE IF(TEXT12.EQ.'STABLE') THEN
        DO 141 IREAC=1,MAXR
 141    IF(KPAX(NEL+IREAC,IDEPL).NE.0) KPAX(NEL+IREAC,IDEPL)=-9999
        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('SCREIR: 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
      GO TO 105
*----
*  FIND FISSION PRODUCTS
*----
 190  DO 200 IEL=1,NEL
        DO 210 JEL=1,NEL
          IF(KPAX(JEL,IEL).EQ.KFISSP) KPAX(NEL+KFISSP,JEL)=-1
 210    CONTINUE
 200  CONTINUE
*----
*  RETURN FROM SCREIR
*----
      RETURN
      END
