*DECK FLUDBV
      SUBROUTINE FLUDBV(CDOOR,IPHASE,JPSYS,JPSTR,NPSYS,IPTRK,IFTRAK,
     1 IPRT,NREG,NUNKNO,NFUNL,NGRP,NMAT,LEXAC,MATCOD,VOL,KEYFLX,TITLE,
     2 ILEAK,B2,DDD,GAMMA,FLUX,IPMACR,REBFLG)
*
*-----------------------------------------------------------------------
*
*Purpose:
* perform multigroup inner iterations for the method of characteristics
* with EXCELL. Leakage rate modelization. Vectorial version.
*
*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): R. Roy and A. Hebert
*
*Parameters: input
* CDOOR   name of the geometry/solution operator.
* IPHASE  type of flux solution door (1 for asm 2 for pij).
* JPSYS   pointer to the system LCM list object.
* JPSTR   pointer to the system LCM list object containing isotropic
*         streaming information (=0 if not required).
* NPSYS   non-converged energy group indices.
* IPTRK   pointer to the tracking LCM object.
* IFTRAK  tracking file unit number.
* IPRT    print flag.
* NREG    number of regions.
* NFUNL   second dimension of matrix KEYFLX.
* NGRP    number of energy groups.
* NUNKNO  number of flux/sources unknowns per energy group.
* NMAT    number of mixtures in the internal library.
* LEXAC   type of exponential function calculation (=.false. to compute
*         exponential functions using tables).
* MATCOD  mixture indices.
* VOL     volumes.
* KEYFLX  index of L-th order flux components in unknown vector.
* TITLE   title.
* ILEAK   method used to include db2 effect:
*         =1: the scattering modified cp matrix is multiplied by PNLR;
*         =2: the reduced cp matrix is multiplied by PNL;
*         =3: sigs0-db2 approximation;
*         =4: (not available);
*         =5: Ecco-type isotropic streaming model;
*         >5: Tibere-type anisotropic streaming model.
* B2      buckling.
* DDD     leakage coefficients.
* GAMMA   gamma factors.
* IPMACR  pointer to the macrolib LCM object.
* REBFLG  ACA or SCR rebalancing flag.
*
*Parameters: input/output
* FLUX    neutron flux:
*         FLUX(:,:,1) <= present inner;
*         FLUX(:,:,2) <= new     inner;
*         FLUX(:,:,3) <= source  inner.
*
*-----------------------------------------------------------------------
*
      USE GANLIB
*----
*  SUBROUTINE ARGUMENTS
*----
      CHARACTER CDOOR*12,TITLE*72
      LOGICAL LEXAC,REBFLG
      TYPE(C_PTR) JPSYS,JPSTR,IPTRK,IPMACR
      INTEGER IPHASE,NPSYS(NGRP),IFTRAK,IPRT,NREG,NUNKNO,NFUNL,NGRP,
     1 NMAT,MATCOD(NREG),KEYFLX(NREG,NFUNL),ILEAK
      REAL VOL(NREG),FLUX(NUNKNO,NGRP,3),B2(4),DDD(NGRP),GAMMA(NGRP)
*----
*  LOCAL VARIABLES
*----
      PARAMETER(IOUT=6)
      TYPE(C_PTR) KPSYS,KPSTR
*----
*  ALLOCATABLE ARRAYS
*----
      REAL, ALLOCATABLE, DIMENSION(:) :: SIGT0,SIGS0,SUNKN,FUNKN
