*DECK EDIDTX
      SUBROUTINE EDIDTX(IPEDIT,IPFLUX,IPMACR,IPRINT,NL,NDEL,ITRANC,
     >                  NGROUP,NGCOND,NBMIX,NREGIO,NMERGE,ILEAKS,ILUPS,
     >                  NWGTH,MATCOD,VOLUME,KEYFLX,IGCOND,IMERGE,FLUXES,
     >                  EIGENK,SPH,VOLMER,WLETYC,WENERG,RATECM,FLXINT,
     >                  SCATTD,SCATTS,NIFISS,NSAVES,CURNAM,NEDMAC,SIGS,
     >                  B2,CUREIN,TIMEF,NTAUXT)
*
*-----------------------------------------------------------------------
*
*Purpose:
* evaluate and print macroscopic reaction rates.
*
*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
* IPEDIT  pointer to the edition LCM object.
* IPFLUX  pointer to the solution LCM object.
* IPMACR  pointer to the macrolib LCM object.
* IPRINT  print level;
*         = 0 no print;
*         = 1 print fluxes;
*         = 2 1+print reaction rates;
*         = 3 2+print homogenized cross sections.
* NL      number of Legendre orders.
* NDEL    number of delayed precursor groups.
* ITRANC  type of transport corrections.
* NGROUP  number of groups.
* NGCOND  number of groups condensed.
* NBMIX   number of mixtures.
* NREGIO  number of regions.
* NMERGE  number of regions merged.
* ILEAKS  type of leakage calculation:
*         = 0 no leakage;
*         = 1 homogeneous leakage (Diffon);
*         = 2 isotropic streaming (Ecco);
*         = 3 anisotropic streaming (Tibere).
* ILUPS   flag to remove up-scattering from output.
* NWGTH   type of weighting for P1 cross section info (=0 P0; =1 P1).
* MATCOD  material per region.
* VOLUME  volume of region.
* KEYFLX  average flux position per region.
* IGCOND  limit condensed groups.
* IMERGE  index of merged region.
* FLUXES  fluxes.
* EIGENK  eigenvalue for problem.
* SPH     SPH homogenization factors.
* B2      square buckling:
*         for ILEAKS=1,2: B2(4) is homogeneous;
*         for ILEAKS=3: B2(1),B2(2),B2(3) are directional heterogeneous
*         and B2(4) is homogeneous.
* CUREIN  infinite multiplication factor.
* NTAUXT  number of reaction rate edits (=15+2*NDEL).
* TIMEF   time stamp in day/burnup/irradiation.
*
*Parameters: output
* VOLMER  volume of region merged.
* WLETYC  lethargy width condensed.
* WENERG  energy group limits.
* RATECM  averaged region/group cross sections:
*         = RATECM(*,1) = fluxes P0;
*         = RATECM(*,2) = fluxes P1;
*         = RATECM(*,3) = total P0;
*         = RATECM(*,4) = total P1;
*         = RATECM(*,5) = absorption;
*         = RATECM(*,6) = nu-sigf;
*         = RATECM(*,7) = fixed sources / productions;
*         = RATECM(*,8) = total leakages;
*         = RATECM(*,9) = total out of group scattering;
*         = RATECM(*,10) = diagonal scattering cross sections;
*         = RATECM(*,11) = fission spectrum;
*         = RATECM(*,12) = transport correction;
*         = RATECM(*,13) = X-directed leakages;
*         = RATECM(*,14) = Y-directed leakages;
*         = RATECM(*,15) = Z-directed leakages;
*         = RATECM(*,16) = nu-sigf for delayed neutrons;
*         = RATECM(*,17+NDEL) = fission spectrum for delayed neutrons.
* FLXINT  integrated flux.
* SCATTD  scattering rates.
* SCATTS  homogenized scattering cross sections.
* NIFISS  number of fissile isotopes.
* NSAVES  homogenized x-s compute/save flag:
*         = 0  no compute, no save;
*         = 1  compute, no save;
*         = 2  compute, save.
* CURNAM  name of LCM directory where the merged/condensed x-s are
*         stored.
* NEDMAC  number of extra edit vectors.
* SIGS    Legendre dependent scattering cross sections.
*
*-----------------------------------------------------------------------
*
      USE GANLIB
*----
*  SUBROUTINE ARGUMENTS
*----
      TYPE(C_PTR) IPEDIT,IPFLUX,IPMACR
      INTEGER     IPRINT,NL,NDEL,ITRANC,NGROUP,NGCOND,NBMIX,NREGIO,
     >            NMERGE,ILEAKS,ILUPS,NWGTH,
     >            MATCOD(NREGIO),KEYFLX(NREGIO),IGCOND(NGCOND),
     >            IMERGE(NREGIO),NIFISS,NSAVES,NEDMAC,NTAUXT
      REAL        VOLUME(NREGIO),FLUXES(NREGIO,NGROUP,NWGTH+1),EIGENK,
     >            SPH(NMERGE,NGCOND,NWGTH+1),VOLMER(NMERGE),
     >            WENERG(NGCOND+1),RATECM(NMERGE,NGCOND,NTAUXT),
     >            FLXINT(NREGIO,NGROUP,NWGTH+1),WLETYC(NGCOND),
     >            SCATTS(NMERGE,NGCOND,NGCOND,NL),B2(4),CUREIN,TIMEF(3),
     >            SIGS(NMERGE,NGCOND,NL)
      CHARACTER   CURNAM*12
      DOUBLE PRECISION SCATTD(NMERGE,NGCOND,NGCOND,NL)
