*DECK EDIRES
      SUBROUTINE EDIRES(IPEDIT,IPFLUX,IPLIB,NL,NDEL,NBISO,NDEPL,ISONAM,
     1 ISONRF,MIX,TN,NED,HVECT,IPRINT,NGROUP,NGCOND,NBMIX,NREGIO,NMERGE,
     2 NDFI,ILEAKS,ILUPS,NWGTH,MATCOD,VOLUME,KEYFLX,CURNAM,IGCOND,
     3 IMERGE,FLUXES,EIGENK,B2,SPH,DEN,ITYPE,IEVOL,LSISO,EMEVF,EMEVG,
     4 DECAY,YIELD,IPIFI,PYIELD,ITRANC,LISO)
*
*-----------------------------------------------------------------------
*
*Purpose:
* calculation of residual macroscopic cross sections.
*
*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
*
*Parameters: input
* IPEDIT  pointer to the edition LCM object (L_EDIT signature).
* IPFLUX  pointer to the solution LCM object (L_FLUX signature).
* IPLIB   pointer to the reference microscopic cross section library
*         LCM object (L_LIBRARY signature).
* NL      number of Legendre orders required in the calculation
*         (NL=1 or higher).
* NDEL    number of delayed precursor groups.
* NBISO   number of isotopes.
* NDEPL   number of depleting isotopes.
* ISONAM  local names of NBISO isotopes:
*         chars 1 to 8  is the local isotope name;
*         chars 9 to 12 is a suffix function of the mix number.
* ISONRF  library name of isotopes.
* MIX     mixture number associated with each isotope.
* TN      absolute temperature associated with each isotope.
* NED     number of extra vector edits from matxs.
* HVECT   MATXS names of the extra vector edits.
* IPRINT  print index.
* NGROUP  number of energy groups.
* NGCOND  number of condensed groups.
* NBMIX   number of mixtures.
* NREGIO  number of volumes.
* NMERGE  number of merged regions.
* NDFI    number of fissile isotopes.
* ILEAKS  leakage calculation type: =0: no leakage; =1: homogeneous
*         leakage (Diffon); =2: isotropic streaming (Ecco);
*         =3: anisotropic streaming (Tibere).
* ILUPS   up-scattering removing flag (=1 to remove up-scattering from
*         output cross-sections).
* NWGTH   type of weighting for P1 cross section info (=0: P0 ; =1: P1).
* MATCOD  mixture index per volume.
* VOLUME  volumes.
* KEYFLX  position of average fluxes.
* CURNAM  name of the LCM directory where the microscopic cross sections
*         are stored (=' ' for no save).
* IGCOND  limits of condensed groups.
* IMERGE  index of merged regions.
* FLUXES  fluxes.
* EIGENK  effective multiplication factor.
* B2      bucklings.
* SPH     SPH homogenization factors.
* DEN     number density of each isotope.
* ITYPE   type of each isotope.
* IEVOL   flag making an isotope non-depleting:
*         =1 to force an isotope to be non-depleting
* LSISO   flag for isotopes saved.
* EMEVF   fission production energy.
* EMEVG   capture production energy.
* DECAY   radioactive decay constant.
* YIELD   group-ordered condensed fission product yield.
* IPIFI   isotope index associated to each fissile isotope of IPLIB.
* PYIELD  fissile isotope ordered condensed fission product yield.
* ITRANC  type of transport correction (=0: no correction).
* LISO    =.TRUE. if we want to keep all the isotopes after 
*         homogeneization.
*
*-----------------------------------------------------------------------
*
      USE GANLIB
