*DECK FLU
      SUBROUTINE FLU(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
*
*-----------------------------------------------------------------------
*
*Purpose:
* multigroup flux solution in a lattice.
*
*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)  create or modification type(L_FLUX);
*         HENTRY(I),I>1:
*         read-only type(L_MACROLIB or L_LIBRARY);
*         read-only type(L_TRACK);
*         read-only sequential binary tracking file;
*         read-only type(L_PIJ);
*         optional read-only type(L_FLUX) => unperturbed solution;
*         optional read-only type(L_GPT)  => GPT sources.
* 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(IOUT=6,NSTATE=40,NLEAK=6,NSDIR=6)
      TYPE(C_PTR) IPFLUX,IPTRK,IPMACR,IPSYS,IPFLUP,IPGPT
      CHARACTER TEXT12*12,TITLE*72,CMODUL*12,HSIGN*12,COPTIO*4,
     1 CXDOOR*12,TYPE10*10,HISO10*10,CREBAL*3,CHLEAK*3,HTYPE(0:5)*8,
     2 CLEAK(NLEAK)*4,CSDIR(NSDIR)*1,HPTRK*12,HPMACR*12,HPSYS*12,
     3 HPFLUP*12,HPGPT*12,HSMG*131,REDUC(4)*3
      LOGICAL LTABLE,REC,LEAKSW,LFORW
      DOUBLE PRECISION REFKEF
      INTEGER ISTATE(NSTATE)
      REAL B2(4)
*----
*  ALLOCATABLE ARRAYS
*----
      INTEGER, ALLOCATABLE, DIMENSION(:) :: MATCOD,KEYFLX,IDL
      REAL, ALLOCATABLE, DIMENSION(:) :: VOL
*----
*  DATA STATEMENTS
*----
      SAVE        HTYPE,CLEAK,CSDIR
      DATA       (HTYPE(JJ),JJ=0,5)/'  SOURCE','     GPT','   K-INF',
     >            '   K-EFF','BUCKLING',' LEAKAGE'/
      DATA       (CLEAK(JJ),JJ=1,NLEAK)
     >           /'PNLR',' PNL','SIGS','ALBS','ECCO','HETE'/
      DATA       (CSDIR(III),III=1,NSDIR)
     >           /'-','X','Y','Z','R','G'/
      DATA       (REDUC(JJ),JJ=1,4)
     >           /'ON ','OFF','ON ','OFF'/
