*DECK EDIDRV
      SUBROUTINE EDIDRV(IPEDIT,IPFLUX,IPLIB,IPSYS,NGROUP,NBMIX,NREGIO,
     >                  MATCOD,VOLUME,KEYFLX,NIFISS,NEDMAC,NL,NDEL,
     >                  ITRANC,NGCOND,NMERGE,IADF,NWGTH,IHF,IFFAC,
     >                  ILUPS,NSAVES,NSTATS,IXEDI,ISOTXS,IGCOND,IMERGE,
     >                  CURNAM,OLDNAM,NBMICR,CARISO,NACTI,IACTI,IPRINT,
     >                  LISO,IADJ)
*
*-----------------------------------------------------------------------
*
*Purpose:
* driver for edition operations.
*
*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 flux LCM object.
* IPLIB   pointer to the internal library or macrolib LCM object.
* IPSYS   pointer to the pij LCM object (only used with Selengut
*         normalization).
* NGROUP  number of energy groups.
* NBMIX   number of mixtures.
* NREGIO  number of regions.
* MATCOD  mixture index in region.
* VOLUME  volume of region.
* KEYFLX  average flux position per region.
* NIFISS  number fissile isotopes.
* NEDMAC  number of extra macroscopic cross section types.
* NL      number of Legendre orders of the scattering cross sections.
* NDEL    number of delayed precursor groups.
* ITRANC  type of transport correction.
* NMERGE  number of regions merged.
* IADF    flag for assembly discontinuity factors (ADF) information:
*         = 0 do not compute them;
*         = 1 compute them using ALBS information;
*         = 2 compute them using averaged fluxes in boundary regions.
* NWGTH   type of weighting for P1 cross section information:
*         = 0 P0; = 1 P1.
* IHF     H-factor calculation flag:
*         = 0 no; = 1 yes.
* IFFAC   four factor calculation flag:
*         = 0 no four factors (defaut);
*         = 1 four factor evaluation.
* ILUPS   flag to remove up-scattering from output.
* NSAVES  homogenized cross section computation and saving:
*         = 0  no compute no save;
*         = 1  compute, no save;
*         = 2  compute, save.
* NSTATS  statistics level:
*         = 0  no stats;
*         = 1  statistics on fluxes
*         = 2  statistics on reaction rates;
*         = 3  statistics on fluxes and reaction rates;
*         =-1  delta sigma ('MERG COMP' only).
* IXEDI   first ISOTX mixture record number.
* ISOTXS  ISOTX file enabling flag (0: off; 1: binary; 2: ascii).
* IGCOND  condensed groups limits.
* IMERGE  merged regions position.
* CURNAM  name of LCM directory where the current rates are to be
*         stored.
* OLDNAM  name of LCM directory where old rates were stored.
* NBMICR  type of microlib edition:
*         =-2: process only macroscopic residue;
*         =-1: process each isotope;
*         =0: process no isotope;
*         >0 number of isotopes to process.
* CARISO  names of the isotopes to process.
* NACTI   number of activation editions.
* IACTI   activation mixtures.
* IPRINT  print index.
* LISO    =.TRUE. if we want to keep all the isotopes after 
*         homogeneization
* IADJ   type of flux:
*         =0: direct;
*         =1: adjoint
*
*-----------------------------------------------------------------------
*
      USE GANLIB
*----
*  SUBROUTINE ARGUMENTS
*----
      LOGICAL       LISO
      TYPE(C_PTR)   IPEDIT,IPFLUX,IPLIB,IPSYS
      INTEGER       NGROUP,NBMIX,NREGIO,MATCOD(NREGIO),KEYFLX(NREGIO),
     >              NIFISS,NEDMAC,NL,NDEL,ITRANC,NGCOND,NMERGE,IADF,
     >              NWGTH,IHF,IFFAC,ILUPS,NSAVES,NSTATS,IXEDI,ISOTXS,
     >              IGCOND(NGROUP),IMERGE(NREGIO),NBMICR,NACTI,
     >              IACTI(NBMIX),IPRINT,IADJ
      REAL          VOLUME(NREGIO)
      CHARACTER     CURNAM*(*),OLDNAM*(*),CARISO(NBMICR)*(*)
