Viewing contents of file '../idllib/astron/contrib/varosi/vlib/allpro/gauss_leg_quadr.pro'
;+
; NAME:
;	Gauss_Leg_Quadr
;
; PURPOSE:
;	Setup Gaussian-Legendre quadrature for numerical integration.
;	Get roots of Legendre polynomials and corresponding
;	weights for Gaussian quadrature of a function:
;	Approximate integral = total( weights * function( roots ) )
;
; CALLING:
;	Gauss_Leg_Quadr, Npq, xq, wq
;
; INPUTS:
;	Npq = integer, number of points desired for quadrature,
;		forced to be an even number. The quadrature will be
;		exact for polynomials up to degree 2*Npq-1.
;
; KEYWORDS:
;	XRANGE = range of integration, default = (-1,1).
;		Range can be changed later by rescaling points and weights,
;		(see code at end of this routine).
;	EPSILON = accuracy of root convergence, default = 3.d-14.
;
; OUTPUTS:
;	xq = points at which function should be evaluated.
;	wq = corresponding weights:  Integral = total( wq * func( xq ) )
;
; EXAMPLE:
;	IDL> Gauss_Leg_Quadr, 2, xq, wq, XRANGE=[0,3]
;	IDL> print, total( wq * xq^2 )
;	       9.0000000		; = integral of x^2 from 0 to 3.
;	IDL> print, total( wq * xq^3 )
;	       20.250000		; = integral of x^3 from 0 to 3.
;
; PROCEDURE:
;	G. Rybicki algorithm as described in Numerical Recipes section 4.5.
;	Uses Newton's method to find roots of Legendre polynomials,
;	since the Leg.Poly. derivatives are needed anyway to compute weights.
; HISTORY:
;	Written: Frank Varosi NASA/GSFC 1994.
;	F.V.1995: fixed mistake in using xrange.
;-

pro Gauss_Leg_Quadr, Npq, xq, wq, XRANGE=xrange, EPSILON=eps

	if N_elements( Npq ) NE 1 then begin
		print,"syntax:"
		print,"	Gauss_Leg_Quadr, Npoint, xpoints, weights, XRANGE=[ , ]"
		return
	   endif

	Npq = ( 2 * fix( (Npq+1)/2 ) ) > 2
	Nroot = Npq/2
	if N_elements( eps ) NE 1 then eps = 3.d-14
	zr = cos( !DPI * (dindgen( Nroot ) + 0.75)/(Npq+0.5) )
	zr1 = zr

	p1 = make_array( Nroot, /DOUBLE )
	p2 = p1
	p3 = p1
	pp = p1
	w = indgen( Nroot )

	REPEAT BEGIN	;apply Newton's method selectively until all converged.

		p1(w) = 1
		p2(w) = 0

		for j = 1, Npq do begin
			p3(w) = p2(w)
			p2(w) = p1(w)
			p1(w) = ( (2*j-1)*zr(w)*p2(w) - (j-1)*p3(w) ) /j
		  endfor

		pp(w) = Npq * ( zr(w)*p1(w) - p2(w) ) / ( zr(w)^2 - 1 )
		zr1(w) = zr(w)
		zr(w) = zr(w) - p1(w)/pp(w)

		w = where( abs( zr - zr1 ) GT eps, newton )

	 ENDREP UNTIL (newton LE 0)

	xq = [ -zr, rotate( zr, 2 ) ]
	wq = 2/( (1-zr^2) * pp^2 )
	wq = [ wq, rotate( wq, 2 ) ]

	if N_elements( xrange ) EQ 2 then begin
		xL = ( xrange(1) - xrange(0) )/2.0
		wq = xL * wq
		xq = xL * xq + total( xrange )/2.0
	   endif
end