*
      IF(ILEAK.EQ.1) THEN
         DO 30 IGR=1,NGRP
         IF((NPSYS(IGR).NE.0).AND.(B2(4).NE.0.0)) THEN
            KPSYS=LCMGIL(JPSYS,IGR)
            CALL LCMLEN(KPSYS,'DRAGON-TXSC',ILCTXS,ITYLCM)
            ALLOCATE(SIGT0(0:ILCTXS-1))
            CALL LCMGET(KPSYS,'DRAGON-TXSC',SIGT0(0))
            CALL LCMLEN(KPSYS,'DRAGON-S0XSC',ILCS0X,ITYLCM)
            ALLOCATE(SIGS0(0:ILCS0X-1))
            CALL LCMGET(KPSYS,'DRAGON-S0XSC',SIGS0(0))
            ZNUM=0.0
            ZDEN=0.0
            DO 10 IR=1,NREG
            IBM=MATCOD(IR)
            IND=KEYFLX(IR,1)
            ZNUM=ZNUM+(SIGT0(IBM)-SIGS0(IBM))*FLUX(IND,IGR,1)*VOL(IR)
   10       ZDEN=ZDEN+FLUX(IND,IGR,1)*VOL(IR)
            DEALLOCATE(SIGS0)
            DEALLOCATE(SIGT0)
            ALP1=ZNUM/(ZNUM+DDD(IGR)*B2(4)*ZDEN)
            DO 20 IR=1,NREG
            IND=KEYFLX(IR,1)
   20       FLUX(IND,IGR,3)=ALP1*FLUX(IND,IGR,3)
         ENDIF
   30    CONTINUE
         IDIR=0
         CALL DOORFVR(CDOOR,JPSYS,NPSYS,IPTRK,IFTRAK,IPRT,NGRP,
     1        NMAT,IDIR,NREG,NUNKNO,IPHASE,LEXAC,MATCOD,VOL,KEYFLX,
     2        TITLE,FLUX(1,1,3),FLUX(1,1,2),IPMACR,REBFLG)
      ELSE IF(ILEAK.EQ.2) THEN
         DO 50 IGR=1,NGRP
         IF((NPSYS(IGR).NE.0).AND.(B2(4).NE.0.0)) THEN
            KPSYS=LCMGIL(JPSYS,IGR)
            CALL LCMLEN(KPSYS,'DRAGON-TXSC',ILCTXS,ITYLCM)
            ALLOCATE(SIGT0(0:ILCTXS-1))
            CALL LCMGET(KPSYS,'DRAGON-TXSC',SIGT0(0))
            CALL LCMLEN(KPSYS,'DRAGON-S0XSC',ILCS0X,ITYLCM)
            ALLOCATE(SIGS0(0:ILCS0X-1))
            CALL LCMGET(KPSYS,'DRAGON-S0XSC',SIGS0(0))
            ZNUM=0.0
            ZDEN=0.0
            DO 40 IR=1,NREG
            IBM=MATCOD(IR)
            IND=KEYFLX(IR,1)
            ZNUM=ZNUM+SIGT0(IBM)*FLUX(IND,IGR,1)*VOL(IR)
   40       ZDEN=ZDEN+FLUX(IND,IGR,1)*VOL(IR)
            ALP1=ZNUM/(ZNUM+DDD(IGR)*B2(4)*ZDEN)
            DO 45 IR=1,NREG
            IND=KEYFLX(IR,1)
            FLUX(IND,IGR,3)=ALP1*FLUX(IND,IGR,3)-(1.0-ALP1)
     >                 *SIGS0(MATCOD(IR))*FLUX(IND,IGR,1)
   45       CONTINUE
            DEALLOCATE(SIGS0,SIGT0)
         ENDIF
   50    CONTINUE
         IDIR=0
         CALL DOORFVR(CDOOR,JPSYS,NPSYS,IPTRK,IFTRAK,IPRT,NGRP,
     1        NMAT,IDIR,NREG,NUNKNO,IPHASE,LEXAC,MATCOD,VOL,KEYFLX,
     2        TITLE,FLUX(1,1,3),FLUX(1,1,2),IPMACR,REBFLG)
      ELSE IF(ILEAK.EQ.3) THEN
         DO 70 IGR=1,NGRP
         IF(NPSYS(IGR).NE.0) THEN
            BB=B2(4)
            DO 60 IR=1,NREG
            IND=KEYFLX(IR,1)
   60       FLUX(IND,IGR,3)=FLUX(IND,IGR,3)-DDD(IGR)*BB*FLUX(IND,IGR,1)
         ENDIF
   70    CONTINUE
         IDIR=0
         CALL DOORFVR(CDOOR,JPSYS,NPSYS,IPTRK,IFTRAK,IPRT,NGRP,
     1        NMAT,IDIR,NREG,NUNKNO,IPHASE,LEXAC,MATCOD,VOL,KEYFLX,
     2        TITLE,FLUX(1,1,3),FLUX(1,1,2),IPMACR,REBFLG)
      ELSE IF(ILEAK.EQ.5) THEN