*----
*  PARAMETER VALIDATION.
*----
      IF(NENTRY.LE.1) CALL XABORT('FLU: TWO PARAMETERS EXPECTED.')
      IPFLUX=KENTRY(1)
      REC=(JENTRY(1).EQ.1)
      IF(REC) THEN
         CALL LCMGTC(IPFLUX,'SIGNATURE',12,1,HSIGN)
         IF(HSIGN.NE.'L_FLUX') THEN
            TEXT12=HENTRY(1)
            CALL XABORT('FLU: SIGNATURE OF '//TEXT12//' IS '//HSIGN//
     1      '. L_FLUX EXPECTED.')
         ENDIF
      ELSE
         HSIGN='L_FLUX'
         CALL LCMPTC(IPFLUX,'SIGNATURE',12,1,HSIGN)
      ENDIF
      IFTRAK=0
      IPMACR=C_NULL_PTR
      IPTRK=C_NULL_PTR
      IPSYS=C_NULL_PTR
      IPGPT=C_NULL_PTR
      IPFLUP=C_NULL_PTR
      HPTRK=' '
      HPMACR=' '
      HPSYS=' '
      DO 10 I1=2,NENTRY
      LTABLE=(IENTRY(I1).EQ.1).OR.(IENTRY(I1).EQ.2)
      IF((IENTRY(I1).EQ.3).AND.(JENTRY(I1).EQ.2)) THEN
        IFTRAK=FILUNIT(KENTRY(I1))
      ELSE IF(LTABLE.AND.(JENTRY(I1).EQ.2)) THEN
        CALL LCMGTC(KENTRY(I1),'SIGNATURE',12,1,HSIGN)
        IF((HSIGN.EQ.'L_TRACK').AND.(.NOT.C_ASSOCIATED(IPTRK))) THEN
          IPTRK=KENTRY(I1)
          HPTRK=HENTRY(I1)
        ELSE IF((HSIGN.EQ.'L_MACROLIB').AND.(.NOT.C_ASSOCIATED(IPMACR)))
     1  THEN
          IPMACR=KENTRY(I1)
          HPMACR=HENTRY(I1)
        ELSE IF((HSIGN.EQ.'L_LIBRARY').AND.(.NOT.C_ASSOCIATED(IPMACR)))
     1  THEN
          CALL LCMLEN(KENTRY(I1),'MACROLIB',ILONG,ITYLCM)
          IF(ILONG.NE.0) THEN
            IPMACR=KENTRY(I1)
            HPMACR=HENTRY(I1)
            CALL LCMSIX(IPMACR,'MACROLIB',1)
          ENDIF
        ELSE IF((HSIGN.EQ.'L_PIJ').AND.(.NOT.C_ASSOCIATED(IPSYS))) THEN
          IPSYS=KENTRY(I1)
          HPSYS=HENTRY(I1)
        ELSE IF((HSIGN.EQ.'L_FLUX').AND.(.NOT.C_ASSOCIATED(IPFLUP)))
     1  THEN
          IPFLUP=KENTRY(I1)
          HPFLUP=HENTRY(I1)
        ELSE IF((HSIGN.EQ.'L_GPT').AND.(.NOT.C_ASSOCIATED(IPGPT))) THEN
          IPGPT=KENTRY(I1)
          HPGPT=HENTRY(I1)
        ELSE
          GO TO 10
        ENDIF
      ELSE
        CALL XABORT('FLU: READ-ONLY TABLE EXPECTED AT RHS.')
      ENDIF
   10 CONTINUE
      IF(.NOT.C_ASSOCIATED(IPTRK)) THEN
         CALL XABORT('FLU: NO TRACKING OBJECT AT RHS.')
      ELSE IF(.NOT.C_ASSOCIATED(IPMACR)) THEN
         CALL XABORT('FLU: NO MACROLIB OBJECT AT RHS.')
      ELSE IF(.NOT.C_ASSOCIATED(IPSYS)) THEN
         CALL XABORT('FLU: NO SYSTEM OBJECT AT RHS.')
      ENDIF
*----
*  RECOVER GENERAL TRACKING INFORMATION.
*----
      CALL XDISET(ISTATE,NSTATE,0)
      CALL LCMGET(IPTRK,'STATE-VECTOR',ISTATE)
      NREG=   ISTATE(1)
      NUN=    ISTATE(2)
      LEAKSW= ISTATE(3).EQ.0
      IGP4=   ISTATE(4)
      NSOUT=  ISTATE(5)
*----
*  RECOVER MACROLIB PARAMETERS.
*----
      CALL LCMPTC(IPFLUX,'LINK.MACRO',12,1,HPMACR)
      CALL XDISET(ISTATE,NSTATE,0)
      CALL LCMGET(IPMACR,'STATE-VECTOR',ISTATE)
      NGRP=   ISTATE(1)
      MAXMIX= ISTATE(2)
      NANIS=  ISTATE(3)-1
      NIFIS=  ISTATE(4)
      ITRANC= ISTATE(6)
      LFORW = (ISTATE(13).EQ.0)
      IF(IGP4.GT.MAXMIX) THEN
         WRITE(HSMG,'(45HFLU: THE NUMBER OF MIXTURES IN THE TRACKING (,
     1   I5,55H) IS GREATER THAN THE NUMBER OF MIXTURES IN THE MACROLI,
     2   3HB (,I5,2H).)') IGP4,MAXMIX
         CALL XABORT(HSMG)
      ENDIF
