*DECK EDIBAL
      SUBROUTINE EDIBAL(IPEDIT,IPFLUX,IPRINT,NL,IFFAC,NGCOND,NMERGE,
     >                  EIGENK,RATECM,FLUXCM,SCATTS,ILEAKS,B2,NW,
     >                  NTAUXT)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Four factor calculation.
*
*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): G. Marleau
*
*Parameters: input
* IPEDIT  pointer to the edition LCM object.
* IPFLUX  pointer to the flux LCM object.
* IPRINT  print level:
*         =1 neutron balance or four factor;
*         =2 material analysis (if available).
* NL      number of Legendre orders.
* IFFAC   number of neutrons in bilan.
* NGCOND  number of condensed groups.
* NMERGE  number of merge regions.
* EIGENK  problem eigenvalue.
* RATECM  averaged region/group cross sections:
*         = RATECM(*,1) = total P0;
*         = RATECM(*,2) = total P1;
*         = RATECM(*,NW+2) = absorption;
*         = RATECM(*,NW+3) = fission;
*         = RATECM(*,NW+4) = fixed sources / productions;
*         = RATECM(*,NW+5) = leakage;
*         = RATECM(*,NW+6) = total out of group scattering;
*         = RATECM(*,NW+7) = diagonal scattering x-s;
*         = RATECM(*,NW+8) = chi;
*         = RATECM(*,NW+9) = wims type transport correction;
*         = RATECM(*,NW+10) = x-directed leakage;
*         = RATECM(*,NW+11) = y-directed leakage;
*         = RATECM(*,NW+12) = z-directed leakage.
* FLUXCM  integrated region/group fluxes:
*         = FLUXCM(*,1) = fluxes P0;
*         = FLUXCM(*,2) = fluxes P1;
* SCATTS  scattering matrix.
* ILEAKS  leakage calculation flag:
*         = 0 no leakage;
*         = 1 homogeneous leakage (Diffon);
*         = 2 isotropic streaming (Ecco);
*         = 3 anisotropic streaming (Tibere).
* B2      square buckling:
*         for ILEAKS=1,2: B2(4) is homogeneous;
*         for ILEAKS=3: B2(1),B2(2),B2(3) are directional heterogeneous
*         and B2(4) is homogeneous.
* NW      type of weighting for PN cross section info (=0 P0; =1 P1).
* NTAUXT  number of reaction rate edits (=12+NW+2*NDEL).
*
*-----------------------------------------------------------------------
*
      USE GANLIB
*----
*  SUBROUTINE ARGUMENTS
*----
      TYPE(C_PTR)    IPEDIT,IPFLUX
      INTEGER        IPRINT,NL,IFFAC,NGCOND,NMERGE,ILEAKS,NW,NTAUXT
      REAL           EIGENK,RATECM(NMERGE,NGCOND,NTAUXT),
     >               FLUXCM(NMERGE,NGCOND,NW+1),
     >               SCATTS(NMERGE,NGCOND,NGCOND,NL),B2(4)
*----
*  LOCAL VARIABLES
*----
      SAVE           CNAMAT
      PARAMETER     (IUNOUT=6,INAMAT=2)
      CHARACTER      CNAMAT(INAMAT)*15
      REAL           XN(8)
      DOUBLE PRECISION DACCK,BUCKL2,XNF(3),XKINF,XN1,XN2,XN3,XN4,XN5,
     > XN6,XKEFF,XA,XLAMF,XLAMTH,XNORMF,XAUX
      INTEGER, ALLOCATABLE, DIMENSION(:) :: ITYPER
      REAL, ALLOCATABLE, DIMENSION(:,:) :: FLXINT
      DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: DLEAK
      DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:) :: DRATE
      DATA          (CNAMAT(JJ),JJ=1,INAMAT)
     >           /'  FUEL         ','NON-FUEL       '/
*----
*  SCRATCH STORAGE ALLOCATION
*   ITYPER  region type.
*   FLXINT  integrated flux.
*   DRATE   group reaction rates:
*           DRATE(1,*,*)  for fuel;
*           DRATE(2,*,*)  for non-fuel;
*           DRATE(*,1,*)  production;
*           DRATE(*,2,*)  absorption;
*           DRATE(*,*,ngcond+1)  group total.
*   DLEAK   group leak rates:
*           DLEAK(1,*)  leakage;
*           DLEAK(2,*)  leakage + absorption;
*           DLEAK(*,ngcond+1)  group total.
*----
      ALLOCATE(ITYPER(NMERGE))
      ALLOCATE(FLXINT(NMERGE,NGCOND))
      ALLOCATE(DRATE(2,2,NGCOND+1),DLEAK(2,NGCOND+1))
