1*DECK XPMUP 2 SUBROUTINE XPMUP (NU1, NU2, MU1, MU2, PQA, IPQA, IERROR) 3C***BEGIN PROLOGUE XPMUP 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 Legendre functions of the first kind of positive 9C order stored in array PQA. The original array is destroyed. 10C***LIBRARY SLATEC 11C***CATEGORY C3A2, C9 12C***TYPE SINGLE PRECISION (XPMUP-S, DXPMUP-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 XPMUP 25 REAL DMU,NU,NU1,NU2,PQA,PROD 26 DIMENSION PQA(*),IPQA(*) 27C***FIRST EXECUTABLE STATEMENT XPMUP 28 IERROR=0 29 NU=NU1 30 MU=MU1 31 DMU=MU 32 N=INT(NU2-NU1+.1)+(MU2-MU1)+1 33 J=1 34 IF(MOD(NU,1.).NE.0.) GO TO 210 35 200 IF(DMU.LT.NU+1.) GO TO 210 36 PQA(J)=0. 37 IPQA(J)=0 38 J=J+1 39 IF(J.GT.N) RETURN 40C INCREMENT EITHER MU OR NU AS APPROPRIATE. 41 IF(NU2-NU1.GT..5) NU=NU+1. 42 IF(MU2.GT.MU1) MU=MU+1 43 GO TO 200 44C 45C TRANSFORM P(-MU,NU,X) TO P(MU,NU,X) USING 46C P(MU,NU,X)=(NU-MU+1)*(NU-MU+2)*...*(NU+MU)*P(-MU,NU,X)*(-1)**MU 47C 48 210 PROD=1. 49 IPROD=0 50 K=2*MU 51 IF(K.EQ.0) GO TO 222 52 DO 220 L=1,K 53 PROD=PROD*(DMU-NU-L) 54 220 CALL XADJ(PROD,IPROD,IERROR) 55 IF (IERROR.NE.0) RETURN 56 222 CONTINUE 57 DO 240 I=J,N 58 IF(MU.EQ.0) GO TO 225 59 PQA(I)=PQA(I)*PROD*(-1)**MU 60 IPQA(I)=IPQA(I)+IPROD 61 CALL XADJ(PQA(I),IPQA(I),IERROR) 62 IF (IERROR.NE.0) RETURN 63 225 IF(NU2-NU1.GT..5) GO TO 230 64 PROD=(DMU-NU)*PROD*(-DMU-NU-1.) 65 CALL XADJ(PROD,IPROD,IERROR) 66 IF (IERROR.NE.0) RETURN 67 MU=MU+1 68 DMU=DMU+1. 69 GO TO 240 70 230 PROD=PROD*(-DMU-NU-1.)/(DMU-NU-1.) 71 CALL XADJ(PROD,IPROD,IERROR) 72 IF (IERROR.NE.0) RETURN 73 NU=NU+1. 74 240 CONTINUE 75 RETURN 76 END 77