1 SUBROUTINE XDPMUP(NU1,NU2,MU1,MU2,PQA,IPQA) 2C***BEGIN PROLOGUE XDPMUP 3C***REFER TO XDLEGF 4C***ROUTINES CALLED XDADJ 5C***DATE WRITTEN 820728 (YYMMDD) 6C***REVISION DATE 871119 (YYMMDD) 7C***CATEGORY NO. C3a2,C9 8C***KEYWORDS LEGENDRE FUNCTIONS 9C***AUTHOR SMITH, JOHN M. (NBS AND GEORGE MASON UNIVERSITY) 10C***PURPOSE TO COMPUTE THE VALUES OF LEGENDRE FUNCTIONS FOR XDLEGF. 11C SUBROUTINE XDPMUP TRANSFORMS AN ARRAY OF LEGENDRE FUNCTIONS 12C OF THE FIRST KIND OF NEGATIVE ORDER STORED IN ARRAY 13C PQA INTO LEGENDRE FUNCTIONS OF THE FIRST KIND OF 14C POSITIVE ORDER STORED IN ARRAY PQA. THE ORIGINAL 15C ARRAY IS DESTROYED. 16C***REFERENCES OLVER AND SMITH,J.COMPUT.PHYSICS,51(1983),N0.3,502-518. 17C***END PROLOGUE XDPMUP 18 DOUBLE PRECISION DMU,NU,NU1,NU2,PQA,PROD 19 DIMENSION PQA(*),IPQA(*) 20C***FIRST EXECUTABLE STATEMENT XDPMUP 21 NU=NU1 22 MU=MU1 23 DMU=DBLE(FLOAT(MU)) 24 N=IFIX(SNGL(NU2-NU1+.1))+(MU2-MU1)+1 25 J=1 26 IF(AMOD(SNGL(NU),1.).NE.0.) GO TO 210 27 200 IF(DMU.LT.NU+1.D0) GO TO 210 28 PQA(J)=0. 29 IPQA(J)=0 30 J=J+1 31 IF(J.GT.N) RETURN 32C INCREMENT EITHER MU OR NU AS APPROPRIATE. 33 IF(NU2-NU1.GT..5D0) NU=NU+1.D0 34 IF(MU2.GT.MU1) MU=MU+1 35 GO TO 200 36C 37C TRANSFORM P(-MU,NU,X) TO P(MU,NU,X) USING 38C P(MU,NU,X)=(NU-MU+1)*(NU-MU+2)*...*(NU+MU)*P(-MU,NU,X)*(-1)**MU 39C 40 210 PROD=1.D0 41 IPROD=0 42 K=2*MU 43 IF(K.EQ.0) GO TO 222 44 DO 220 L=1,K 45 PROD=PROD*(DMU-NU-DBLE(FLOAT(L))) 46 220 CALL XDADJ(PROD,IPROD) 47 222 CONTINUE 48 DO 240 I=J,N 49 IF(MU.EQ.0) GO TO 225 50 PQA(I)=PQA(I)*PROD*DBLE(FLOAT((-1)**MU)) 51 IPQA(I)=IPQA(I)+IPROD 52 CALL XDADJ(PQA(I),IPQA(I)) 53 225 IF(NU2-NU1.GT..5D0) GO TO 230 54 PROD=(DMU-NU)*PROD*(-DMU-NU-1.D0) 55 CALL XDADJ(PROD,IPROD) 56 MU=MU+1 57 DMU=DMU+1.D0 58 GO TO 240 59 230 PROD=PROD*(-DMU-NU-1.D0)/(DMU-NU-1.D0) 60 CALL XDADJ(PROD,IPROD) 61 NU=NU+1.D0 62 240 CONTINUE 63 RETURN 64 END 65