*----
*  LOCALIZE FUEL AND NON-FUEL REGION
*----
      NGC1=NGCOND+1
      DO 100 IGR=1,NGC1
        DO 110 IRAT=1,2
          DRATE(1,IRAT,IGR)=0.0D0
          DRATE(2,IRAT,IGR)=0.0D0
 110    CONTINUE
        DLEAK(1,IGR)=0.0D0
        DLEAK(2,IGR)=0.0D0
 100  CONTINUE
      DO 120 IREG=1,NMERGE
        ITYPER(IREG)=2
 120  CONTINUE
      DO 130 IGR=1,NGCOND
        DO 140 IREG=1,NMERGE
          IF(RATECM(IREG,IGR,NW+3).GT.0.0) ITYPER(IREG)=1
 140    CONTINUE
 130  CONTINUE
*----
*  GET BUCKL2
*----
      CALL LCMLEN(IPFLUX,'B2  B1HOM',ILCMLN,ILCMTY)
      IF(ILCMLN.EQ.1) THEN
        CALL LCMGET(IPFLUX,'B2  B1HOM',BL2)
        BUCKL2=DBLE(BL2)
      ELSE
        BUCKL2=0.0D0
      ENDIF
      IF(EIGENK.EQ.0.0) THEN
        WRITE(IUNOUT,7000)
        FLXRGE=1.0
        FLXREN=1.0
        DACCK=1.0D0
        WRITE(IUNOUT,6000)
      ELSE
        FLXRGE=REAL(IFFAC)
        FLXREN=REAL(IFFAC)*EIGENK
        DACCK=DBLE(EIGENK)
        IF(NGCOND.NE.3) THEN
          WRITE(IUNOUT,7001) NGCOND
          WRITE(IUNOUT,6001)
        ELSE
          WRITE(IUNOUT,6002)
        ENDIF
      ENDIF
      IF(IPRINT.EQ.1) THEN
        WRITE(IUNOUT,6100)
        WRITE(IUNOUT,6101)(IREG,CNAMAT(ITYPER(IREG)),IREG=1,NMERGE)
      ENDIF
*----
*  FIND INTEGRATED FLUX DIVIDED BY SPH FACTOR
*----
      DO 150 IGR=1,NGCOND
        DO 160 IREG=1,NMERGE
          FLXINT(IREG,IGR)=FLUXCM(IREG,IGR,1)
 160    CONTINUE
 150  CONTINUE
      IF(IPRINT.GE.1) THEN
        WRITE(IUNOUT,6200)
      ENDIF
      DO 170 IGR=1,NGCOND
*----
*  REACTION RATES PER GROUP AND MATERIAL TYPE
*----
        IF(IPRINT.GE.1) THEN
          WRITE(IUNOUT,6201) IGR,NGCOND
        ENDIF
        DO 180 IREG=1,NMERGE
*----
*  ADD PRODUCTION AND ABSORPTION IN MATERIAL TYPE
*----
          IF(ITYPER(IREG).EQ.1) THEN
            DRATE(1,1,IGR)=DRATE(1,1,IGR)+DBLE(RATECM(IREG,IGR,NW+4))
     >                   *DBLE(FLXINT(IREG,IGR))
            DRATE(1,2,IGR)=DRATE(1,2,IGR)+DBLE(RATECM(IREG,IGR,NW+2))
     >                   *DBLE(FLXINT(IREG,IGR))
          ELSE
            DRATE(2,1,IGR)=DRATE(2,1,IGR)+DBLE(RATECM(IREG,IGR,NW+4))
     >                   *DBLE(FLXINT(IREG,IGR))
            DRATE(2,2,IGR)=DRATE(2,2,IGR)+DBLE(RATECM(IREG,IGR,NW+2))
     >                   *DBLE(FLXINT(IREG,IGR))
          ENDIF
