*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
      INTEGER INDD(3),INDC(3),INDB(3)
*----
*  ALLOCATABLE ARRAYS
*----
      REAL, ALLOCATABLE, DIMENSION(:) :: SIGT0,SIGS0,SUNKNO,FUNKNO
*
      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(SUNKNO((NUNKNO/2)*NGRP),FUNKNO((NUNKNO/2)*NGRP))
         IOF=0
         DO 140 IGR=1,NGRP
         DO 140 IND=1,NUNKNO/2
         IOF=IOF+1
         SUNKNO(IOF)=FLUX(NUNKNO/2+IND,IGR,3)
  140    FUNKNO(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,SUNKNO,FUNKNO,IPMACR,REBFLG)
         IOF=0
         DO 150 IGR=1,NGRP
         DO 150 IND=1,NUNKNO/2
         IOF=IOF+1
         FLUX(NUNKNO/2+IND,IGR,3)=SUNKNO(IOF)
  150    FLUX(NUNKNO/2+IND,IGR,2)=FUNKNO(IOF)
         DEALLOCATE(FUNKNO,SUNKNO)
      ELSE IF(MOD(ILEAK,10).EQ.6) THEN
*        ----
*        TIBERE ANISOTROPIC STREAMING MODEL.
*        ----
         IF(.NOT.C_ASSOCIATED(JPSTR)) THEN
            CALL XABORT('FLUDBV: MISSING STREAMING INFO.')
         ENDIF
* ADD SOURCES FOR FLUX EQUATION
         DO IGR=1,NGRP
           IF(NPSYS(IGR).NE.0) THEN 
             IF((B2(1).NE.0.0).AND.(B2(2).NE.0.0).AND.
     1       (B2(3).NE.0.0)) THEN
               S=0.0
               DO IR=1,NREG 
                 IND=KEYFLX(IR,1)
                 INDC(1)=3*NUNKNO/8+IND
                 INDC(2)=5*NUNKNO/8+IND
                 INDC(3)=7*NUNKNO/8+IND
                 FLUX(IND,IGR,3)=FLUX(IND,IGR,3)-(B2(1)
     1           *FLUX(INDC(1),IGR,1)+B2(2)*FLUX(INDC(2),IGR,1)+
     2           B2(3)*FLUX(INDC(3),IGR,1))
               ENDDO 
             ENDIF  
           ENDIF 
         ENDDO
         IF(IPRT.GE.3) WRITE(IOUT,'(28H FLUDBV: FUNDAMENTAL FLUXES.)')
           IDIR=0
           NUNKNO4=NUNKNO/4
           ALLOCATE(SUNKNO(NUNKNO4*NGRP),FUNKNO(NUNKNO4*NGRP))
           IOF=0
           DO IGR=1,NGRP
             DO IND=1,NUNKNO4
               IOF=IOF+1
               SUNKNO(IOF)=FLUX(IND,IGR,3)
               FUNKNO(IOF)=FLUX(IND,IGR,2)
             ENDDO
           ENDDO
           CALL DOORFVR(CDOOR,JPSYS,NPSYS,IPTRK,IFTRAK,IPRT,NGRP,
     1        NMAT,IDIR,NREG,NUNKNO4,IPHASE,LEXAC,MATCOD,VOL,KEYFLX,
     2        TITLE,SUNKNO,FUNKNO,IPMACR,REBFLG)
           IOF=0
           DO IGR=1,NGRP
             DO IND=1,NUNKNO4
               IOF=IOF+1
               FLUX(IND,IGR,3)=SUNKNO(IOF)
               FLUX(IND,IGR,2)=FUNKNO(IOF) 
             ENDDO
           ENDDO
           DEALLOCATE(FUNKNO,SUNKNO)   
* ADD SOURCES FOR CURRENT EQUATIONS
           DO 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 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)
             ENDDO
             DO IR=1,NREG
               IBM=MATCOD(IR)
               INDD(1)=NUNKNO/4+KEYFLX(IR,1)
               INDD(2)=NUNKNO/2+KEYFLX(IR,1)
               INDD(3)=3*NUNKNO/4+KEYFLX(IR,1)
               DO IDIR=1,3
                 FLUX(INDD(IDIR),IGR,3)=FLUX(INDD(IDIR),IGR,3)+
     1           (1.0-GAMMA(IGR))*(ZNUM/ZDEN-SIGT0(IBM))*
     2            FLUX(INDD(IDIR),IGR,2)
               ENDDO
             ENDDO
             DO IR=1,NREG
               INDD(1)=NUNKNO/4+KEYFLX(IR,1)
               INDD(2)=NUNKNO/2+KEYFLX(IR,1)
               INDD(3)=3*NUNKNO/4+KEYFLX(IR,1)
               DO IDIR=1,3
                 FLUX(INDD(IDIR),IGR,3)=(FLUX(INDD(IDIR),IGR,3)
     1           +FLUX(KEYFLX(IR,1),IGR,2)/3.0)/GAMMA(IGR)
               ENDDO
             ENDDO
             DEALLOCATE(SIGT0)
           ENDIF
           ENDDO
         DO IDIR=1,3
           IF(IPRT.GE.3) 
     >     WRITE(IOUT,'(30H FLUDBV: FUNDAMENTAL CURRENTS.)') 
           IF(IDIR.EQ.1) WRITE(6,*)'FUNDAMENTAL CURRENT X '
           IF(IDIR.EQ.2) WRITE(6,*)'FUNDAMENTAL CURRENT Y '
           IF(IDIR.EQ.3) WRITE(6,*)'FUNDAMENTAL CURRENT Z '
           NUNKNO4=NUNKNO/4
           ALLOCATE(SUNKNO(NUNKNO4*NGRP),FUNKNO(NUNKNO4*NGRP))
           IOF=0
           DO IGR=1,NGRP
             DO IND=1,NUNKNO4
               INDB(1)=NUNKNO/4+IND
               INDB(2)=NUNKNO/2+IND
               INDB(3)=3*NUNKNO/4+IND
               IOF=IOF+1
               SUNKNO(IOF)=FLUX(INDB(IDIR),IGR,3)
               FUNKNO(IOF)=FLUX(INDB(IDIR),IGR,2)
             ENDDO
           ENDDO
           CALL DOORFVR(CDOOR,JPSTR,NPSYS,IPTRK,IFTRAK,IPRT,NGRP,
     1       NMAT,IDIR,NREG,NUNKNO4,IPHASE,LEXAC,MATCOD,VOL,KEYFLX,
     2       TITLE,SUNKNO,FUNKNO,IPMACR,REBFLG)
           IOF=0
           DO IGR=1,NGRP
             DO IND=1,NUNKNO4
               INDB(1)=NUNKNO/4+IND
               INDB(2)=NUNKNO/2+IND
               INDB(3)=3*NUNKNO/4+IND
               IOF=IOF+1
               FLUX(INDB(IDIR),IGR,3)=SUNKNO(IOF)
               FLUX(INDB(IDIR),IGR,2)=FUNKNO(IOF)   
             ENDDO
           ENDDO
           DEALLOCATE(FUNKNO,SUNKNO)  
         ENDDO
      ELSE
         CALL XABORT('FLUDBV: TYPE OF LEAKAGE NOT IMPLEMENTED.')
      ENDIF
      RETURN
      END
