C$TEST LGEJ C*********************************************************************** C C EXAMPLE OF USE OF THE PORT PROGRAM GELU C C*********************************************************************** SUBROUTINE DET(N,A,IA,DETMAN,IDETEX) C C THIS SUBROUTINE COMPUTES THE DETERMINANT OF A C THE RESULT IS GIVEN BY DETMAN*BETA**IDETEX C WHERE BETA IS THE BASE OF THE MACHINE C AND DETMAN IS BETWEEN 1/BETA AND 1 C INTEGER N, IA, IDETEX INTEGER E, IPOINT, ISTKGT, I1MACH, ISIGN, I INTEGER IN(1000) REAL A(IA, N), DETMAN, BETA, FLOAT, ONOVBE, M, ABS DOUBLE PRECISION D(500) COMMON /CSTAK/ D EQUIVALENCE(D(1),IN(1)) C C ALLOCATE SPACE FROM THE STACK FOR THE PIVOT ARRAY C IPOINT=ISTKGT(N,2) CALL GELU(N,A,IA,IN(IPOINT),0.0) C C THE DETERMINANT IS THE PRODUCT OF THE DIAGONAL ELEMENTS C AND THE LAST ELEMENT OF THE INTERCHANGE ARRAY C WE TRY TO COMPUTE THIS PRODUCT IN A WAY THAT WILL C AVOID UNDERFLOW AND OVERFLOW C BETA=FLOAT(I1MACH(10)) ONOVBE=1.0/BETA ISIGN=IPOINT + N-1 DETMAN=IN(ISIGN)*ONOVBE IDETEX=1 DO 10 I=1,N CALL UMKFL(A(I,I),E,M) DETMAN=DETMAN*M IDETEX=IDETEX+E IF(ABS(DETMAN).GE.ONOVBE) GO TO 10 IDETEX=IDETEX-1 DETMAN=DETMAN*BETA 10 CONTINUE RETURN END .