1*DECK DXQNU 2 SUBROUTINE DXQNU (NU1, NU2, MU1, THETA, X, SX, ID, PQA, IPQA, 3 1 IERROR) 4C***BEGIN PROLOGUE DXQNU 5C***SUBSIDIARY 6C***PURPOSE To compute the values of Legendre functions for DXLEGF. 7C Method: backward nu-wise recurrence for Q(MU,NU,X) for 8C fixed mu to obtain Q(MU1,NU1,X), Q(MU1,NU1+1,X), ..., 9C Q(MU1,NU2,X). 10C***LIBRARY SLATEC 11C***CATEGORY C3A2, C9 12C***TYPE DOUBLE PRECISION (XQNU-S, DXQNU-D) 13C***KEYWORDS LEGENDRE FUNCTIONS 14C***AUTHOR Smith, John M., (NBS and George Mason University) 15C***ROUTINES CALLED DXADD, DXADJ, DXPQNU 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 Corrected order of sections in prologue and added TYPE 21C section. (WRB) 22C 920127 Revised PURPOSE section of prologue. (DWL) 23C***END PROLOGUE DXQNU 24 DIMENSION PQA(*),IPQA(*) 25 DOUBLE PRECISION DMU,NU,NU1,NU2,PQ,PQA,PQ1,PQ2,SX,X,X1,X2 26 DOUBLE PRECISION THETA,PQL1,PQL2 27C***FIRST EXECUTABLE STATEMENT DXQNU 28 IERROR=0 29 K=0 30 PQ2=0.0D0 31 IPQ2=0 32 PQL2=0.0D0 33 IPQL2=0 34 IF(MU1.EQ.1) GO TO 290 35 MU=0 36C 37C CALL DXPQNU TO OBTAIN Q(0.,NU2,X) AND Q(0.,NU2-1,X) 38C 39 CALL DXPQNU(NU1,NU2,MU,THETA,ID,PQA,IPQA,IERROR) 40 IF (IERROR.NE.0) RETURN 41 IF(MU1.EQ.0) RETURN 42 K=(NU2-NU1+1.5D0) 43 PQ2=PQA(K) 44 IPQ2=IPQA(K) 45 PQL2=PQA(K-1) 46 IPQL2=IPQA(K-1) 47 290 MU=1 48C 49C CALL DXPQNU TO OBTAIN Q(1.,NU2,X) AND Q(1.,NU2-1,X) 50C 51 CALL DXPQNU(NU1,NU2,MU,THETA,ID,PQA,IPQA,IERROR) 52 IF (IERROR.NE.0) RETURN 53 IF(MU1.EQ.1) RETURN 54 NU=NU2 55 PQ1=PQA(K) 56 IPQ1=IPQA(K) 57 PQL1=PQA(K-1) 58 IPQL1=IPQA(K-1) 59 300 MU=1 60 DMU=1.D0 61 320 CONTINUE 62C 63C FORWARD RECURRENCE IN MU TO OBTAIN Q(MU1,NU2,X) AND 64C Q(MU1,NU2-1,X) USING 65C Q(MU+1,NU,X)=-2.*MU*X*SQRT(1./(1.-X**2))*Q(MU,NU,X) 66C -(NU+MU)*(NU-MU+1.)*Q(MU-1,NU,X) 67C 68C FIRST FOR NU=NU2 69C 70 X1=-2.D0*DMU*X*SX*PQ1 71 X2=(NU+DMU)*(NU-DMU+1.D0)*PQ2 72 CALL DXADD(X1,IPQ1,-X2,IPQ2,PQ,IPQ,IERROR) 73 IF (IERROR.NE.0) RETURN 74 CALL DXADJ(PQ,IPQ,IERROR) 75 IF (IERROR.NE.0) RETURN 76 PQ2=PQ1 77 IPQ2=IPQ1 78 PQ1=PQ 79 IPQ1=IPQ 80 MU=MU+1 81 DMU=DMU+1.D0 82 IF(MU.LT.MU1) GO TO 320 83 PQA(K)=PQ 84 IPQA(K)=IPQ 85 IF(K.EQ.1) RETURN 86 IF(NU.LT.NU2) GO TO 340 87C 88C THEN FOR NU=NU2-1 89C 90 NU=NU-1.D0 91 PQ2=PQL2 92 IPQ2=IPQL2 93 PQ1=PQL1 94 IPQ1=IPQL1 95 K=K-1 96 GO TO 300 97C 98C BACKWARD RECURRENCE IN NU TO OBTAIN 99C Q(MU1,NU1,X),Q(MU1,NU1+1,X),....,Q(MU1,NU2,X) 100C USING 101C (NU-MU+1.)*Q(MU,NU+1,X)= 102C (2.*NU+1.)*X*Q(MU,NU,X)-(NU+MU)*Q(MU,NU-1,X) 103C 104 340 PQ1=PQA(K) 105 IPQ1=IPQA(K) 106 PQ2=PQA(K+1) 107 IPQ2=IPQA(K+1) 108 350 IF(NU.LE.NU1) RETURN 109 K=K-1 110 X1=(2.D0*NU+1.D0)*X*PQ1/(NU+DMU) 111 X2=-(NU-DMU+1.D0)*PQ2/(NU+DMU) 112 CALL DXADD(X1,IPQ1,X2,IPQ2,PQ,IPQ,IERROR) 113 IF (IERROR.NE.0) RETURN 114 CALL DXADJ(PQ,IPQ,IERROR) 115 IF (IERROR.NE.0) RETURN 116 PQ2=PQ1 117 IPQ2=IPQ1 118 PQ1=PQ 119 IPQ1=IPQ 120 PQA(K)=PQ 121 IPQA(K)=IPQ 122 NU=NU-1.D0 123 GO TO 350 124 END 125