Viewing contents of file '../idllib/contrib/meron/solve_linsys.pro'
Function Solve_linsys, arr, rhs, threshold = thresh, status = stat, row = row,$
    svd = svdfl, umat = u, vmat = v, dvec = wvec

;+
; NAME:
;	SOLVE_LINSYS
; VERSION:
;	3.0
; PURPOSE:
;	Solves the system of linear equations ARR*X = RHS
; CATEGORY:
;	Mathematical Function /matrix manipulation.
; CALLING SEQUENCE:
;	Result = SOLVE_LINSYS( ARR, RHS [, keywords])
; INPUTS:
;    ARR
;	Matrix, numeric.  Must be square, unless the keyword SVD is set.
;    RHS
;	Vector representing the right hand side of the equation.  Length should
;	be compatible to the dimensions of the matrix.
; OPTIONAL INPUT PARAMETERS:
;	None.
; KEYWORD PARAMETERS:
;    THRESHOLD
;	Sets the threshold that's used to determine whether the matrix is 
;	regular.  Default value is 1e-20.  See OPTIONAL OUTPUT PARAMETERS for
;	details.
;    STATUS
;	Optional output, see below.
;    /ROW
;	Switch.  If set, ARR is taken in a row major format.  Default is 
;	column major (IDL standard).
;    /SVD
;	Switch.  Specifies solution using the Singular Value Decomposition 
;	method.  Default is LU decomposition.
;    UMAT
;	Optional SVD output.  See below.
;    VMAT
;	Optional SVD output.  See below.
;    DVEC
;	Optional SVD output.  See below.
; OUTPUTS:
;    Returns the solution of the linear system in a vector form, type floating 
;    or higher.
; OPTIONAL OUTPUT PARAMETERS:
;    STATUS
;	The name of the variable to receive the status flag for the operation.
;	Possible values are 0 for a singular ARR, 1 for regular.  ARR is
;	considered singular if the ratio of the smallest and largest diagonal
;	element in the LU decomposition (or the diagonal part of the SVD 
;	decomposition) of ARR is less then THRESHOLD.
;    UMAT
;	SVD only.  The name of the variable to receive the U matrix from the 
;	SVD decomposition.  See SVD routine for more detail.
;    VMAT
;	SVD only.  The name of the variable to receive the V matrix from the 
;	SVD decomposition.  See SVD routine for more detail.
;    DVEC
;	Named variable.  Result depends on calculation mode, namely:
;	    LU 	:    vector of the diagonal elements of the LU decomposition.
;	    SVD	:    vector of the diagonal elements of W (see the SVD routine).
; COMMON BLOCKS:
;	None.
; SIDE EFFECTS:
;	None.
; RESTRICTIONS:
;	None.
; PROCEDURE:
;	Normally uses LU decomposition and backsubstitution, followed by LU 
;	correction.  These operations are perfomed by the system routines
;	LUDC, LUSOL and LUMPROVE, based on routines from the book NUMERICAL 
;	RECIPES IN C.  If the keyword SVD is set, the solution is obtained 
;	using Singular Value Decomposition, and back-substitution performed by 
;	the system routines SVDC and SVSOL (same source).  Also uses the 
;	functions CAST, DEFAULT, DIAGOVEC, FPU_FIX, ISNUM and TOLER from MIDL.
; MODIFICATION HISTORY:
;	Created 15-DEC-1991 by Mati Meron.
;	Modified 25-MAY-1993 by Mati Meron.  SVD option added.
;	Modified 30-JUN-1995 by Mati Meron.  Changed from the SVD and SVBKSB
;	routines to the new SVDC and SVSOL.  The change is transparent to the 
;	user other than the fact that that it allows for a DOUBLE type SVD 
;	solution.
;	Modified 25-MAR-1997 by Mati Meron.  Changed from LUDCMP, LUBKSB and
;	MPROVE to the newer LUDC, LUSOL and LUMPROVE.  Same as with the 
;	previous change, it is transparent for the user other than the fact
;	that it allows for a DOUBLE type solution.
;	Also added the keyword ROW which allows for treating the input matrix
;	in standard algebraic fashion, instead of the transposed IDL fashion.
;	Modified 10-SEP-1998 by Mati Meron.  Underflow filtering added.
;-

    on_error, 1
    siz = size(arr)
    if siz(0) ne 2 then message, 'Not a matrix!' else $
    if n_elements(rhs) ne siz(1) then message, 'Incompatible sizes!'
    dob = Isnum(arr,/double) or Isnum(rhs,/double)
    thresh = Default(thresh,Toler(double=dob))
    col = keyword_set(row) eq 0

    if keyword_set(svdfl) then begin
	if siz(1) lt siz(2) then begin
	    tarr = [arr,fltarr(siz(2) - siz(1), siz(2))]
	    trhs = [rhs,fltarr(siz(2) - siz(1))]
	endif else begin
	    tarr = arr
	    trhs = rhs
	endelse
	svdc, tarr, w, u, v, double = dob, column = col
	u = FPU_fix(u)
	v = FPU_fix(v)
	w = FPU_fix(w)
	wvec = w
	abw = abs(wvec)
	smalw = where(abw lt thresh*max(abw), scon)
	if scon gt 0 then w(smalw) = 0
	res = svsol(u,w,v,trhs, double = dob, column = col)
    endif else begin
	if siz(1) ne siz(2) then message, 'Not a square matrix!'
	tarr = arr
	trhs = Cast(rhs,4)
	ludc, tarr, ivec, double = dob, column = col
	tarr = FPU_fix(tarr)
	wvec = Diagovec(tarr)
	abw = abs(wvec)
	smalw = where(abw lt thresh*max(abw), scon)
	res = lusol(tarr,ivec,trhs, double = dob, column = col)
	res = lumprove(arr,tarr,ivec,trhs,res, double = dob, column = col)
    endelse
    stat = (scon eq 0)

    return, FPU_fix(res)
end