*DECK XELTSW
      SUBROUTINE XELTSW(ABSC,NANGLE,PTSANG,WGTANG)
*
*-----------------------------------------------------------------------
*
*Purpose:
* To compute the integration weights for cyclic tracking.
*
*Copyright:
* Copyright (C) 1994 Ecole Polytechnique de Montreal.
*
*Author(s): R. Roy
*
*Parameters: input
* ABSC   multidimensional width of the cell.
* NANGLE number of angles.
* PTSANG integration points.
*
*Parameters: output
* WGTANG integration weights.
*
*Reference:
* R. Roy, G. Marleau, A. Hebert and D. Rozon,
* A Cyclic Tracking Procedure for Collision Probability Calculations
* in 2-D Lattices, Advances in Mathematics, Computations and 
* Reactor Physics, Pittsburgh, PA, April 28 - May 2 (1991).
*
*-----------------------------------------------------------------------
*
      IMPLICIT NONE
*----
*  SUBROUTINE ARGUMENTS
*----
      DOUBLE PRECISION ABSC(2)
      INTEGER          NANGLE
      DOUBLE PRECISION PTSANG(NANGLE)
      DOUBLE PRECISION WGTANG(NANGLE)
*----
*  LOCAL PARAMETERS
*----
      INTEGER          IOUT,MXANGL
      CHARACTER        NAMSBR*6
      PARAMETER       (IOUT=6,MXANGL=30,NAMSBR='XELTSW')
      DOUBLE PRECISION XDRCST,PI
*----
*  LOCAL VARIABLES
*----
      INTEGER          I,K,N,P
      DOUBLE PRECISION X(0:MXANGL-1),W(0:MXANGL-1),ACCUW,A,B
      INTEGER          INEGW
      DOUBLE PRECISION AC0,AC1,AC2,AC3
*----
*  Test for validity of NANGLE
*----
      PI=XDRCST('Pi',' ')
      IF(NANGLE.GT. MXANGL) CALL XABORT(NAMSBR//
     >': Number of specular azimuthal points too large')
      A= ABSC(1)
      B= ABSC(2)
      P= NANGLE-1
      ACCUW= 1.D0
      DO 10 I= 0, P
         X(I)= PTSANG(NANGLE-I)*PTSANG(NANGLE-I)
         W(I)= ACCUW
         ACCUW= ACCUW*DBLE(2*I+1)/DBLE(2*(I+1))
   10 CONTINUE
      N= NANGLE-1
      DO 30 K= 0, N-1
         DO 20 I= N, K+1, -1
            W(I)=  W(I) - W(I-1) * X(K)
   20    CONTINUE
   30 CONTINUE
      DO 60 K= N-1, 0, -1
         DO 40 I= K+1, N
            W(I)= W(I)  / ( X(I) - X(I-K-1) )
   40    CONTINUE
         DO 50 I= K, N-1
            W(I)= W(I)  - W(I+1)
   50    CONTINUE
   60 CONTINUE
      INEGW=0
      DO 70 I= 0, P
         WGTANG(NANGLE-I)= W(I)
         IF(WGTANG(NANGLE-I) .LT. 0.0D0) INEGW=INEGW+1
   70 CONTINUE
*----
*  If some weights are negative write warning
*  and use Sanchez weighting
*  R. Sanchez, L. Mao, S. Santandrea
*  Nucl. Sci. Eng. 140, 23-50 (2002).
*----
      IF(INEGW .GT. 0) THEN
        WRITE(IOUT,7000) NAMSBR
        I=1
        AC0=PI
        AC1=ACOS(PTSANG(I))
        AC2=ACOS(PTSANG(I+1))
        WGTANG(I)=ABS(AC2-AC1)/AC0
        ACCUW=WGTANG(1)
        AC3=0
        DO 80 I=2,NANGLE-1
          AC3=ACOS(PTSANG(I+1))
          WGTANG(I)=ABS(AC3-AC1)/AC0
          ACCUW=ACCUW+WGTANG(I)
          AC1=AC2
          AC2=AC3
  80    CONTINUE
        I=NANGLE
        WGTANG(I)=ABS(AC3-AC1)/AC0
        ACCUW=ACCUW+WGTANG(I)
        DO 90 I=1,NANGLE
        WGTANG(I)=WGTANG(I)/ACCUW
  90    CONTINUE
      ENDIF
*----
*  Processing finished, return
*----
      RETURN
*----
*  FORMATS
*----
 7000 FORMAT(' ******  WARNING in : ',A6,' *****'/
     >10X,'Some of the integration weights are negative'/
     >10X,'this may result in invalid integration of CP'/
     >10X,'Use Sanchez instead of Roy weighting')
      END
