Viewing contents of file '../idllib/iuedac/iuelib/pro/determ.pro'
;*************************************************************************
;+
;*NAME:
;
; DETERM (General IDL Library 01) July 25 1984
;
;*CLASS:
;
; Matrix Arithmetic
;
;*CATEGORY:
;
;*PURPOSE:
;
; TO CALCULATE THE DETERMINANT OF A SQUARE MATRIX
;
;*CALLING SEQUENCE:
;
; DETERM,ARRAY,DET,darr
;
;*PARAMETERS:
;
; ARRAY (REQ) (I) (2) (I L F D)
; Required input square array for which the determinant is
; to be calculated.
;
; DET (REQ) (O) (0) (F D)
; Determinant of square matrix.
;
; DARR (OPT) (O) (2) (I L F D)
; optional diagonalized array (note off-diagonal elements
; not zeroed)
;
;*EXAMPLES:
;
;*SYSTEM VARIABLES USED:
;
;*INTERACTIVE INPUT:
;
;*SUBROUTINES CALLED:
;
; PARCHECK
; PCHECK
;
;*FILES USED:
;
;*SIDE EFFECTS:
;
;*RESTRICTIONS:
;
;*NOTES:
;
; tested with IDL Version 2.1.0 (sunos sparc) 20 Jun 91
; tested with IDL Version 2.1.0 (ultrix mispel) N/A
; tested with IDL Version 2.1.0 (vms vax) 21 Jun 91
;
;*PROCEDURE:
;
; DETERM is an IDL version of Bevingtons routine by the same name (p.293)
; As explained in Bevington, the determinant is calculated from the product
; of the diagonal elements of a diagonalized matrix.
;
;
;*MODIFICATION HISTORY:
;
; Jul 25 1984 RWT GSFC incorporated into RDAF library, based on a
; procedure by I. Ahmad and documentation updated.
; Apr 13 1987 RWT GSFC add PARCHECK
; Mar 8 1988 CAG GSFC add VAX RDAF-style prolog, add printing of the
; calling sequence if no parameters have
; been specified.
; Apr 21 1988 RWT GSFC make working set array double precision and make it
; an optional output parameter to avoid changing input
; array
; Jun 21 1991 PJL GSFC cleaned up; lowercase; tested on SUN and VAX;
; updated prolog
;
;-
;***************************************************************************
pro determ,array,det,darr
;
; Print calling sequence if no parameters have been specified.
;
if n_params(0) eq 0 then begin
print,'DETERM,ARRAY,DET,darr'
retall
endif ; n_params(0)
;
; check that all parameters have been specified
;
parcheck,n_params(0),[2,3],'DETERM'
pcheck,array,1,001,0011
s=size(array)
s1=s(1)-1
det=1.
darr = double(array)
for k=0,s1 do begin
;
; interchange columns if diagonal element is 0
;
if darr(k,k) eq 0 then begin
j=k
while (j lt s1) and (darr(k,j) eq 0) do j=j+1
;
; if matrix is singular set det=0 and end procedure
;
if darr(k,j) eq 0. then begin
det=0
print,'WARNING! Determinent equals ZERO!'
return ; end procedure if matrix singular
endif else begin
;
; if nonzero diagonal element found, swap
;
for i=k,s1 do begin
save=darr(i,j)
darr(i,j)=darr(i,k)
darr(i,k)=save
endfor ; i loop
endelse ; j eq s1
det=-det ; column swap changes sign of determinant
endif ; darr(k,k)
;
; subtract row k from lower rows to get diagonal matrix
;
arrkk=darr(k,k)
det=det*arrkk
if k lt s1 then begin ; if not at last row, proceed
k1=k+1
for i=k1,s1 do begin
for j=k1,s1 do darr(i,j)=darr(i,j)-darr(i,k)*(darr(k,j)/arrkk)
endfor ; i
endif ; k lt s1
endfor ; k
return
end ; determ