*DECK EVO
      SUBROUTINE EVO(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
*
*-----------------------------------------------------------------------
*
*Purpose:
* driver for an isotopic depletion calculation.
*
*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/output
* NENTRY  number of LCM objects or files used by the operator.
* HENTRY  name of each LCM object or file:
*         HENTRY(1): creation or modification type(L_BURNUP);
*         HENTRY(2): modification type(L_LIBRARY);
*         HENTRY(3): read-only type(L_TRACK);
*         HENTRY(4): optional read-only type(L_FLUX)
*         or
*         HENTRY(1): creation or modification type(L_BURNUP);
*         HENTRY(2): creation type(L_LIBRARY);
*         HENTRY(3): read-only type(L_LIBRARY);
*         HENTRY(4): read-only type(L_TRACK);
*         HENTRY(5): optional read-only type(L_FLUX).
* 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)
      CHARACTER HSMG*131,TEXT12*12,CDOOR*12,HSIGN*12
      INTEGER IPAR(NSTATE),IGP(NSTATE)
      INTEGER ITYPE,ITIXS,IFLMAC,IEXTR,IGLOB,ISAT,IDIRAC,ISAVE,ISET,INR
      REAL RPAR(5),XT(5)
      LOGICAL LOG,LMACRO
      TYPE(C_PTR) IPLIB,IPFLUX,JPFLUX,IPDEPL,IPTRK,IPMACR,JPMACR,KPMACR
      INTEGER, ALLOCATABLE, DIMENSION(:) :: JMIX,MIXBRN,MIXPWR,IEVOL,
     1 ISONA,ISONR,MAT,IDL
      REAL, ALLOCATABLE, DIMENSION(:) :: JDEN,TIMES,VX,FLMIX,VOL,FUNKN,
     1 FLUXE
