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