*DECK FLPDRV
      SUBROUTINE FLPDRV(IPPOW,IPNFX,IPFLX,IPKIN,IPTRK,IPMTX,IPMAP,
     1 IPMAC,PTOT,LNEW,LMAP,JMOD,LFLX,LPOW,LRAT,IMPX,FSTH,LFSTH,LFLU,
     2 LBUN,LNRM)
*
*-----------------------------------------------------------------------
*
*Purpose:
* driver for the powers and fluxes computations.
*
*Copyright:
* Copyright (C) 2007 Ecole Polytechnique de Montreal.
*
*Author(s): D. Sekki, M. Guyot
*
*Parameters: input/output
* IPPOW  pointer to power information.
* IPFLX  pointer to flux information.
* IPKIN  pointer to kinetics information.
* IPTRK  pointer to tracking information.
* IPMTX  pointer to matex information.
* IPMAP  pointer to fuel-map information.
* IPMAC  pointer to macrolib information.
* PTOT   given total reactor power in mega-watts.
* LNEW   new total power flag (=.true. for new computation).
* LMAP   fuel-map printing on file flag (=.true. for print).
* JMOD   modification index for L_MAP object.
* LFLX   flux printing on file flag (=.true. for print).
* LPOW   power printing on file flag (=.true. for print).
* LRAT   flux-ratio printing on file flag (=.true. for print).
* IMPX   printing on screen index (=0 for no print).
* FSTH   thermal to fission power ratio
* LFSTH  =.true if the thermal fission ratio is specified
* LFLU   =.true. if an output flux is to be created
* LBUN   =.true. if the output flux is a flux per bundle
* LNRM   =.true. if the output flux is a flux per mesh-splitted element
*
*-----------------------------------------------------------------------
*
      USE GANLIB
*----
*  SUBROUTINE ARGUMENTS
*----
      TYPE(C_PTR) IPPOW,IPNFX,IPFLX,IPKIN,IPTRK,IPMTX,IPMAP,IPMAC
      INTEGER JMOD,IMPX
      LOGICAL LNEW,LMAP,LFLX,LPOW,LRAT,LFSTH,LFLU,LBUN,LNRM
      REAL PTOT,FSTH
*----
*  LOCAL VARIABLES
*----
      PARAMETER(NSTATE=40)
      INTEGER KCHAR(3),ISTATE(NSTATE),IGR,NUN,NGRP,IGEO
      DOUBLE PRECISION ZNRM,VTOT,POWR
      CHARACTER HSIGN*12
      TYPE(C_PTR) JPMAC,KPMAC,MPFLUX
      INTEGER, ALLOCATABLE, DIMENSION(:) :: MAT,IDL
      REAL, ALLOCATABLE, DIMENSION(:) :: HFC,VECT,FLUX,VOL,FXYZ,RAT,
     1 PXYZ,FMAP,POWC,POWB,VECNR
