*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