C MATRIX DETERMINANT SUBROUTINE MDET(XVBLS,I1,I2,J1,J2,DET) INCLUDE 'VKLUGPRM.FTN' REAL*8 XVBLS(1),DET,SUMA,SUMB C NOTE XVBLS IS RRW BY RCL MATRIX IN PORTACALC C I1,I2 ARE TOP COL,ROW COORD; J1,J2 ARE BOTTOM C STORAGE OF XVBLS IS (COL,ROW) SO LOCATIONS INSIDE C IT ARE C ADDR=(ROW-1)*RRW+COL (RRW IS # OF COLS) DET=0. N=J1-I1+1 M=J2-I2+1 IF(N.NE.M)RETURN IF(N.LE.1)RETURN C ONLY SQUARE MATRICES MAY HAVE NONZERO DETERMINANTS C ALSO, DIMENSION HAS TO BE > 1 NN=N C FIXUP... (OK FOR N=2,3 ANYHOW) IF(N.EQ.2)NN=N-1 C SUM OVER DIAGS... C MULTIPLY DIAGONALS FROM TOP AND BOTTOM ROWS OF MATRIX AND GET C DIFFERENCE EACH TIME FOR ACCURACY DO 1 N1=1,NN SUMA=1. SUMB=1. DO 2 N2=1,N NCL=N1+N2-1 N2L=N+1-N2 IF(NCL.GT.N)NCL=NCL-N C NOW MULTIPLY SUMA (POSITIVE TERMS) BY X(NCL,N2) AND SUMB(NEG TERMS) C BY X(NCL,N2L) LA=(N2-2+I2)*RRW+I1+NCL-1 LB=(N2L-2+I2)*RRW+I1+NCL-1 CALL XVBLGT(LA,1,XVBLS(1)) SUMA=SUMA*XVBLS(1) CALL XVBLGT(LB,1,XVBLS(1)) SUMB=SUMB*XVBLS(1) 2 CONTINUE C NOW ACCUMULATE TERMS IN DETERMINANT DET=DET+SUMA-SUMB C DO IN THIS ORDER TO AVOID EXCESSIVE LOSS OF PRECISION DUE TO C DIFFERENCES OF LARGE TERMS. THIS IS BAD ENOUGH AS IT IS... 1 CONTINUE RETURN END