*----
*  LOCAL VARIABLES
*----
      TYPE(C_PTR) JPFLUX,JPMACR,KPMACR
      CHARACTER   APG*3
      PARAMETER  (IUNOUT=6,APG=' > ',ILCMUP=1,ILCMDN=2)
      CHARACTER   CEDNAM*12,TEXT12*12,CM*2
      LOGICAL     LH
      DOUBLE PRECISION SCATWG,TOTFIS,FXSOUR,FLFUEL,FCELL
      INTEGER, ALLOCATABLE, DIMENSION(:) :: IFUELR,INGSCT,IFGSCT,IPOSCT
      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: NAMEAD
      REAL, ALLOCATABLE, DIMENSION(:) :: DISFCT,ENERV,SIGMA,XSCAT,WORKF,
     > DLETYF,ENERG,DIFFU,SIGMAF
      REAL, ALLOCATABLE, DIMENSION(:,:) :: FFUEL,FLDMC,OVERV,HFACT,DECAY
      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: TAUXE
*----
*  SCRATCH STORAGE ALLOCATION
*   NAMEAD  extra edit names.
*   IFUELR  fuel region location.
*   DISFCT  disadvantage factor.
*   TAUXE   extra edit rates.
*   FFUEL   flux in fuel.
*   FLDMC   fission rate condensed.
*   ENERV   averaged energy.
*   OVERV   1/v merge condensed.
*   HFACT   H-factors.
*   DECAY   precursor decay constants.
*----
      ALLOCATE(NAMEAD(2,NEDMAC),IFUELR(NREGIO))
      ALLOCATE(DISFCT(NGCOND),TAUXE(NMERGE,NGCOND,NEDMAC),
     > FFUEL(NREGIO,NIFISS),FLDMC(NMERGE,NGCOND),ENERV(NGROUP),
     > OVERV(NMERGE,NGCOND),HFACT(NMERGE,NGCOND),DECAY(NDEL,NIFISS))
*----
*  ALLOCATE WORK VECTOR AND INITIALIZE REQUIRED VECTORS
*----
      ILEAK2=ILEAKS
      ALLOCATE(INGSCT(NBMIX),IFGSCT(NBMIX),IPOSCT(NBMIX))
      ALLOCATE(SIGMA(0:NBMIX*MAX(NIFISS,1)),XSCAT(NBMIX*NGROUP))
      CALL XDRSET(RATECM,NMERGE*NGCOND*NTAUXT,0.0)
      CALL XDRSET(SIGS,NMERGE*NGCOND*NL,0.0)
      CALL XDRSET(OVERV,NMERGE*NGCOND,0.0)
      CALL XDRSET(HFACT,NMERGE*NGCOND,0.0)
      CALL XDRSET(TAUXE,NMERGE*NGCOND*NEDMAC,0.0)
      CALL XDRSET(VOLMER,NMERGE,0.0)
      CALL XDRSET(FFUEL,NREGIO*NIFISS,0.0)
      CALL XDISET(IFUELR,NREGIO,0)
      SIGMA(0)=0.0
*----
*  FIND EDIT XS
*----
      IF(NEDMAC.GT.0) CALL LCMGET(IPMACR,'ADDXSNAME-P0',NAMEAD)
*----
*  ENERGY AND LETHARGY CONDENSATION
*----
      CALL LCMLEN(IPMACR,'ENERGY',ILCMLN,ITYLCM)
      IF(ILCMLN.EQ.0) THEN
        NENER=0
        CALL XDRSET(WLETYC,NGCOND,0.0)
        CALL XDRSET(WENERG,NGCOND+1,0.0)
      ELSE IF(ILCMLN.EQ.NGROUP+1) THEN
        NENER=NGCOND+1
        ALLOCATE(DLETYF(NGROUP),ENERG(NGROUP+1))
        CALL LCMGET(IPMACR,'ENERGY',ENERG)
        CALL LCMLEN(IPMACR,'DELTAU',ILCMLN,ITYLCM)
        IF(ILCMLN.EQ.0) THEN
          DO 15 IGR=1,NGROUP
            DLETYF(IGR)=LOG(ENERG(IGR)/ENERG(IGR+1))
  15      CONTINUE
        ELSE
          CALL LCMGET(IPMACR,'DELTAU',DLETYF)
        ENDIF
        IGRFIN=0
        WENERG(1)=ENERG(1)
        DO 30 IGC=1,NGCOND
          WENERG(IGC+1)=ENERG(IGCOND(IGC)+1)
          IGRDEB=IGRFIN+1
          IGRFIN=IGCOND(IGC)-1
          WLETYC(IGC)=0.0
          DO 20 IGF=IGRDEB,IGRFIN
            WLETYC(IGC)=WLETYC(IGC)+DLETYF(IGF)
  20      CONTINUE
  30    CONTINUE
        IF(ENERG(NGROUP+1).EQ.0.0) ENERG(NGROUP+1)=1.0E-5
        DO 40 IGR=1,NGROUP
          ENERV(IGR)=SQRT(ENERG(IGR+1)*ENERG(IGR))
  40    CONTINUE
        DEALLOCATE(ENERG,DLETYF)
      ELSE
        CALL XABORT('EDIDTX: READ ERROR INVALID NUMBER OF GROUPS')
      ENDIF
