path: root/Dragon/src/EDI.f

*DECK EDI
      SUBROUTINE EDI(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Edition operator for Dragon.
*
*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 and G. Marleau
*
*Parameters: input/output
* NENTRY  number of LCM objects or files used by the operator.
* HENTRY  name of each LCM object or file (order is arbitrary for
*         objects 2,3,4):
*         HENTRY(1): create or modification type(L_EDIT);
*         HENTRY(2): read-only type(L_FLUX);
*         HENTRY(3): read-only type(L_MACROLIB OR L_LIBRARY);
*         HENTRY(4): read-only type(L_TRACK);
*         The object 5 is required if the "MERG CELL" option is used.
*         HENTRY(5): optional read-only type(L_GEOM) containing the
*         original geometry;
*         HENTRY(6): optional read-only type(L_GEOM) containing the
*         macrogeometry;
*         HENTRY(7): optional read-only type(L_SYS) containing the
*         L_PIJ object of the original geometry in cases where a
*         Selengut normalization is required.
* IENTRY  type of each LCM object or file:
*         =1 LCM memory object; =2 XSM file; =3 sequential binary file;
*         =4 sequential ascii file.
* JENTRY  access of each LCM object or file:
*         =0 the LCM object or file is created;
*         =1 the LCM object or file is open for modifications;
*         =2 the LCM object or file is open in read-only mode.
* KENTRY  LCM object address or file unit number.
*
*-----------------------------------------------------------------------
*
      USE GANLIB
*----
*  SUBROUTINE ARGUMENTS
*----
      INTEGER      NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)
      TYPE(C_PTR)  KENTRY(NENTRY)
      CHARACTER    HENTRY(NENTRY)*12
*----
*  LOCAL VARIABLES
*----
      PARAMETER (NSTATE=40,IOUT=6,MAXED=100,MAXOUT=100)
      TYPE(C_PTR) IPEDIT,IPFLUX,IPTRK1,IPLIB,JPMAC,KPMAC,IPGEO1,IPGEO2,
     > JPFLUX,IPSYS,IPMRG
      CHARACTER*12 TEXT12,CDOOR,OLDGEO,MACGEO,CURNAM,OLDNAM,HSIGN,
     > CARISO(MAXED)
      CHARACTER TITLE*72,HSMG*131,HVOUT(MAXOUT)*8
      INTEGER IGP(NSTATE),IDATA(NSTATE),ISTATE(NSTATE)
      LOGICAL LNEWGE,LISO,LDEPL,LMACR,LREMIX
      INTEGER, ALLOCATABLE, DIMENSION(:) :: KEYFL,MAT,IDL,IGCOND,IMERGE,
     > IACTI,IGCR,IREMIX
      REAL, ALLOCATABLE, DIMENSION(:) :: VOL,FLINT,ENERG,ENERV,ECR
