*DECK NXTSQD
      SUBROUTINE NXTSQD(IFTRK ,IPRINT,NDIM  ,NQUAD ,NBANGL,
     >                  DANGLT,DDENWT)
*
*-----------------------------------------------------------------------
*
*Purpose:
* To transform double precision to simple precision
* quadrature and save on IFTRK.
*
*Copyright:
* Copyright (C) 2005 Ecole Polytechnique de Montreal.
*
*Author(s):
* G. Marleau
*
*Update(s):
* None.
*
*Reference:
*  G. Marleau,
*  \textsl{New Geometries Processing in DRAGON: The NXT: Module},
*  Report IGE-260, \'{E}cole Polytechnique de Montr\'{e}al,
*  Montr\'{e}al, 2005.
*
*Parameters: input
* IFTRK   pointer to the TRACKING file in creation mode.
* IPRINT  print level.
* NDIM    number of dimensions for geometry.
* NQUAD   number of quadrant (in 3-D) and quarter (in 2-D).
* NBANGL  number of angles.
* DANGLT  angles (double precision).
* DDENWT  angular density for each angle (double precision).
*
*----------
*
      IMPLICIT         NONE
*----
*  Subroutine arguments
*----
      INTEGER          IFTRK,IPRINT
      INTEGER          NDIM,NQUAD,NBANGL
      DOUBLE PRECISION DANGLT(NDIM*NQUAD*NBANGL),DDENWT(NQUAD*NBANGL)
*----
*  Local parameters
*----
      INTEGER          IOUT
      CHARACTER        NAMSBR*6
      PARAMETER       (IOUT=6,NAMSBR='NXTSQD')
*----
*  Local variables
*----
      INTEGER          JJ
*----
*  Allocatable arrays
*----
      REAL, ALLOCATABLE, DIMENSION(:) :: ANGLT,DENWT
*----
*  Scratch storage allocation
*   ANGLT   angles (simple precision).
*   DENWT   angular density for each angle (simple precision).
*----
      ALLOCATE(ANGLT(NDIM*NQUAD*NBANGL),DENWT(NQUAD*NBANGL))
*----
*  Processing starts:
*  print routine opening header if required
*  and initialize various parameters.
*----
      IF(IPRINT .GE. 1) THEN
        WRITE(IOUT,6000) NAMSBR
      ENDIF
      DO JJ=1,NDIM*NQUAD*NBANGL
        ANGLT(JJ)=REAL(DANGLT(JJ))
      ENDDO
      DO JJ=1,NQUAD*NBANGL
        DENWT(JJ)=REAL(DDENWT(JJ))
      ENDDO
      WRITE(IFTRK) (ANGLT(JJ),JJ=1,NQUAD*NBANGL*NDIM)
      WRITE(IFTRK) (DENWT(JJ),JJ=1,NQUAD*NBANGL)
*----
*  Processing finished:
*  print routine closing output header if required
*  and return
*----
      IF(IPRINT .GE. 1) THEN
        WRITE(IOUT,6001) NAMSBR
      ENDIF
*----
*  Scratch storage deallocation
*----
      DEALLOCATE(DENWT,ANGLT)
      RETURN
*----
*  Output formats
*----
 6000 FORMAT('(* Output from --',A6,'-- follows ')
 6001 FORMAT('   Output from --',A6,'-- completed *)')
      END