*----
*  COMPUTE MERGED VOLUME
*----
      DO 50 IREGIO=1,NREGIO
        IKK=IMERGE(IREGIO)
        IF(IKK.GT.0) THEN
          VOLMER(IKK)=VOLMER(IKK)+VOLUME(IREGIO)
        ENDIF
  50  CONTINUE
*----
*  COMPUTE INTEGRATED/CONDENSED FUNDAMENTAL CURRENTS (ILEAKS=2,3)
*----
      IF(ILEAKS.EQ.2) THEN
        CALL LCMLEN(IPFLUX,'FLUX',ILCMLN,ITYLCM)
        IF(ILCMLN.EQ.0) CALL XABORT('EDIDTX: MISSING FLUX INFO.')
        JPFLUX=LCMGID(IPFLUX,'FLUX')
        CALL LCMLEL(JPFLUX,1,ILCMLN,ITYLCM)
        ALLOCATE(WORKF(ILCMLN))
        DO 70 IGR=1,NGROUP
          CALL LCMGDL(JPFLUX,IGR,WORKF)
          DO 60 IREG=1,NREGIO
            FLXINT(IREG,IGR,1)=WORKF(KEYFLX(IREG)+ILCMLN/2)*VOLUME(IREG)
  60      CONTINUE
  70    CONTINUE
        IGRFIN=0
        DO 90 IGRC=1,NGCOND
          IGRDEB=IGRFIN+1
          IGRFIN=IGCOND(IGRC)
          DO 80 IGR=IGRDEB,IGRFIN
*----
*  COMPUTE MERGED INTEGRATED CURRENTS
*----
            CALL EDIRAT(0,NREGIO,NBMIX,MATCOD,FLXINT(1,IGR,1),
     >                 RATECM(1,IGRC,8),SIGMA(0),IMERGE,NMERGE)
  80      CONTINUE
  90    CONTINUE
        DEALLOCATE(WORKF)
      ELSE IF(ILEAKS.EQ.3) THEN
        CALL LCMLEN(IPFLUX,'FLUX',ILCMLN,ITYLCM)
        IF(ILCMLN.EQ.0) CALL XABORT('EDIDTX: MISSING FLUX INFO.')
        JPFLUX=LCMGID(IPFLUX,'FLUX')
        CALL LCMLEL(JPFLUX,1,ILCMLN,ITYLCM)
        ALLOCATE(WORKF(ILCMLN))
        DO 140 IDIR=1,3
          DO 110 IGR=1,NGROUP
            CALL LCMGDL(JPFLUX,IGR,WORKF)
            DO 100 IREG=1,NREGIO
              FLXINT(IREG,IGR,1)=WORKF(KEYFLX(IREG)+IDIR*NREGIO)
     >        *VOLUME(IREG)
 100        CONTINUE
 110      CONTINUE
          IGRFIN=0
          DO 130 IGRC=1,NGCOND
            IGRDEB=IGRFIN+1
            IGRFIN=IGCOND(IGRC)
            DO 120 IGR=IGRDEB,IGRFIN
*----
*  COMPUTE MERGED INTEGRATED CURRENTS
*----
              CALL EDIRAT(0,NREGIO,NBMIX,MATCOD,FLXINT(1,IGR,1),
     >                   RATECM(1,IGRC,12+IDIR),SIGMA(0),
     >                   IMERGE,NMERGE)
 120        CONTINUE
 130      CONTINUE
 140    CONTINUE
        DEALLOCATE(WORKF)
      ENDIF
*----
*  COMPUTE INTEGRATED FLUX
*----
      DO 170 IW=1,NWGTH+1
        DO 160 IGR=1,NGROUP
          DO 150 IREGIO=1,NREGIO
            FLXINT(IREGIO,IGR,IW)=FLUXES(IREGIO,IGR,IW)*VOLUME(IREGIO)
 150      CONTINUE
 160    CONTINUE
 170  CONTINUE
