*DECK FMTDFD
      SUBROUTINE FMTDFD(NENTRY,KENTRY,IPRINT,NOPT,IOPT,IKFLU,
     >                  NREG  ,NGROUP,NDIM  ,POLOAQ,AZMOAQ,
     >                  VOLUME,XPOL  ,WPOL  ,XAZI  ,WAZI  ,
     >                  AFLUX ,TFLUX ,WGHT  ,MU    ,ETA   )
*
*-----------------------------------------------------------------------
*
*Purpose:
* To process the angular fluxes and generate the directional
* flux file.
*
*Copyright:
* Copyright (C) 2008 Ecole Polytechnique de Montreal.
*
*Author(s):
* G. Marleau
*
*Parameters: input
* NENTRY  number of data structures transfered to this module.
* KENTRY  data structure pointer.
* IPRINT  print level
* NOPT    number of options
* IOPT    processing option
* IKFLU   : pointer to the FLUX data structure
* NREG    : number of regions for problem
* NGROUP  : number of groups for problem
* NDIM    : number of dimensions of problem
* POLOAQ  : polar quadrature order
* AZMOAQ  : azimuthal quadrature order
* VOLUME  : regional volumes
* XPOL    : polar quadrature points
* WPOL    : polar quadrature weights
* XAZI    : azimuthal quadrature points
* WAZI    : azimuthal quadrature weights
*
*Parameters: output
* AFLUX   : angular components of the
*           direct and adjoint flux.
* TFLUX   : temporary flux vector.
* WGHT    : temporary weight
* MU      : temporary mu
* ETA     : temporary eta
*
*----------
*
      USE              GANLIB
      IMPLICIT         NONE
*----
*  Subroutine arguments
*----
      INTEGER          NENTRY
      TYPE(C_PTR)      KENTRY(NENTRY)
      INTEGER          IPRINT,NOPT,IOPT(NOPT),IKFLU
      INTEGER          NREG,NGROUP,NDIM,POLOAQ,AZMOAQ
      REAL             VOLUME(NREG),XPOL(POLOAQ,2),WPOL(POLOAQ),
     >                 XAZI(NDIM,AZMOAQ),WAZI(AZMOAQ)
      DOUBLE PRECISION AFLUX(NREG,POLOAQ,AZMOAQ*2,2,NGROUP)
      DOUBLE PRECISION TFLUX(NREG+1,POLOAQ,AZMOAQ*2)
      REAL             WGHT(POLOAQ*AZMOAQ*2),MU(POLOAQ*AZMOAQ*2),
     >                 ETA(POLOAQ*AZMOAQ*2)
*----
*  Local parameters
*----
      INTEGER          IOUT
      CHARACTER        NAMSBR*6
      PARAMETER       (IOUT=6,NAMSBR='FMTDFD')
      INTEGER          ILCMUP,ILCMDN
      PARAMETER       (ILCMUP=1,ILCMDN=2)
*----
*  Local variables
*----
      INTEGER          ILONG,ITYLCM
      TYPE(C_PTR)      IPU
      INTEGER          IFPU,IGROUP,NAZ,IA,IP,IR,IQUA,NFLUX,IFTT,KOPT
      CHARACTER*12     NAMREC
      REAL             ETATMP
      CHARACTER*12     NAMFLX(2)
*----
*  Initialize FLUX vectors
*----
      NFLUX=1
      KOPT=IOPT(1)
      NAMFLX(1)='FLUX        '
      IPU=KENTRY(IKFLU)
      CALL LCMLEN(IPU,'FLUXADJOINT ',ILONG,ITYLCM)
      write(6,*) 'FLUXADJOINT ',ILONG,ITYLCM
      IF(ILONG .EQ. -1) THEN
        NFLUX=2
        NAMFLX(2)='ADJOINT     '
      ENDIF
      NAZ=AZMOAQ
      DO IP=1,POLOAQ
        XPOL(IP,2)=SQRT(1.-XPOL(IP,1)*XPOL(IP,1))
      ENDDO
      IF(IPRINT .GE. 10) THEN
        WRITE(IOUT,6000) NAMSBR,NGROUP,NDIM,2*AZMOAQ,POLOAQ,NREG
        WRITE(IOUT,6005)
        WRITE(IOUT,6012) (NAMFLX(IFTT),IFTT=1,NFLUX)
        WRITE(IOUT,6001)
        WRITE(IOUT,6011) (XAZI(1,IA),XAZI(2,IA),WAZI(IA),IA=1,AZMOAQ)
        WRITE(IOUT,6002)
        WRITE(IOUT,6011) (XPOL(IP,1),XPOL(IP,2),WPOL(IP),IP=1,POLOAQ)
      ENDIF
      CALL XDDSET(AFLUX,NREG*POLOAQ*AZMOAQ*2*2*NGROUP,0.0D0)
*----
*  Get information from FLUX data structure.
*  1. Angular flux
*  2. Angular adjoint
*----
      CALL LCMSIX(IPU,'FLUXDIRECT  ',ILCMUP)
      CALL LCMSIX(IPU,'ANGULAR DIR ',ILCMUP)
      DO IGROUP=1,NGROUP
        WRITE(NAMREC,'(A5,I3,4X)') 'AFLUX',IGROUP
        CALL LCMGET(IPU,NAMREC,AFLUX(1,1,1,1,IGROUP))
      ENDDO
      CALL LCMSIX(IPU,'ANGULAR DIR ',ILCMDN)
      CALL LCMSIX(IPU,'FLUXDIRECT  ',ILCMDN)
      IF(NFLUX .GT. 1) THEN
        CALL LCMSIX(IPU,'FLUXADJOINT ',ILCMUP)
        CALL LCMSIX(IPU,'ANGULAR ADJ ',ILCMUP)
        DO IGROUP=1,NGROUP
          WRITE(NAMREC,'(A5,I3,4X)') 'AFLUX',IGROUP
          CALL LCMGET(IPU,NAMREC,AFLUX(1,1,1,2,IGROUP))
        ENDDO
        CALL LCMSIX(IPU,'ANGULAR ADJ ',ILCMDN)
        CALL LCMSIX(IPU,'FLUXADJOINT ',ILCMDN)
      ENDIF
