Google
 

Trailing-Edge - PDP-10 Archives - decus_20tap1_198111 - decus/20-0025/tpoly.for
There is 1 other file named tpoly.for in the archive. Click here to see a list.
C	TPOLY
	DIMENSION PL(26,26),PROD(26)
9000	FORMAT(' GENERATE LEGENDRE POLYNOMIALS')
9001	FORMAT(//' WHAT IS MAXIMUM DEGREE? ',$)
9002	FORMAT(I)
9003	FORMAT(/'  P(',I2,')')
9004	FORMAT(/' PRODUCT OF P(',I2,') BY P(',
	1I2,') INTEGRATES TO ',F10.6)
9005	FORMAT('  THEORY SAYS INTEGRAL IS',F12.8)
C
	TYPE 9000
1	TYPE 9001
	ACCEPT 9002,L
	IF(L) 9,9,3
3	M=L+1
	CALL LEGEND(PL,L)
	DO 2 I=1,M
	K=I-1
	TYPE 9003,K
	CALL PRNT(PL(1,I),K)
	NP=K+L
	IF(NP-25)4,4,2
4	CALL MTALG(PL(1,I),K,PL(1,M),L,PROD)
	AREA=PINT(PROD,NP,-1.,+1.)
	TYPE 9004,K,L,AREA
	IF(I-M)2,5,5
5	EL=L
	THEORY=2./(1.+2.*EL)
	TYPE 9005,THEORY
2	CONTINUE
	GO TO 1
9	CALL EXIT
	END
C
	FUNCTION PINT(C,NC,XLOW,XHIGH)
	DIMENSION C(26)
	NPLUS=NC+1
	J=NPLUS
	DO 101 I=1,NPLUS
	D=J
	C(J+1)=C(J)/D
101	J=J-1
	C(1)=0.
	PINT=CLPLY(XHIGH,C,NPLUS)-CLPLY(XLOW,C,NPLUS)
	RETURN
	END
C
	SUBROUTINE LEGEND(CL,LL)
C	COMPUTE THE COEFFICIENTS OF THE LEGENDRE
C	POLYNOMIALS BY RECURSION
	DIMENSION CL(26,26),TA(26),TB(26),TC(26),TD(26)
	CL(1,1)=1.
	CL(1,2)=0.
	CL(2,2)=1.
	IF(LL-1) 207,207,201
201	L=0
	ND=1
	TD(1)=0.
	NC=0
	N=LL+1
	DO 202 I=1,N
	TA(I)=0.
202	TB(I)=0.
203	K=L
	L=L+1
	IF(L-LL) 204,207,207
204	M=L+1
	N=L+2
	EL=L
	TD(2)=2.*EL+1.
	TC(1)=EL
	CALL MTALG(TC,NC,CL(1,L),K,TB)
	CALL MTALG(TD,ND,CL(1,M),L,TA)
	DO 205 I=1,N
205	CL(I,N)=(TA(I)-TB(I))/(EL+1.)
	GO TO 203
207	RETURN
	END
C
	SUBROUTINE PRNT(A,NA)
	DIMENSION A(26)
1300	FORMAT('  POLYNOMIAL IS')
1301	FORMAT(1X,F12.6,5H  X**,I3)
	TYPE 1300
	NPLUS=NA+1
	J=NPLUS
	K=NA
	DO 303 I=1,NPLUS
	IF(A(J)) 301,302,301
301	TYPE 1301,A(J),K
302	J=J-1
303	K=K-1
	RETURN
	END