*----
*  COMPUTE INTEGRATED/CONDENSED FUNDAMENTAL CURRENTS (ILEAKS=1)
*  (OBTAINED AS THE PRODUCT OF THE FUNDAMENTAL FLUX BY THE LEAKAGE
*  COEFFICIENT)
*----
      IF(ILEAKS.EQ.1) THEN
        ALLOCATE(DIFFU(NGROUP))
        CALL LCMGET(IPFLUX,'DIFFB1HOM',DIFFU)
        IGRFIN=0
        DO 200 IGRC=1,NGCOND
          IGRDEB=IGRFIN+1
          IGRFIN=IGCOND(IGRC)
          DO 190 IGR=IGRDEB,IGRFIN
            DO 180 IMIX=1,NBMIX
              SIGMA(IMIX)=DIFFU(IGR)
 180        CONTINUE
            CALL EDIRAT(1,NREGIO,NBMIX,MATCOD,FLXINT(1,IGR,1),
     >                 RATECM(1,IGRC,8),SIGMA(0),IMERGE,NMERGE)
 190      CONTINUE
 200    CONTINUE
        DEALLOCATE(DIFFU)
      ENDIF
*----
*  READ FIXE SOURCES/COMPUTE FIXE PRODUCTION RATE AND TOTAL SOURCE
*----
      IGRFIN=0
      TOTFIS=0.0D0
      FXSOUR=0.0D0
      JPMACR=LCMGID(IPMACR,'GROUP')
      DO 250 IGRC=1,NGCOND
        IGRDEB=IGRFIN+1
        IGRFIN=IGCOND(IGRC)
        DO 240 IGR=IGRDEB,IGRFIN
          KPMACR=LCMGIL(JPMACR,IGR)
          CALL LCMLEN(KPMACR,'FIXE',ILCMLN,ITYLCM)
          IF(ILCMLN.GT.0) THEN
            CALL LCMGET(KPMACR,'FIXE',SIGMA(1))
            CALL EDIRAT(1,NREGIO,NBMIX,MATCOD,VOLUME,RATECM(1,IGRC,7),
     >                  SIGMA(0),IMERGE,NMERGE)
            DO 210 IKK=1,NMERGE
              FXSOUR=FXSOUR+DBLE(RATECM(IKK,IGRC,7))
 210        CONTINUE
          ENDIF
          CALL EDIRAT(0,NREGIO,NBMIX,MATCOD,FLXINT(1,IGR,1),
     >                RATECM(1,IGRC,1),SIGMA(0),IMERGE,NMERGE)
          IF(NWGTH.GE.1) THEN
           CALL EDIRAT(0,NREGIO,NBMIX,MATCOD,FLXINT(1,IGR,2),
     >                 RATECM(1,IGRC,2),SIGMA(0),IMERGE,NMERGE)
          ENDIF
*----
*  READ FISSION X-S/ COMPUTE FISSION RATES
*----
          CALL LCMLEN(KPMACR,'NUSIGF',ILCMLN,ITYLCM)
          IF(ILCMLN.GT.0) THEN
            CALL LCMGET(KPMACR,'NUSIGF',SIGMA(1))
            DO 230 IFIS=1,NIFISS
            DO 220 IREGIO=1,NREGIO
              IBM=MATCOD(IREGIO)
              IF(IBM.GT.0) THEN
                 IF(SIGMA((IFIS-1)*NBMIX+IBM).GT.0.0) THEN
                   FLXFIS=FLXINT(IREGIO,IGR,1)*SIGMA((IFIS-1)*NBMIX+IBM)
                   FFUEL(IREGIO,IFIS)=FFUEL(IREGIO,IFIS)+FLXFIS
                   TOTFIS=TOTFIS+DBLE(FLXFIS)
                   IFUELR(IREGIO)=1
                 ENDIF
              ENDIF
 220        CONTINUE
 230        CONTINUE
          ENDIF
*----
 240    CONTINUE
 250  CONTINUE
*----
*  RECOVER THE PRECURSOR RADIOACTIVE DECAY CONSTANTS. USE THE VALUES
*  OF THE FISSILE ISOTOPE WITH MAXIMUM FISSION RATE
*----
      IF(CURNAM.NE.' ') THEN
        CALL LCMLEN(IPMACR,'LAMBDA-D',ILCMLN,ITYLCM)
        IF((NDEL.GT.0).AND.(ILCMLN.GT.0)) THEN
          ZMAX=0.0
          KFIS=0
          DO 340 IFIS=1,NIFISS
            ZTOT=0.0
            DO 330 IREGIO=1,NREGIO
 330        ZTOT=ZTOT+FFUEL(IREGIO,IFIS)
            IF(ZTOT.GE.ZMAX) THEN
              KFIS=IFIS
              ZMAX=ZTOT
            ENDIF
 340      CONTINUE
          IF(KFIS.EQ.0) CALL XABORT('EDIDTX: FISSILE ISOTOPE NOT FOUND')
          CALL LCMGET(IPMACR,'LAMBDA-D',DECAY)
          CALL LCMSIX(IPEDIT,CURNAM,ILCMUP)
          CALL LCMSIX(IPEDIT,'MACROLIB',ILCMUP)
          CALL LCMPUT(IPEDIT,'LAMBDA-D',NDEL,2,DECAY(1,KFIS))
          CALL LCMSIX(IPEDIT,' ',ILCMDN)
          CALL LCMSIX(IPEDIT,' ',ILCMDN)
        ENDIF
      ENDIF
