*DECK FLUDB2
      SUBROUTINE FLUDB2(FMODUL,IPSYS,IPSTR,IPTRK,IFTRAK,IMPX,NREGIO,
     >                  NUNKNO,NBMIX,MATCOD,VOLUME,KEYFLX,FUNKNO,SUNKNO,
     >                  ILEAK,B2,DDD,GAMMA,TITLE)
*
*-----------------------------------------------------------------------
*
*Purpose:
* find a leakage parameter to match the input DB2 value and find the
* corresponding flux.
*
*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
* FMODUL  flux solution module.
* IPSYS   pointer to the system LCM object (=0 for the method of
*         characteristics MOCC).
* IPSTR   pointer to the system LCM object containing isotropic
*         streaming information (=0 if not required).
* IPTRK   pointer to the tracking LCM object.
* IFTRAK  tracking file unit number.
* IMPX    print selection for flux modules.
* NREGIO  number of regions considered.
* NUNKNO  number of unknown in the system including current unknowns
*         if ILEAK.ge.5.
* NBMIX   number of mixtures.
* MATCOD  material code in region.
* VOLUME  volume of region.
* KEYFLX  flux elements in unknown system.
* SUNKNO  source for system of unknown.
* 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: albedo approximation;
*         =5: Ecco-type isotropic streaming model;
*         >5: Tibere-type anisotropic streaming model.
* B2      directionnal buckling.
* DDD     leakage coefficient.
* GAMMA   gamma coefficient.
* TITLE   title.
*
*Parameters: input/output
* FUNKNO  unknown vector solved for.
*
*-----------------------------------------------------------------------
*
      USE GANLIB
*----
*  SUBROUTINE ARGUMENTS
*----
      EXTERNAL    FMODUL
      CHARACTER   TITLE*72
      TYPE(C_PTR) IPSYS,IPSTR,IPTRK
      INTEGER     IFTRAK,IMPX,NREGIO,NUNKNO,NBMIX,MATCOD(NREGIO),
     >            KEYFLX(NREGIO),ILEAK
      REAL        VOLUME(NREGIO),FUNKNO(NUNKNO),SUNKNO(NUNKNO),B2(4),
     >            DDD,GAMMA
*----
*  LOCAL VARIABLES
*----
      PARAMETER  (IOUT=6)
      CHARACTER   TEXT12*12
      INTEGER     INDD(3)
*----
*  ALLOCATABLE ARRAYS
*----
      REAL, ALLOCATABLE, DIMENSION(:) :: SIGT0,SIGS0,SUNKN,F1,F2,PP
*----
*  READ THE TRANSPORT CORRECTED CROSS SECTIONS.
*----
      IF((ILEAK.EQ.1).OR.(ILEAK.EQ.2).OR.(ILEAK.EQ.4)) THEN
         CALL LCMLEN(IPSYS,'DRAGON-TXSC',ILCTXS,ITYLCM)
         ALLOCATE(SIGT0(0:ILCTXS-1))
         CALL LCMGET(IPSYS,'DRAGON-TXSC',SIGT0(0))
         CALL LCMLEN(IPSYS,'DRAGON-S0XSC',ILCS0X,ITYLCM)
         ALLOCATE(SIGS0(0:ILCS0X-1))
         CALL LCMGET(IPSYS,'DRAGON-S0XSC',SIGS0(0))
      ENDIF
*
      IF(IMPX.GT.10) THEN
         ALLOCATE(SUNKN(NUNKNO))
         DO 5 I=1,NUNKNO
   5     SUNKN(I)=SUNKNO(I)
      ENDIF