*----
*  PRINT PRODUCTION AND ABSORPTION PER REGION
*----
          IF(IPRINT.GE.2) THEN
            IF(IFFAC.EQ.1000) THEN
              WRITE(IUNOUT,6300) IREG,CNAMAT(ITYPER(IREG)),
     >                  FLXRGE*RATECM(IREG,IGR,NW+4)*FLXINT(IREG,IGR),
     >                  FLXREN*RATECM(IREG,IGR,NW+2)*FLXINT(IREG,IGR)
            ELSE
              WRITE(IUNOUT,6301) IREG,CNAMAT(ITYPER(IREG)),
     >                  FLXRGE*RATECM(IREG,IGR,NW+4)*FLXINT(IREG,IGR),
     >                  FLXREN*RATECM(IREG,IGR,NW+2)*FLXINT(IREG,IGR)
            ENDIF
          ENDIF
*----
*  ADD GROUP LEAKAGE
*----
          IF((ILEAKS.EQ.1).OR.(ILEAKS.EQ.2)) THEN
            DLEAK(1,IGR)=DLEAK(1,IGR)+DBLE(RATECM(IREG,IGR,NW+5))
     >                        *B2(4)*DBLE(FLXINT(IREG,IGR))
          ELSE IF(ILEAKS.EQ.3) THEN
            DLEAK(1,IGR)=DLEAK(1,IGR)+DBLE(FLXINT(IREG,IGR))
     >       *(DBLE(RATECM(IREG,IGR,NW+10))*B2(1)
     >        +DBLE(RATECM(IREG,IGR,NW+11))*B2(2)
     >        +DBLE(RATECM(IREG,IGR,NW+12))*B2(3))
          ELSE
            DO 190 JGR=1,NGCOND
              IF(JGR.NE.IGR)
     >          DLEAK(2,IGR)=DLEAK(2,IGR)+DBLE(SCATTS(IREG,IGR,JGR,1))
     >               *DBLE(FLXINT(IREG,JGR))
 190        CONTINUE
            DLEAK(2,IGR)=DLEAK(2,IGR)+DBLE(FLXINT(IREG,IGR))*
     >                     ( DBLE(RATECM(IREG,IGR,NW+4))/DACCK
     >                      -DBLE(RATECM(IREG,IGR,1))
     >                      +DBLE(RATECM(IREG,IGR,NW+2))
     >                      +DBLE(SCATTS(IREG,IGR,IGR,1)) )
          ENDIF
 180    CONTINUE
        IF((ILEAKS.EQ.1).OR.(ILEAKS.EQ.2)) THEN
          DLEAK(2,IGR)=DLEAK(1,IGR)+DRATE(1,2,IGR)+DRATE(2,2,IGR)
        ELSE
          DLEAK(1,IGR)=DLEAK(2,IGR)-DRATE(1,2,IGR)-DRATE(2,2,IGR)
        ENDIF
*----
*  PRINT PRODUCTION AND ABSORPTION PER MATERIAL TYPE AND TOTAL
*  PRODUCTION, ABSORPTION, LEAKAGE AND LEAKAGE+ABSORPTION
*----
        IF(IPRINT.GE.1) THEN
          IF(IFFAC.EQ.1000) THEN
            WRITE(IUNOUT,6302) 'TOTAL FUEL     ',
     >                  FLXRGE*DRATE(1,1,IGR),
     >                  FLXREN*DRATE(1,2,IGR)
            WRITE(IUNOUT,6302) 'TOTAL NON-FUEL ',
     >                  FLXRGE*DRATE(2,1,IGR),
     >                  FLXREN*DRATE(2,2,IGR)
            WRITE(IUNOUT,6302) 'FUEL + NON-FUEL',
     >                  FLXRGE*(DRATE(1,1,IGR)+DRATE(2,1,IGR)),
     >                  FLXREN*(DRATE(1,2,IGR)+DRATE(2,2,IGR)),
     >                  FLXREN*DLEAK(1,IGR),FLXREN*DLEAK(2,IGR)
          ELSE
            WRITE(IUNOUT,6303) 'TOTAL FUEL     ',
     >                  FLXRGE*DRATE(1,1,IGR),
     >                  FLXREN*DRATE(1,2,IGR)
            WRITE(IUNOUT,6303) 'TOTAL NON-FUEL ',
     >                  FLXRGE*DRATE(2,1,IGR),
     >                  FLXREN*DRATE(2,2,IGR)
            WRITE(IUNOUT,6303) 'FUEL + NON-FUEL',
     >                  FLXRGE*(DRATE(1,1,IGR)+DRATE(2,1,IGR)),
     >                  FLXREN*(DRATE(1,2,IGR)+DRATE(2,2,IGR)),
     >                  FLXREN*DLEAK(1,IGR),FLXREN*DLEAK(2,IGR)
          ENDIF
        ENDIF