*----
*  FIND FUEL VOLUME FOR DISADVANTAGE FACTOR
*----
      VFUEL=0.0
      VCELL=0.0
      DO 350 IREGIO=1,NREGIO
        IF(IFUELR(IREGIO).EQ.1) THEN
          VFUEL=VFUEL+VOLUME(IREGIO)
        ENDIF
        VCELL=VCELL+VOLUME(IREGIO)
 350  CONTINUE
      LH=.FALSE.
      IGRFIN=0
      DO 510 IGRC=1,NGCOND
        FCELL=0.0D0
        FLFUEL=0.0D0
        IGRDEB=IGRFIN+1
        IGRFIN=IGCOND(IGRC)
        DO 380 JGRC=1,NGCOND
          DO 370 I=1,NMERGE
            DO 360 IL=1,NL
              SCATTD(I,IGRC,JGRC,IL)=0.0D0
 360        CONTINUE
 370      CONTINUE
 380    CONTINUE
        DO 500 IGR=IGRDEB,IGRFIN
          KPMACR=LCMGIL(JPMACR,IGR)
*----
*  INTEGRATED 1/V
*----
          CALL LCMLEN(KPMACR,'OVERV',ILCMLN,ITYLCM)
          IF(ILCMLN.GT.0) THEN
            CALL LCMGET(KPMACR,'OVERV',SIGMA(1))
            CALL EDIRAT(1,NREGIO,NBMIX,MATCOD,FLXINT(1,IGR,1),
     >                  OVERV(1,IGRC),SIGMA(0),IMERGE,NMERGE)
          ENDIF
*----
*  INTEGRATED H-FACTORS
*----
          CALL LCMLEN(KPMACR,'H-FACTOR',ILCMLN,ITYLCM)
          IF(ILCMLN.GT.0) THEN
            LH=.TRUE.
            CALL LCMGET(KPMACR,'H-FACTOR',SIGMA(1))
            CALL EDIRAT(1,NREGIO,NBMIX,MATCOD,FLXINT(1,IGR,1),
     >                  HFACT(1,IGRC),SIGMA(0),IMERGE,NMERGE)
          ENDIF
*----
*  TOTAL, ABSROPTION, ETC. RATES
*----
          CALL LCMLEN(KPMACR,'NTOT0',ILCMLN,ITYLCM)
          IF(ILCMLN.EQ.0) CALL XABORT('EDIDTX: READ ERROR ON LCM REC'//
     >    'ORD= TOTAL')
          CALL LCMGET(KPMACR,'NTOT0',SIGMA(1))
          CALL EDIRAT(1,NREGIO,NBMIX,MATCOD,FLXINT(1,IGR,1),
     >                RATECM(1,IGRC,5),SIGMA(0),IMERGE,NMERGE)
          CALL EDIRAT(1,NREGIO,NBMIX,MATCOD,FLXINT(1,IGR,1),
     >                RATECM(1,IGRC,3),SIGMA(0),IMERGE,NMERGE)
          IF(NWGTH.GE.1) THEN
           CALL LCMLEN(KPMACR,'NTOT1',ILCMLN,ITYLCM)
           IF(ILCMLN.GT.0) CALL LCMGET(KPMACR,'NTOT1',SIGMA(1))
           CALL EDIRAT(1,NREGIO,NBMIX,MATCOD,FLXINT(1,IGR,2),
     >                 RATECM(1,IGRC,4),SIGMA(0),IMERGE,NMERGE)
          ENDIF
          CALL LCMLEN(KPMACR,'SIGS00',ILCMLN,ITYLCM)
          IF(ILCMLN.EQ.0) CALL XABORT('EDIDTX: READ ERROR ON LCM REC'//
     >    'ORD= SIGS00')
          CALL LCMGET(KPMACR,'SIGS00',SIGMA(1))
          CALL EDIRAT(-1,NREGIO,NBMIX,MATCOD,FLXINT(1,IGR,1),
     >                RATECM(1,IGRC,5),SIGMA(0),IMERGE,NMERGE)
          IF(ILEAKS.EQ.0) THEN
            CALL LCMLEN(KPMACR,'DIFF',ILCMLN,ITYLCM)
            IF(ILCMLN.GT.0) THEN
              CALL LCMGET(KPMACR,'DIFF',SIGMA(1))
              CALL EDIRAT(1,NREGIO,NBMIX,MATCOD,FLXINT(1,IGR,1),
     >                    RATECM(1,IGRC,8),SIGMA(0),IMERGE,NMERGE)
              ILEAK2=10
            ENDIF
            CALL LCMLEN(KPMACR,'DIFFX',ILCMLN,ITYLCM)
            IF(ILCMLN.GT.0) THEN
              CALL LCMGET(KPMACR,'DIFFX',SIGMA(1))
              CALL EDIRAT(1,NREGIO,NBMIX,MATCOD,FLXINT(1,IGR,1),
     >                    RATECM(1,IGRC,13),SIGMA(0),IMERGE,NMERGE)
              ILEAK2=11
            ENDIF
            CALL LCMLEN(KPMACR,'DIFFY',ILCMLN,ITYLCM)
            IF(ILCMLN.GT.0) THEN
              CALL LCMGET(KPMACR,'DIFFY',SIGMA(1))
              CALL EDIRAT(1,NREGIO,NBMIX,MATCOD,FLXINT(1,IGR,1),
     >                    RATECM(1,IGRC,14),SIGMA(0),IMERGE,NMERGE)
              ILEAK2=11
            ENDIF
            CALL LCMLEN(KPMACR,'DIFFZ',ILCMLN,ITYLCM)
            IF(ILCMLN.GT.0) THEN
              CALL LCMGET(KPMACR,'DIFFZ',SIGMA(1))
              CALL EDIRAT(1,NREGIO,NBMIX,MATCOD,FLXINT(1,IGR,1),
     >                    RATECM(1,IGRC,15),SIGMA(0),IMERGE,NMERGE)
              ILEAK2=11
            ENDIF
          ENDIF