*----
*  SUBROUTINE ARGUMENTS
*----
      TYPE(C_PTR) IPEDIT,IPFLUX,IPLIB
      INTEGER NL,NDEL,NBISO,NDEPL,ISONAM(3,NBISO),ISONRF(3,NBISO),
     1 MIX(NBISO),NED,IPRINT,NGROUP,NGCOND,NBMIX,NREGIO,NMERGE,NDFI,
     2 ILEAKS,ILUPS,NWGTH,MATCOD(NREGIO),KEYFLX(NREGIO),IGCOND(NGCOND),
     3 IMERGE(NREGIO),ITYPE(NBISO),IEVOL(NBISO),LSISO(NBISO),
     4 IPIFI(NDFI,NMERGE),ITRANC
      REAL TN(NBISO),VOLUME(NREGIO),FLUXES(NREGIO,NGROUP,NWGTH+1),
     1 EIGENK,B2(4),SPH(NMERGE,NGCOND,NWGTH+1),DEN(NBISO),EMEVF(NBISO),
     2 EMEVG(NBISO),DECAY(NBISO),YIELD(NGCOND+1,NBISO,NMERGE),
     3 PYIELD(NDFI,NBISO,NMERGE)
      CHARACTER*(*) HVECT(NED),CURNAM
      LOGICAL LISO
*----
*  LOCAL VARIABLES
*----
      PARAMETER (NSTATE=40,MAXHMA=100)
      TYPE(C_PTR) IPWORK
      CHARACTER HMAKE(MAXHMA)*12,TEXT12*12,CM*2
      LOGICAL LWD,LYIEL
      INTEGER IPAR(NSTATE)
      INTEGER, ALLOCATABLE, DIMENSION(:) :: LSIS2,ISMIX,ISTYP,ISTOD,
     1 ITYPRO,JPIFI
      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: IHNISO,IHNIRF
      REAL, ALLOCATABLE, DIMENSION(:) :: WDLA,SDEN,VOLISO,TNISO,WORK,
     1 WPY,DENTOT,DAWR,TNTOT
      REAL, ALLOCATABLE, DIMENSION(:,:) :: GAS,SIGS
      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: WSCAT,PNFIRA,WORK2
*----
*  SCRATCH STORAGE ALLOCATION
*   PNFIRA  nu*fission rates.
*----
*
* GAS CONTENTS:
*            1 : 'NWT0'
*            2 : 'NWT1'
*            3 : 'SIGS00' |
*            4 : 'SIGS01' | NL VALUES
*  ...                    |
*         3+NL : 'NTOT0'
*         4+NL : 'NTOT1'
*         5+NL : 'NUSIGF'
*         6+NL : HVECT(1) |
*         7+NL : HVECT(2) | NED VALUES
*  ...                    |
*  MAXH-2*NDEL-4 : 'H-FACTOR'
*  MAXH-2*NDEL-3 : 'OVERV'
*  MAXH-2*NDEL-2 : 'TRANC'
*  MAXH-2*NDEL-1 : 'NUSIGF01' |
*  MAXH-2*NDEL   : 'NUSIGF02' |
*  MAXH-2*NDEL+1 : 'NUSIGF03' | NDEL VALUES
*  MAXH-2*NDEL+2 : 'NUSIGF04' |
*  ...                        |
*  MAXH-NDEL-1 : 'CHI'
*    MAXH-NDEL : 'CHI01' |
*  MAXH-NDEL+1 : 'CHI02' |
*  MAXH-NDEL+2 : 'CHI03' | NDEL VALUES
*  MAXH-NDEL+3 : 'CHI04' |
*  ...                   |
*         MAXH : 'STRD'
*
      ALLOCATE(LSIS2(NBISO),IHNISO(3,NBISO*NMERGE),
     1 IHNIRF(3,NBISO*NMERGE),ISMIX(NBISO*NMERGE),ISTYP(NBISO*NMERGE),
     2 ISTOD(NBISO*NMERGE),JPIFI(NDFI),ITYPRO(NL))
      ALLOCATE(WDLA(NDEL),SDEN(NBISO*NMERGE),VOLISO(NBISO*NMERGE),
     1 TNISO(NBISO*NMERGE),WSCAT(NGCOND,NGCOND,NL),
     2 GAS(NGCOND,10+NL+NED+2*NDEL),WORK(NGCOND+1),WPY(NDFI),
     3 PNFIRA(NGCOND,0:NDEL,2),WORK2(NGCOND,NGCOND,NL),DENTOT(NMERGE),
     4 DAWR(NMERGE),TNTOT(NMERGE))
