*DECK TRFICF
      SUBROUTINE TRFICF(IPSYS,IPTRK,IFTRAK,IPRNTF,IDIR,NREGIO,NBMIX,
     >                  NUNKNO,MATCOD,VOLUME,KEYFLX,FUNKNO,SUNKNO,TITRE)
*
*-----------------------------------------------------------------------
*
*Purpose:
* solve one group transport equation for fluxes using the scattering
* modified collision probability matrix.
*
*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
* IPSYS   pointer to the pij LCM object.
* IPTRK   pointer to the tracking LCM object.
* IFTRAK  not used.
* IPRNTF  print selection for flux modules.
* IDIR    directional collision probability flag:
*         =0 for pij or wij;
*         =k for pijk or wijk k=1,2,3.
* NREGIO  number of regions considered.
* NBMIX   number of mixtures.
* NUNKNO  number of unknown in the system.
* MATCOD  mixture code in region.
* VOLUME  volume of region.
* KEYFLX  flux elements in unknown system.
* SUNKNO  source for system of unknown.
* TITRE   title.
*
*Parameters: input/output
* FUNKNO  unknown vector solved for.
*
*-----------------------------------------------------------------------
*
      USE GANLIB
*----
*  SUBROUTINE ARGUMENTS
*----
      TYPE(C_PTR) IPSYS,IPTRK
      CHARACTER   TITRE*72
      INTEGER     IFTRAK,IPRNTF,IDIR,NREGIO,NBMIX,NUNKNO,MATCOD(NREGIO),
     >            KEYFLX(NREGIO)
      REAL        VOLUME(NREGIO),FUNKNO(NUNKNO),SUNKNO(NUNKNO)
*----
*  LOCAL VARIABLES
*----
      PARAMETER  (IUNOUT=6,NSTATE=40)
      CHARACTER   CNS(0:3)*1,CNFDIR(0:3)*9,NAMLCM*12,NAMMY*12
      INTEGER     ISTATE(NSTATE),ILCMLN
      LOGICAL     EMPTY,LCM,LBIHET
      SAVE        CNS,CNFDIR
      DATA   CNS  /'-','1','2','3'/
      DATA CNFDIR /'F L U X  ','C U R - X','C U R - Y','C U R - Z'/
*----
*  ALLOCATABLE ARRAYS
*----
      TYPE(C_PTR) CPMAT_PTR
      REAL, ALLOCATABLE, DIMENSION(:) :: SUNKN
      REAL, POINTER, DIMENSION(:) :: CPMAT
*----
*  PRINT SOURCES WHEN REQUIRED
*----
      IF(IFTRAK.LT.0) CALL XABORT('TRFICF: EXPECTING IFTRAK>=0')
      IF(MATCOD(1).LT.0) CALL XABORT('TRFICF: EXPECTING MATCOD(1)>=0')
      IF(VOLUME(1).LT.0.0) CALL XABORT('TRFICF: EXPECTING VOLUME(1)>=0')
      IF(IPRNTF.GT.90) WRITE(IUNOUT,'(//1X,A72/)') TITRE
      IF(IPRNTF.GT.3) THEN
        WRITE(IUNOUT,'(12H  SOURCES : ,3X,A9)') CNFDIR(IDIR)
        WRITE(IUNOUT,'(1P,6(5X,E15.7))') (SUNKNO(KEYFLX(I)),I=1,NREGIO)
      ENDIF
*----
*  DOUBLE HETEROGENEITY TREATMENT
*----
      NREGAR=0
      NBMIXG=0
      CALL LCMGET(IPTRK,'STATE-VECTOR',ISTATE)
      LBIHET=ISTATE(40).NE.0
      IF(LBIHET) THEN
         ALLOCATE(SUNKN(NUNKNO))
         DO 10 I=1,NUNKNO
           SUNKN(I)=SUNKNO(I)
   10    CONTINUE
         NREGAR=NREGIO
         NBMIXG=NBMIX
         CALL DOORFB2(IPSYS,IPTRK,IPRNTF,NBMIX,NREGIO,NUNKNO,KEYFLX,
     1   NBMIX2,NREGI2,SUNKNO)
         NREGIO=NREGI2
         NBMIX=NBMIX2
         CALL LCMSIX(IPSYS,'BIHET',1)
      ENDIF
*----
*  ALLOCATE STORAGE AND READ SCATTERING MODIFIED COLLISION PROBABILITIES
*----
      CALL LCMINF(IPSYS,NAMLCM,NAMMY,EMPTY,ILONG,LCM)
      CALL LCMLEN(IPSYS,'DRAGON'//CNS(IDIR)//'PCSCT',ILCMLN,ITYLCM)
      IF((ILCMLN.GT.0).AND.LCM) THEN
        CALL LCMGPD(IPSYS,'DRAGON'//CNS(IDIR)//'PCSCT',CPMAT_PTR)
        CALL C_F_POINTER(CPMAT_PTR,CPMAT,(/ NREGIO*NREGIO /))
      ELSE IF(ILCMLN.GT.0) THEN
        ALLOCATE(CPMAT(NREGIO*NREGIO))
        CALL LCMGET(IPSYS,'DRAGON'//CNS(IDIR)//'PCSCT',CPMAT)
      ELSE
        CALL XABORT('TRFICF: RECORD DRAGON'//CNS(IDIR)//
     >              'PCSCT ABSENT FROM LCM')
      ENDIF
*----
*  SOLVE TRANSPORT EQUATION
*----
      JCPMAT=0
      DO 30 I=1,NREGIO
        FUNKNO(KEYFLX(I))=0.0
   30 CONTINUE
      DO 50 I=1,NREGIO
        IPOS=KEYFLX(I)
        DO 40 J=1,NREGIO
          JPOS=KEYFLX(J)
          JCPMAT=JCPMAT+1
          FUNKNO(JPOS)=FUNKNO(JPOS)+SUNKNO(IPOS)*CPMAT(JCPMAT)
   40   CONTINUE
   50 CONTINUE
      IF(.NOT.LCM) DEALLOCATE(CPMAT)
*----
*  DOUBLE HETEROGENEITY TREATMENT
*----
      IF(LBIHET) THEN
         CALL LCMSIX(IPSYS,' ',2)
         NREGIO=NREGAR
         NBMIX=NBMIXG
         DO 60 I=1,NUNKNO
           SUNKNO(I)=SUNKN(I)
   60    CONTINUE
         DEALLOCATE(SUNKN)
         CALL DOORFB3(IPSYS,IPTRK,IPRNTF,NBMIX,NREGIO,NUNKNO,KEYFLX,
     1   SUNKNO,FUNKNO)
      ENDIF
*----
*  PRINT FLUXES WHEN REQUIRED
*----
      IF(IPRNTF.GT.3) THEN
        WRITE(IUNOUT,'(12H SOLUTION : ,5X,A9)') CNFDIR(IDIR)
        WRITE(IUNOUT,'(1P,6(5X,E15.7))') (FUNKNO(KEYFLX(I)),I=1,NREGIO)
      ENDIF
      RETURN
      END
