*DECK LIBEWR
      SUBROUTINE LIBEWR(CFILNA,MAXR,NEL,ITNAM,KPAX,BPAX)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Read depletion data on a WIMA-AECL formatted library
*
*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): G. Marleau
*
*Parameters: input
* CFILNA  WIMA-AECL file name
* MAXR    number of reaction types
* NEL     number of isotopes on library
*
*Parameters: output
* ITNAM   reactive isotope names in chain
* KPAX    complete reaction type matrix
* BPAX    complete branching ratio matrix
*
*-----------------------------------------------------------------------
*
      USE GANLIB
      IMPLICIT NONE
*----
*  SUBROUTINE ARGUMENTS
*----
      CHARACTER CFILNA*8
      INTEGER MAXR,NEL,ITNAM(3,NEL),KPAX(NEL+MAXR,NEL)
      REAL BPAX(NEL+MAXR,NEL)
*----
*  INTERNAL PARAMETERS
*   CONVE  : ENERGY CONVERSION FACTOR FROM JOULES/(MOLES*10**-24)
*            TO MEV/NUCLIDE = 1.03643526E+13
*   CONVD  : DECAY CONSTANT CONVERSION FACTOR FROM S**(-1) TO
*            10**(-8)*S**(-1) = 1.0+8
*----
      INTEGER      KCAPTU,KDECAY,KFISSP,KN2N,KN3N
      REAL         CONVE,CONVD
      PARAMETER   (KDECAY=1,KFISSP=2,KCAPTU=3,KN2N=4,KN3N=5,
     >             CONVE=1.03643526E+13,CONVD=1.0E+8)
      CHARACTER    TEXT8*8
*----
*  WIMS-AECL LIBRARY PARAMETERS
*   IUTYPE : TYPE OF FILE = 4 (DA)                I
*   LRIND  : LENGHT RECORD ON DA FILE = 256       I
*   IACTO  : OPEN ACTION = 2 (READ ONLY)          I
*   IACTC  : CLOSE ACTION = 2 (KEEP)              I
*   MAXISO : MAX. NB. OF ISO = 246                I
*   MLDEP  : MAXIMUM NUMBER OF REACTION PER       I
*            ISOTOPE IN WIMS-AECL = MAXISO+4
*   LPZ    : LENGTH OF WIMS PARAMETER ARRAY = 9   I
*   LMASTB : LENGTH OF MST TAB = MAXISO+9         I
*   LMASIN : LENGTH OF MST IDX = LMASTB-4         I
*   LGENTB : LENGTH OF GEN TAB = 6                I
*   LGENIN : LENGTH OF GEN IDX = LGENTB           I
*   LSUBTB : LENGTH OF SUB TAB = 6*MAXTEM+21-5+12 I
*   LSUBIN : LENGTH OF SUB IDX = LSUBTB-12        I
*   ICAPTU : WIMS-AECL CAPTURE FLAG = 1           I
*   IDECAY : WIMS-AECL DECAY FLAG = 2             I
*   IFISSP : WIMS-AECL FISSION PRODUCT FLAG = 3   I
*   IFISSI : WIMS-AECL FISSILE ISOTOPE FLAG = 4   I
*   IN2N   : WIMS-AECL N2N FLAG = 5               I
*   IN3N   : WIMS-AECL N3N FLAG = 6               I
*   MASTER : MASTER INDEX ARRAY                   I(LMASTB)
*   GENINX : GENERAL INDEX ARRAY                  I(LGENTB)
*   SUBINX : SUB INDEX ARRAY                      I(LSUBTB)
*   NPZ    : LIST OF MAIN PARAMETERS              I(LPZ)
*   IWISO  : ID OF ISOTOPE                        I(2*MAXISO)
*   IBURN  : INTEGER BURNUP PARAMETERS            I(2,MLDEP)
*   RBURN  : REAL BURNUP PARAMETERS               R(2,MLDEP)
*----
      INTEGER      IUTYPE,LRIND,IACTO,IACTC,MAXISO,MLDEP,LPZ,
     >             MAXTEM,LMASTB,LMASIN,LGENTB,LGENIN,LSUBTB,
     >             LSUBIN,ICAPTU,IDECAY,IFISSP,IFISSI,IN2N,IN3N
      PARAMETER   (IUTYPE=4,LRIND=256,IACTO=2,IACTC=1,MAXISO=246,
     >             MLDEP=MAXISO+4,LPZ=9,MAXTEM=20,LMASTB=MAXISO+9,
     >             LMASIN=LMASTB-4,LGENTB=6,LGENIN=LGENTB,
     >             LSUBTB=6*MAXTEM+28,LSUBIN=LSUBTB-12,ICAPTU=1,
     >             IDECAY=2,IFISSP=3,IFISSI=4,IN2N=5,IN3N=6)
      INTEGER      MASTER(LMASTB),GENINX(LGENTB),SUBINX(LSUBTB),
     >             NPZ(LPZ),IWISO(2*MAXISO)