*        ISOTROPIC STREAMING MODEL (ECCO).
         IF(.NOT.C_ASSOCIATED(JPSTR)) THEN
            CALL XABORT('FLUDBV: MISSING STREAMING INFO.')
         ENDIF
         DO 95 IGR=1,NGRP
         IF(NPSYS(IGR).NE.0) THEN
            BB=B2(4)
            DO 90 IR=1,NREG
            IND=KEYFLX(IR,1)
   90       FLUX(IND,IGR,3)=FLUX(IND,IGR,3)-BB*FLUX(NUNKNO/2+IND,IGR,1)
         ENDIF
   95    CONTINUE
         IF(IPRT.GE.3) WRITE(IOUT,'(28H FLUDBV: FUNDAMENTAL FLUXES.)')
         IDIR=0
         CALL DOORFVR(CDOOR,JPSYS,NPSYS,IPTRK,IFTRAK,IPRT,NGRP,
     1        NMAT,IDIR,NREG,NUNKNO,IPHASE,LEXAC,MATCOD,VOL,KEYFLX,
     2        TITLE,FLUX(1,1,3),FLUX(1,1,2),IPMACR,REBFLG)
         DO 130 IGR=1,NGRP
         IF(NPSYS(IGR).NE.0) THEN
            KPSTR=LCMGIL(JPSTR,IGR)
            CALL LCMLEN(KPSTR,'DRAGON-TXSC',ILCTXS,ITYLCM)
            ALLOCATE(SIGT0(0:ILCTXS-1))
            CALL LCMGET(KPSTR,'DRAGON-TXSC',SIGT0(0))
            ZNUM=0.0
            ZDEN=0.0
            DO 100 IR=1,NREG
               IBM=MATCOD(IR)
               IND=KEYFLX(IR,1)
               ZNUM=ZNUM+SIGT0(IBM)*FLUX(IND,IGR,2)*VOL(IR)
               ZDEN=ZDEN+FLUX(IND,IGR,2)*VOL(IR)
  100       CONTINUE
            DO 110 IR=1,NREG
            IBM=MATCOD(IR)
            IND=KEYFLX(IR,1)
  110       FLUX(NUNKNO/2+IND,IGR,3)=FLUX(NUNKNO/2+IND,IGR,3)+
     1      (1.0-GAMMA(IGR))*(ZNUM/ZDEN-SIGT0(IBM))*
     2      FLUX(NUNKNO/2+IND,IGR,2)
            DEALLOCATE(SIGT0)
            DO 120 IR=1,NREG
            IND=KEYFLX(IR,1)
  120       FLUX(NUNKNO/2+IND,IGR,3)=(FLUX(NUNKNO/2+IND,IGR,3)
     1      +FLUX(IND,IGR,2)/3.0)/GAMMA(IGR)
         ENDIF
  130    CONTINUE
         IF(IPRT.GE.3) WRITE(IOUT,'(30H FLUDBV: FUNDAMENTAL CURRENTS.)')
         ALLOCATE(SUNKN((NUNKNO/2)*NGRP),FUNKN((NUNKNO/2)*NGRP))
         IOF=0
         DO 140 IGR=1,NGRP
         DO 140 IND=1,NUNKNO/2
         IOF=IOF+1
         SUNKN(IOF)=FLUX(NUNKNO/2+IND,IGR,3)
  140    FUNKN(IOF)=FLUX(NUNKNO/2+IND,IGR,2)
         IDIR=0
         CALL DOORFVR(CDOOR,JPSTR,NPSYS,IPTRK,IFTRAK,IPRT,NGRP,
     1        NMAT,IDIR,NREG,NUNKNO/2,IPHASE,LEXAC,MATCOD,VOL,KEYFLX,
     2        TITLE,SUNKN,FUNKN,IPMACR,REBFLG)
         IOF=0
         DO 150 IGR=1,NGRP
         DO 150 IND=1,NUNKNO/2
         IOF=IOF+1
         FLUX(NUNKNO/2+IND,IGR,3)=SUNKN(IOF)
  150    FLUX(NUNKNO/2+IND,IGR,2)=FUNKN(IOF)
         DEALLOCATE(FUNKN,SUNKN)
      ELSE
         CALL XABORT('FLUDBV: TYPE OF LEAKAGE NOT IMPLEMENTED.')
      ENDIF
      RETURN
      END
