Repatch (from linux) of OSX IRAF

1 files changed, 54 insertions, 0 deletions

diff --git a/math/bevington/determ.f b/math/bevington/determ.f
new file mode 100644
index 00000000..4bdc2778
--- /dev/null
+++ b/math/bevington/determ.f
@@ -0,0 +1,54 @@
+C FUNCTION DETERM.F
+C
+C SOURCE
+C   BEVINGTON, PAGE 294.
+C
+C PURPOSE
+C   CALCULATE THE DETERMINANT OF A SQUARE MATRIX
+C
+C USAGE 
+C   DET = DETERM (ARRAY, NORDER)
+C
+C DESCRIPTION OF PARAMETERS
+C   ARRAY  - MATRIX
+C   NORDER - ORDER OF DETERMINANT (DEGREE OF MATRIX)
+C
+C SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED 
+C   NONE
+C
+C COMMENTS
+C   THIS SUBPROGRAM DESTROYS THE INPUT MATRIX ARRAY
+C   DIMENSION STATEMENT VALID FOR NORDER UP TO 10
+C
+	FUNCTION DETERM (ARRAY,NORDER)
+	DOUBLE PRECISION ARRAY,SAVE
+	DIMENSION ARRAY(10,10)
+C
+10	DETERM=1.
+11	DO 50 K=1,NORDER
+C
+C INTERCHANGE COLUMNS IF DIAGONAL ELEMENT IS ZERO
+C
+	IF (ARRAY(K,K)) 41,21,41
+21	DO 23 J=K,NORDER
+	IF (ARRAY(K,J)) 31,23,31
+23	CONTINUE
+	DETERM=0.
+	GOTO 60 
+31	DO 34 I=K,NORDER
+	SAVE=ARRAY(I,J) 
+	ARRAY(I,J)=ARRAY(I,K)
+34	ARRAY(I,K)=SAVE 
+	DETERM=-DETERM
+C
+C SUBTRACT ROW K FROM LOWER ROWS TO GET DIAGONAL MATRIX 
+C
+41	DETERM=DETERM*ARRAY(K,K)
+	IF (K-NORDER) 43,50,50
+43	K1=K+1
+	DO 46 I=K1,NORDER
+	DO 46 J=K1,NORDER
+46	ARRAY(I,J)=ARRAY(I,J)-ARRAY(I,K)*ARRAY(K,J)/ARRAY(K,K)
+50	CONTINUE
+60	RETURN
+	END