1*DECK XPNRM
2      SUBROUTINE XPNRM (NU1, NU2, MU1, MU2, PQA, IPQA, IERROR)
3C***BEGIN PROLOGUE  XPNRM
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 normalized Legendre polynomials stored in array PQA.
9C            The original array is destroyed.
10C***LIBRARY   SLATEC
11C***CATEGORY  C3A2, C9
12C***TYPE      SINGLE PRECISION (XPNRM-S, DXPNRM-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  XPNRM
25      REAL C1,DMU,NU,NU1,NU2,PQA,PROD
26      DIMENSION PQA(*),IPQA(*)
27C***FIRST EXECUTABLE STATEMENT  XPNRM
28      IERROR=0
29      L=(MU2-MU1)+(NU2-NU1+1.5)
30      MU=MU1
31      DMU=MU1
32      NU=NU1
33C
34C         IF MU .GT.NU, NORM P =0.
35C
36      J=1
37  500 IF(DMU.LE.NU) GO TO 505
38      PQA(J)=0.
39      IPQA(J)=0
40      J=J+1
41      IF(J.GT.L) RETURN
42C
43C        INCREMENT EITHER MU OR NU AS APPROPRIATE.
44C
45      IF(MU2.GT.MU1) DMU=DMU+1.
46      IF(NU2-NU1.GT..5) NU=NU+1.
47      GO TO 500
48C
49C         TRANSFORM P(-MU,NU,X) INTO NORMALIZED P(MU,NU,X) USING
50C              NORM P(MU,NU,X)=
51C                 SQRT((NU+.5)*FACTORIAL(NU+MU)/FACTORIAL(NU-MU))
52C                              *P(-MU,NU,X)
53C
54  505 PROD=1.
55      IPROD=0
56      K=2*MU
57      IF(K.LE.0) GO TO 520
58      DO 510 I=1,K
59      PROD=PROD*SQRT(NU+DMU+1.-I)
60  510 CALL XADJ(PROD,IPROD,IERROR)
61      IF (IERROR.NE.0) RETURN
62  520 DO 540 I=J,L
63      C1=PROD*SQRT(NU+.5)
64      PQA(I)=PQA(I)*C1
65      IPQA(I)=IPQA(I)+IPROD
66      CALL XADJ(PQA(I),IPQA(I),IERROR)
67      IF (IERROR.NE.0) RETURN
68      IF(NU2-NU1.GT..5) GO TO 530
69      IF(DMU.GE.NU) GO TO 525
70      PROD=SQRT(NU+DMU+1.)*PROD
71      IF(NU.GT.DMU) PROD=PROD*SQRT(NU-DMU)
72      CALL XADJ(PROD,IPROD,IERROR)
73      IF (IERROR.NE.0) RETURN
74      MU=MU+1
75      DMU=DMU+1.
76      GO TO 540
77  525 PROD=0.
78      IPROD=0
79      MU=MU+1
80      DMU=DMU+1.
81      GO TO 540
82  530 PROD=SQRT(NU+DMU+1.)*PROD
83      IF(NU.NE.DMU-1.) PROD=PROD/SQRT(NU-DMU+1.)
84      CALL XADJ(PROD,IPROD,IERROR)
85      IF (IERROR.NE.0) RETURN
86      NU=NU+1.
87  540 CONTINUE
88      RETURN
89      END
90