*----
*  READ ADDITIONAL X-SECTIONS
*----
          DO 390 IED=1,NEDMAC
            WRITE(CEDNAM,'(2A4)') (NAMEAD(I1,IED),I1=1,2)
            IF(CEDNAM(:2).EQ.'NW') GO TO 390
            CALL LCMLEN(KPMACR,CEDNAM,ILONG,ITYLCM)
            IF(ILONG.GT.0) THEN
              CALL LCMGET(KPMACR,CEDNAM,SIGMA(1))
              CALL EDIRAT(1,NREGIO,NBMIX,MATCOD,FLXINT(1,IGR,1),
     >                    TAUXE(1,IGRC,IED),SIGMA(0),IMERGE,
     >                    NMERGE)
            ENDIF
 390      CONTINUE
*----
*  FISSION SPECTRUM AND NU*SIGF
*----
          CALL LCMLEN(KPMACR,'NUSIGF',ILCMLN,ITYLCM)
          IF(ILCMLN.GT.0) THEN
            ALLOCATE(SIGMAF(0:NBMIX))
            SIGMAF(0)=0.0
            CALL LCMGET(KPMACR,'NUSIGF',SIGMA(1))
            DO 400 IFIS=1,NIFISS
              DO 395 IBM=1,NBMIX
                SIGMAF(IBM)=SIGMA((IFIS-1)*NBMIX+IBM)
 395          CONTINUE
              CALL EDIRAT(1,NREGIO,NBMIX,MATCOD,FLXINT(1,IGR,1),
     >                    RATECM(1,IGRC,6),SIGMAF(0),IMERGE,NMERGE)
 400        CONTINUE
            DEALLOCATE(SIGMAF)
          ENDIF
          CALL LCMLEN(KPMACR,'CHI',ILCMLN,ITYLCM)
          IF(ILCMLN.GT.0) THEN
            ALLOCATE(SIGMAF(0:NBMIX))
            SIGMAF(0)=0.0
            CALL LCMGET(KPMACR,'CHI',SIGMA(1))
            DO 410 IFIS=1,NIFISS
              DO 405 IBM=1,NBMIX
                SIGMAF(IBM)=SIGMA((IFIS-1)*NBMIX+IBM)
 405          CONTINUE
              CALL EDIRAT(1,NREGIO,NBMIX,MATCOD,FFUEL(1,IFIS),
     >                    RATECM(1,IGRC,7),SIGMAF(0),IMERGE,NMERGE)
 410        CONTINUE
            DEALLOCATE(SIGMAF)
          ENDIF
*----
*  DELAYED FISSION SPECTRUM AND NU*SIGF
*----
          DO 440 IDEL=1,NDEL
            WRITE(TEXT12,'(6HNUSIGF,I2.2)') IDEL
            CALL LCMLEN(KPMACR,TEXT12,ILCMLN,ITYLCM)
            IF(ILCMLN.GT.0) THEN
              ALLOCATE(SIGMAF(0:NBMIX))
              SIGMAF(0)=0.0
              CALL LCMGET(KPMACR,TEXT12,SIGMA(1))
              DO 420 IFIS=1,NIFISS
                DO 415 IBM=1,NBMIX
                  SIGMAF(IBM)=SIGMA((IFIS-1)*NBMIX+IBM)
 415            CONTINUE
                CALL EDIRAT(1,NREGIO,NBMIX,MATCOD,FLXINT(1,IGR,1),
     >                      RATECM(1,IGRC,15+IDEL),SIGMAF(0),IMERGE,
     >                      NMERGE)
 420          CONTINUE
              DEALLOCATE(SIGMAF)
            ENDIF
            WRITE(TEXT12,'(3HCHI,I2.2)') IDEL
            CALL LCMLEN(KPMACR,TEXT12,ILCMLN,ITYLCM)
            IF(ILCMLN.GT.0) THEN
              ALLOCATE(SIGMAF(0:NBMIX))
              SIGMAF(0)=0.0
              CALL LCMGET(KPMACR,TEXT12,SIGMA(1))
              DO 430 IFIS=1,NIFISS
                DO 425 IBM=1,NBMIX
                  SIGMAF(IBM)=SIGMA((IFIS-1)*NBMIX+IBM)
 425            CONTINUE
                CALL EDIRAT(1,NREGIO,NBMIX,MATCOD,FFUEL(1,IFIS),
     >                      RATECM(1,IGRC,15+NDEL+IDEL),SIGMAF(0),
     >                      IMERGE,NMERGE)
 430          CONTINUE
              DEALLOCATE(SIGMAF)
            ENDIF
 440      CONTINUE