*----
*  CHECK THE TYPE OF FLUX SELECTED FOR OUTPUT
*----
      IF(LFLU)THEN
        IF(LNRM.AND.LBUN) CALL XABORT('@FLPDRV: KEYWORD NORM AND BUND '
     1    //'BOTH SELECTED.')
        IF((.NOT.LNRM).AND.(.NOT.LBUN)) THEN
          LNRM=.TRUE.
          WRITE(6,*) 'FLPDRV: default option for L_FLUX object is NORM.'
        ENDIF
      ENDIF
*----
*  RECOVER INFORMATION
*----
      CALL XDISET(ISTATE,NSTATE,0)
      IF(C_ASSOCIATED(IPFLX)) THEN
*       L_FLUX object
        CALL LCMGET(IPFLX,'STATE-VECTOR',ISTATE)
        NGRP=ISTATE(1)
        NUN=ISTATE(2)
        CALL LCMGET(IPFLX,'K-EFFECTIVE',FKEFF)
      ELSE IF(C_ASSOCIATED(IPKIN)) THEN
*       L_KINET object
        CALL LCMGET(IPKIN,'STATE-VECTOR',ISTATE)
        NGRP=ISTATE(3)
        NUN=ISTATE(7)
        CALL LCMGET(IPKIN,'E-KEFF',FKEFF)
        CALL LCMGET(IPKIN,'E-POW',PTOT)
      ENDIF
      CALL XDISET(ISTATE,NSTATE,0)
      CALL LCMGET(IPTRK,'STATE-VECTOR',ISTATE)
      NEL=ISTATE(1)
      IF(ISTATE(2).NE.NUN) CALL XABORT('@FLPDRV: INCOMPATIBLE L_TRACK '
     1 //'AND L_FLUX/L_KINET OBJECTS')
      LX=ISTATE(14)
      LY=ISTATE(15)
      LZ=ISTATE(16)
      CALL XDISET(ISTATE,NSTATE,0)
      IF(.NOT.C_ASSOCIATED(IPMAC))THEN
        CALL LCMGET(IPMAP,'STATE-VECTOR',ISTATE)
        NB=ISTATE(1)
        NCH=ISTATE(2)
        IGEO=ISTATE(12)
        IF((IGEO.NE.7).AND.(IGEO.NE.9))CALL XABORT('@FLPDRV: INVALID'
     1   //' GEOMETRY IN FUEL MAP : ONLY 3-D CARTESIAN OR 3-D'
     2  //' HEXAGONAL GEOMETRIES AVAIlABLE') 
        IF(ISTATE(4).NE.NGRP)CALL XABORT('@FLPDRV: INVALID NUM'
     1   //'BER OF ENERGY GROUPS IN FUEL MAP OR FLUX.')
        CALL XDISET(ISTATE,NSTATE,0)
        CALL LCMGET(IPMTX,'STATE-VECTOR',ISTATE)
        NMIX=ISTATE(2)
        NTOT=ISTATE(5)
        IF(ISTATE(6).NE.IGEO)CALL XABORT('@FLPDRV: GEOMETRIES IN'
     1   //' MATEX AND FUEL MAP ARE DIFFERENT')
        IF(ISTATE(7).NE.NEL)CALL XABORT('@FLPDRV: INVALID TOTAL'
     1   //' NUMBER OF REGIONS IN FUEL MAP OR TRACK.')
        ALLOCATE(HFC(NMIX*NGRP))
        CALL XDRSET(HFC,NMIX*NGRP,0.)
        CALL LCMGET(IPMTX,'H-FACTOR',HFC)
      ELSE
        CALL LCMGET(IPMAC,'STATE-VECTOR',ISTATE)
        IF(ISTATE(1).NE.NGRP)CALL XABORT('@FLPDRV: INVALID NUM'
     1   //'BER OF ENERGY GROUPS IN MACROLIB OR FLUX.')
        NMIX=ISTATE(2)
        ALLOCATE(HFC(NMIX*NGRP))
        JPMAC=LCMGID(IPMAC,'GROUP')
        DO JGR=1,NGRP
          KPMAC=LCMGIL(JPMAC,JGR)
          CALL LCMLEN(KPMAC,'H-FACTOR',LENGT,ITYP)
          IF(LENGT.NE.NMIX)CALL XABORT('@FLPDRV: UNABLE TO F'
     1    //'IND H-FACTOR BLOCK DATA IN THE MACROLIB.')
          CALL LCMGET(KPMAC,'H-FACTOR',HFC((JGR-1)*NMIX+1))
        ENDDO
      ENDIF
*----
*  FLUX NORMALIZATION
*----
      ALLOCATE(VECT(NUN*NGRP),FLUX(NEL*NGRP),MAT(NEL),VOL(NEL),IDL(NEL))
      IF(LNEW)THEN
*       NEW TOTAL REACTOR POWER
        CALL LCMLEN(IPPOW,'NORM',LENGT,ITYP)
        IF(LENGT.EQ.0)CALL XABORT('@FLPDRV: UNABLE TO F'
     1   //'IND FLUX NORMALIZATION FACTOR IN L_POWER.')
        CALL LCMGET(IPPOW,'NORM',ZNRM)
        CALL FLPTOT(IPFLX,IPKIN,IPTRK,NMIX,NGRP,NEL,NUN,VECT,FLUX,MAT,
     1  VOL,IDL,HFC,POWR,ZNRM,IMPX)
      ELSE
*       GIVEN TOTAL REACTOR POWER
        POWR=DBLE(PTOT*10**6)
        IF(PTOT.EQ.0.0)CALL XABORT('@FLPDRV: PTOT IS NOT DEFINED')
        CALL FLPNRM(IPFLX,IPKIN,IPTRK,NMIX,NGRP,NEL,NUN,VECT,FLUX,MAT,
     1  VOL,IDL,HFC,POWR,ZNRM,IMPX)
        CALL LCMPUT(IPPOW,'NORM',2,4,ZNRM)
      ENDIF
      DEALLOCATE(IDL)
      CALL LCMPUT(IPPOW,'FLUX',NEL*NGRP,2,FLUX)
      POWR=POWR/(10**6)
      CALL LCMPUT(IPPOW,'PTOT',2,4,POWR)
*----
*  WHOLE REACTOR
*----
      ALLOCATE(FXYZ(NEL*NGRP),RAT(NEL*(NGRP-1)))
*     FLUX DISTRIBUTION
      IF(IGEO.EQ.7) THEN
        CALL FLPFLX(NGRP,NEL,LX,LY,LZ,MAT,VOL,FLUX,FXYZ,RAT,VTOT,IMPX,
     1  LFLX,LRAT)
      ELSEIF(IGEO.EQ.9) THEN
        CALL FLPHFX(NGRP,NEL,LX,LZ,MAT,VOL,FLUX,FXYZ,RAT,VTOT,IMPX,
     1  LFLX,LRAT)
      ENDIF
      CALL LCMPUT(IPPOW,'VTOT',2,4,VTOT)
      CALL LCMPUT(IPPOW,'FLUX-DISTR',NEL*NGRP,2,FXYZ)
      CALL LCMPUT(IPPOW,'FLUX-RATIO',NEL*(NGRP-1),2,RAT)
      DEALLOCATE(RAT,FXYZ)
*     POWER DISTRIBUTION
      ALLOCATE(PXYZ(NEL))
      IF(IGEO.EQ.7) THEN
        CALL FLPOWR(NMIX,NGRP,NEL,LX,LY,LZ,MAT,VOL,FLUX,HFC,PXYZ,VTOT,
     1  IMPX,LPOW)
      ELSEIF(IGEO.EQ.9) THEN
        CALL FLPHPW(NMIX,NGRP,NEL,LX,LZ,MAT,VOL,FLUX,HFC,PXYZ,VTOT,
     1  IMPX,LPOW)
      ENDIF
      CALL LCMPUT(IPPOW,'POWER-DISTR',NEL,2,PXYZ)
      DEALLOCATE(PXYZ)
      CALL LCMPUT(IPPOW,'K-EFFECTIVE',1,2,FKEFF)
*----
*  FUEL-MAP
*----
      IF((C_ASSOCIATED(IPMAP)).AND.(C_ASSOCIATED(IPMTX))) THEN
        ALLOCATE(FMAP(NCH*NB*NGRP))
*       COMPUTE FLUXES
        CALL FLPFLB(IPMTX,NTOT,NGRP,NEL,NCH,NB,FLUX,VOL,FMAP,IMPX,LMAP)
        CALL LCMPUT(IPPOW,'FLUX-BUND',NCH*NB*NGRP,2,FMAP)
        ALLOCATE(POWC(NCH),POWB(NCH*NB))
*       COMPUTE POWERS
        CALL FLPOWB(IPPOW,IPMAP,IPMTX,NMIX,NTOT,NGRP,NCH,NB,NEL,MAT,
     1  VOL,HFC,FLUX,POWB,POWC,IMPX,POWR,FSTH,LFSTH,FMAP,IGEO)
        CALL LCMPUT(IPPOW,'POWER-CHAN',NCH,2,POWC)
        CALL LCMPUT(IPPOW,'POWER-BUND',NCH*NB,2,POWB)
        CALL LCMPUT(IPPOW,'FLUX',NEL*NGRP,2,FLUX)
        CALL LCMPUT(IPPOW,'FLUX-BUND',NCH*NB*NGRP,2,FMAP)
        IF(JMOD.GE.1) THEN
          CALL LCMPUT(IPMAP,'TOT-PW',1,2,PTOT)
          CALL LCMPUT(IPMAP,'BUND-PW',NCH*NB,2,POWB)
          CALL LCMPUT(IPMAP,'FLUX-AV',NCH*NB*NGRP,2,FMAP)
          IF(JMOD.EQ.2) THEN
            CALL LCMPUT(IPMAP,'BUND-PW-INI',NCH*NB,2,POWB)
          ENDIF
        ENDIF
        DEALLOCATE(POWB,POWC)
      ENDIF
      DEALLOCATE(VOL,MAT,FLUX,HFC)

      IF(LFLU) THEN
*----
*  STATE-VECTOR FOR L_FLUX OBJECT
*----
        IF(LNRM) THEN
          CALL XDISET(ISTATE,NSTATE,0)
          IF(C_ASSOCIATED(IPFLX)) THEN
            CALL LCMGET(IPFLX,'STATE-VECTOR',ISTATE)
          ELSE IF(C_ASSOCIATED(IPKIN)) THEN
            ISTATE(1)=NGRP
            ISTATE(2)=NUN
          ENDIF
          CALL LCMPUT(IPNFX,'STATE-VECTOR',NSTATE,1,ISTATE)
          HSIGN='L_FLUX'
          READ(HSIGN,'(3A4)') (KCHAR(I),I=1,3)
          CALL LCMPUT(IPNFX,'SIGNATURE',3,3,KCHAR)
          ALLOCATE(VECNR(NUN*NGRP))
          DO 10 I=1,NUN*NGRP
            VECNR(I)=VECT(I)*REAL(ZNRM)
   10     CONTINUE
          MPFLUX=LCMLID(IPNFX,'FLUX',NGRP)
          DO 20 IGR=1,NGRP
            IOFSET=(IGR-1)*NUN
            CALL LCMPDL(MPFLUX,IGR,NUN,2,VECNR(IOFSET+1))
   20     CONTINUE        
          DEALLOCATE(VECNR)
        ELSE
          MPFLUX=LCMLID(IPNFX,'FLUX',NGRP)
          DO 30 IGR=1,NGRP
              IOFSET=(IGR-1)*NB*NCH
              CALL LCMPDL(MPFLUX,IGR,NB*NCH,2,FMAP(IOFSET+1))
   30     CONTINUE 
        ENDIF
      ENDIF
      IF(C_ASSOCIATED(IPMAP)) DEALLOCATE(FMAP)
      DEALLOCATE(VECT)
*----
*  STATE-VECTOR FOR L_FLUX OBJECT
*----
      IF(LFLU) THEN
        CALL XDISET(ISTATE,NSTATE,0)
        IF(C_ASSOCIATED(IPFLX)) THEN
          CALL LCMGET(IPFLX,'STATE-VECTOR',ISTATE)
        ELSE IF(C_ASSOCIATED(IPKIN)) THEN
          ISTATE(1)=NGRP
          ISTATE(2)=NUN
        ENDIF
        IF(LBUN) ISTATE(2)=NB*NCH
        CALL LCMPUT(IPNFX,'STATE-VECTOR',NSTATE,1,ISTATE)
        HSIGN='L_FLUX'
        READ(HSIGN,'(3A4)') (KCHAR(I),I=1,3)
        CALL LCMPUT(IPNFX,'SIGNATURE',3,3,KCHAR)
      ENDIF
*----
*  STATE-VECTOR FOR L_POWER OBJECT
*----
      CALL XDISET(ISTATE,NSTATE,0)
      ISTATE(1)=NGRP
      ISTATE(2)=NEL
      ISTATE(3)=LX
      ISTATE(4)=LY
      ISTATE(5)=LZ
      ISTATE(6)=NCH
      ISTATE(7)=NB
      ISTATE(8)=IGEO
      CALL LCMPUT(IPPOW,'STATE-VECTOR',NSTATE,1,ISTATE)
      HSIGN='L_POWER'
      READ(HSIGN,'(3A4)') (KCHAR(I),I=1,3)
      CALL LCMPUT(IPPOW,'SIGNATURE',3,3,KCHAR)
      IF(IMPX.GT.1)CALL LCMLIB(IPPOW)
      RETURN
      END