*----
*  RECOVER THE RADIOACTIVE DECAY CONSTANTS OF DELAYED NEUTRON GROUPS
*  FROM THE MACROLIB IF THEY EXIST.
*----
      IF(IPRINT.GT.3) THEN
         WRITE(6,'(/36H EDIRES: COMPUTE A RESIDUAL ISOTOPE.)')
      ENDIF
      CALL LCMOP(IPWORK,'*TEMPORARY*',0,1,0)
      LWD=.FALSE.
      IF(CURNAM.NE.' ') THEN
         CALL LCMSIX(IPEDIT,CURNAM,1)
         CALL LCMSIX(IPEDIT,'MACROLIB',1)
         CALL LCMLEN(IPEDIT,'LAMBDA-D',ILONG,ITYLCM)
         LWD=(ILONG.EQ.NDEL).AND.(NDEL.GT.0)
         IF(LWD) CALL LCMGET(IPEDIT,'LAMBDA-D',WDLA)
         CALL LCMSIX(IPEDIT,' ',2)
         CALL LCMSIX(IPEDIT,' ',2)
*
         IF(LWD) THEN
            CALL LCMSIX(IPWORK,'DEFAULT',1)
            CALL LCMSIX(IPWORK,'MACROLIB',1)
            CALL LCMPUT(IPWORK,'LAMBDA-D',NDEL,2,WDLA)
            CALL LCMSIX(IPWORK,' ',2)
            CALL LCMSIX(IPWORK,' ',2)
         ENDIF
      ENDIF
*----
*  COMPUTE MICROSCOPIC CROSS SECTIONS OF REMAINING ISOTOPES. WE SET
*  NDFI=0 TO GET RID OF PPF YIELDS.
*----
      DO 10 ISO=1,NBISO
      LSIS2(ISO)=0
      IF(LSISO(ISO).EQ.0) LSIS2(ISO)=1
   10 CONTINUE
      IPRIN2=MAX(0,IPRINT-2)
      CALL EDIMIC(IPWORK,IPFLUX,IPLIB,NL,NDEL,NBISO,NDEPL,ISONAM,ISONRF,
     1 MIX,TN,NED,HVECT,IPRIN2,NGROUP,NGCOND,NBMIX,NREGIO,NMERGE,0,
     2 ILEAKS,ILUPS,NWGTH,MATCOD,VOLUME,KEYFLX,'DEFAULT',IGCOND,IMERGE,
     3 FLUXES,EIGENK,B2,SPH,DEN,ITYPE,IEVOL,LSIS2,EMEVF,EMEVG,DECAY,
     4 YIELD,IPIFI,PYIELD,ITRANC,LISO)
