*DECK DOORFVR
      SUBROUTINE DOORFVR(CDOOR,IPSYS,NPSYS,IPTRK,IFTRAK,IMPX,NGRP,NMAT,
     1 IDIR,NREG,NUN,IPHASE,LEXAC,MAT,VOL,KEYFLX,TITR,SUNKNO,FUNKNO,
     2 IPMACR,REBFLG)
*
*-----------------------------------------------------------------------
*
*Purpose:
* calculation of the flux. Vectorial version. Multigroup rebalancing
* option.
*
*Copyright:
* Copyright (C) 2004 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. Le Tellier
*
*Parameters: input
* CDOOR   name of the geometry/solution operator.
* IPSYS   pointer to the assembly LCM object (L_PIJ signature). IPSYS is
*         a list of directories.
* NPSYS   index array pointing to the IPSYS list component corresponding
*         to each energy group. Set to zero if a group is not to be
*         processed. Usually, NPSYS(I)=I.
* IPTRK   pointer to the tracking (L_TRACK signature).
* IFTRAK  unit of the sequential binary tracking file.
* IMPX    print flag (equal to zero for no print).
* NGRP    number of energy groups.
* NMAT    number of mixtures in the internal library.
* IDIR    directional collision probability flag:
*         =0 for pij or wij;
*         =k for pijk or wijk k=1,2,3.
* NREG    total number of merged blocks for which specific values
*         of the neutron flux and reactions rates are required.
* NUN     total number of unknowns in vectors SUNKNO and FUNKNO.
* IPHASE  type of flux solution (=1: use a native flux solution door;
*         =2: use collision probabilities).
* MAT     index-number of the mixture type assigned to each volume.
* VOL     volumes.
* KEYFLX  index of L-th order flux components in unknown vector.
* TITR    title.
* SUNKNO  input source vector.
* FUNKNO  unknown vector.
* LEXAC   type of exponential function calculation (=.false. to compute
*         exponential functions using tables).
* IPMACR  pointer to the macrolib LCM object.
* REBFLG  ACA or SCR rebalancing flag.
*
*-----------------------------------------------------------------------
*
      USE GANLIB
*----
*  SUBROUTINE ARGUMENTS
*----
      TYPE(C_PTR) IPSYS,IPTRK,IPMACR
      CHARACTER CDOOR*12,TITR*72
      INTEGER NGRP,NPSYS(NGRP),IFTRAK,IMPX,NMAT,IDIR,NREG,NUN,IPHASE,
     > MAT(NREG),KEYFLX(NREG)
      REAL VOL(NREG),SUNKNO(NUN,NGRP),FUNKNO(NUN,NGRP)
      LOGICAL LEXAC,REBFLG
*----
*  LOCAL VARIABLES
*----
      PARAMETER (NSTATE=40)
      INTEGER IPAR(NSTATE)
      TYPE(C_PTR) KPSYS
*
      IF(IPHASE.EQ.1) THEN
