1*DECK DXPNRM
2      SUBROUTINE DXPNRM (NU1, NU2, MU1, MU2, PQA, IPQA, IERROR)
3C***BEGIN PROLOGUE  DXPNRM
4C***SUBSIDIARY
5C***PURPOSE  To compute the values of Legendre functions for DXLEGF.
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      DOUBLE PRECISION (XPNRM-S, DXPNRM-D)
13C***KEYWORDS  LEGENDRE FUNCTIONS
14C***AUTHOR  Smith, John M., (NBS and George Mason University)
15C***ROUTINES CALLED  DXADJ
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  DXPNRM
25      DOUBLE PRECISION C1,DMU,NU,NU1,NU2,PQA,PROD
26      DIMENSION PQA(*),IPQA(*)
27C***FIRST EXECUTABLE STATEMENT  DXPNRM
28      IERROR=0
29      L=(MU2-MU1)+(NU2-NU1+1.5D0)
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.D0
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.D0
46      IF(NU2-NU1.GT..5D0) NU=NU+1.D0
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.D0
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.D0-I)
60  510 CALL DXADJ(PROD,IPROD,IERROR)
61      IF (IERROR.NE.0) RETURN
62  520 DO 540 I=J,L
63      C1=PROD*SQRT(NU+.5D0)
64      PQA(I)=PQA(I)*C1
65      IPQA(I)=IPQA(I)+IPROD
66      CALL DXADJ(PQA(I),IPQA(I),IERROR)
67      IF (IERROR.NE.0) RETURN
68      IF(NU2-NU1.GT..5D0) GO TO 530
69      IF(DMU.GE.NU) GO TO 525
70      PROD=SQRT(NU+DMU+1.D0)*PROD
71      IF(NU.GT.DMU) PROD=PROD*SQRT(NU-DMU)
72      CALL DXADJ(PROD,IPROD,IERROR)
73      IF (IERROR.NE.0) RETURN
74      MU=MU+1
75      DMU=DMU+1.D0
76      GO TO 540
77  525 PROD=0.D0
78      IPROD=0
79      MU=MU+1
80      DMU=DMU+1.D0
81      GO TO 540
82  530 PROD=SQRT(NU+DMU+1.D0)*PROD
83      IF(NU.NE.DMU-1.D0) PROD=PROD/SQRT(NU-DMU+1.D0)
84      CALL DXADJ(PROD,IPROD,IERROR)
85      IF (IERROR.NE.0) RETURN
86      NU=NU+1.D0
87  540 CONTINUE
88      RETURN
89      END
90