*----
* PARAMETER VALIDATION.
*----
      IF(NENTRY.LT.2) CALL XABORT('EDI: MORE RHS LCM OBJECTS EXPECTED.')
      IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2)) CALL XABORT('EDI: LC'
     > //'M OBJECT EXPECTED AT LHS.')

      IPEDIT=KENTRY(1)
      IF(JENTRY(1) .EQ. 0) THEN
        HSIGN='L_EDIT'
        CALL LCMPTC(IPEDIT,'SIGNATURE',12,HSIGN)
      ELSE IF(JENTRY(1) .EQ. 1) THEN
        CALL LCMGTC(IPEDIT,'SIGNATURE',12,HSIGN)
        IF(HSIGN .NE. 'L_EDIT') THEN
          TEXT12=HENTRY(1)
          CALL XABORT('EDI: SIGNATURE OF '//TEXT12//' IS '//HSIGN//
     >    '. L_EDIT EXPECTED.')
        ENDIF
      ELSE
        CALL XABORT('EDI: EDITING LCM OBJECT IN CREATE OR MODIFY MODE '
     >  //'EXPECTED.')
      ENDIF
*----
*  SCAN READ-ONLY MODE DATA STRUCTURE ENTRY(2) TO ENTRY(4)
*  FOR FLUX, TRACK AND LIB
*----
      IF(JENTRY(2).NE.2) CALL XABORT('EDI: LCM OBJECT IN READ-ONLY MOD'
     > //'E EXPECTED AT RHS.')
      IPFLUX=C_NULL_PTR
      IKFLUX=0
      IPTRK1=C_NULL_PTR
      IKTRK1=0
      IPLIB=C_NULL_PTR
      IKLIB=0
      DO 10 IEN=2,MIN(4,NENTRY)
        IF((IENTRY(IEN).EQ.1).OR.(IENTRY(IEN).EQ.2)) THEN
          CALL LCMGTC(KENTRY(IEN),'SIGNATURE',12,HSIGN)
          IF((HSIGN.EQ.'L_FLUX').AND.(IKFLUX.EQ.0)) THEN
            IPFLUX=KENTRY(IEN)
            IKFLUX=IEN
          ELSE IF((HSIGN.EQ.'L_TRACK').AND.(IKTRK1.EQ.0)) THEN
            IPTRK1=KENTRY(IEN)
            IKTRK1=IEN
          ELSE IF((HSIGN.EQ.'L_LIBRARY').AND.(IKLIB.EQ.0)) THEN
            IPLIB=KENTRY(IEN)
            IKLIB=IEN
          ELSE IF((HSIGN.EQ.'L_MACROLIB').AND.(IKLIB.EQ.0)) THEN
            IPLIB=KENTRY(IEN)
            IKLIB=-IEN
          ENDIF
        ENDIF
   10 CONTINUE
*----
*  READ MACROLIB INFORMATION
*----
      IF(IKLIB.EQ.0) CALL XABORT('EDI: NO MACROLIB OR MICROLIB LCM OBJ'
     > //'ECT FOUND.')
      IF(IKLIB.GT.0) THEN
        CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
        MAXISM=ISTATE(22)
        CALL LCMSIX(IPLIB,'MACROLIB',1)
      ELSE
        MAXISM=1
      ENDIF
      CALL LCMGET(IPLIB,'STATE-VECTOR',IDATA)
      NGRP=IDATA(1)
      NBMIX=IDATA(2)
      NL=IDATA(3)
      NIFISS=IDATA(4)
      NEDMAC=IDATA(5)
      ITRANC=IDATA(6)
      NDEL=IDATA(7)
      NALBP=IDATA(8)
      IDFM=IDATA(12)
*----
*  BUILD L_TRACK AND L_FLUX OBJECTS FROM EXTENDED MACROLIB
*----
      IF((IKTRK1.EQ.0).AND.(IKFLUX.EQ.0)) THEN
         CALL LCMOP(IPTRK1,'PSEUDO_TRACK',0,1,0)
         CALL LCMOP(IPFLUX,'PSEUDO_FLUX',0,1,0)
         HSIGN='L_TRACK'
         CALL LCMPTC(IPTRK1,'SIGNATURE',12,HSIGN)
         HSIGN='L_FLUX'
         CALL LCMPTC(IPFLUX,'SIGNATURE',12,HSIGN)
         TEXT12='DUMMY'
         CALL LCMPTC(IPTRK1,'TRACK-TYPE',12,TEXT12)
         ALLOCATE(KEYFL(NBMIX))
         DO 20 IBM=1,NBMIX
         KEYFL(IBM)=IBM
   20    CONTINUE
         CALL LCMPUT(IPTRK1,'MATCOD',NBMIX,1,KEYFL)
         CALL LCMPUT(IPTRK1,'KEYFLX',NBMIX,1,KEYFL)
         DEALLOCATE(KEYFL)
         ALLOCATE(VOL(NBMIX))
         CALL LCMLEN(IPLIB,'VOLUME',ILONG,ITYLCM)
         IF(ILONG.EQ.0) CALL XABORT('EDI: NO VOLUME IN MACROLIB.')
         CALL LCMGET(IPLIB,'VOLUME',VOL)
         CALL LCMPUT(IPTRK1,'VOLUME',NBMIX,2,VOL)
         ISTATE(:NSTATE)=0
         ISTATE(1)=NBMIX
         ISTATE(2)=NBMIX
         ISTATE(4)=NBMIX
         CALL LCMPUT(IPTRK1,'STATE-VECTOR',NSTATE,1,ISTATE)
         ALLOCATE(FLINT(NBMIX))
         JPMAC=LCMGID(IPLIB,'GROUP')
         JPFLUX=LCMLID(IPFLUX,'FLUX',NGRP)
         DO 40 IGR=1,NGRP
            KPMAC=LCMGIL(JPMAC,IGR)
            CALL LCMLEN(KPMAC,'FLUX-INTG',ILONG,ITYLCM)
            IF(ILONG.EQ.0) CALL XABORT('EDI: NO FLUX-INTG IN MACROLIB.')
            CALL LCMGET(KPMAC,'FLUX-INTG',FLINT)
            DO 30 IBM=1,NBMIX
            FLINT(IBM)=FLINT(IBM)/VOL(IBM)
   30       CONTINUE
            CALL LCMPDL(JPFLUX,IGR,NBMIX,2,FLINT)
   40    CONTINUE
         DEALLOCATE(FLINT,VOL)
         CALL LCMLEN(IPLIB,'K-EFFECTIVE',ILONG,ITYLCM)
         IF(ILONG.EQ.1) THEN
            CALL LCMGET(IPLIB,'K-EFFECTIVE',FLOAT)
            CALL LCMPUT(IPFLUX,'K-EFFECTIVE',1,2,FLOAT)
         ENDIF
         CALL LCMLEN(IPLIB,'K-INFINITY',ILONG,ITYLCM)
         IF(ILONG.EQ.1) THEN
            CALL LCMGET(IPLIB,'K-INFINITY',FLOAT)
            CALL LCMPUT(IPFLUX,'K-INFINITY',1,2,FLOAT)
         ENDIF
         ISTATE(:NSTATE)=0
         ISTATE(1)=NGRP
         ISTATE(2)=NBMIX
         CALL LCMPUT(IPFLUX,'STATE-VECTOR',NSTATE,1,ISTATE)
      ENDIF
      IF(IKLIB.GT.0) CALL LCMSIX(IPLIB,' ',2)
      IF(.NOT.C_ASSOCIATED(IPFLUX)) THEN
         CALL XABORT('EDI: NO REFERENCE FLUX AVAILABLE.')
      ENDIF
      CALL LCMGET(IPFLUX,'STATE-VECTOR',ISTATE)
      ILEAKC=ISTATE(7)
*----
*  READ GEOMETRIES AND SYSTEM
*----
      IPGEO1=C_NULL_PTR
      IKGEO1=0
      IPGEO2=C_NULL_PTR
      IKGEO2=0
      IPSYS=C_NULL_PTR
      IKSYS=0
      OLDGEO=' '
      IFGEO=0
      IF(NENTRY.GT.4) THEN
        DO 70 IEN=5,NENTRY
          IF((IENTRY(IEN).EQ.1).OR.(IENTRY(IEN).EQ.2)) THEN
            CALL LCMGTC(KENTRY(IEN),'SIGNATURE',12,HSIGN)
            IF(HSIGN.EQ.'L_GEOM') THEN
              IF(IKGEO1.EQ.0) THEN
                IPGEO1=KENTRY(IEN)
                OLDGEO=HENTRY(IEN)
                IKGEO1=IEN
              ELSE IF(IKGEO2.EQ.0) THEN
                IPGEO2=KENTRY(IEN)
                IKGEO2=IEN
              ENDIF
            ELSE IF((HSIGN.EQ.'L_PIJ').AND.(IKSYS.EQ.0)) THEN
              IPSYS=KENTRY(IEN)
              IKSYS=IEN
            ENDIF
          ELSE IF((IENTRY(IEN).EQ.4).AND.(JENTRY(IEN).EQ.2)) THEN
            IFGEO=FILUNIT(KENTRY(IEN))
          ELSE
            CALL XABORT('EDI: INVALID TYPE AT RHS.')
          ENDIF
   70   CONTINUE
      ENDIF
*----
*  RECOVER GENERAL TRACKING INFORMATION
*----
      IF(.NOT.C_ASSOCIATED(IPTRK1)) THEN
         CALL XABORT('EDI: NO REFERENCE TRACKING AVAILABLE.')
      ENDIF
      CALL LCMGET(IPTRK1,'STATE-VECTOR',IGP)
      NREG=IGP(1)
      CALL LCMGTC(IPTRK1,'TRACK-TYPE',12,CDOOR)
      IF(CDOOR.EQ.'MCCG') THEN
         CALL LCMLEN(IPTRK1,'KEYFLX',LKFL,ITYLCM)
         NFUNL=LKFL/NREG
      ELSE
         NFUNL=1
      ENDIF
      ALLOCATE(MAT(NREG),VOL(NREG),IDL(NREG*NFUNL))
      CALL LCMGET(IPTRK1,'MATCOD',MAT)
      CALL LCMGET(IPTRK1,'VOLUME',VOL)
      CALL LCMGET(IPTRK1,'KEYFLX',IDL)
      CALL LCMLEN(IPTRK1,'TITLE',LENGT,ITYLCM)
      IF(LENGT.GT.0) THEN
         CALL LCMGTC(IPTRK1,'TITLE',72,TITLE)
         CALL LCMPTC(IPEDIT,'TITLE',72,TITLE)
      ELSE
         TITLE='*** NO TITLE PROVIDED FOR THE REFERENCE CASE ***'
      ENDIF
*----
*  READ GROUP STRUCTURE
*----
      ALLOCATE(ENERG(2*NGRP+1),ENERV(NGRP))
      CALL LCMLEN(IPLIB,'ENERGY',NTENER,ITYLCM)
      IF(NTENER.EQ.NGRP+1) THEN
        CALL LCMGET(IPLIB,'ENERGY',ENERG)
      ELSE IF(NTENER.NE.0) THEN
        CALL XABORT('EDI: INVALID NUMBER OF GROUP ON MACROLIB.')
      ENDIF
*----
*  READ EDITION OPTIONS PARAMETERS
*----
      ALLOCATE(IGCOND(NGRP),IMERGE(NREG),IACTI(NBMIX))
      ICALL=0
      CURNAM=' '
      MAXCND=0
      MAXISK=0
      MAXMRG=0
      ITMERG=-4
      BB2=0.0
      IF(JENTRY(1).EQ.0) THEN
         HSIGN='L_EDIT'
         CALL LCMPTC(IPEDIT,'SIGNATURE',12,HSIGN)
         OLDNAM=' '
         MACGEO=' '
         NMERGE=NREG
         NGCOND=NGRP
         IHF=1
         IFFAC=0
         ILUPS=0
         NACTI=0
         NSTATS=0
         IADF=0
         NBMICR=0
         IPRINT=1
         NSAVES=0
         NW=0
         IF(ILEAKC.GE.6) NW=1
         ICURR=NW
         IXEDI=0
         IADJ=0
         IEUR=0
         NOUT=0
         IEDCUR=0
         IGOVE=0
         MAXPTS=NREG
         DO 90 IGROUP=1,NGRP
         IGCOND(IGROUP)=IGROUP
   90    CONTINUE
         DO 100 IREGIO=1,NREG
         IMERGE(IREGIO)=IREGIO
  100    CONTINUE
      ELSE IF(JENTRY(1).EQ.1) THEN
         CALL LCMGTC(IPEDIT,'SIGNATURE',12,HSIGN)
         IF(HSIGN.NE.'L_EDIT') THEN
            TEXT12=HENTRY(1)
            CALL XABORT('EDI: SIGNATURE OF '//TEXT12//' IS '//HSIGN//
     >      '. L_EDIT EXPECTED.')
         ENDIF
         CALL LCMGET(IPEDIT,'STATE-VECTOR',ISTATE)
         NMERGE=ISTATE(1)
         NGCOND=ISTATE(2)
         IFFAC=ISTATE(3)
         ILUPS=ISTATE(4)
         NACTI=ISTATE(5)
         NSTATS=ISTATE(6)
         IADF=ISTATE(7)
         IEUR=ISTATE(8)
         NBMICR=ISTATE(9)
         IPRINT=ISTATE(10)
         NSAVES=ISTATE(11)
         NW=ISTATE(12)
         MAXISK=ISTATE(13)
         MAXCND=ISTATE(14)
         MAXMRG=ISTATE(15)
         IXEDI=ISTATE(16)
         MAXPTS=ISTATE(17)
         IHF=ISTATE(18)
         IF(ISTATE(19).NE.NDEL) CALL XABORT('EDI: BAD VALUE OF NDEL')
         IADJ=ISTATE(21)
         ICURR=ISTATE(22)
         NOUT=ISTATE(23)
         IEDCUR=ISTATE(24)
         IGOVE=ISTATE(25)
         IF(NOUT.GT.MAXOUT) CALL XABORT('EDI: MAXOUT OVERFLOW')
         CALL LCMLEN(IPEDIT,'LAST-EDIT',LENGT,ITYLCM)
         IF(LENGT.GT.0) THEN
            CALL LCMGTC(IPEDIT,'LAST-EDIT',12,OLDNAM)
            INTLIR=0
            READ(OLDNAM,'(8X,I4)',ERR=105) INTLIR
  105       ICALL=MAX(ICALL,INTLIR)
         ENDIF
         CALL LCMLEN(IPEDIT,'REF:IMERGE',LENGT,ITYLCM)
         IF(LENGT.EQ.NREG) THEN
            CALL LCMGET(IPEDIT,'REF:IMERGE',IMERGE)
         ELSE
            DO 106 IREGIO=1,NREG
            IMERGE(IREGIO)=IREGIO
  106       CONTINUE
         ENDIF
         CALL LCMLEN(IPEDIT,'REF:IGCOND',LENGT,ITYLCM)
         IF(LENGT.EQ.NGCOND) THEN
            CALL LCMGET(IPEDIT,'REF:IGCOND',IGCOND)
         ELSE
            DO 107 IGROUP=1,NGRP
            IGCOND(IGROUP)=IGROUP
  107       CONTINUE
         ENDIF
         CALL LCMLEN(IPEDIT,'LINK.MACGEOM',LENGT,ITYLCM)
         IF(LENGT.GT.0) THEN
            CALL LCMGTC(IPEDIT,'LINK.MACGEOM',12,MACGEO)
         ELSE
            MACGEO=' '
         ENDIF
         IF(NBMICR.GT.0) THEN
            IF(NBMICR.GT.MAXED) CALL XABORT('EDI: CARISO OVERFLOW.')
            CALL LCMGTC(IPEDIT,'CARISO',12,NBMICR,CARISO)
         ENDIF
         IF(NACTI.GT.0) CALL LCMGET(IPEDIT,'IACTI',IACTI)
         IF(NOUT.GT.0) CALL LCMGTC(IPEDIT,'REF:HVOUT',8,NOUT,HVOUT)
      ENDIF
      NGCR=0
      LISO=.FALSE.
      LDEPL=.TRUE.
      LMACR=.TRUE.
      MAXISK=MAX(MAXISK,MAXISM)
      ALLOCATE(IGCR(NGRP+1),ECR(NGRP+1))
      IGCR(:NGRP+1)=NGRP
      ECR(:NGRP+1)=0.0
      CALL EDIGET(IPEDIT,IFGEO,NGRP,NGCR,NREG,NBMIX,MAT,ITMERG,NMERGE,
     1 IHF,IFFAC,ILUPS,NSAVES,NSTATS,IGCR,ECR,IMERGE,CURNAM,OLDNAM,IADF,
     2 NW,ICURR,NBMICR,CARISO,NACTI,IACTI,IPRINT,MAXPTS,ICALL,ISOTXS,
     3 LISO,LDEPL,LMACR,IADJ,MACGEO,IEUR,NOUT,HVOUT,BB2,IEDCUR,IGOVE)
      IF((IGOVE.EQ.1).AND.(ILEAKC.GE.6)) THEN
        CALL XABORT('EDI: OPTION NOIN IS FORBIDDEN.')
      ENDIF
*----
*  CALL EDIMRG TO FIND MERGE INDEX ASSOCIATED WITH THE SECOND GEOMETRY
*  OR TRACK FILE (EQUIGEOM CAPABILITIES)
*----
      TEXT12=' '
      LNEWGE=.FALSE.
      IF(ITMERG.EQ.-1) THEN
        IF(IKGEO2.GT.0) THEN
          ITM=-1
          IPMRG=IPGEO2
          TEXT12=HENTRY(IKGEO2)
        ELSE IF(IKGEO1.GT.0) THEN
          ITM=-1
          IPMRG=IPGEO1
          TEXT12=HENTRY(IKGEO1)
        ELSE
          ITM=0
          IPMRG=IPTRK1
        ENDIF
        CALL EDIMRG(IPTRK1,IPMRG,IPRINT,TEXT12,ITM,NREG,NMERGE,IMERGE)
*----
*  BUILD A MACRO-GEOMETRY FROM REFERENCE GEOMETRY OLDGEO (CELL OPTION)
*----
      ELSE IF(ITMERG.EQ.-2) THEN
        LREMIX=(NMERGE.NE.0)
        IF(LREMIX) THEN
*          REMIX option.
           NMEOLD=NMERGE
           NMERGE=0
           ALLOCATE(IREMIX(NMEOLD))
           IREMIX(:NMEOLD)=IMERGE(:NMEOLD)
        ENDIF
        IF(((CDOOR.EQ.'EXCELL').OR.(CDOOR.EQ.'MCCG')).AND.
     >  (IGP(7).EQ.4)) THEN
          CALL EDIMRC(IPTRK1,IPRINT,NREG,NMERGE,IMERGE)
        ELSE
          IF(.NOT.C_ASSOCIATED(IPGEO1)) THEN
             CALL XABORT('EDI: NO REFERENCE GEOMETRY AVAILABLE.')
          ELSE IF(C_ASSOCIATED(IPGEO2)) THEN
             CALL XABORT('EDI: INPUT MACRO-GEOMETRY NOT EXPECTED WITH '
     >       //'CELL OPTION.')
          ENDIF
          IF(IPRINT.GT.0) WRITE(IOUT,190) OLDGEO,CDOOR
          CALL LCMGET(IPGEO1,'STATE-VECTOR',ISTATE)
          MAXGEO=MAX(MAXPTS,ISTATE(6))
          IF(IEUR.EQ.4) MAXGEO=8*MAXGEO
          LNEWGE=.TRUE.
          MACGEO='MACRO$GEO'
          CALL LCMOP(IPGEO2,'MACRO$GEO',0,1,9)
          MAXMER=MIN(NREG,MAXGEO)
          CALL EDIGEO(MAXGEO,MAXMER,IPGEO1,IPGEO2,IPRINT,NREG,IEUR,
     >    NMERGE,IMERGE)
*
*         COPY THE MACRO-GEOMETRY INTO THE EDITION OBJECT.
          CALL LCMSIX(IPEDIT,'MACRO-GEOM',1)
          CALL LCMEQU(IPGEO2,IPEDIT)
          CALL LCMSIX(IPEDIT,' ',2)
        ENDIF
        IF(LREMIX) THEN
*          REMIX option.
           IF(NMERGE.NE.NMEOLD) THEN
              WRITE(HSMG,'(37HEDI: INVALID NUMBER OF REMIX INDICES:,
     >        I5,11H ARE GIVEN;,I5,14H ARE EXPECTED.)') NMEOLD,NMERGE
              CALL XABORT(HSMG)
           ENDIF
           NMERGE=0
           DO IREG=1,NREG
             IF(IMERGE(IREG).GT.NMEOLD) CALL XABORT('EDI: NMERGE OVERF'
     >       //'LOW IN REMIX.')
             IF(IMERGE(IREG).NE.0) IMERGE(IREG)=IREMIX(IMERGE(IREG))
             NMERGE=MAX(NMERGE,IMERGE(IREG))
           ENDDO
           DEALLOCATE(IREMIX)
        ENDIF
      ELSE IF(ITMERG.EQ.-3) THEN
*----
*  CALL EDIMRG TO FIND MERGE INDEX ASSOCIATED WITH HMIX
*----
        IPMRG=IPTRK1
        CALL EDIHMX(IPTRK1,NREG,NMERGE,IMERGE)
      ENDIF
*----
*  SET THE ANISOTROPY OF WEIGHTING FLUXES
*----
      IF((NW.GT.0).AND.(ICURR.EQ.4)) THEN
         CALL LCMGTC(IPTRK1,'TRACK-TYPE',12,TEXT12)
         NANIS=1
         IF(TEXT12.EQ.'MCCG') THEN
           CALL LCMGET(IPTRK1,'STATE-VECTOR',ISTATE)
           NANIS=ISTATE(6)
         ELSE IF(TEXT12.EQ.'SN') THEN
           CALL LCMGET(IPTRK1,'STATE-VECTOR',ISTATE)
           NANIS=ISTATE(16)
         ELSE
           CALL XABORT('EDI: MCCG OR SN TRACKING EXPECTED WITH P1W_SP '
     >     //'OPTION')
         ENDIF
         NW=NANIS-1
         IF(IPRINT.GT.0) WRITE(IOUT,'(/15H EDI: NW SET TO,I3,1H.)')
     >   NW
         IF(NW.EQ.0) CALL XABORT('EDI: NW>0 EXPECTED.')
      ENDIF
*----
*  TEST ENERGY CONDENSATION INPUT
*----
      CALL EDIENE(NGRP,NGCR,NGCOND,NTENER,IGCR,ECR,IGCOND,ENERG,ENERV)
*
      CALL LCMLEN(IPEDIT,'MACRO-GEOM',ILONG,ITYLCM)
      LGEO=0
      IF((ILONG.NE.0).OR.(MACGEO.NE.' ')) LGEO=1
      IF(IPRINT.GT.0) THEN
        WRITE(IOUT,200) NMERGE,NGCOND,IFFAC,ILUPS,NACTI,NSTATS,IADF,
     >  IEUR,NBMICR,IPRINT
        WRITE(IOUT,210) NSAVES,NW,MAXPTS,IHF,NDEL,LGEO,IADJ,ICURR,
     >  NOUT,IEDCUR,IGOVE
        WRITE(IOUT,'(//15H MERGING INDEX:/(1X,14I5))')
     >    (IMERGE(I),I=1,NREG)
        IF(CURNAM.NE.' ') WRITE(IOUT,'(/27H EDI: SAVE MICROLIB INFO ON,
     >  12H DIRECTORY '',A12,2H''.)') CURNAM
      ENDIF
      DEALLOCATE(ECR,IGCR)
      ISTATE(:NSTATE)=0
      ISTATE(1)=NMERGE
      ISTATE(2)=NGCOND
      ISTATE(3)=IFFAC
      ISTATE(4)=ILUPS
      ISTATE(5)=NACTI
      ISTATE(6)=NSTATS
      ISTATE(7)=IADF
      ISTATE(8)=IEUR
      ISTATE(9)=NBMICR
      ISTATE(10)=IPRINT
      ISTATE(11)=NSAVES
      ISTATE(12)=NW
      ISTATE(13)=MAXISK
      ISTATE(14)=MAX(NGCOND,MAXCND)
      ISTATE(15)=MAX(NMERGE,MAXMRG)
      ISTATE(16)=IXEDI+ISOTXS*NMERGE
      ISTATE(17)=MAXPTS
      ISTATE(18)=IHF
      ISTATE(19)=NDEL
      ISTATE(20)=LGEO
      ISTATE(21)=IADJ
      ISTATE(22)=ICURR
      ISTATE(23)=NOUT
      ISTATE(24)=IEDCUR
      ISTATE(25)=IGOVE
      CALL LCMPUT(IPEDIT,'STATE-VECTOR',NSTATE,1,ISTATE)
      IF(OLDGEO.NE.' ') THEN
         CALL LCMPTC(IPEDIT,'LINK.GEOM',12,OLDGEO)
      ENDIF
      IF(NSAVES.GE.2) THEN
         CALL LCMPTC(IPEDIT,'LAST-EDIT',12,CURNAM)
      ENDIF
      IF(NBMICR.GT.0) THEN
         CALL LCMPTC(IPEDIT,'CARISO',12,NBMICR,CARISO)
      ENDIF
      IF(NACTI.GT.0) CALL LCMPUT(IPEDIT,'IACTI',NACTI,1,IACTI)
      IF(MACGEO.NE.' ') THEN
         IF(HENTRY(IKGEO1).EQ.MACGEO) THEN
            IPGEO2=IPGEO1
            IKGEO2=IKGEO1
         ENDIF
         IF(.NOT.C_ASSOCIATED(IPGEO2)) THEN
            CALL XABORT('EDI: MISSING LCM OBJECT FOR THE MACRO-GEOMETR'
     >      //'Y.')
         ENDIF
         IF(IKGEO2.NE.0) THEN
           IF(HENTRY(IKGEO2).NE.MACGEO) THEN
             WRITE(HSMG,'(33HEDI: WRONG MACRO-GEOMETRY NAMED '',
     >       A12,17H'' FOUND ON RHS. '',A12,11H'' EXPECTED.)')
     >       HENTRY(IKGEO2),MACGEO
             CALL XABORT(HSMG)
           ENDIF
         ENDIF
         CALL LCMGTC(IPGEO2,'SIGNATURE',12,HSIGN)
         IF(HSIGN.NE.'L_GEOM') THEN
            CALL XABORT('EDI: SIGNATURE OF '//MACGEO//' IS '//HSIGN//
     >      '. L_GEOM EXPECTED.')
         ENDIF
*
*        COPY THE MACRO-GEOMETRY INTO THE EDITION OBJECT.
         CALL LCMSIX(IPEDIT,'MACRO-GEOM',1)
         CALL LCMEQU(IPGEO2,IPEDIT)
         CALL LCMSIX(IPEDIT,' ',2)
      ENDIF
*----
*  EDITION
*----
      IF(NREG.EQ.0) CALL XABORT('EDI: NREG = 0.')
      IF(NGRP.EQ.0) CALL XABORT('EDI: NGRP = 0.')
      CALL EDIDRV(IPEDIT,IPTRK1,IPFLUX,IPLIB,IPSYS,NGRP,NBMIX,NREG,MAT,
     1 VOL,IDL,NIFISS,NEDMAC,NL,NDEL,NALBP,ITRANC,NGCOND,NMERGE,IADF,
     2 IDFM,NW,ICURR,IHF,IFFAC,ILUPS,NSAVES,NSTATS,IXEDI,ISOTXS,IGCOND,
     3 IMERGE,CURNAM,OLDNAM,NBMICR,CARISO,NACTI,IACTI,IPRINT,LISO,LDEPL,
     4 LMACR,IADJ,NOUT,HVOUT,BB2,IEDCUR,IGOVE)
*----
*  DESTROY THE TEMPORARY MACRO-GEOMETRY
*----
      IF(LNEWGE) THEN
         CALL LCMCL(IPGEO2,1)
         TEXT12='MACRO$GEO'
         CALL LCMOP(IPGEO2,TEXT12,1,1,0)
         CALL LCMCL(IPGEO2,2)
      ENDIF
*----
*  COMPLETE THE EDITION LCM OBJECT
*----
      CALL LCMPUT(IPEDIT,'REF:IMERGE',NREG,1,IMERGE)
      CALL LCMPUT(IPEDIT,'REF:MATCOD',NREG,1,MAT)
      CALL LCMPUT(IPEDIT,'REF:VOLUME',NREG,2,VOL)
      CALL LCMPUT(IPEDIT,'REF:IGCOND',NGCOND,1,IGCOND)
      IF(NOUT.GT.0) CALL LCMPTC(IPEDIT,'REF:HVOUT',8,NOUT,HVOUT)
*
      DEALLOCATE(IACTI,IMERGE,IGCOND)
*----
*  RELEASE GENERAL TRACKING INFORMATION
*----
      DEALLOCATE(IDL,VOL,MAT,ENERV,ENERG)
      IF(IPRINT.GT.2) CALL LCMLIB(IPEDIT)
*----
*  RELEASE TEMPORARY L_TRACK AND L_FLUX OBJECTS
*----
      IF((IKTRK1.EQ.0).AND.(IKFLUX.EQ.0)) THEN
         CALL LCMCL(IPFLUX,2)
         CALL LCMCL(IPTRK1,2)
      ENDIF
      RETURN
*
  190 FORMAT (/16H EDI: GEOMETRY ',A12,28H' WAS PREVIOUSLY TRACKED BY ,
     > 7HMODULE ,A12,1H.)
  200 FORMAT(/24H EDITION-RELATED OPTIONS/1X,23(1H-)/
     1  7H NMERGE,I8,29H   (NUMBER OF MERGED REGIONS)/
     2  7H NGCOND,I8,38H   (NUMBER OF CONDENSED ENERGY GROUPS)/
     3  7H IFFAC ,I8,40H   (=1: 4 FACTORS CALCULATION REQUESTED)/
     4  7H ILUPS ,I8,43H   (=1: REMOVE UP-SCATTERING CONTRIBUTIONS)/
     5  7H NACTI ,I8,45H   (NUMBER OF MIXTURES WITH ACTIVATION EDITS)/
     6  7H NSTATS,I8,35H   (TYPE OF STATISTIC CALCULATIONS)/
     7  7H IADF  ,I8,47H   (=0: DO NOT COMPUTE ADF; =1: USE ALBS INFO; ,
     8  60H=-2/2: USE BOUNDARY FLUX INFO; =3: USE EURYDICE INFO; =4: US,
     9  16HE MACROLIB INFO)/
     1  7H IEUR  ,I8,47H   (=1/2/3: SYBIL OR EXCELL MACRO-TRACKING/NXT ,
     2  20HMACRO-TRACKING/ELSE)/
     3  7H NBMICR,I8,47H   (=-1: PROCESS ALL ISOTOPES; >1: NUMBER OF IS,
     4  18HOTOPES TO PROCESS)/
     5  7H IPRINT,I8,16H   (PRINT LEVEL))
  210 FORMAT(
     1  7H NSAVES,I8,47H   (=0: NO COMPUTE/NO SAVE; =1: COMPUTE/NO SAVE,
     2  19H; =2: COMPUTE/SAVE)/
     3  7H NW    ,I8,47H   (=0: FLUX WEIGHTING FOR P1 INFO; =1: CURRENT,
     4  23H WEIGHTING FOR P1 INFO)/
     5  7H MAXPTS,I8,47H   (ALLOCATED STORAGE LENGTH FOR REGION-DEPENDE,
     6  10HNT ARRAYS)/
     7  7H IHF   ,I8,39H   (=1: H-FACTOR CALCULATION REQUESTED)/
     8  7H NDEL  ,I8,39H   (NUMBER OF DELAYED PRECURSOR GROUPS)/
     9  7H LGEO  ,I8,47H   (=0: MACRO-GEOMETRY NOT AVAILABLE; =1: IS AV,
     1  8HAILABLE)/
     2  7H IADJ  ,I8,47H   (=0: DIRECT FLUX; =1: DIRECT-ADJOINT WEIGHTI,
     3  3HNG)/
     4  7H ICURR ,I8,47H   (=1: HETEROGENEOUS BN WEIGHTING; =2: TODOROV,
     5  58HA OUTSCATTER WEIGHTING; =4: SPHERICAL HARMONICS WEIGHTING)/
     6  7H NOUT  ,I8,47H   (=0: OUTPUT ALL REACTIONS; >0: NUMBER OF OUT,
     7  14HPUT REACTIONS)/
     8  7H IEDCUR,I8,40H   (=0/1: FLUX/FLUX AND CURRENT EDITION)/
     9  7H GOLVER,I8,38H   (=0/1: GOLFIER-VERGAIN FLAG OFF/ON))
      END