*DECK MOCCHR
      SUBROUTINE MOCCHR(NDIM,NL,NMU,XMUANG,PHI,R)
*
*     WRITTEN BY R.ROY
*
*  1. GENERATES ALL SPHERICAL HARMONICS R(L,M) AT POINT (XMUANG,PHI)
*               FOR 0 <= L <= NL (AND FOR -L <= M <= L)
*           AND FOR ALL ANGLES (FOR 1 <= IMU <= NMU)
*
*     DEFINITION OF THESE FUNCTIONS:
*     R(L, M)= FACT(L,M)*P(L,M)*COS(M*PHI)  FOR 0 < M <= L
*     R(L, 0)=           P(L,0)
*     R(L,-M)= FACT(L,M)*P(L,M)*SIN(M*PHI)  FOR 0 < M <= L
*     WHERE FACT(L,M)= SQRT( 2*(L-M)!/(L+M)! )
*
*  2. ALL THESE FUNCTION VALUES ARE COMPRESSED TO BE USED
*     ACCORDING TO THE RECTANGULAR DIMENSION 'NDIM'. THE REMAINING
*     PLACE IS FILLED UP WITH ZEROS TO ENSURE THAT NO PROBLEM ARISE
*     IF ONE OVERRIDES THE DIMENSIONS.
*
      IMPLICIT NONE
      INTEGER          NDIM,NL,NMU,IMU,L,M,LPM,LMMP1,IND,NSELEC
      REAL             XMUANG(NMU),PHI,R(NMU,(NL+1)*(NL+1))
      LOGICAL          LROK
      DOUBLE PRECISION DPHI,DCOPHI,DSIPHI,DCOP2,DSIP2,
     >                 DL00,DL10,DL01,DL11,DM0,DM1,DM2,
     >                 DCOS,DSIN,DCOT,DFAC,DZERO,DONE
      PARAMETER ( DZERO= 0.0D0, DONE= 1.0D0 )
*
*     INDEX FOR MATRIX 'R'
      IND(L,M)= L*(L+1) + M + 1
*
***** FIRST, COMPUTES ALL SPHERICAL HARMONICS
*
*     GENERATES ALL LEGENDRE POLYNOMIALS P(L,M) AT POINT XMU
*               FOR 0 <= L <= NL (AND FOR 0 <= M <= L)
*     USING THE RECURENCE RELATIONS:
*     P(L+1,M)= ((2*L+1)*XMU*P(L,M)-(L+M)*P(L-1,M))/(L-M+1)
*     P(L,M+1)= 2*M*XMU*P(L,M)/SQRT(1-XMU**2)-(L+M)*(L-M+1)*P(L,M-1)
*
*     ESTABLISH SIMPLE CASES
      IF( NL.GE.0 )THEN
         DO 10 IMU= 1, NMU
            R(IMU,IND(0,0))= DONE
   10    CONTINUE
      ELSE
         CALL XABORT('MOCCHR: THE FIRST ARGUMENT MUST NON NEGATIVE')
      ENDIF
*
      IF( NL.GE.1 )THEN
*        PHI IS ALREADY "COS(PHI)"
         DCOPHI= DBLE(PHI)
         DPHI=   ACOS(DCOPHI)
         DSIPHI= SQRT( DONE - DCOPHI*DCOPHI)
         DO 40 IMU= 1, NMU
            DCOS=   DBLE(XMUANG(IMU))
            DSIN=   SQRT( DONE - DCOS  *DCOS   )
            R(IMU,IND(1,-1))= REAL(DSIN*DSIPHI)
            R(IMU,IND(1, 0))= REAL(DCOS)
            R(IMU,IND(1, 1))= REAL(DSIN*DCOPHI)
*
            IF( NL.GE.2 )THEN
*              RECURENCE PLG(IND(L,0)),PLG(IND(L,1) FOR 2 <= L <= NL
               DCOT= DCOS/DSIN
               DL00= DONE
               DL10= DCOS
               DL01= DZERO
               DL11= DSIN
               DO 30 L= 1, NL-1
*                 IF M=1, L=L+1 THEN L+M=L+2, L-M+1=L+1
                  LPM=   L + 2
                  LMMP1= L + 1
                  DFAC= (DONE+DONE)/DBLE(LPM*LMMP1)
                  DM0=(DBLE(2*L+1)*DCOS*DL10 - DBLE(L)*DL00)/DBLE(L+1)
                  DM1=(DBLE(2*L+1)*DCOS*DL11 - DBLE(L+1)*DL01)/DBLE(L)
*                 ESTABLISH RELATIONS FOR L=L+1, ABS(M)<=1
                  R(IMU,IND(L+1,-1))= REAL(SQRT(DFAC)*DM1*DSIPHI)
                  R(IMU,IND(L+1, 0))= REAL(DM0)
                  R(IMU,IND(L+1, 1))= REAL(SQRT(DFAC)*DM1*DCOPHI)
                  DL00= DL10
                  DL01= DL11
                  DL10= DM0
                  DL11= DM1
*                 RECURENCE PLG(IND(L,M)) FOR 2 <= M <= L
                  DO 20 M= 1, L
*                    HERE DM0=PLG(L+1,0), DM1=PLG(L+1,1)
*                    ESTABLISH RELATIONS FOR L=L+1, ABS(M)>1
                     DFAC= DFAC/DBLE((LMMP1-1)*(LPM+1))
                     DCOP2= COS(DBLE(M+1)*DPHI)
                     DSIP2= SIN(DBLE(M+1)*DPHI)
                     DM2= DBLE(2*M)*DCOT*DM1 - DBLE(LPM*LMMP1)*DM0
                     R(IMU,IND(L+1,-(M+1)))= REAL(SQRT(DFAC)*DM2*DSIP2)
                     R(IMU,IND(L+1, M+1 ))= REAL(SQRT(DFAC)*DM2*DCOP2)
                     DM0= DM1
                     DM1= DM2
                     LPM=   LPM   + 1
                     LMMP1= LMMP1 - 1
   20             CONTINUE
   30          CONTINUE
            ENDIF
   40    CONTINUE
      ENDIF
*
***** SELECTS THE GOOD SPHERICAL HARMONICS R(L,M) FUNCTIONS
*             FOR NDIM=1(SLAB),2(TWO-D RECT),3(THREE-D).
*
*     COMPRESSES 'R' IN PLACE.
*
      NSELEC= 0
      LROK= .FALSE.
      DO 80 L= 0, NL
         DO 70 M= -L, L
            IF( NDIM.EQ.1 )THEN
               LROK= M.EQ.0
            ELSEIF( NDIM.EQ.2 )THEN
               LROK= MOD(L+M,2).EQ.0
            ELSEIF( NDIM.EQ.3 )THEN
               LROK= .TRUE.
            ENDIF
            IF( LROK )THEN
               NSELEC= NSELEC+1
               IF(NSELEC.NE.IND(L,M))THEN
                  DO 50 IMU= 1, NMU
                     R(IMU,NSELEC)= R(IMU,IND(L,M))
   50             CONTINUE
               ENDIF
            ELSE
               DO 60 IMU= 1, NMU
                  R(IMU,IND(L,M))= DZERO
   60          CONTINUE
            ENDIF
   70   CONTINUE
   80 CONTINUE
*
      RETURN
      END