*----
*  GROUP SUM
*----
        DRATE(1,1,NGC1)=DRATE(1,1,NGC1)+DRATE(1,1,IGR)
        DRATE(2,1,NGC1)=DRATE(2,1,NGC1)+DRATE(2,1,IGR)
        DRATE(1,2,NGC1)=DRATE(1,2,NGC1)+DRATE(1,2,IGR)
        DRATE(2,2,NGC1)=DRATE(2,2,NGC1)+DRATE(2,2,IGR)
        DLEAK(1,NGC1)=DLEAK(1,NGC1)+DLEAK(1,IGR)
        DLEAK(2,NGC1)=DLEAK(2,NGC1)+DLEAK(2,IGR)
 170  CONTINUE
      IF(NGCOND.GT.1) THEN
        WRITE(IUNOUT,6202)
        IF(IFFAC.EQ.1000) THEN
          WRITE(IUNOUT,6302) 'TOTAL FUEL     ',
     >                FLXRGE*DRATE(1,1,NGC1),
     >                FLXREN*DRATE(1,2,NGC1)
          WRITE(IUNOUT,6302) 'TOTAL NON-FUEL ',
     >                FLXRGE*DRATE(2,1,NGC1),
     >                FLXREN*DRATE(2,2,NGC1)
          WRITE(IUNOUT,6302) 'FUEL + NON-FUEL',
     >                FLXRGE*(DRATE(1,1,NGC1)+DRATE(2,1,NGC1)),
     >                FLXREN*(DRATE(1,2,NGC1)+DRATE(2,2,NGC1)),
     >                FLXREN*DLEAK(1,NGC1),FLXREN*DLEAK(2,NGC1)
        ELSE
          WRITE(IUNOUT,6303) 'TOTAL FUEL     ',
     >                FLXRGE*DRATE(1,1,NGC1),
     >                FLXREN*DRATE(1,2,NGC1)
          WRITE(IUNOUT,6303) 'TOTAL NON-FUEL ',
     >                FLXRGE*DRATE(2,1,NGC1),
     >                FLXREN*DRATE(2,2,NGC1)
          WRITE(IUNOUT,6303) 'FUEL + NON-FUEL',
     >                FLXRGE*(DRATE(1,1,NGC1)+DRATE(2,1,NGC1)),
     >                FLXREN*(DRATE(1,2,NGC1)+DRATE(2,2,NGC1)),
     >                FLXREN*DLEAK(1,NGC1),FLXREN*DLEAK(2,NGC1)
        ENDIF
      ENDIF
      IF( (EIGENK.GT.0.0) .AND. (NGCOND.EQ.3) ) THEN
*----
*  FOUR FACTOR CALCULATION
*----
        XNF(1)=0.0D0
        XNF(2)=0.0D0
        XNF(3)=0.0D0
        DO 200 IREG=1,NMERGE
*----
*  ADD NUSIGF AND TOTAL RATES IN FUEL
*----
          IF(ITYPER(IREG).EQ.1) THEN
            XNF(3)=XNF(3)+DBLE(RATECM(IREG,3,NW+3))*DBLE(FLXINT(IREG,3))
            XNF(2)=XNF(2)+DBLE(RATECM(IREG,2,NW+3))*DBLE(FLXINT(IREG,2))
            XNF(1)=XNF(1)+DBLE(RATECM(IREG,1,NW+3))*DBLE(FLXINT(IREG,1))
          ENDIF
 200    CONTINUE
        XKINF=DRATE(1,1,4)/(DRATE(1,2,4)+DRATE(2,2,4))
        XKEFF=DRATE(1,1,4)/DLEAK(2,4)
        XN1=(DRATE(1,1,4)/XKEFF)-DLEAK(1,4)
        XN2=XN1-(DRATE(1,2,1)+DRATE(2,2,1))
        XN3=XN2-(DRATE(1,2,2)+DRATE(2,2,2))
        XN4=XN3-DRATE(2,2,3)
        XN5=XNF(2)+XNF(3)
        XN6=XN5+XNF(1)