*
      IF(ILEAK.EQ.1) THEN
         IF(B2(4).NE.0.0) THEN
            ZNUM=0.0
            ZDEN=0.0
            DO 10 I=1,NREGIO
            IND=KEYFLX(I)
            IR=MATCOD(I)
            ZNUM=ZNUM+(SIGT0(IR)-SIGS0(IR))*FUNKNO(IND)*VOLUME(I)
  10        ZDEN=ZDEN+FUNKNO(IND)*VOLUME(I)
            ALP1=ZNUM/(ZNUM+DDD*B2(4)*ZDEN)
            DO 20 I=1,NREGIO
            IND=KEYFLX(I)
  20        SUNKNO(IND)=ALP1*SUNKNO(IND)
         ENDIF
         CALL FMODUL(IPSYS,IPTRK,IFTRAK,IMPX,0,NREGIO,NBMIX,NUNKNO,
     >               MATCOD,VOLUME,KEYFLX,FUNKNO,SUNKNO,TITLE)
      ELSE IF(ILEAK.EQ.2) THEN
         IF(B2(4).NE.0.0) THEN
            ZNUM=0.0
            ZDEN=0.0
            DO 30 I=1,NREGIO
            IND=KEYFLX(I)
            ZNUM=ZNUM+SIGT0(MATCOD(I))*FUNKNO(IND)*VOLUME(I)
  30        ZDEN=ZDEN+FUNKNO(IND)*VOLUME(I)
            ALP1=ZNUM/(ZNUM+DDD*B2(4)*ZDEN)
            DO 40 I=1,NREGIO
            IND=KEYFLX(I)
            SUNKNO(IND)=ALP1*SUNKNO(IND)-(1.0-ALP1)*SIGS0(MATCOD(I))*
     >      FUNKNO(IND)
  40        CONTINUE
         ENDIF
         CALL FMODUL(IPSYS,IPTRK,IFTRAK,IMPX,0,NREGIO,NBMIX,NUNKNO,
     >               MATCOD,VOLUME,KEYFLX,FUNKNO,SUNKNO,TITLE)
      ELSE IF(ILEAK.EQ.3) THEN
         DO 50 I=1,NREGIO
         IND=KEYFLX(I)
  50     SUNKNO(IND)=SUNKNO(IND)-DDD*B2(4)*FUNKNO(IND)
         CALL FMODUL(IPSYS,IPTRK,IFTRAK,IMPX,0,NREGIO,NBMIX,NUNKNO,
     >               MATCOD,VOLUME,KEYFLX,FUNKNO,SUNKNO,TITLE)
      ELSE IF(ILEAK.EQ.4) THEN
         ALLOCATE(F1(NREGIO),F2(NREGIO))
*
         CALL FLUALB(IPSYS,NREGIO,NUNKNO,ILCTXS,MATCOD,VOLUME,KEYFLX,
     >   FUNKNO,SUNKNO,SIGS0(0),SIGT0(0),F1,F2)
*
         IF(IMPX.GT.2) THEN
           WRITE(IOUT,'(//33H N E U T R O N    S O U R C E S :)')
           WRITE(IOUT,'(1P,6(5X,E15.7))') (SUNKNO(KEYFLX(I)),I=1,NREGIO)
         ENDIF
         CALL XDRSET(FUNKNO,NUNKNO,0.0)
         DO 80 I=1,NREGIO
   80    FUNKNO(KEYFLX(I))=F1(I)+DDD*B2(4)*F2(I)
         IF(IMPX.GT.2) THEN
           WRITE(IOUT,'(//33H N E U T R O N    F L U X E S   :)')
           WRITE(IOUT,'(1P,6(5X,E15.7))') (FUNKNO(KEYFLX(I)),I=1,NREGIO)
         ENDIF
         DEALLOCATE(F2,F1)
      ELSE IF(ILEAK.EQ.5) THEN
*        ISOTROPIC STREAMING MODEL (ECCO).
         IF(.NOT.C_ASSOCIATED(IPSTR)) THEN
            CALL XABORT('FLUDB2: MISSING STREAMING INFO.')
         ENDIF
         IF(B2(4).NE.0.0) THEN
            DO 90 IREG=1,NREGIO
            IND=KEYFLX(IREG)
  90        SUNKNO(IND)=SUNKNO(IND)-B2(4)*FUNKNO(NUNKNO/2+IND)
         ENDIF
         CALL FMODUL(IPSYS,IPTRK,IFTRAK,IMPX,0,NREGIO,NBMIX,NUNKNO/2,
     >              MATCOD,VOLUME,KEYFLX,FUNKNO,SUNKNO,TITLE)
         CALL LCMLEN(IPSTR,'DRAGON-TXSC',ILCTXS,ITYLCM)
         ALLOCATE(SIGT0(0:ILCTXS-1))
         CALL LCMGET(IPSTR,'DRAGON-TXSC',SIGT0(0))
         ZNUM=0.0
         ZDEN=0.0
         DO 100 IREG=1,NREGIO
            IBM=MATCOD(IREG)
            IND=KEYFLX(IREG)
            ZNUM=ZNUM+SIGT0(IBM)*FUNKNO(IND)*VOLUME(IREG)
            ZDEN=ZDEN+FUNKNO(IND)*VOLUME(IREG)
 100     CONTINUE
         DO 110 IREG=1,NREGIO
         IBM=MATCOD(IREG)
         IND=KEYFLX(IREG)
 110     SUNKNO(NUNKNO/2+IND)=SUNKNO(NUNKNO/2+IND)+(1.0-GAMMA)
     >   *(ZNUM/ZDEN-SIGT0(IBM))*FUNKNO(NUNKNO/2+IND)
         DEALLOCATE(SIGT0)
         DO 120 IREG=1,NREGIO
         IND=KEYFLX(IREG)
 120     SUNKNO(NUNKNO/2+IND)=(SUNKNO(NUNKNO/2+IND)+FUNKNO(IND)/3.0)
     >   /GAMMA
         CALL FMODUL(IPSTR,IPTRK,IFTRAK,IMPX,0,NREGIO,NBMIX,NUNKNO/2,
     >              MATCOD,VOLUME,KEYFLX,FUNKNO(NUNKNO/2+1),
     >              SUNKNO(NUNKNO/2+1),TITLE)
      ELSE IF(ILEAK.GE.6) THEN