*
      MAXH=10+NL+NED+2*NDEL
      IF(MAXH+NL.GT.MAXHMA) CALL XABORT('EDIRES: HMAKE OVERFLOW.')
      CALL LCMSIX(IPWORK,'DEFAULT',1)
      CALL LCMGET(IPWORK,'STATE-VECTOR',IPAR)
      JJISO=IPAR(2)
      IF(JJISO.GT.NBISO*NMERGE) CALL XABORT('EDIRES: JJISO OVERFLOW.')
      IF(JJISO.GT.0) THEN
         CALL LCMGET(IPWORK,'ISOTOPESUSED',IHNISO)
         CALL LCMGET(IPWORK,'ISOTOPESDENS',SDEN)
         CALL LCMGET(IPWORK,'ISOTOPESMIX',ISMIX)
         CALL LCMGET(IPWORK,'ISOTOPESTEMP',TNISO)
      ENDIF
      DO 240 INM=1,NMERGE
      DO 20 J=1,MAXH+NL
   20 HMAKE(J)=' '
      CALL XDRSET(GAS,MAXH*NGCOND,0.0)
      CALL XDRSET(WSCAT,NL*NGCOND*NGCOND,0.0)
      CALL XDRSET(PNFIRA(1,0,2),NGCOND*(NDEL+1),0.0)
      CALL XDRSET(YIELD(1,1,1),1+NGCOND,0.0)
      CALL XDRSET(PYIELD(1,1,1),NDFI,0.0)
      DENTOT(INM)=0.0
      DAWR(INM)=0.0
      DECISO=0.0
      DO 170 ISO=1,JJISO
      IF(ISMIX(ISO).EQ.INM) THEN
         WRITE(TEXT12,'(3A4)') (IHNISO(I0,ISO),I0=1,3)
         DDEN=SDEN(ISO)
         CALL LCMSIX(IPWORK,TEXT12,1)
         CALL LCMLEN(IPWORK,'AWR',LENGTH,ITYLCM)
         IF(LENGTH.EQ.1) THEN
            CALL LCMGET(IPWORK,'AWR',FLOTT)
            DAWR(INM)=DAWR(INM)+DDEN*FLOTT
         ENDIF
         DENTOT(INM)=DENTOT(INM)+DDEN
         TNTOT(INM)=TNISO(ISO)
         CALL LCMLEN(IPWORK,'DECAY',LENGTH,ITYLCM)
         IF(LENGTH.EQ.1) THEN
            CALL LCMGET(IPWORK,'DECAY',FLOTT)
            DECISO=DECISO+FLOTT*DDEN
         ENDIF
         CALL LCMLEN(IPWORK,'YIELD',LENGTH,ITYLCM)
         IF(LENGTH.EQ.NGCOND+1) THEN
            CALL LCMGET(IPWORK,'YIELD',WORK)
            DO 30 IGR=1,NGCOND+1
   30       YIELD(IGR,1,1)=YIELD(IGR,1,1)+WORK(IGR)
         ENDIF
         CALL LCMLEN(IPWORK,'PYIELD',LENGTH,ITYLCM)
         IF((LENGTH.GT.0).AND.(LENGTH.EQ.NDFI)) THEN
            CALL LCMGET(IPWORK,'PIFI',JPIFI)
            CALL LCMGET(IPWORK,'PYIELD',WPY)
            DO 40 I=1,NDFI
   40       PYIELD(I,1,1)=PYIELD(I,1,1)+WPY(I)
         ENDIF