*----
*  EXTERNAL FUNCTIONS
*----
      INTEGER      KDROPN,LIBWID
*----
*  LOCAL VARIABLES
*----
      INTEGER      IUNIT,IEL2,IEL,ISO,NBURN,NMIN,NFP,JBRN,JSO
      INTEGER      NDECAY,IBURN(2*MLDEP)
      DOUBLE PRECISION TOTLAM
      REAL         RBURN(2*MLDEP)
*----
*  OPEN WIMS-AECL LIBRARY
*  READ INDEX AND GENERAL DIMENSIONING NPZ
*  READ ISOTOPE NAME AND ID NUMBER
*----
      IUNIT=KDROPN(CFILNA,IACTO,IUTYPE,LRIND)
      IF(IUNIT.LE.0) CALL XABORT('LIBEWR: WIMS-AECL LIBRARY '//
     >    CFILNA//' CANNOT BE OPENED FOR DEPLETION')
      CALL OPNIND(IUNIT,MASTER,LMASTB)
      CALL REDIND(IUNIT,MASTER,LMASIN,GENINX,LGENTB,1)
      CALL REDIND(IUNIT,GENINX,LGENIN,NPZ,LPZ,1)
      IF(NPZ(1).NE.NEL) CALL XABORT('LIBEWR: TOO MANY ISOTOPES '//
     >    'ON WIMS-AECL LIBRARY'//CFILNA)
      CALL REDIND(IUNIT,GENINX,LGENIN,IWISO,2*NEL,3)
      IEL2=1
      DO 10 IEL=1,NEL
        CALL UPCKIC(IWISO(IEL2),TEXT8,1)
        READ(TEXT8,'(2A4)') ITNAM(1,IEL),ITNAM(2,IEL)
        IEL2=IEL2+2
 10   CONTINUE
      CALL REDIND(IUNIT,GENINX,LGENIN,IWISO,NEL,2)
*----
*  READ DEPLETION CHAIN FOR EACH ISOTOPES
*----
      DO 100 ISO=1,NEL
*----
*  READ SUB INDEX ASSOCIATED WITH ISOTOPE
*----
        NDECAY=0
        TOTLAM=0.0D0
        CALL REDIND(IUNIT,MASTER,LMASIN,SUBINX,LSUBTB,ISO+4)
        NBURN=SUBINX(LSUBIN+1)
        IF(NBURN.GT.MAXISO) THEN
          CALL XABORT('LIBEWR: NBURN LARGER THAN MAXISO')
        ENDIF
        NMIN=2*MAX0(NBURN,1)
        CALL REDIND(IUNIT,SUBINX,LSUBIN,GENINX,4,1)
        CALL REDIND(IUNIT,GENINX,4,IBURN,NMIN,1)
        CALL REDIND(IUNIT,GENINX,4,RBURN,NMIN,2)
*----
*  STORE REACTION TYPES AND RATES IN KPAX AND BPAX STARTING
*  WITH HEAVIER ISOTOPES
*----
        NFP=0
        DO 101 JBRN=1,NBURN
          IF(IBURN(2*(JBRN-1)+2).EQ.IDECAY.AND.
     >            RBURN(2*(JBRN-1)+1).GE.0.0) THEN
            JSO=LIBWID(NEL,IWISO,IBURN(2*(JBRN-1)+1))
            NDECAY=NDECAY+1
            TOTLAM=TOTLAM+DBLE(RBURN(2*(JBRN-1)+1))
            IF(JSO.GT.0) THEN
              KPAX(JSO,ISO)=KDECAY
              BPAX(JSO,ISO)=RBURN(2*(JBRN-1)+1)
              KPAX(NEL+KCAPTU,JSO)=1
            ENDIF
            KPAX(NEL+KDECAY,ISO)=1
          ELSE IF(IBURN(2*(JBRN-1)+2).EQ.IFISSI.AND.
     >            RBURN(2*(JBRN-1)+1).GE.0.0) THEN
            KPAX(NEL+KFISSP,ISO)=1
            BPAX(NEL+KFISSP,ISO)=RBURN(2*(JBRN-1)+1)*CONVE
          ELSE IF(IBURN(2*(JBRN-1)+2).EQ.ICAPTU) THEN
            JSO=LIBWID(NEL,IWISO,IBURN(2*(JBRN-1)+1))
            IF(JSO.GT.0) THEN
              KPAX(JSO,ISO)=KCAPTU
              BPAX(JSO,ISO)=RBURN(2*(JBRN-1)+1)
              KPAX(NEL+KCAPTU,JSO)=1
            ENDIF
            KPAX(NEL+KCAPTU,ISO)=1
          ELSE IF(IBURN(2*(JBRN-1)+2).EQ.IN2N) THEN
            JSO=LIBWID(NEL,IWISO,IBURN(2*(JBRN-1)+1))
            IF(JSO.GT.0) THEN
              KPAX(JSO,ISO)=KN2N
              BPAX(JSO,ISO)=RBURN(2*(JBRN-1)+1)
              KPAX(NEL+KCAPTU,JSO)=1
            ENDIF
            KPAX(NEL+KN2N,ISO)=1
          ELSE IF(IBURN(2*(JBRN-1)+2).EQ.IN3N) THEN
            JSO=LIBWID(NEL,IWISO,IBURN(2*(JBRN-1)+1))
            IF(JSO.GT.0) THEN
              KPAX(JSO,ISO)=KN3N
              BPAX(JSO,ISO)=RBURN(2*(JBRN-1)+1)
              KPAX(NEL+KCAPTU,JSO)=1
            ENDIF
            KPAX(NEL+KN3N,ISO)=1
          ELSE IF(IBURN(2*(JBRN-1)+2).EQ.IFISSP.AND.
     >            RBURN(2*(JBRN-1)+1).GE.0.0) THEN
            JSO=LIBWID(NEL,IWISO,IBURN(2*(JBRN-1)+1))
            IF(JSO.GT.0) THEN
              NFP=NFP+1
              KPAX(JSO,ISO)=KFISSP
              BPAX(JSO,ISO)=RBURN(2*(JBRN-1)+1)
              KPAX(NEL+KFISSP,JSO)=-1
              KPAX(NEL+KCAPTU,JSO)=1
            ENDIF
          ENDIF
 101    CONTINUE
        IF(NDECAY .EQ. 1) THEN
          BPAX(NEL+KDECAY,ISO)=REAL(TOTLAM)*CONVD
          DO JSO=1,NEL
            IF(KPAX(JSO,ISO).EQ. KDECAY) THEN
              BPAX(JSO,ISO)=1.0
            ENDIF
          ENDDO
        ELSE IF(NDECAY .GT. 1) THEN
          BPAX(NEL+KDECAY,ISO)=REAL(TOTLAM)*CONVD
          DO JSO=1,NEL
            IF(KPAX(JSO,ISO).EQ. KDECAY) THEN
              BPAX(JSO,ISO)=BPAX(JSO,ISO)/REAL(TOTLAM)
            ENDIF
          ENDDO
        ENDIF
 100  CONTINUE
*----
*  CLOSE WIMS-AECL LIBRARY
*----
      CALL CLSIND(IUNIT)
*----
*  RETURN
*----
      RETURN
      END
