Initial commit from Polytechnique Montreal

1 files changed, 667 insertions, 0 deletions

diff --git a/Dragon/src/EDI.f b/Dragon/src/EDI.f
new file mode 100644
index 0000000..cb9ed74
--- /dev/null
+++ b/Dragon/src/EDI.f
@@ -0,0 +1,667 @@
+*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