1*DECK XPMUP
2      SUBROUTINE XPMUP (NU1, NU2, MU1, MU2, PQA, IPQA, IERROR)
3C***BEGIN PROLOGUE  XPMUP
4C***SUBSIDIARY
5C***PURPOSE  To compute the values of Legendre functions for XLEGF.
6C            This subroutine transforms an array of Legendre functions
7C            of the first kind of negative order stored in array PQA
8C            into Legendre functions of the first kind of positive
9C            order stored in array PQA. The original array is destroyed.
10C***LIBRARY   SLATEC
11C***CATEGORY  C3A2, C9
12C***TYPE      SINGLE PRECISION (XPMUP-S, DXPMUP-D)
13C***KEYWORDS  LEGENDRE FUNCTIONS
14C***AUTHOR  Smith, John M., (NBS and George Mason University)
15C***ROUTINES CALLED  XADJ
16C***REVISION HISTORY  (YYMMDD)
17C   820728  DATE WRITTEN
18C   890126  Revised to meet SLATEC CML recommendations.  (DWL and JMS)
19C   901019  Revisions to prologue.  (DWL and WRB)
20C   901106  Changed all specific intrinsics to generic.  (WRB)
21C           Corrected order of sections in prologue and added TYPE
22C           section.  (WRB)
23C   920127  Revised PURPOSE section of prologue.  (DWL)
24C***END PROLOGUE  XPMUP
25      REAL DMU,NU,NU1,NU2,PQA,PROD
26      DIMENSION PQA(*),IPQA(*)
27C***FIRST EXECUTABLE STATEMENT  XPMUP
28      IERROR=0
29      NU=NU1
30      MU=MU1
31      DMU=MU
32      N=INT(NU2-NU1+.1)+(MU2-MU1)+1
33      J=1
34      IF(MOD(NU,1.).NE.0.) GO TO 210
35  200 IF(DMU.LT.NU+1.) GO TO 210
36      PQA(J)=0.
37      IPQA(J)=0
38      J=J+1
39      IF(J.GT.N) RETURN
40C        INCREMENT EITHER MU OR NU AS APPROPRIATE.
41      IF(NU2-NU1.GT..5) NU=NU+1.
42      IF(MU2.GT.MU1) MU=MU+1
43      GO TO 200
44C
45C        TRANSFORM P(-MU,NU,X) TO P(MU,NU,X) USING
46C        P(MU,NU,X)=(NU-MU+1)*(NU-MU+2)*...*(NU+MU)*P(-MU,NU,X)*(-1)**MU
47C
48  210 PROD=1.
49      IPROD=0
50      K=2*MU
51      IF(K.EQ.0) GO TO 222
52      DO 220 L=1,K
53      PROD=PROD*(DMU-NU-L)
54  220 CALL XADJ(PROD,IPROD,IERROR)
55      IF (IERROR.NE.0) RETURN
56  222 CONTINUE
57      DO 240 I=J,N
58      IF(MU.EQ.0) GO TO 225
59      PQA(I)=PQA(I)*PROD*(-1)**MU
60      IPQA(I)=IPQA(I)+IPROD
61      CALL XADJ(PQA(I),IPQA(I),IERROR)
62      IF (IERROR.NE.0) RETURN
63  225 IF(NU2-NU1.GT..5) GO TO 230
64      PROD=(DMU-NU)*PROD*(-DMU-NU-1.)
65      CALL XADJ(PROD,IPROD,IERROR)
66      IF (IERROR.NE.0) RETURN
67      MU=MU+1
68      DMU=DMU+1.
69      GO TO 240
70  230 PROD=PROD*(-DMU-NU-1.)/(DMU-NU-1.)
71      CALL XADJ(PROD,IPROD,IERROR)
72      IF (IERROR.NE.0) RETURN
73      NU=NU+1.
74  240 CONTINUE
75      RETURN
76      END
77