*        ANISOTROPIC STREAMING MODEL (TIBERE).
         INDD(1)=NUNKNO/4
         INDD(2)=NUNKNO/2
         INDD(3)=3*NUNKNO/4
         NUN4=NUNKNO/4
         ALLOCATE(PP(NREGIO*NREGIO))
         DO 145 IDIR=1,3
         IF(B2(IDIR).NE.0.0) THEN
            WRITE(TEXT12,'(6HDRAGON,I1,5HP*SCT)') IDIR
            CALL LCMGET(IPSYS,TEXT12,PP)
            DO 140 IREG=1,NREGIO
            IND=KEYFLX(IREG)
            S=0.0
            DO 130 JREG=1,NREGIO
            JND=KEYFLX(JREG)
 130        S=S+FUNKNO(INDD(IDIR)+JND)*PP((JREG-1)*NREGIO+IREG)
 140        SUNKNO(IND)=SUNKNO(IND)-B2(IDIR)*S
         ENDIF
 145     CONTINUE
         DEALLOCATE(PP)
         CALL FMODUL(IPSYS,IPTRK,IFTRAK,IMPX,0,NREGIO,NBMIX,NUN4,
     >              MATCOD,VOLUME,KEYFLX,FUNKNO,SUNKNO,TITLE)
         CALL LCMLEN(IPSYS,'DRAGON-TXSC',ILCTXS,ITYLCM)
         ALLOCATE(SIGT0(0:ILCTXS-1))
         CALL LCMGET(IPSYS,'DRAGON-TXSC',SIGT0(0))
         ZNUM=0.0
         ZDEN=0.0
         DO 150 IREG=1,NREGIO
            IBM=MATCOD(IREG)
            IND=KEYFLX(IREG)
            ZNUM=ZNUM+SIGT0(IBM)*FUNKNO(IND)*VOLUME(IREG)
            ZDEN=ZDEN+FUNKNO(IND)*VOLUME(IREG)
 150     CONTINUE
         DO 180 IDIR=1,3
         DO 160 IREG=1,NREGIO
         IBM=MATCOD(IREG)
         IND=KEYFLX(IREG)
 160     SUNKNO(INDD(IDIR)+IND)=SUNKNO(INDD(IDIR)+IND)+(1.0-GAMMA)
     >   *(ZNUM/ZDEN-SIGT0(IBM))*FUNKNO(INDD(IDIR)+IND)
         DO 170 IND=1,NUN4
 170     SUNKNO(INDD(IDIR)+IND)=(SUNKNO(INDD(IDIR)+IND)+FUNKNO(IND)/3.0)
     >   /GAMMA
         CALL FMODUL(IPSYS,IPTRK,IFTRAK,IMPX,IDIR,NREGIO,NBMIX,NUN4,
     >              MATCOD,VOLUME,KEYFLX,FUNKNO(INDD(IDIR)+1),
     >              SUNKNO(INDD(IDIR)+1),TITLE)
 180     CONTINUE
         DEALLOCATE(SIGT0)
      ENDIF
      IF((ILEAK.EQ.1).OR.(ILEAK.EQ.2).OR.(ILEAK.EQ.4)) THEN
         DEALLOCATE(SIGS0,SIGT0)
      ENDIF
*----
*  COMPUTE DB2 PARAMETER CORRESPONDING TO ACTUAL LEAKAGE
*----
      IF(IMPX.GT.10) THEN
         NUN=NUNKNO
         IF(ILEAK.EQ.5) NUN=NUNKNO/2
         IF(ILEAK.GE.6) NUN=NUNKNO/4
         DB2NEW=FLUFUI(IPSYS,NREGIO,NUN,MATCOD,VOLUME,KEYFLX,FUNKNO,
     >                 SUNKN)
         WRITE(IOUT,'(43HFLUDB2: DB2 LEAKAGE PARAMETER FROM DIFFON =,1P,
     >   E13.4/13X,30HACTUAL DB2 LEAKAGE PARAMETER =,E13.4)') DDD*B2(4),
     >   DB2NEW
         DEALLOCATE(SUNKN)
      ENDIF
      RETURN
      END