*     USE A NATIVE DOOR
         IF(CDOOR.EQ.'SYBIL') THEN
            DO 100 IGR=1,NGRP
            IOFSET=NPSYS(IGR)
            IF(IOFSET.NE.0) THEN
               IF(IMPX.GT.10) WRITE(6,'(/26H DOORFVR: PROCESSING GROUP,
     >         I5,6H WITH ,A,1H.)') IGR,CDOOR
               KPSYS=LCMGIL(IPSYS,IOFSET)
               CALL LCMLEN(KPSYS,'FUNKNO$USS',ILENG,ITYLCM)
               IF(ILENG.EQ.NUN) CALL LCMGET(KPSYS,'FUNKNO$USS',
     >                                            FUNKNO(1,IGR))
               CALL SYBILF(KPSYS,IPTRK,IFTRAK,IMPX,IDIR,NREG,NMAT,
     >                     NUN,MAT,VOL,KEYFLX,FUNKNO(1,IGR),
     >                     SUNKNO(1,IGR),TITR)
            ENDIF
 100        CONTINUE
         ELSE IF(CDOOR.EQ.'BIVAC') THEN
            DO 110 IGR=1,NGRP
            IOFSET=NPSYS(IGR)
            IF(IOFSET.NE.0) THEN
               IF(IMPX.GT.10) WRITE(6,'(/26H DOORFVR: PROCESSING GROUP,
     >         I5,6H WITH ,A,1H.)') IGR,CDOOR
               KPSYS=LCMGIL(IPSYS,IOFSET)
               CALL LCMLEN(KPSYS,'FUNKNO$USS',ILENG,ITYLCM)
               IF(ILENG.EQ.NUN) CALL LCMGET(KPSYS,'FUNKNO$USS',
     >                                            FUNKNO(1,IGR))
               CALL LCMGET(IPTRK,'STATE-VECTOR',IPAR)
               NLF=IPAR(14)
               IF(NLF.EQ.0) THEN
                  CALL BIVAF(KPSYS,IPTRK,IFTRAK,IMPX,IDIR,NREG,NMAT,
     >                       NUN,MAT,VOL,KEYFLX,FUNKNO(1,IGR),
     >                       SUNKNO(1,IGR),TITR)
               ELSE
                  CALL PNF(KPSYS,IPTRK,IFTRAK,IMPX,IDIR,NREG,NMAT,
     >                     NUN,MAT,VOL,KEYFLX,FUNKNO(1,IGR),
     >                     SUNKNO(1,IGR),TITR)
               ENDIF
            ENDIF
 110        CONTINUE
         ELSE IF(CDOOR.EQ.'TRIVAC') THEN
            DO 115 IGR=1,NGRP
            IOFSET=NPSYS(IGR)
            IF(IOFSET.NE.0) THEN
               IF(IMPX.GT.10) WRITE(6,'(/26H DOORFVR: PROCESSING GROUP,
     >         I5,6H WITH ,A,1H.)') IGR,CDOOR
               KPSYS=LCMGIL(IPSYS,IOFSET)
               CALL LCMLEN(KPSYS,'FUNKNO$USS',ILENG,ITYLCM)
               IF(ILENG.EQ.NUN) CALL LCMGET(KPSYS,'FUNKNO$USS',
     >                                            FUNKNO(1,IGR))
               CALL TRIVAF(KPSYS,IPTRK,IFTRAK,IMPX,IDIR,NREG,NMAT,
     >                     NUN,MAT,VOL,KEYFLX,FUNKNO(1,IGR),
     >                     SUNKNO(1,IGR),TITR)
            ENDIF
 115        CONTINUE
         ELSE IF(CDOOR.EQ.'SN') THEN
            DO 120 IGR=1,NGRP
            IOFSET=NPSYS(IGR)
            IF(IOFSET.NE.0) THEN
               IF(IMPX.GT.10) WRITE(6,'(/26H DOORFVR: PROCESSING GROUP,
     >         I5,6H WITH ,A,1H.)') IGR,CDOOR
               KPSYS=LCMGIL(IPSYS,IOFSET)
               CALL LCMLEN(KPSYS,'FUNKNO$USS',ILENG,ITYLCM)
               IF(ILENG.EQ.NUN) CALL LCMGET(KPSYS,'FUNKNO$USS',
     >                                            FUNKNO(1,IGR))
               CALL SNF(KPSYS,IPTRK,IFTRAK,IMPX,IDIR,NREG,NMAT,NUN,MAT,
     >                  VOL,KEYFLX,FUNKNO(1,IGR),SUNKNO(1,IGR),TITR)
            ENDIF
 120        CONTINUE
         ELSE IF(CDOOR.EQ.'MCCG') THEN
            CALL MCCGF(IPSYS,NPSYS,IPTRK,IFTRAK,IPMACR,IMPX,NGRP,IDIR,
     >                 NREG,NMAT,NUN,LEXAC,MAT,VOL,KEYFLX,FUNKNO,SUNKNO,
     >                 TITR,REBFLG)
         ENDIF
      ELSE IF(IPHASE.EQ.2) THEN
         DO 200 IGR=1,NGRP
         IOFSET=NPSYS(IGR)
         IF(IOFSET.NE.0) THEN
            KPSYS=LCMGIL(IPSYS,IOFSET)
            CALL TRFICF(KPSYS,IPTRK,IFTRAK,IMPX,IDIR,NREG,NMAT,NUN,MAT,
     >                  VOL,KEYFLX,FUNKNO(1,IGR),SUNKNO(1,IGR),TITR)
         ENDIF
 200     CONTINUE
      ENDIF
*
      RETURN
      END