*----
*  LOCAL VARIABLES
*----
      PARAMETER    (IUNOUT=6,MAXED=100,NSTATE=40,IOUT=6)
      TYPE(C_PTR)   JPFLUX,IPMAC2,IPADF
      CHARACTER     HSIGN*12,TEXT8*8,HVECT(MAXED)*8,NISEXT*6,NISOTX*12,
     >              CTITLE*72,HNEW*12,NAMSBR*12,HTYPE*8
      INTEGER       IFPAR(NSTATE),IPAR(NSTATE),KCHAR(3),IDIM(NSTATE)
      REAL          B2(4),B2T(3),TIMEF(3)
      INTEGER, ALLOCATABLE, DIMENSION(:) :: IHADF,IHADF2,ITYPE,MIX,
     > IDEPL,ISONA,ISONR,LSISO,INADPL,JPIFI,KDRI,INNAM,INNRF,NMIX
      REAL, ALLOCATABLE, DIMENSION(:) :: WORKF,VOLME,WLETY,WE,SPH,COURI,
     > TAUXT,SIGS,SCATS,FLINT,SCATD,DEN,TN,EMEVF,EMEVG,RER,DECAY,YIELD,
     > PYIEL,RRD,FIYI,ENERG,NAWR,NDEN,NTMP,NVOL,SNEJ
      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: FLUXES
*----
*  SCRATCH STORAGE ALLOCATION
*----
      ALLOCATE(FLUXES(NREGIO,NGROUP,NWGTH+1))
*----
*  FIND THE SIGNATURE OF IPLIB
*----
      CALL LCMGET(IPLIB,'SIGNATURE',KCHAR)
      WRITE(HSIGN,'(3A4)') (KCHAR(I1),I1=1,3)
*----
*  RECOVER NEUTRON FLUXES AND CURRENTS (IF ILEAKC.GE.5)
*----
      CALL LCMGET(IPFLUX,'STATE-VECTOR',IFPAR)
      ITYPEC=IFPAR(6)
      ILEAKC=IFPAR(7)
      IF(ILEAKC.EQ.0) THEN
*       NO LEAKAGE
        ILEAKS=0
      ELSE IF(ILEAKC.LE.4) THEN
*       DIFFON-TYPE LEAKAGE
        ILEAKS=1
      ELSE IF(ILEAKC.EQ.5) THEN
*       ECCO-TYPE LEAKAGE (WITH ISOTROPIC STREAMING EFFECTS)
        ILEAKS=2
      ELSE IF(ILEAKC.GE.6) THEN
