*DECK BIVS05
      SUBROUTINE BIVS05(IELEM,ISPLH,LX,NUN,LL4,IIMAX,IZGLOB,KN,BFR,IDL,
     1 MU,SOURCE,SYS,FUNKNO)
*
*-----------------------------------------------------------------------
*
*Purpose:
* one-speed flux calculation in a Thomas-Raviart-Schneider (dual) finite
* element diffusion approximation (hexagonal geometry). Used in door
* BIVAF of Dragon.
*
*Copyright:
* Copyright (C) 2006 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
* IELEM   degree of the Lagrangian finite elements: =1 (linear);
*          =2 (parabolic); =3 (cubic).
* ISPLH   mesh-splitting index. Each hexagon is splitted into 3*ISPLH**2
*         lozenges.
* LX      number of hexagons in the W-X-Y plane.
* NUN     dimension of array FUNKNO.
* LL4     number of unknowns per group in BIVAC.
* IIMAX   allocated dimension of array SYS.
* IZGLOB  hexagon index assigned to each lozenge.
* KN      element-ordered unknown list.
* BFR     element-ordered surface fractions.
* IDL     position of the average flux component associated with each
*         volume.
* MU      indices used with compressed diagonal storage mode matrix SYS.
* SOURCE  fission and diffusion sources.
* SYS     factorized system matrix.
*
*Parameters: output
* FUNKNO  neutron fluxes (surface-averaged flux are in position
*         FUNKNO(NUN)).
*
*-----------------------------------------------------------------------
*
*----
*  SUBROUTINE ARGUMENTS
*----
      INTEGER IELEM,ISPLH,LX,NUN,LL4,IIMAX,IZGLOB(LX*ISPLH**2),
     1 KN(LX*ISPLH**2,4+6*IELEM*(IELEM+1)),IDL(LX),MU(LL4)
      REAL BFR(LX*ISPLH**2,6),SOURCE(LL4),SYS(IIMAX),FUNKNO(NUN)
*----
*  RESOLUTION.
*----
      DO 10 I=1,LL4
   10 FUNKNO(I)=SOURCE(I)
      CALL ALLDLS (LL4,MU,SYS,FUNKNO)
*----
*  CALCULATION OF ELEMENT-AVERAGED FLUXES.
*----
      DO 20 IHEX=1,LX
      IF(IDL(IHEX).NE.0) FUNKNO(IDL(IHEX))=0.0
   20 CONTINUE
      NBLOS=LX*ISPLH**2
      NUM=0
      DO 30 KEL=1,NBLOS
      IHEX=IZGLOB(KEL)
      IF(IHEX.EQ.0) GO TO 30
      NUM=NUM+1
      JND1=KN(NUM,1)
      JND2=KN(NUM,2)
      JND3=KN(NUM,3)
      TEMP=FUNKNO(JND1)+FUNKNO(JND2)+FUNKNO(JND3)
      FUNKNO(IDL(IHEX))=FUNKNO(IDL(IHEX))+TEMP/REAL(3*ISPLH**2)
   30 CONTINUE
*----
*  CALCULATION OF THE SURFACE-AVERAGED FLUX.
*----
      FUNKNO(NUN)=0.0
      NELEM=IELEM*(IELEM+1)
      NUM=0
      DO 100 KEL=1,NBLOS
      IF(IZGLOB(KEL).EQ.0) GO TO 100
      NUM=NUM+1
      IF(BFR(NUM,1).GT.0.0) THEN
         SG=1.0
         DO 40 I0=1,IELEM
         IND1=KN(NUM,1)+I0-1
         FUNKNO(NUN)=FUNKNO(NUN)+SG*SQRT(REAL(2*I0-1))*FUNKNO(IND1)*
     1   BFR(NUM,1)
   40    SG=-SG
      ENDIF
      IF(BFR(NUM,2).GT.0.0) THEN
         DO 50 I0=1,IELEM
         IND1=KN(NUM,2)+(I0-1)*IELEM
   50    FUNKNO(NUN)=FUNKNO(NUN)+SQRT(REAL(2*I0-1))*FUNKNO(IND1)*
     1   BFR(NUM,2)
      ENDIF
      IF(BFR(NUM,3).GT.0.0) THEN
         SG=1.0
         DO 60 I0=1,IELEM
         IND1=KN(NUM,2)+I0-1
         FUNKNO(NUN)=FUNKNO(NUN)+SG*SQRT(REAL(2*I0-1))*FUNKNO(IND1)*
     1   BFR(NUM,3)
   60    SG=-SG
      ENDIF
      IF(BFR(NUM,4).GT.0.0) THEN
         DO 70 I0=1,IELEM
         IND1=KN(NUM,3)+(I0-1)*IELEM
   70    FUNKNO(NUN)=FUNKNO(NUN)+SQRT(REAL(2*I0-1))*FUNKNO(IND1)*
     1   BFR(NUM,4)
      ENDIF
      IF(BFR(NUM,5).GT.0.0) THEN
         SG=1.0
         DO 80 I0=1,IELEM
         IND1=KN(NUM,3)+I0-1
         FUNKNO(NUN)=FUNKNO(NUN)+SG*SQRT(REAL(2*I0-1))*FUNKNO(IND1)*
     1   BFR(NUM,5)
   80    SG=-SG
      ENDIF
      IF(BFR(NUM,6).GT.0.0) THEN
         DO 90 I0=1,IELEM
         IND1=KN(NUM,4)+(I0-1)*IELEM
   90    FUNKNO(NUN)=FUNKNO(NUN)+SQRT(REAL(2*I0-1))*FUNKNO(IND1)*
     1   BFR(NUM,6)
      ENDIF
  100 CONTINUE
      RETURN
      END