*----
*  PARAMETER VALIDATION
*----
      IF(NENTRY.LE.1) CALL XABORT('EVO: TWO PARAMETERS EXPECTED.')
      IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2)) CALL XABORT('EVO: LCM O'
     1 //'BJECT EXPECTED AT FIRST LHS.')
      IF(JENTRY(1).EQ.2) CALL XABORT('EVO: BURNUP HISTORY STORAGE IN CR'
     1 //'EATION OR MODIFICATION MODE EXPECTED.')
      IPDEPL=KENTRY(1)
      IF((IENTRY(2).NE.1).AND.(IENTRY(2).NE.2)) CALL XABORT('EVO: LCM O'
     1 //'BJECT EXPECTED AT SECOND LHS.')
      IENT=1
      IF(JENTRY(2).EQ.0) THEN
*        INTERNAL LIBRARY CREATION. COPY THE FIRST RHS ON THIS LHS.
         IF(NENTRY.LE.3) CALL XABORT('EVO: FOUR PARAMETERS EXPECTED.')
         IF((JENTRY(3).NE.2).OR.((IENTRY(3).NE.1).AND.
     1   (IENTRY(3).NE.2)))  CALL XABORT('EVO: LCM OBJECT IN READ-ONLY '
     2   //'MODE EXPECTED AT FIRST RHS.')
         CALL LCMEQU(KENTRY(3),KENTRY(2))
         IENT=4
      ELSE IF(JENTRY(2).EQ.1) THEN
*        INTERNAL LIBRARY MODIFICATION.
         IENT=3
      ELSE
         CALL XABORT('EVO: INTERNAL LIBRARY IN CREATE OR MODIFICATION M'
     1   //'ODE EXPECTED.')
      ENDIF
      IPLIB=KENTRY(2)
      TEXT12=HENTRY(2)
      CALL LCMPTC(IPDEPL,'LINK.LIB',12,1,TEXT12)
*----
*  RECOVER IPTRK AND IPFLUX POINTERS
*----
      IPFLUX=C_NULL_PTR
      IPTRK=C_NULL_PTR
      DO 10 I=IENT,NENTRY
      IF((JENTRY(I).EQ.2).AND.((IENTRY(I).EQ.1).OR.(IENTRY(I).EQ.2)))
     1 THEN
         CALL LCMGTC(KENTRY(I),'SIGNATURE',12,1,HSIGN)
         IF(HSIGN.EQ.'L_FLUX') THEN
            IPFLUX=KENTRY(I)
         ELSE IF(HSIGN.EQ.'L_TRACK') THEN
            IPTRK=KENTRY(I)
         ELSE
            WRITE(HSMG,'(35HEVO: UNEXPECTED SIGNATURE AT RHS ('',A12,
     1      3H'').)') HSIGN
            CALL XABORT(HSMG)
         ENDIF
      ELSE
         CALL XABORT('EVO: LCM OBJECT IN READ-ONLY MODE EXPECTED AT '
     1   //'RHS.')
      ENDIF
   10 CONTINUE
      IF((C_ASSOCIATED(IPFLUX)).AND.(.NOT.C_ASSOCIATED(IPTRK))) THEN
         CALL XABORT('EVO: UNABLE TO FIND A POINTER TO A L_TRACK OBJEC'
     1   //'T.')
      ENDIF
*----
*  RECOVER GENERAL INTERNAL LIBRARY INFORMATION
*----
      CALL LCMGTC(IPLIB,'SIGNATURE',12,1,HSIGN)
      IF(HSIGN.NE.'L_LIBRARY') THEN
         TEXT12=HENTRY(2)
         CALL XABORT('EVO: SIGNATURE OF '//TEXT12//' IS '//HSIGN//
     1   '. L_LIBRARY EXPECTED.')
      ENDIF
      CALL LCMGET(IPLIB,'STATE-VECTOR',IPAR)
      NBMIX=IPAR(1)
      NBISO=IPAR(2)
      NGRO=IPAR(3)
      NDEPL=IPAR(11)
      NCOMB=IPAR(12)
      LMACRO=(IPAR(17).GE.0).AND.(IPAR(18).EQ.1)
      CALL LCMSIX(IPLIB,'DEPL-CHAIN',1)
         CALL LCMGET(IPLIB,'STATE-VECTOR',IPAR)
         IF(IPAR(1).NE.NDEPL) CALL XABORT('EVO: INVALID NUMBER OF D'
     1   //'EPLETING ISOTOPES.')
         NSUPS=IPAR(7)
         NREAC=IPAR(8)
      CALL LCMSIX(IPLIB,' ',2)
      ALLOCATE(JMIX(NBISO),IEVOL(NBISO),MIXBRN(NBMIX),MIXPWR(NBMIX),
     1 ISONA(3*NBISO),ISONR(3*NBISO))
      ALLOCATE(JDEN(NBISO))
      CALL LCMGET(IPLIB,'ISOTOPESMIX',JMIX)
      CALL LCMGET(IPLIB,'ISOTOPESDENS',JDEN)
      CALL LCMGET(IPLIB,'ISOTOPESTODO',IEVOL)
*----
*  RECOVER LOCAL ISOTOPES NAMES
*----
      CALL LCMGET(IPLIB,'ISOTOPESUSED',ISONA)
      CALL LCMGET(IPLIB,'ISOTOPERNAME',ISONR)
*----
*  READ THE INPUT DATA
*----
*     DEFAULT OPTIONS:
      IMPX=1
      IDEPL=0
      INR=-1
      XT(4)=0.0
      IF(JENTRY(1).EQ.0) THEN
         INDREC=1
         RPAR(1)=1.0E-5
         RPAR(2)=1.0E-4
         RPAR(3)=80.0
         RPAR(4)=1.0E-4
         RPAR(5)=0.0
         ITYPE=2
         IEXTR=1
         IGLOB=0
         ISAT=0
         IDIRAC=0
         ITIXS=0
         IFLMAC=0
         HSIGN='L_BURNUP'
         CALL LCMPTC(IPDEPL,'SIGNATURE',12,1,HSIGN)
         CALL LCMPUT(IPDEPL,'ISOTOPESMIX',NBISO,1,JMIX)
         CALL LCMPUT(IPDEPL,'ISOTOPESUSED',3*NBISO,3,ISONA)
         CALL XDISET(MIXBRN,NBMIX,1)
         CALL XDISET(MIXPWR,NBMIX,1)
         CALL LCMPUT(IPDEPL,'MIXTURESBurn',NBMIX,1,MIXBRN)
         CALL LCMPUT(IPDEPL,'MIXTURESPowr',NBMIX,1,MIXPWR)
      ELSE IF(JENTRY(1).EQ.1) THEN
         CALL LCMGTC(IPDEPL,'SIGNATURE',12,1,HSIGN)
         IF(HSIGN.NE.'L_BURNUP') THEN
            TEXT12=HENTRY(1)
            CALL XABORT('LIB: SIGNATURE OF '//TEXT12//' IS '//HSIGN//
     1      '. L_BURNUP EXPECTED.')
         ENDIF
         INDREC=2
         CALL LCMGET(IPDEPL,'STATE-VECTOR',IPAR)
         ITYPE=IPAR(1)
         NTIME=IPAR(3)
         IEXTR=IPAR(9)
         IGLOB=IPAR(10)
         ISAT=IPAR(11)
         IDIRAC=IPAR(12)
         ITIXS=IPAR(13)
         IFLMAC=IPAR(14)
         IF(IPAR(4).NE.NBISO) CALL XABORT('EVO: INVALID NUMBER OF ISOTO'
     1   //'PES.')
         CALL LCMGET(IPDEPL,'EVOLUTION-R',RPAR)
         IF(NTIME.GT.0) THEN
            ALLOCATE(TIMES(NTIME+2))
            CALL LCMGET(IPDEPL,'DEPL-TIMES',TIMES)
            XT(4)=TIMES(NTIME)
            DEALLOCATE(TIMES)
         ENDIF
         CALL LCMLEN(IPDEPL,'MIXTURESBurn',ILONG,ITYLCM)
         IF(ILONG.EQ.NBMIX) THEN
           CALL LCMGET(IPDEPL,'MIXTURESBurn',MIXBRN)
           CALL LCMGET(IPDEPL,'MIXTURESPowr',MIXPWR)
         ELSE
           CALL XDISET(MIXBRN,NBMIX,1)
           CALL XDISET(MIXPWR,NBMIX,1)
         ENDIF
         CALL LCMLEN(IPDEPL,'ISOTOPESUSED',ILONG,ITYLCM)
         IF(ILONG.NE.3*NBISO) CALL XABORT('EVO: INCONSISTENT RECORD IS'
     1   //'OTOPESUSED.')
      ENDIF
*----
*  READ INPUT OPTIONS
*----
      IF(NBMIX.EQ.0) CALL XABORT('EVO: NBMIX NOT YET DEFINED.')
      CALL EVOGET(IMPX,ITYPE,ITIXS,IEXTR,IGLOB,ISAT,IDIRAC,ISAVE,ISET,
     > INR,IDEPL,IFLMAC,RPAR,XT,NBMIX,MIXBRN,MIXPWR)
*
      XTI=XT(3)
      XTF=XT(5)
      EPS1=RPAR(1)
      EPS2=RPAR(2)
      EXPMAX=RPAR(3)
      H1=RPAR(4)
      FIT=RPAR(5)
      LOG=(ISAVE.GE.0).OR.(IDEPL.GT.0)
      IF(LOG.AND.(INR.EQ.-1)) CALL XABORT('EVO: TYPE OF DEPLETION NO'//
     1 'T DEFINED.')
      IF(NDEPL.EQ.0) CALL XABORT('EVO: NO DEPLETING ISOTOPES.')
      IF(NCOMB.EQ.0) CALL XABORT('EVO: NO DEPLETING MIXTURES.')
*----
*  RECOVER MIXTURE VOLUMES AND AVERAGE NEUTRON FLUXES
*----
      ALLOCATE(VX(NBMIX),FLMIX(NBMIX*NGRO))
      IF(IFLMAC.NE.0) THEN
*        RECOVER MIXTURE VOLUMES AND FLUXES FROM L_MACROLIB
         CALL LCMLEN(IPLIB,'MACROLIB',ILONG,ITYLCM)
         IF(ILONG.EQ.0) CALL XABORT('EVO: NO MACROLIB IN MICROLIB.')
         IPMACR=LCMGID(IPLIB,'MACROLIB')
         CALL LCMGET(IPMACR,'STATE-VECTOR',IPAR)
         IF(IPAR(1).NE.NGRO) CALL XABORT('EVO: INVALID NGRO.')
         IF(IPAR(2).NE.NBMIX) CALL XABORT('EVO: INVALID NBMIX.')
         CALL LCMGET(IPMACR,'VOLUME',VX)
         ALLOCATE(FUNKN(NBMIX))
         JPMACR=LCMGID(IPMACR,'GROUP')
         DO 20 IGR=1,NGRO
         KPMACR=LCMGIL(JPMACR,IGR)
         CALL LCMGET(KPMACR,'FLUX-INTG',FUNKN)
         DO 20 IBM=1,NBMIX
         FLMIX((IBM-1)*NGRO+IGR)=FUNKN(IBM)/VX(IBM)
   20    CONTINUE
         DEALLOCATE(FUNKN)
      ELSE
*        RECOVER GENERAL TRACKING INFORMATION
         IF(.NOT.C_ASSOCIATED(IPTRK)) THEN
            CALL XABORT('EVO: L_TRACK OBJECT NOT DEFINED.')
         ENDIF
         CALL LCMGET(IPTRK,'STATE-VECTOR',IGP)
         NREG=IGP(1)
         IF(IGP(4).GT.NBMIX) THEN
            WRITE(HSMG,'(42HEVO: THE NUMBER OF MIXTURES IN THE TRACKIN,
     1      3HG (,I5,46H) IS GREATER THAN THE NUMBER OF MIXTURES IN TH,
     2      20HE INTERNAL LIBRARY (,I5,2H).)') IGP(4),NBMIX
            CALL XABORT(HSMG)
         ENDIF
         IF(NREG.EQ.0) CALL XABORT('EVO: NREG = 0')
         CALL LCMGTC(IPTRK,'TRACK-TYPE',12,1,CDOOR)
         IF(CDOOR.EQ.'MCCG') THEN
            CALL LCMLEN(IPTRK,'KEYFLX',LKFL,ITYLCM)
            NFUNL=LKFL/NREG
         ELSE
            NFUNL=1
         ENDIF
         ALLOCATE(MAT(NREG),VOL(NREG),IDL(NREG*NFUNL))
         CALL LCMGET(IPTRK,'MATCOD',MAT)
         CALL LCMGET(IPTRK,'VOLUME',VOL)
         CALL LCMGET(IPTRK,'KEYFLX',IDL)
*
*        RECOVER MIXTURE VOLUMES FROM L_TRACK
         CALL XDRSET(VX,NBMIX,0.0)
         CALL XDRSET(FLMIX,NBMIX*NGRO,0.0)
         DO 30 I=1,NREG
         IBM=MAT(I)
         IF(IBM.GT.0) VX(IBM)=VX(IBM)+VOL(I)
   30    CONTINUE
         IF(C_ASSOCIATED(IPFLUX)) THEN
*           RECOVER MIXTURE FLUXES FROM L_FLUX
            ALLOCATE(FLUXE(NREG*NGRO))
            JPFLUX=LCMGID(IPFLUX,'FLUX')
            CALL LCMLEL(JPFLUX,1,ILONG,ITYLCM)
            ALLOCATE(FUNKN(ILONG))
            DO 40 IGR=1,NGRO
            CALL LCMGDL(JPFLUX,IGR,FUNKN)
            DO 40 I=1,NREG
            KEYFLX=IDL(I)
   40       FLUXE((IGR-1)*NREG+I)=FUNKN(KEYFLX)
            DEALLOCATE(FUNKN)
            DO 60 IBM=1,NBMIX
            DO 60 IGR=1,NGRO
            FLXMIX=0.0
            DO 50 I=1,NREG
            IF(MAT(I).EQ.IBM) THEN
               VOLTMP=VOL(I)
               FLXMIX=FLXMIX+FLUXE((IGR-1)*NREG+I)*VOLTMP
            ENDIF
   50       CONTINUE
            VOLTMP=VX(IBM)
            IF(VOLTMP.NE.0.0) THEN
               FLMIX((IBM-1)*NGRO+IGR)=FLXMIX/VOLTMP
            ENDIF
   60       CONTINUE
            DEALLOCATE(FLUXE)
         ENDIF
         DEALLOCATE(IDL,VOL,MAT)
      ENDIF
*----
*  PERFORM DEPLETION CALCULATION
*----
      CALL EVODRV(IPDEPL,IPLIB,INDREC,IMPX,NBISO,NGRO,NBMIX,ISONA,
     1 ISONR,JMIX,JDEN,IEVOL,VX,NDEPL,NSUPS,NREAC,NCOMB,EPS1,EPS2,
     2 EXPMAX,H1,ITYPE,INR,IEXTR,IGLOB,ISAT,IDIRAC,ITIXS,IFLMAC,FIT,
     3 ISAVE,ISET,IDEPL,XTI,XTF,XT,LMACRO,FLMIX,MIXBRN,MIXPWR)
      CALL LCMPUT(IPLIB,'ISOTOPESDENS',NBISO,2,JDEN)
*----
*  RELEASE GENERAL INTERNAL LIBRARY INFORMATION
*----
      DEALLOCATE(FLMIX,VX)
      DEALLOCATE(JDEN)
      DEALLOCATE(ISONR,ISONA,MIXPWR,MIXBRN,IEVOL,JMIX)
      RETURN
      END