*----
*  RECOVER INFORMATION FROM L_PIJ OBJECT.
*----
      IF(C_ASSOCIATED(IPSYS)) THEN
         CALL LCMGTC(IPSYS,'LINK.MACRO',12,1,TEXT12)
         IF(HPMACR.NE.TEXT12) THEN
            WRITE(HSMG,'(37H FLU: INVALID MACROLIB OBJECT NAME ='',A12,
     1      18H'', EXPECTED NAME='',A12,2H''.)') HPMACR,TEXT12
            CALL XABORT(HSMG)
         ENDIF
         CALL LCMGTC(IPSYS,'LINK.TRACK',12,1,TEXT12)
         IF(HPTRK.NE.TEXT12) THEN
            WRITE(HSMG,'(37H FLU: INVALID TRACKING OBJECT NAME ='',A12,
     1      18H'', EXPECTED NAME='',A12,2H''.)') HPTRK,TEXT12
            CALL XABORT(HSMG)
         ENDIF
         CALL LCMPTC(IPFLUX,'LINK.TRACK',12,1,HPTRK)
         CALL LCMPTC(IPFLUX,'LINK.SYSTEM',12,1,HPSYS)
         CALL LCMGET(IPSYS,'STATE-VECTOR',ISTATE)
         ITPIJ=ISTATE(1)
         IPHASE=ISTATE(5)
         IF(ISTATE(8).NE.NGRP) CALL XABORT('FLU: INVALID NUMBER OF ENE'
     1   //'RGY GROUPS.')
         IF(ISTATE(10).NE.MAXMIX) CALL XABORT('FLU: INVALID NUMBER OF '
     1   //'MIXTURES.')
         IF(LEAKSW) THEN
            IF((ISTATE(2).EQ.0).OR.(ISTATE(3).EQ.0)) LEAKSW=.FALSE.
         ENDIF
      ELSE
         ITPIJ=2
         IPHASE=1
         CALL LCMPTC(IPFLUX,'LINK.TRACK',12,1,HPTRK)
      ENDIF
*----
*  INITIALISE/READ ITERATIONS PARAMETERS
*----
      IF(NREG.EQ.0) CALL XABORT('FLU: NREG = 0')
      CALL FLUGPI(IPFLUX,IPMACR,LEAKSW,ITYPEC,MAXOUT,MAXINR,EPSOUT,
     1 EPSUNK,EPSINR,IREBAL,IFRITR,IACITR,COPTIO,ILEAK,B2,NGRP,NREG,
     2 NIFIS,REFKEF,ITPIJ,IPRINT,REC,INITFL)
      IF(ITYPEC.EQ.1) THEN
        IF(.NOT.C_ASSOCIATED(IPFLUP)) CALL XABORT('FLU: NO UNPERTURBED'
     1  //'FLUX OBJECT AT RHS.')
        IF(.NOT.C_ASSOCIATED(IPGPT)) CALL XABORT('FLU: NO GPT SOURCE O'
     1  //'BJECT AT RHS.')
      ENDIF
*----
*  RECOVER TRACKING FILE INFORMATION.
*----
      CALL LCMGTC(IPTRK,'TRACK-TYPE',12,1,CMODUL)
      CALL LCMGET(IPTRK,'STATE-VECTOR',ISTATE)
      IF(IPHASE.EQ.1) THEN
        CXDOOR=CMODUL
      ELSE
        CXDOOR='TRAFIC'
        IF(.NOT.C_ASSOCIATED(IPSYS)) CALL XABORT('FLU: NO PIJ OBJECT A'
     1  //'T RHS.')
      ENDIF
      IF(CXDOOR.EQ.'MCCG') THEN
         NLF=ISTATE(6)
         NANI=ISTATE(6)
      ELSE IF(CXDOOR.EQ.'BIVAC')  THEN
         NLF=MAX(1,ISTATE(14))
         NANI=MAX(1,ISTATE(16))
      ELSE IF(CXDOOR.EQ.'TRIVAC') THEN
         NLF=MAX(1,ISTATE(30))
         NANI=MAX(1,ISTATE(32))
      ELSE IF(CXDOOR.EQ.'SN') THEN
         NLF=1
         NANI=MAX(1,ISTATE(16))
      ELSE
         NLF=1
         NANI=1
      ENDIF
*----
*  CHECK FOR THE ANISOTROPY SETTINGS COHERENCE
*----
      IF((ITRANC.NE.0).AND.(NANI.GT.1)) THEN
         WRITE(IOUT,6400) CXDOOR,NANI
         ITRANC=0
      ENDIF
*----
*  RECOVER TABULATED FUNCTIONS FOR THE METHOD OF CHARACTERISTICS.
*----
      IF(CXDOOR.EQ.'MCCG') CALL XDRTA2(IPTRK)
*----
*  THE NUMBER OF UNKNOWNS OF A CURRENT-BASED SYBIL ITERATION IS
*  INCREASED TO HOLD INTERFACE CURRENT COMPONENTS PLUS ONE COMPONENT
*  FOR OUTGOING BOUNDARY AVERAGE CURRENT.
*----
      IF(CXDOOR.EQ.'SYBIL') NUN=NUN+ISTATE(9)+1
*----
*  THE NUMBER OF UNKNOWNS IS MULTIPLIED BY 2 WITH THE ECCO-TYPE
*  ISOTROPIC STREAMING MODEL AND BY 4 WITH THE TIBERE ANISOTROPIC
*  STREAMING MODEL. THE EXTRA-LOCATIONS ARE USED TO STORE THE
*  HETEROGENEOUS FUNDAMENTAL CURRENT VALUES.
*----
      IF(ILEAK.EQ.5) NUN=NUN*2
      IF(ILEAK.GE.6) NUN=NUN*4
*----
*  PRINT REQUIRED INFORMATION
*----
      IF(IPRINT.GE.1) THEN
        IF(LFORW) THEN
          TYPE10='    DIRECT'
        ELSE
          TYPE10='   ADJOINT'
        ENDIF
        IF(NLF.EQ.1 ) THEN
          HISO10=' ISOTROPIC'
        ELSE
          HISO10='ANISOTROPI'
        ENDIF
        WRITE(IOUT,6010) HTYPE(ITYPEC),TYPE10,HISO10
        IF(ITYPEC.EQ.3) THEN
            WRITE(IOUT,6011) COPTIO,CLEAK(MOD(ILEAK,10)),' IMPOSED'
            IF(ILEAK.LT.6) THEN
              WRITE(IOUT,6012) B2(4)
            ELSE
              WRITE(IOUT,6013) B2(1),B2(2),B2(3)
            ENDIF
        ELSE IF(ITYPEC.GT.3) THEN
          IF(ILEAK.LT.6) THEN
            WRITE(IOUT,6011) COPTIO,CLEAK(ILEAK),'G SEARCH'
            WRITE(IOUT,6012) B2(4)
          ELSE
            WRITE(IOUT,6011) COPTIO,CLEAK(6),CSDIR(ILEAK/10)//' SEARCH'
            WRITE(IOUT,6013) B2(1),B2(2),B2(3)
          ENDIF
        ENDIF
        CREBAL='ON '
        IF(IREBAL.EQ.0) CREBAL='OFF'
        CHLEAK='ON '
        IF(LEAKSW) CHLEAK='OFF'
        WRITE(IOUT,6000) CXDOOR,NGRP,NREG,NUN,MAXOUT,MAXINR,IFRITR,
     >                   IACITR,CREBAL,REDUC(ITPIJ),CHLEAK,EPSOUT,
     >                   EPSUNK,EPSINR
        IF(ITRANC.GT.0) WRITE(IOUT,6100)
      ENDIF
*----
*  RECOVER TRACKING INFORMATION.
*----
      IF(CXDOOR.EQ.'MCCG') THEN
         CALL LCMGET(IPTRK,'MCCG-STATE',ISTATE)
         NFUNL=ISTATE(19)
         NLIN=ISTATE(20)
      ELSE IF(CXDOOR.EQ.'SN') THEN
         CALL LCMGET(IPTRK,'STATE-VECTOR',ISTATE)
         ITYPE=ISTATE(6)
         NFUNL=ISTATE(7)
         NLIN=ISTATE(8)
         IF(ITYPE.EQ.5) NLIN=NLIN**2
         IF(ITYPE.EQ.7) NLIN=NLIN**3
      ELSE
         NFUNL=1
         NLIN=1
      ENDIF
      ALLOCATE(MATCOD(NREG),VOL(NREG),KEYFLX(NREG*NLIN*NFUNL))
      CALL LCMLEN(IPTRK,'MATCOD',ILNLCM,ITYLCM)
      IF(ILNLCM.NE.NREG) 
     1   CALL XABORT( 'FLU: INCOMPATIBLE NUMBER OF REGIONS.')
      CALL LCMGET(IPTRK,'MATCOD',MATCOD)
      CALL LCMGET(IPTRK,'VOLUME',VOL)
      IF(CXDOOR.EQ.'SN') THEN
         ALLOCATE(IDL(NREG))
         CALL LCMGET(IPTRK,'KEYFLX',IDL)
         DO 20 IR=1,NREG
         IND=IDL(IR)
         DO 20 IE=1,NLIN
         DO 20 IL=1,NFUNL
         IOF=(IL-1)*NREG*NLIN+(IE-1)*NREG+IR
         IF(IND.EQ.0) THEN
            KEYFLX(IOF)=0
         ELSE
            KEYFLX(IOF)=IND+(IL-1)*NLIN+IE-1
         ENDIF
   20    CONTINUE
         DEALLOCATE(IDL)
      ELSE
         CALL LCMGET(IPTRK,'KEYFLX',KEYFLX)
      ENDIF
      CALL LCMLEN(IPTRK,'TITLE',ILNLCM,ITYLCM)
      IF( ILNLCM.GT.0 )THEN
         CALL LCMGTC(IPTRK,'TITLE',72,1,TITLE)
      ELSE
         TITLE='*** NO TITLE PROVIDED ***'
      ENDIF
*----
*  COMPUTE THE FLUX.
*----
      IF(ITYPEC.EQ.1) THEN
*       FIXED SOURCE EIGENVALUE PROBLEM
        CALL FLUGPT(IPRINT,IPFLUX,IPTRK,IPMACR,IPFLUP,IPGPT,IFTRAK,
     1  IPSYS,IPHASE,ITPIJ,CXDOOR,ITRANC,TITLE,INITFL,LFORW,LEAKSW,
     2  IREBAL,NGRP,MAXMIX,NIFIS,NANIS,NLF,NLIN,NFUNL,COPTIO,NUN,
     3  MAXINR,EPSINR,MAXOUT,EPSUNK,EPSOUT,IFRITR,IACITR,ILEAK,NREG,
     4  NSOUT,MATCOD,KEYFLX,VOL,REFKEF)
      ELSE
        CALL FLUDRV(IPRINT,IPFLUX,IPTRK,IPMACR,IFTRAK,IPSYS,IPHASE,
     1  ITPIJ,CXDOOR,ITRANC,TITLE,B2,INITFL,LFORW,LEAKSW,IREBAL,NGRP,
     2  MAXMIX,NIFIS,NANIS,NLF,NLIN,NFUNL,COPTIO,NUN,MAXINR,EPSINR,
     3  MAXOUT,EPSUNK,EPSOUT,IFRITR,IACITR,ITYPEC,ILEAK,NREG,NSOUT,
     4  MATCOD,KEYFLX,VOL,REFKEF)
      ENDIF
*----
*  RELEASE GENERAL TRACKING INFORMATION.
*----
      DEALLOCATE(KEYFLX,VOL,MATCOD)
      CALL LCMSIX(IPMACR,' ',0)
      RETURN
*
6000  FORMAT(' FLUX SOLUTION DOOR          =',4X,A6/
     > ' NB. OF GROUPS               =',I10/
     > ' NB. OF REGIONS              =',I10/
     > ' NB. OF UNKNOWNS PER GROUP   =',I10/
     > ' MAX. OUTER ITERATIONS       =',I10/
     > ' MAX. THERMAL ITERATIONS     =',I10/
     > ' ACCELERATION SCHEME         =(',I2,' FREE,',I2,' ACCELERATED)'/
     > ' REBALANCING OPTION          = ',A3/
     > ' SELF-SCATTERING REDUCTION   = ',A3/
     > ' FUNDAMENTAL MODE            = ',A3/
     > ' EIGENVALUE TOLERANCE        = ',1P,E10.3/
     > ' UNKNOWN OUTER TOLERANCE     = ',E10.3/
     > ' UNKNOWN INNER TOLERANCE     = ',E10.3/)
6010  FORMAT(////' P. I. M.    SOLUTION TO TRANSPORT EQUATION',//
     > ' CALCULATION TYPE            =',2X,A8/
     > ' FORWARD/BACKWARD OPTION     =',A10/
     > ' (AN)ISOTROPY OPTION         =',A10)
6011  FORMAT(' LEAKAGE TYPE                =',6X,A4/
     > ' LEAKAGE OPTION              =',6X,A4/
     > ' BUCKLING                    =',2X,A8)
6012  FORMAT(' INITIAL TOTAL BUCKLING      =',E13.5)
6013  FORMAT(' INITIAL BUCKLING - X        =',E13.5/
     >       ' INITIAL BUCKLING - Y        =',E13.5/
     >       ' INITIAL BUCKLING - Z        =',E13.5)
6100  FORMAT(/' USE TRANSPORT CORRECTED CROSS-SECTIONS')
6400  FORMAT(//' *** WARNING:  DOOR ',A12,'IS USED WITH AN ANISOTROPY',
     > ' LEVEL FROM L_TRACK =',I2,' AND WITH A TRANSPORT CORRECTION S',
     > 'ET IN LIB:.'/15X,'--> THE TRANSPORT CORRECTION IS DISABLED.'/)
      END