*----
*  Create output file
*----
      IFPU=FILUNIT(KENTRY(1))
      WRITE(IFPU,1000) NGROUP,NDIM,2*AZMOAQ*POLOAQ,NREG,NFLUX
      WRITE(IFPU,1001) (NAMFLX(IFTT),IFTT=1,NFLUX)
*----
*  -\Omega (\varphi+\pi,\pi-\theta)
*----
      IQUA=0
      DO IA=1,AZMOAQ
        ETATMP=XAZI(2,NAZ+1-IA)
        DO IP=1,POLOAQ
          IQUA=IQUA+1
          MU(IQUA)=-XPOL(IP,2)*XAZI(1,NAZ+1-IA)
          ETA(IQUA)=-XPOL(IP,2)*ETATMP
          WGHT(IQUA)=WPOL(IP)/WAZI(NAZ+1-IA)
        ENDDO
      ENDDO
*----
*  +\Omega (\varphi,\theta)
*----
      DO IA=1,AZMOAQ
        ETATMP=XAZI(2,IA)
        DO IP=1,POLOAQ
          IQUA=IQUA+1
          MU(IQUA)=XPOL(IP,2)*XAZI(1,IA)
          ETA(IQUA)=XPOL(IP,2)*ETATMP
          WGHT(IQUA)=WPOL(IP)/WAZI(IA)
        ENDDO
      ENDDO
      WRITE(IFPU,1002) (WGHT(IQUA),IQUA=1,POLOAQ*AZMOAQ*2)
      WRITE(IFPU,1002) (MU(IQUA),IQUA=1,POLOAQ*AZMOAQ*2)
      WRITE(IFPU,1002) (ETA(IQUA),IQUA=1,POLOAQ*AZMOAQ*2)
      WRITE(IFPU,1002) (VOLUME(IR),IR=1,NREG)
*----
*  Print angular flux
*----
      DO IGROUP=1,NGROUP
        DO IA=1,AZMOAQ*2
          DO IP=1,POLOAQ
            DO IR=1,NREG
              TFLUX(IR,IP,IA)=AFLUX(IR,IP,IA,1,IGROUP)
            ENDDO
            IF(IPRINT .GE. 100) THEN
              WRITE(IOUT,6003) IP,IA,IGROUP
              WRITE(IOUT,6010) (TFLUX(IR,IP,IA),IR=1,NREG)
            ENDIF
          ENDDO
        ENDDO
        WRITE(IFPU,1002) (((TFLUX(IR,IP,IA),IR=1,NREG),
     >                  IP=1,POLOAQ),IA=1,AZMOAQ),
     >                  (((TFLUX(IR,IP,IA),IR=1,NREG),
     >                  IP=1,POLOAQ),IA=AZMOAQ*2,AZMOAQ+1,-1)
      ENDDO
*----
*  Print angular adjoint
*----
      IF(NFLUX .GT. 1) THEN
        DO IGROUP=1,NGROUP
          DO IA=1,AZMOAQ*2
            DO IP=1,POLOAQ
              DO IR=1,NREG
                TFLUX(IR,IP,IA)=AFLUX(IR,IP,IA,2,IGROUP)
              ENDDO
              IF(IPRINT .GE. 100) THEN
                WRITE(IOUT,6004) IP,IA,IGROUP
                WRITE(IOUT,6010) (TFLUX(IR,IP,IA),IR=1,NREG)
              ENDIF
            ENDDO
          ENDDO
          WRITE(IFPU,1002) (((TFLUX(IR,IP,IA),IR=1,NREG),
     >                    IP=1,POLOAQ),IA=1,AZMOAQ),
     >                    (((TFLUX(IR,IP,IA),IR=1,NREG),
     >                    IP=1,POLOAQ),IA=AZMOAQ*2,AZMOAQ+1,-1)
        ENDDO
      ENDIF
*----
*  Processing finished, return
*----
      RETURN
*----
*  Formats
*----
 1000 FORMAT(5I10)
 1001 FORMAT(5(A12,2X))
 1002 FORMAT(1P,5E20.10)
 6000 FORMAT('Output from routine ',A6/
     >       'Number of groups  =',I5/
     >       'Number of dimens  =',I5/
     >       'Number of azimuth =',I5/
     >       'Number of polar   =',I5/
     >       'Number of regions =',I5)
 6001 FORMAT('Azimuthal quadrature')
 6002 FORMAT('Polar quadrature')
 6003 FORMAT('Polar =',I5,2X,'Azim  = ',I5,2X,'Group = ',I5/
     >       'Direct angular flux per region ')
 6004 FORMAT('Polar =',I5,2X,'Azim  = ',I5,2X,'Group = ',I5/
     >       'Adjoint angular flux per region')
 6005 FORMAT('Flux record types')
 6010 FORMAT(1P,5E20.10)
 6011 FORMAT(1P,3E20.10)
 6012 FORMAT(5(A12,2X))
      END