*
*        SET ARRAY HMAKE.
         CALL LCMLEN(IPWORK,'NWT0',ILONG,ITYLCM)
         IF(ILONG.EQ.NGCOND) HMAKE(1)='NWT0'
         CALL LCMLEN(IPWORK,'NWT1',ILONG,ITYLCM)
         IF(ILONG.EQ.NGCOND) HMAKE(2)='NWT1'
         IOF=2
         DO 50 IL=0,NL-1
         IOF=IOF+1
         WRITE (CM,'(I2.2)') IL
         CALL LCMLEN(IPWORK,'SIGS'//CM,ILONG,ITYLCM)
         IF(ILONG.EQ.NGCOND) HMAKE(IOF)='SIGS'//CM
   50    CONTINUE
         CALL LCMLEN(IPWORK,'NTOT0',ILONG,ITYLCM)
         IF(ILONG.EQ.NGCOND) HMAKE(IOF+1)='NTOT0'
         CALL LCMLEN(IPWORK,'NTOT1',ILONG,ITYLCM)
         IF(ILONG.EQ.NGCOND) HMAKE(IOF+2)='NTOT1'
         CALL LCMLEN(IPWORK,'NUSIGF',ILONG,ITYLCM)
         IF(ILONG.EQ.NGCOND) HMAKE(IOF+3)='NUSIGF'
         IOF=IOF+3
         DO 60 IED=1,NED
         IOF=IOF+1
         CALL LCMLEN(IPWORK,HVECT(IED),ILONG,ITYLCM)
         IF(ILONG.EQ.NGCOND) HMAKE(IOF)=HVECT(IED)
   60    CONTINUE
         CALL LCMLEN(IPWORK,'H-FACTOR',ILONG,ITYLCM)
         IF(ILONG.EQ.NGCOND) HMAKE(IOF+1)='H-FACTOR'
         CALL LCMLEN(IPWORK,'OVERV',ILONG,ITYLCM)
         IF(ILONG.EQ.NGCOND) HMAKE(IOF+2)='OVERV'
         CALL LCMLEN(IPWORK,'TRANC',ILONG,ITYLCM)
         IF(ILONG.EQ.NGCOND) HMAKE(IOF+3)='TRANC'
         IOF=IOF+3
         DO 70 IDEL=1,NDEL
         IOF=IOF+1
         WRITE(TEXT12,'(6HNUSIGF,I2.2)') IDEL
         CALL LCMLEN(IPWORK,TEXT12,ILONG,ITYLCM)
         IF(ILONG.EQ.NGCOND) HMAKE(IOF)=TEXT12
   70    CONTINUE
         IOF=IOF+1
         CALL LCMLEN(IPWORK,'CHI',ILONG,ITYLCM)
         IF(ILONG.EQ.NGCOND) HMAKE(IOF)='CHI'
         DO 80 IDEL=1,NDEL
         IOF=IOF+1
         WRITE(TEXT12,'(3HCHI,I2.2)') IDEL
         CALL LCMLEN(IPWORK,TEXT12,ILONG,ITYLCM)
         IF(ILONG.EQ.NGCOND) HMAKE(IOF)=TEXT12
   80    CONTINUE
         CALL LCMLEN(IPWORK,'STRD',ILONG,ITYLCM)
         IF(ILONG.EQ.NGCOND) HMAKE(IOF+1)='STRD'
*
         DO 150 J=1,MAXH
         IF(HMAKE(J).NE.' ') THEN
            CALL LCMLEN(IPWORK,HMAKE(J),ILONG,ITYLCM)
            IF(ILONG.GT.0) THEN
               CALL LCMGET(IPWORK,HMAKE(J),WORK)
               IF(HMAKE(J).EQ.'NUSIGF') THEN
                  DO 90 IGR=1,NGCOND
                  DEL=WORK(IGR)*GAS(IGR,1)*DDEN
                  PNFIRA(IGR,0,1)=DEL
                  PNFIRA(IGR,0,2)=PNFIRA(IGR,0,2)+DEL
   90             GAS(IGR,J)=GAS(IGR,J)+WORK(IGR)*DDEN
               ELSE IF(HMAKE(J)(:3).EQ.'NUS') THEN
                  IDEL=J-(8+NL+NED)
                  DO 100 IGR=1,NGCOND
                  DEL=WORK(IGR)*GAS(IGR,1)*DDEN
                  PNFIRA(IGR,IDEL,1)=DEL
                  PNFIRA(IGR,IDEL,2)=PNFIRA(IGR,IDEL,2)+DEL
  100             GAS(IGR,J)=GAS(IGR,J)+WORK(IGR)*DDEN
               ELSE IF(HMAKE(J)(:3).EQ.'NWT') THEN
                  DO 110 IGR=1,NGCOND
  110             GAS(IGR,J)=WORK(IGR)
               ELSE IF(HMAKE(J).EQ.'CHI') THEN
                  DO 120 IGR=1,NGCOND
  120             GAS(IGR,J)=GAS(IGR,J)+WORK(IGR)*PNFIRA(IGR,0,1)
               ELSE IF(HMAKE(J)(:3).EQ.'CHI') THEN
                  IDEL=J-(9+NL+NED+NDEL)
                  DO 130 IGR=1,NGCOND
  130             GAS(IGR,J)=GAS(IGR,J)+WORK(IGR)*PNFIRA(IGR,IDEL,1)
               ELSE
                  DO 140 IGR=1,NGCOND
  140             GAS(IGR,J)=GAS(IGR,J)+WORK(IGR)*DDEN
               ENDIF
            ENDIF
         ENDIF
  150    CONTINUE
         ALLOCATE(SIGS(NGCOND,NL))
         CALL XDRLGS(IPWORK,-1,IPRINT,0,NL-1,1,NGCOND,SIGS,WORK2,ITYPRO)
         DEALLOCATE(SIGS)
         DO 160 IL=1,NL
         DO 160 JGR=1,NGCOND
         DO 160 IGR=1,NGCOND
  160    WSCAT(IGR,JGR,IL)=WSCAT(IGR,JGR,IL)+WORK2(IGR,JGR,IL)*DDEN
         CALL LCMSIX(IPWORK,' ',2)
      ENDIF
  170 CONTINUE
      IF(DENTOT(INM).GT.0.0) THEN
         WRITE(TEXT12,'(A8,I4.4)') '*MAC*RES',INM
         IF(IPRINT.GT.0) WRITE (6,600) TEXT12
         CALL LCMSIX(IPEDIT,CURNAM,1)
         CALL LCMSIX(IPEDIT,TEXT12,1)
         CALL LCMPUT(IPEDIT,'AWR',1,2,DAWR(INM))
         DECISO=DECISO/DENTOT(INM)
         IF(DECISO.GT.0.0) CALL LCMPUT(IPEDIT,'DECAY',1,2,DECISO)
         LYIEL=.FALSE.
         DO 175 IGR=1,NGCOND+1
  175    LYIEL=LYIEL.OR.(YIELD(IGR,1,1).GT.0.0)
         LYIEL=LYIEL.AND.(NDFI.GT.0)
         IF(LYIEL) THEN
            CALL LCMPUT(IPEDIT,'YIELD',NGCOND+1,2,YIELD(1,1,1))
            CALL LCMPUT(IPEDIT,'PYIELD',NDFI,2,PYIELD(1,1,1))
            CALL LCMPUT(IPEDIT,'PIFI',NDFI,1,JPIFI)
         ENDIF
         DO 210 J=1,MAXH
         IF(HMAKE(J).EQ.'OVERV') THEN
            DO 180 IGR=1,NGCOND
  180       GAS(IGR,J)=GAS(IGR,J)/DENTOT(INM)
         ELSE IF(HMAKE(J).EQ.'CHI') THEN
            DO 190 IGR=1,NGCOND
            IF(GAS(IGR,J).NE.0.0) THEN
               GAS(IGR,J)=GAS(IGR,J)/PNFIRA(IGR,0,2)
            ENDIF
  190       CONTINUE
         ELSE IF(HMAKE(J)(:3).EQ.'CHI') THEN
            IDEL=J-(9+NL+NED+NDEL)
            DO 200 IGR=1,NGCOND
            IF(GAS(IGR,J).NE.0.0) THEN
               GAS(IGR,J)=GAS(IGR,J)/PNFIRA(IGR,IDEL,2)
            ENDIF
  200       CONTINUE
         ENDIF
         IF((HMAKE(J).NE.' ').AND.(HMAKE(J)(:4).NE.'SIGS')) THEN
            CALL LCMPUT(IPEDIT,HMAKE(J),NGCOND,2,GAS(1,J))
         ENDIF
  210    CONTINUE
         DO 220 IL=1,NL
         ITYPRO(IL)=0
         IF(HMAKE(MAXH+IL+1).NE.' ') ITYPRO(IL)=1
  220    CONTINUE
         CALL XDRLGS(IPEDIT,1,IPRINT,0,NL-1,1,NGCOND,GAS(1,3),WSCAT,
     1   ITYPRO)
         IF(LWD) CALL LCMPUT(IPEDIT,'LAMBDA-D',NDEL,2,WDLA)
         CALL LCMSIX(IPEDIT,' ',2)
         CALL LCMSIX(IPEDIT,' ',2)
*
         IF(IPRINT.GT.3) THEN
            WRITE(6,'(/17H NUMBER DENSITY =,1P,E12.4)') 1.0
            DO 230 J=1,MAXH
            IF(HMAKE(J).NE.' ') THEN
               WRITE (6,610) HMAKE(J),(GAS(I,J),I=1,NGCOND)
            ENDIF
  230       CONTINUE
            WRITE (6,610) 'SIGA    ',(GAS(I,3+NL)-GAS(I,3),I=1,NGCOND)
            WRITE (6,610) 'SIGW00  ',(WSCAT(I,I,1),I=1,NGCOND)
            IF(NL.GT.1) THEN
               WRITE (6,610) 'SIGW01  ',(WSCAT(I,I,2),I=1,NGCOND)
            ENDIF
            IF(LWD) WRITE (6,610) 'LAMBDA-D',(WDLA(I),I=1,NDEL)
         ENDIF
      ENDIF
  240 CONTINUE
      CALL LCMSIX(IPWORK,' ',2)
      CALL LCMCL(IPWORK,2)
*----
*  UPDATE RECORDS ISOTOPESUSED, ISOTOPERNAME, ISOTOPESMIX, ETC.
*----
      CALL LCMSIX(IPEDIT,CURNAM,1)
      CALL LCMGET(IPEDIT,'STATE-VECTOR',IPAR)
      JJISO=IPAR(2)
      IF(JJISO.GT.0) THEN
         CALL LCMGET(IPEDIT,'ISOTOPESUSED',IHNISO)
         CALL LCMGET(IPEDIT,'ISOTOPERNAME',IHNIRF)
         CALL LCMGET(IPEDIT,'ISOTOPESDENS',SDEN)
         CALL LCMGET(IPEDIT,'ISOTOPESMIX',ISMIX)
         CALL LCMGET(IPEDIT,'ISOTOPESTYPE',ISTYP)
         CALL LCMGET(IPEDIT,'ISOTOPESTODO',ISTOD)
         CALL LCMGET(IPEDIT,'ISOTOPESVOL',VOLISO)
         CALL LCMGET(IPEDIT,'ISOTOPESTEMP',TNISO)
      ENDIF
      DO 260 INM=1,NMERGE
      IF(DENTOT(INM).GT.0.0) THEN
         JJISO=JJISO+1
         IF(JJISO.GT.NBISO*NMERGE) CALL XABORT('EDIRES: OVERFLOW.')
         WRITE(TEXT12,'(A8,I4.4)') '*MAC*RES',INM
         READ(TEXT12,'(3A4)') (IHNISO(I0,JJISO),I0=1,3)
         WRITE(TEXT12,'(A12)') '*MAC*RES'
         READ(TEXT12,'(3A4)') (IHNIRF(I0,JJISO),I0=1,3)
         SDEN(JJISO)=1.0
         ISMIX(JJISO)=INM
         ISTYP(JJISO)=1
         ISTOD(JJISO)=1
         DVOL=0.0
         DO 250 IREGIO=1,NREGIO
         IF(IMERGE(IREGIO).EQ.INM) DVOL=DVOL+VOLUME(IREGIO)
  250    CONTINUE
         VOLISO(JJISO)=DVOL
         TNISO(JJISO)=TNTOT(INM)
      ENDIF
  260 CONTINUE
      IPAR(2)=JJISO
      IPAR(22)=IPAR(22)+1
      CALL LCMPUT(IPEDIT,'STATE-VECTOR',NSTATE,1,IPAR)
      CALL LCMPUT(IPEDIT,'ISOTOPESUSED',3*JJISO,3,IHNISO)
      CALL LCMPUT(IPEDIT,'ISOTOPERNAME',3*JJISO,3,IHNIRF)
      CALL LCMPUT(IPEDIT,'ISOTOPESDENS',JJISO,2,SDEN)
      CALL LCMPUT(IPEDIT,'ISOTOPESMIX',JJISO,1,ISMIX)
      CALL LCMPUT(IPEDIT,'ISOTOPESTYPE',JJISO,1,ISTYP)
      CALL LCMPUT(IPEDIT,'ISOTOPESTODO',JJISO,1,ISTOD)
      CALL LCMPUT(IPEDIT,'ISOTOPESVOL',JJISO,2,VOLISO)
      CALL LCMPUT(IPEDIT,'ISOTOPESTEMP',JJISO,2,TNISO)
      CALL LCMSIX(IPEDIT,' ',2)
*----
*  SCRATCH STORAGE DEALLOCATION
*----
      DEALLOCATE(TNTOT,DAWR,DENTOT,WORK2,PNFIRA,WPY,WORK,GAS,WSCAT,
     1 TNISO,VOLISO,SDEN,WDLA)
      DEALLOCATE(ITYPRO,JPIFI,ISTOD,ISTYP,ISMIX,IHNIRF,IHNISO,LSIS2)
      RETURN
*
  600 FORMAT (//44H CROSS SECTION OF MERGED/CONDENSED ISOTOPE ',A12,
     1 2H':)
  610 FORMAT (/11H REACTION ',A12,2H':/(1X,1P,10E12.4))
      END