*----
*  COMPUTATION OF EPSILON, F, ETA, P, LAMBDAF, LAMBDATH, KINF, KEFF
*----
        XN(1)=REAL((XN6-DRATE(1,2,1)-DRATE(2,2,1))/XN5)
        XN(5)=REAL(XN4/XN3)
        XN(6)=REAL(XN5/XN4)
        XN(3)=REAL(XKINF)/(XN(1)*XN(5)*XN(6))
        XA=DRATE(1,2,4)+DRATE(2,2,4)
        XLAMF=1/(1+((DLEAK(1,1)+DLEAK(1,2))/XA))
        XLAMTH=1/(1+(DLEAK(1,3)/XA))
        XAUX=XLAMF*XLAMTH
        XNORMF=XKEFF/(XKINF*XAUX)
        XN(2)=REAL(XLAMF*SQRT(XNORMF))
        XN(4)=REAL(XLAMTH*SQRT(XNORMF))
        XN(7)=XN(1)*XN(3)*XN(5)*XN(6)
        XN(8)=XN(7)*XN(2)*XN(4)
        IF(IPRINT.GE.1) THEN
          WRITE(IUNOUT,6400) (XN(JJ),JJ=1,8)
        ENDIF
        CALL LCMPUT(IPEDIT,'FOUR-FACTOR ',8,2,XN)
      ENDIF
*----
*  SCRATCH STORAGE DEALLOCATION
*----
      DEALLOCATE(DLEAK,DRATE)
      DEALLOCATE(FLXINT)
      DEALLOCATE(ITYPER)
      RETURN
*----
*  PRINT FORMATS
*----
 6000 FORMAT(/20X,'F I X E D    S O U R C E',
     >'    N E U T R O N    B A L A N C E')
 6001 FORMAT(/20X,'S I M P L E    N E U T R O N    B A L A N C E')
 6002 FORMAT(/20X,'F O U R    F A C T O R    C A L C U L A T I O N')
 6100 FORMAT(4(4X,'REGION',5X,'MATERIAL TYPE  '))
 6101 FORMAT(4(5X,I5,5X,A15))
 6200 FORMAT(15X,' REGION',3X,'MATERIAL TYPE  ',3X,'NEUTRON PRODUCTION',
     >       3X,'NEUTRON ABSORPTION',3X,'NEUTRON LEAKAGE   ',
     >       3X,'ABSORPTION+LEAKAGE')
 6201 FORMAT(' GROUP :',I3,'/',I3)
 6202 FORMAT(' SUM OVER GROUPS')
 6300 FORMAT(17X,I5,3X,A15,3X,F12.1,8X,F12.1)
 6301 FORMAT(17X,I5,3X,A15,3X,1P,E15.7,5X,E15.7)
 6302 FORMAT(25X,A15,3X,F12.1,8X,F12.1,8X,F12.1,8X,F12.1)
 6303 FORMAT(25X,A15,3X,1P,E15.7,5X,E15.7,5X,E15.7,5X,E15.7)
 6400 FORMAT(/' FOUR FACTORS'/1P,
     >        ' EPSILON (FAST FISSION FACTOR)  =',E15.7/
     >        ' LAMBDAF (FAST NON-LEAKAGE)     =',E15.7/
     >        ' P (ANTITRAP FACTOR)            =',E15.7/
     >        ' LAMBDAT (THERMAL NON-LEAKAGE)  =',E15.7/
     >        ' F (THERMAL UTILIZATION FACTOR) =',E15.7/
     >        ' ETA (THERMAL REPRODUCTION)     =',E15.7/
     >        ' INFINITE MULTIPLICATION (4F)   =',E15.7/
     >        ' EFFECTIVE MULTIPLICATION       =',E15.7)
*----
*  WARNING FORMATS
*----
 7000 FORMAT(' * * *  W A R N I N G  * * * ',/
     >       ' NO FOUR FACTOR CALCULATION PERMITTED FOR FIXED SOURCE',
     >       ' PROBLEM',/' A SIMPLE GROUP BY GROUP NEUTRON',
     >       ' BALANCE PERFORMED HERE')
 7001 FORMAT(' * * *  W A R N I N G  * * * ',/
     >       ' FOUR FACTOR CALCULATION REQUIRES 3 GROUPS, NUMBER OF',
     >       ' GROUPS HERE IS =',I10/' A SIMPLE GROUP BY GROUP NEUTRON',
     >       ' BALANCE PERFORMED HERE')
      END