*       TIBERE-TYPE LEAKAGE (WITH ANISOTROPIC STREAMING EFFECTS)
        ILEAKS=3
      ENDIF
      IF(ITYPEC.GT.0) CALL LCMGET(IPFLUX,'K-INFINITY',CUREIN)
      CALL XDRSET(B2,4,0.0)
      IF(ITYPEC.GT.2) THEN
        CALL LCMGET(IPFLUX,'B2  B1HOM',B2(4))
        IF(ILEAKS.EQ.3) THEN
          CALL LCMGET(IPFLUX,'B2  HETE',B2)
          IF(B2(4).EQ.0.0) THEN
            B2T(1)=1.0/3.0
            B2T(2)=B2T(1)
            B2T(3)=B2T(1)
          ELSE
            B2T(1)=B2(1)/B2(4)
            B2T(2)=B2(2)/B2(4)
            B2T(3)=B2(3)/B2(4)
          ENDIF
        ENDIF
      ENDIF
      IF((NWGTH.GE.1).AND.(ILEAKC.LE.4)) THEN
        CALL XABORT('EDIDRV: CURRENT WEIHTING OF P1 XS INFO (NWGTH=1) '
     >  //'IS ONLY AVAILABLE WITH A STREAMING-ENABLED LEAKAGE MODEL.')
      ENDIF
      IF(ILEAKC.EQ.4) THEN
        CALL XDRSET(B2,4,0.0)
        CALL XDRSET(B2T,3,0.0)
      ENDIF
      IF(IADJ.EQ.0) THEN
        CALL LCMLEN(IPFLUX,'FLUX',ILON,ITYLCM)
        IF(ILON.EQ.0) CALL XABORT('EDIDRV: MISSING FLUX INFO.')
        JPFLUX=LCMGID(IPFLUX,'FLUX')
      ELSE IF(IADJ.EQ.1) THEN
        CALL LCMLEN(IPFLUX,'AFLUX',ILON,ITYLCM)
        IF(ILON.EQ.0) CALL XABORT('EDIDRV: MISSING ADJOINT FLUX INFO.')
        JPFLUX=LCMGID(IPFLUX,'AFLUX')
      ELSE
        CALL XABORT('EDIDRV: INVALID VALUE OF IADJ.')
      ENDIF
      CALL LCMLEL(JPFLUX,1,NUN,ITYLCM)
      ALLOCATE(WORKF(NUN))
      DO 120 IGR=1,NGROUP
        IF(IADJ.EQ.0) THEN
          CALL LCMGDL(JPFLUX,IGR,WORKF)
        ELSE IF(IADJ.EQ.1) THEN
          CALL LCMGDL(JPFLUX,NGROUP-IGR+1,WORKF)
        ENDIF
        DO 80 IREG=1,NREGIO
          FLUXES(IREG,IGR,1)=WORKF(KEYFLX(IREG))
   80   CONTINUE
        IF((NWGTH.GE.1).AND.(ILEAKS.EQ.2)) THEN
*         ISOTROPIC STREAMING (ECCO)
          DO 90 IREG=1,NREGIO
            FLUXES(IREG,IGR,2)=WORKF(NUN/2+KEYFLX(IREG))
   90     CONTINUE
        ELSE IF((NWGTH.GE.1).AND.(ILEAKS.EQ.3)) THEN
*         ANISOTROPIC STREAMING
          DO 110 IREG=1,NREGIO
            CURN=0.0
            DO 100 IDIR=1,3
              CURN=CURN+B2T(IDIR)*WORKF(IDIR*NUN/4+KEYFLX(IREG))
  100       CONTINUE
            FLUXES(IREG,IGR,2)=CURN
  110     CONTINUE
        ENDIF
  120 CONTINUE
      DEALLOCATE(WORKF)
*----
*  ALLOCATE MEMORY FOR GROUP CONDENSATION AND MERGE
*----
      ALLOCATE(VOLME(NMERGE),WLETY(NGCOND),WE(NGCOND+1))
      NELEMT=NMERGE*NGCOND
*----
*  SET SPH FACTORS TO ONE (NO CORRECTION)
*----
      ALLOCATE(SPH(NELEMT*(NWGTH+1)))
      CALL XDRSET(SPH,NELEMT*(NWGTH+1),1.0)
*----
*  COMPUTE BOUNDARY EDITIONS FOR ADF OR SPH WITH SELENGUT
*----
      IF(CURNAM.NE.' ') THEN
         IF(HSIGN.EQ.'L_LIBRARY') THEN
            CALL LCMSIX(IPLIB,'MACROLIB',1)
         ENDIF
         IPMAC2=LCMDID(IPEDIT,CURNAM)
         IPMAC2=LCMDID(IPMAC2,'MACROLIB')
         IF(IADF.EQ.1) THEN
*           USE ALBS INFORMATION
            CALL EDIALB(IPMAC2,IPFLUX,IPLIB,IPSYS,IPRINT,NBMIX,NWGTH,
     1      B2,NGROUP,NIFISS,NGCOND,ITRANC,ILEAKS,NREGIO,MATCOD,
     2      VOLUME,KEYFLX,IGCOND,FLUXES)
         ELSE IF(IADF.EQ.2) THEN
*           USE AVERAGED FLUXES OBTAINED OVER BOUNDARY REGIONS
            IPADF=LCMGID(IPEDIT,'REF:ADF')
            CALL LCMGET(IPADF,'NTYPE',NTYPE)
            IF(NTYPE.EQ.0) CALL XABORT('EDIADF: NTYPE=0.')
            CALL LCMSIX(IPMAC2,'ADF',1)
            ALLOCATE(IHADF(NTYPE),IHADF2(2*NTYPE*(NWGTH+1)),
     1      COURI(NGCOND))
            CALL LCMGET(IPADF,'HADF',IHADF)
            DO 130 IT=1,NTYPE
            DO 130 INL=1,NWGTH+1
            WRITE(HTYPE,'(A4)') IHADF(IT)
            CALL EDIGAP(IPADF,INL,HTYPE(:4),NGROUP,NGCOND,NREGIO,VOLUME,
     1      IGCOND,FLUXES(1,1,INL),IPRINT,COURI)
            WRITE(HTYPE,'(A4,I2.2)') IHADF(IT),INL-1
            CALL LCMPUT(IPMAC2,HTYPE,NGCOND,2,COURI)
            IOF=(INL-1)*2*NTYPE+2*IT-1
            READ(HTYPE,'(2A4)') IHADF2(IOF),IHADF2(IOF+1)
  130       CONTINUE
            CALL LCMPUT(IPMAC2,'NTYPE',1,1,NTYPE)
            CALL LCMPUT(IPMAC2,'HADF',2*NTYPE*(NWGTH+1),3,IHADF2)
            DEALLOCATE(COURI,IHADF2,IHADF)
            CALL LCMSIX(IPMAC2,' ',2)
         ENDIF
         IF(HSIGN.EQ.'L_LIBRARY') CALL LCMSIX(IPLIB,' ',2)
      ENDIF
*----
*  COMPUTE REACTION RATES FOR THE EDITION MACROLIB
*----
      NTAUXT=15+2*NDEL
      ALLOCATE(TAUXT(NTAUXT*NELEMT),SIGS(NL*NELEMT),
     > SCATS(NELEMT*NGCOND*NL),FLINT(NREGIO*NGROUP*(NWGTH+1)),
     > SCATD(2*NELEMT*NGCOND*NL))
      NBISO=0
      CALL LCMLEN(IPFLUX,'K-EFFECTIVE',ILCMLN,ITYLCM)
      IF(ILCMLN.EQ.1) THEN
        CALL LCMGET(IPFLUX,'K-EFFECTIVE',EIGENK)
      ELSE
        EIGENK=1.0
      ENDIF
      TIMEF(1)=0.0
      TIMEF(2)=0.0
      TIMEF(3)=0.0
      IF(HSIGN.EQ.'L_LIBRARY') THEN
        CALL LCMSIX(IPLIB,'MACROLIB',1)
        CALL LCMLEN(IPLIB,'TIMESTAMP',ILCMLN,ILCMTY)
        IF((ILCMLN.GE.1).AND.(ILCMLN.LE.3)) THEN
           CALL LCMGET(IPLIB,'TIMESTAMP',TIMEF)
        ENDIF
      ENDIF
      CALL EDIDTX(IPEDIT,IPFLUX,IPLIB,IPRINT,NL,NDEL,ITRANC,NGROUP,
     >            NGCOND,NBMIX,NREGIO,NMERGE,ILEAKS,ILUPS,NWGTH,MATCOD,
     >            VOLUME,KEYFLX,IGCOND,IMERGE,FLUXES,EIGENK,SPH,
     >            VOLME,WLETY,WE,TAUXT,FLINT,SCATD,SCATS,NIFISS,
     >            NSAVES,CURNAM,NEDMAC,SIGS,B2,CUREIN,TIMEF,NTAUXT)
      IF(HSIGN.EQ.'L_LIBRARY') CALL LCMSIX(IPLIB,' ',2)
      DEALLOCATE(SCATD,FLINT)
*----
*  RECOVER ISOTOPIC INFORMATION FROM THE MICROLIB
*----
      IF(HSIGN.EQ.'L_LIBRARY') THEN
        CALL LCMGET(IPLIB,'STATE-VECTOR',IPAR)
        NBISO=IPAR(2)
        NED=IPAR(13)
        IF(NBISO.EQ.0) CALL XABORT('EDIDRV: NO ISOTOPES FOUND.')
        ALLOCATE(DEN(NBISO),ITYPE(NBISO),MIX(NBISO),TN(NBISO),
     >  IDEPL(NBISO),ISONA(3*NBISO),ISONR(3*NBISO),LSISO(NBISO))
        CALL LCMGET(IPLIB,'ISOTOPESDENS',DEN)
        CALL LCMGET(IPLIB,'ISOTOPESTYPE',ITYPE)
        CALL LCMGET(IPLIB,'ISOTOPESMIX',MIX)
        CALL LCMGET(IPLIB,'ISOTOPESTEMP',TN)
        CALL LCMGET(IPLIB,'ISOTOPESTODO',IDEPL)
        CALL LCMGTC(IPLIB,'ADDXSNAME-P0',8,NED,HVECT)
        CALL LCMGET(IPLIB,'ISOTOPESUSED',ISONA)
        CALL LCMGET(IPLIB,'ISOTOPERNAME',ISONR)
        CALL XDISET(LSISO,NBISO,0)
        IF(NBMICR.EQ.-2) THEN
          CALL XDISET(LSISO,NBISO,0)
        ELSE IF(NBMICR.EQ.-1) THEN
          CALL XDISET(LSISO,NBISO,1)
        ELSE IF(NBMICR.GT.0) THEN
          DO 160 IISO=1,NBISO
            WRITE(TEXT8,'(2A4)') (ISONA((IISO-1)*3+I0),I0=1,2)
            DO 150 IIII=1,NBMICR
              IF(CARISO(IIII)(1:8).EQ.TEXT8) LSISO(IISO)=1
  150       CONTINUE
  160     CONTINUE
        ENDIF
      ENDIF
*----
*  EVALUATE H-FACTOR IF REQUIRED FOR THE EDITION MACROLIB
*----
      ALLOCATE(EMEVF(NBISO),EMEVG(NBISO))
      CALL XDRSET(EMEVF,NBISO,0.0)
      CALL XDRSET(EMEVG,NBISO,0.0)
      IF((NSAVES.GE.2).AND.(IHF.NE.0)) THEN
        CALL LCMLEN(IPLIB,'DEPL-CHAIN',ILLCM,ITLCM)
        IF(ILLCM.NE.0) THEN
          CALL LCMSIX(IPEDIT,CURNAM,1)
          CALL LCMSIX(IPLIB,'DEPL-CHAIN',1)
          CALL LCMGET(IPLIB,'STATE-VECTOR',IDIM)
          NDEPL=IDIM(1)
          NREAC=IDIM(8)
*
          ALLOCATE(INADPL(3*NDEPL),RER(NREAC*NDEPL))
          CALL LCMGET(IPLIB,'ISOTOPESDEPL',INADPL)
          CALL LCMGET(IPLIB,'DEPLETE-ENER',RER)
          CALL LCMSIX(IPLIB,' ',2)
*
          CALL EDIHFC(IPEDIT,IPLIB,NGROUP,NGCOND,NREGIO,NMERGE,NBISO,
     >                NDEPL,NREAC,MATCOD,VOLUME,INADPL,ISONA,ISONR,MIX,
     >                FLUXES(1,1,1),SPH,DEN,IGCOND,IMERGE,RER,EMEVF,
     >                EMEVG)
*
          DEALLOCATE(RER,INADPL)
          CALL LCMSIX(IPEDIT,' ',2)
        ENDIF
      ENDIF
*----
*  LUMP THE DEPLETION CHAIN
*----
      ALLOCATE(DECAY(NBISO),YIELD((NGCOND+1)*NBISO*NMERGE))
      CALL XDRSET(DECAY,NBISO,0.0)
      CALL XDRSET(YIELD,(NGCOND+1)*NBISO*NMERGE,0.0)
      NDEPL=0
      NDFI=0
      IF((NBMICR.NE.0).AND.(NBISO.NE.0)) THEN
        CALL LCMSIX(IPEDIT,CURNAM,1)
        CALL LCMLEN(IPLIB,'DEPL-CHAIN',ILCMLN,ITYLCM)
        IF((ILCMLN.NE.0).AND.(CURNAM.NE.' ')) THEN
          CALL LCMSIX(IPLIB,'DEPL-CHAIN',1)
          CALL EDIDEP(IPRINT,IPLIB,IPEDIT,NBISO,ISONR,LSISO,LISO,NBCH)
          CALL LCMSIX(IPLIB,' ',2)
        ENDIF
*----
*  RECOVER DEPLETION INFORMATION FROM THE INTERNAL LIBRARY
*----
        CALL LCMLEN(IPEDIT,'DEPL-CHAIN',ILLCM,ITLCM)
        IF(ILLCM.NE.0) THEN
          CALL LCMSIX(IPEDIT,'DEPL-CHAIN',1)
          CALL LCMGET(IPEDIT,'STATE-VECTOR',IDIM)
          NDEPL=IDIM(1)
          NDFI=IDIM(2)
          NDFP=IDIM(3)
          NREAC=IDIM(8)
          ALLOCATE(JPIFI(NDFI*NMERGE),PYIEL(NDFI*NBISO*NMERGE))
*
          ALLOCATE(INADPL(3*NDEPL),KDRI(NREAC*NDEPL),RRD(NDEPL),
     >    FIYI(NDFI*NDFP))
          CALL LCMGET(IPEDIT,'ISOTOPESDEPL',INADPL)
          CALL LCMGET(IPEDIT,'DEPLETE-REAC',KDRI)
          CALL LCMGET(IPEDIT,'DEPLETE-DECA',RRD)
          IF(NDFI*NDFP.GT.0) THEN
             CALL LCMGET(IPEDIT,'FISSIONYIELD',FIYI)
          ENDIF
          CALL LCMSIX(IPEDIT,' ',2)
*
          CALL EDIHFD(IPLIB,NGROUP,NGCOND,NREGIO,NMERGE,NBISO,NDEPL,
     >                NDFI,NDFP,NREAC,MATCOD,VOLUME,INADPL,ISONA,
     >                ISONR,MIX,FLUXES(1,1,1),DEN,IDEPL,IGCOND,IMERGE,
     >                KDRI,RRD,FIYI,DECAY,YIELD,JPIFI,PYIEL)
*
          DEALLOCATE(FIYI,RRD,KDRI,INADPL)
        ENDIF
        CALL LCMSIX(IPEDIT,' ',2)
*----
*  COMPUTE MICROSCOPIC CROSS SECTIONS
*----
        CALL EDIMIC(IPEDIT,IPFLUX,IPLIB,NL,NDEL,NBISO,NDEPL,ISONA,
     >             ISONR,MIX,TN,NED,HVECT,IPRINT,NGROUP,NGCOND,NBMIX,
     >             NREGIO,NMERGE,NDFI,ILEAKS,ILUPS,NWGTH,MATCOD,VOLUME,
     >             KEYFLX,CURNAM,IGCOND,IMERGE,FLUXES,EIGENK,B2,SPH,
     >             DEN,ITYPE,IDEPL,LSISO,EMEVF,EMEVG,DECAY,YIELD,JPIFI,
     >             PYIEL,ITRANC,LISO)
*----
*  ISOTX FILE PROCESSING
*----
        IF(ISOTXS.GE.1) THEN
          CALL LCMSIX(IPEDIT,CURNAM,1)
          CALL LCMGET(IPEDIT,'STATE-VECTOR',IPAR)
          NBNISO=IPAR(2)
          NAMSBR='EDIDRV'
          IF(IPRINT.GE.1) WRITE(IOUT,6000) NAMSBR
          ALLOCATE(INNAM(3*NBNISO),INNRF(3*NBNISO),NMIX(NBNISO))
          ALLOCATE(ENERG(NGCOND+1),NAWR(NBNISO),NDEN(NBNISO),
     >    NTMP(NBNISO),NVOL(NBNISO),SNEJ(NBNISO))
          CALL LCMGET(IPEDIT,'ENERGY',ENERG)
          CALL LCMGET(IPEDIT,'ISOTOPESUSED',INNAM)
          CALL LCMGET(IPEDIT,'ISOTOPERNAME',INNRF)
          CALL LCMGET(IPEDIT,'ISOTOPESMIX',NMIX)
          CALL LCMGET(IPEDIT,'ISOTOPESDENS',NDEN)
          CALL LCMGET(IPEDIT,'ISOTOPESTEMP',NTMP)
          CALL LCMGET(IPEDIT,'ISOTOPESVOL',NVOL)
          DO 170 ISO=1,NBNISO
            WRITE(HNEW,'(3A4)') (INNAM((ISO-1)*3+I0),I0=1,3)
            CALL LCMSIX(IPEDIT,HNEW,1)
            CALL LCMGET(IPEDIT,'AWR',AWR)
            EMEVF2=0.0
            EMEVG2=0.0
            CALL LCMLEN(IPEDIT,'MEVF',ILENF,ITYLCM)
            CALL LCMLEN(IPEDIT,'MEVG',ILENG,ITYLCM)
            IF(ILENF.EQ.1) CALL LCMGET(IPEDIT,'MEVF',EMEVF2)
            IF(ILENG.EQ.1) CALL LCMGET(IPEDIT,'MEVG',EMEVG2)
            CALL LCMSIX(IPEDIT,' ',2)
            NAWR(ISO)=AWR
            SNEJ(ISO)=EMEVF2+EMEVG2
  170     CONTINUE
*
          NBIXS=IXEDI
          DO 190 IMRG=1,NMERGE
            NBIXS=NBIXS+1
            WRITE(NISEXT,'(I6)') NBIXS
            DO 180 ICAR=1,6
              IF(NISEXT(ICAR:ICAR) .EQ. ' ' .OR.
     >           NISEXT(ICAR:ICAR) .EQ. '*') THEN
                 NISEXT(ICAR:ICAR)='0'
              ENDIF
 180        CONTINUE
            NISOTX='ISOTXS'//NISEXT
*----
*  GENERATE ONE ISOTXS FILE FOR EACH MERGED REGION IN EACH MIXTURE
*----
            WRITE(CTITLE,9000) NAMSBR,CURNAM,
     >                        'MICR        ','MIX',IMRG,NISOTX
            IF(IPRINT.GE.1) WRITE(IOUT,6002) IMRG,NISOTX
            IUTYPE=ISOTXS+1
            IWGOXS=KDROPN(NISOTX,0,IUTYPE,0)
            CALL EDITXS(IPEDIT,IWGOXS,IUTYPE,IPRINT,NGCOND,NL,NBNISO,
     >                  CTITLE,IMRG,ENERG,INNAM,INNRF,NMIX,NAWR,NDEN,
     >                  NTMP,SNEJ)
            IRETRN=KDRCLS(IWGOXS,1)
 190      CONTINUE
*
          DEALLOCATE(SNEJ,NVOL,NTMP,NDEN,NAWR,ENERG)
          DEALLOCATE(NMIX,INNRF,INNAM)
          CALL LCMSIX(IPEDIT,' ',2)
        ENDIF
      ENDIF
*----
*  COMPUTE MACROSCOPIC RESIDUAL CROSS SECTIONS
*----
      IF((NBMICR.NE.0).AND.(NBMICR.NE.-1).AND.(NBISO.NE.0)) THEN
        IPRIN2=IPRINT-1
        CALL EDIRES(IPEDIT,IPFLUX,IPLIB,NL,NDEL,NBISO,NDEPL,
     >             ISONA,ISONR,MIX,TN,
     >             NED,HVECT,IPRIN2,NGROUP,NGCOND,NBMIX,NREGIO,NMERGE,
     >             NDFI,ILEAKS,ILUPS,NWGTH,MATCOD,VOLUME,KEYFLX,CURNAM,
     >             IGCOND,IMERGE,FLUXES,EIGENK,B2,SPH,DEN,ITYPE,IDEPL,
     >             LSISO,EMEVF,EMEVG,DECAY,YIELD,JPIFI,PYIEL,ITRANC,
     >             LISO)
      ENDIF
*----
*  EDIT MICROSCOPIC ACTIVATION XS
*----
      IF(NACTI.GT.0) THEN
        CALL EDIACT(IPEDIT,IPLIB,IPRINT,NGROUP,NGCOND,NREGIO,NMERGE,
     >              NL,NBISO,NED,VOLUME,MIX,IGCOND,IMERGE,FLUXES(1,1,1),
     >              SPH,ITRANC,ISONA,HVECT,CURNAM,NACTI,IACTI,EMEVF,
     >              EMEVG)
      ENDIF
*----
*  STATISTICS AND DELTA SIGMAS
*----
      IF(NSTATS.NE.0) THEN
        CALL EDIDST(IPEDIT,IPRINT,NL,NGCOND,NMERGE,NSTATS,ILEAKS,
     >              EIGENK,B2,VOLME,WLETY,TAUXT,SCATS,OLDNAM,NTAUXT)
      ENDIF
*----
*  FOUR FACTORS
*----
      IF(IFFAC.NE.0) THEN
        CALL EDIBAL(IPEDIT,IPFLUX,IPRINT,NL,IFFAC,NGCOND,NMERGE,EIGENK,
     >              TAUXT,SCATS,ILEAKS,B2,NTAUXT)
      ENDIF
*
      IF(NDFI.GT.0) DEALLOCATE(PYIEL,JPIFI)
      DEALLOCATE(YIELD,DECAY)
      DEALLOCATE(EMEVG,EMEVF)
      DEALLOCATE(SCATS,SIGS,TAUXT)
      DEALLOCATE(SPH)
      DEALLOCATE(WE,WLETY,VOLME)
      IF(HSIGN.EQ.'L_LIBRARY') THEN
         DEALLOCATE(ISONR,ISONA,IDEPL,TN,MIX,ITYPE,DEN,LSISO)
      ENDIF
*----
*  SCRATCH STORAGE DEALLOCATION
*----
      DEALLOCATE(FLUXES)
      RETURN
*----
*  FORMAT
*----
 6000 FORMAT(1X,A6,': GENERATING ISOTXS FILE ')
 6002 FORMAT(8X,' FOR EDITING MIXTURE    = ',I6,
     >          ' INFORMATION STORED ON FILE = ',A12)
 9000 FORMAT(1X,A6,3X,A12,3X,A12,3X,A4,I6,5X,A12)
      END