*----
*  INTEGRATED FLUX AND FORM FACTOR
*----
          DO 450 IREGIO=1,NREGIO
            IF(IFUELR(IREGIO).EQ.1) THEN
              FLFUEL=FLFUEL+DBLE(FLXINT(IREGIO,IGR,1))
            ENDIF
            FCELL=FCELL+DBLE(FLXINT(IREGIO,IGR,1))
 450      CONTINUE
*----
*  TRANSPORT CORRECTION
*----
          IF(ITRANC.NE.0) THEN
            CALL LCMLEN(KPMACR,'TRANC',ILCMLN,ITYLCM)
            IF(ILCMLN.GT.0) THEN
              CALL LCMGET(KPMACR,'TRANC',SIGMA(1))
              CALL EDIRAT(1,NREGIO,NBMIX,MATCOD,FLXINT(1,IGR,1),
     >        RATECM(1,IGRC,12),SIGMA(0),IMERGE,NMERGE)
            ENDIF
          ENDIF
*----
*  SCATTERING NEUTRONS
*----
          DO 490 IL=1,NL
          IW=MIN(IL,NWGTH+1)
          WRITE (CM,'(I2.2)') IL-1
          CALL LCMLEN(KPMACR,'SIGS'//CM,ILCMLN,ITYLCM)
          IF(ILCMLN.GT.0) THEN
            CALL LCMGET(KPMACR,'SIGS'//CM,SIGMA(1))
            CALL EDIRAT(1,NREGIO,NBMIX,MATCOD,FLXINT(1,IGR,IW),
     >      SIGS(1,IGRC,IL),SIGMA(0),IMERGE,NMERGE)
          ENDIF
          CALL LCMLEN(KPMACR,'NJJS'//CM,ILCMLN,ITYLCM)
          IF(ILCMLN.GT.0) THEN
            CALL LCMGET(KPMACR,'SIGW'//CM,SIGMA(1))
            CALL LCMGET(KPMACR,'NJJS'//CM,INGSCT)
            CALL LCMGET(KPMACR,'IJJS'//CM,IFGSCT)
            CALL LCMGET(KPMACR,'IPOS'//CM,IPOSCT)
            CALL LCMGET(KPMACR,'SCAT'//CM,XSCAT)
            DO 480 IREGIO=1,NREGIO
              MATNUM=MATCOD(IREGIO)
              IKK=IMERGE(IREGIO)
              IF((IKK.GT.0).AND.(MATNUM.GT.0)) THEN
                NGSCAT=INGSCT(MATNUM)
                IGSCAT=IFGSCT(MATNUM)
                IPOSIT=IPOSCT(MATNUM)
                JGRFIN=0
                DO 470 JGRC=1,NGCOND
                  JGRDEB=JGRFIN+1
                  JGRFIN=IGCOND(JGRC)
                  J2=MIN(JGRFIN,IGSCAT)
                  J1=MAX(JGRDEB,IGSCAT-NGSCAT+1)
                  IPO=IPOSIT+IGSCAT-J2
                  DO 460 JGR=J2,J1,-1
                    IF(IGR.EQ.JGR) THEN
                      SCATTD(IKK,IGRC,JGRC,IL)=SCATTD(IKK,IGRC,JGRC,IL)
     >                       +SIGMA(MATNUM)*FLXINT(IREGIO,JGR,IW)
                    ELSE
                      SCATTD(IKK,IGRC,JGRC,IL)=SCATTD(IKK,IGRC,JGRC,IL)
     >                       +XSCAT(IPO)*FLXINT(IREGIO,JGR,IW)
                    ENDIF
                    IPO=IPO+1
 460              CONTINUE
 470            CONTINUE
              ENDIF
 480        CONTINUE
          ENDIF
 490      CONTINUE
 500    CONTINUE
        IF(VFUEL*FCELL.GT.0.0) THEN
          DISFCT(IGRC)=REAL(FLFUEL*VCELL/(VFUEL*FCELL))
        ELSE
          DISFCT(IGRC)=0.0
        ENDIF
 510  CONTINUE
*----
*  UP-SCATTERING CORRECTIONS
*----
      IF(ILUPS.EQ.1) THEN
        DO 520 IKK=1,NMERGE
        DO 520 IGRC=2,NGCOND
        DO 520 JGRC=1,IGRC-1
        DO 520 IL=1,NL
          SCATTD(IKK,IGRC,JGRC,IL)=
     >      SCATTD(IKK,IGRC,JGRC,IL)-SCATTD(IKK,JGRC,IGRC,IL)
          SCATTD(IKK,JGRC,IGRC,IL)=0.0D0
 520    CONTINUE
      ENDIF
*----
*  SCATTERING NORMALIZATION
*----
      DO 560 IGRC=1,NGCOND
        DO 550 IKK=1,NMERGE
          DO 540 IL=1,NL
            SCATWG=SIGS(IKK,IGRC,IL)
            DO 530 JGRC=1,NGCOND
              IF(JGRC.NE.IGRC) SCATWG=SCATWG-SCATTD(IKK,JGRC,IGRC,IL)
 530        CONTINUE
            DEN=REAL(MAX(ABS(SCATWG),ABS(SCATTD(IKK,IGRC,IGRC,IL))))
            IF(DEN.GT.0.0) THEN
              ERR=ABS(REAL(SCATWG-SCATTD(IKK,IGRC,IGRC,IL)))/DEN
              IF(ERR.GT.1.0E-3) THEN
                WRITE(IUNOUT,6000) IL,IGRC,IKK,100.0*ERR
              ENDIF
              SCATTD(IKK,IGRC,IGRC,IL)=SCATWG
            ENDIF
 540      CONTINUE
 550    CONTINUE
 560  CONTINUE
*----
*  FISSION SPECTRUM NORMALIZATION
*----
      IF((FXSOUR.EQ.0.0D0).AND.(TOTFIS.GT.0.0D0)) THEN
        CALL XDRSET(FLDMC,NMERGE*NGCOND,0.0)
        DO 580 IGRC=1,NGCOND
          DO 570 IFIS=1,NIFISS
            CALL EDIRAT(0,NREGIO,NBMIX,MATCOD,FFUEL(1,IFIS),
     >                  FLDMC(1,IGRC),SIGMA(0),IMERGE,NMERGE)
 570      CONTINUE
 580    CONTINUE
        DO 640 IKK=1,NMERGE
          TOTAL1=0.0
          DO 590 IGRC=1,NGCOND
            IF(RATECM(IKK,IGRC,7).NE.0.0) THEN
              RATECM(IKK,IGRC,11)=RATECM(IKK,IGRC,7)/FLDMC(IKK,IGRC)
              TOTAL1=TOTAL1+RATECM(IKK,IGRC,11)
            ELSE
              RATECM(IKK,IGRC,11)=0.0
            ENDIF
 590      CONTINUE
          IF(TOTAL1.GT.0.9) THEN
            DO 600 IGRC=1,NGCOND
              RATECM(IKK,IGRC,11)=RATECM(IKK,IGRC,11)/TOTAL1
 600        CONTINUE
          ENDIF
          DO 630 IDEL=1,NDEL
            K=15+NDEL+IDEL
            TOTAL1=0.0
            DO 610 IGRC=1,NGCOND
              IF(RATECM(IKK,IGRC,K).NE.0.0) THEN
                RATECM(IKK,IGRC,K)=RATECM(IKK,IGRC,K)/FLDMC(IKK,IGRC)
                TOTAL1=TOTAL1+RATECM(IKK,IGRC,K)
              ELSE
                RATECM(IKK,IGRC,K)=0.0
              ENDIF
 610        CONTINUE
            IF(TOTAL1.GT.0.9) THEN
              DO 620 IGRC=1,NGCOND
                RATECM(IKK,IGRC,K)=RATECM(IKK,IGRC,K)/TOTAL1
 620          CONTINUE
            ENDIF
 630      CONTINUE
 640    CONTINUE
      ENDIF
      DEALLOCATE(XSCAT,SIGMA)
      DEALLOCATE(IPOSCT,IFGSCT,INGSCT)
*----
*  PRINT REACTION RATES
*----
      ILEAKS=ILEAK2
      IF(IPRINT.GE.1) THEN
        CALL EDIPRR(IPRINT,NL,ITRANC,NGCOND,NMERGE,ILEAKS,NTAUXT,
     >              B2,VOLMER,NENER,WENERG,RATECM,SCATTD)
      ENDIF
*----
*  COMPUTE MERGED/CONDENSED X-S
*----
      CALL EDIPXS(IPEDIT,IPRINT,NL,NDEL,ITRANC,NSAVES,NGCOND,NMERGE,
     >            ILEAKS,NWGTH,NTAUXT,EIGENK,B2,CUREIN,NIFISS,CURNAM,
     >            NEDMAC,SPH,VOLMER,WLETYC,WENERG,SCATTD,RATECM,SIGS,
     >            SCATTS,DISFCT,TAUXE,NAMEAD,OVERV,HFACT,NENER,TIMEF,LH)
*----
*  SCRATCH STORAGE DEALLOCATION
*----
      DEALLOCATE(DECAY,HFACT,OVERV,ENERV,FLDMC,FFUEL,TAUXE,DISFCT)
      DEALLOCATE(IFUELR,NAMEAD)
      RETURN
*----
*  FORMAT
*----
 6000 FORMAT(/53H EDIDTX: *** WARNING *** NORMALIZATION OF THE WITHIN-,
     > 34HGROUP SCATTERING TRANSFER OF ORDER,I3,9H IN GROUP,I4,5H AND ,
     > 6HREGION,I5,3H BY,F6.2,3H %.)
      END
