------- Comment #1 from dominiq at lps dot ens dot fr 2010-08-23 12:20 -------
Reduced test
! --------------------------------------------------------------------
MODULE kinds
INTEGER, PARAMETER :: RK8 = SELECTED_REAL_KIND(15, 300)
END MODULE kinds
! --------------------------------------------------------------------
PROGRAM TEST_FPU ! A number-crunching benchmark using matrix inversion.
USE kinds ! Implemented by: David Frank dave_fr...@hotmail.com
IMPLICIT NONE ! Gauss routine by: Tim Prince n...@aol.com
REAL(RK8) :: pool(101,101,1000), pool3(1001,1001) ! random numbers to invert
EQUIVALENCE (pool,pool3) ! use same pool numbers for test 3,4
REAL(RK8) :: a(101,101), a3(1001,1001) ! working matrices
REAL(RK8) :: avg_err, dt
INTEGER :: i, n, t(8), clock1, clock2, rate
CHARACTER (LEN=36) :: invert_id = &
'Test1 - Gauss 2000 (101x101) inverts'
CALL DATE_AND_TIME ( values = t )
CALL RANDOM_NUMBER(pool) ! fill pool with random data ( 0. -> 1. )
CALL SYSTEM_CLOCK (clock1,rate) ! get benchmark (n) start time
DO i = 1,1000
a = pool(:,:,i) ! get next matrix to invert
CALL Gauss (a,101) ! invert a
CALL Gauss (a,101) ! invert a
END DO
avg_err = SUM(ABS(a-pool(:,:,1000)))/(101*101) ! last matrix error
CALL SYSTEM_CLOCK (clock2,rate)
dt = (clock2-clock1)/DBLE(rate) ! get benchmark (n) elapsed sec.
WRITE (*,92) invert_id, dt, ' sec Err=', avg_err
92 FORMAT (A,F5.1,A,F18.15)
END PROGRAM TEST_FPU
! --------------------------------------------------------------------
SUBROUTINE Gauss (a,n) ! Invert matrix by Gauss method
! --------------------------------------------------------------------
USE kinds
IMPLICIT NONE
INTEGER :: n
REAL(RK8) :: a(n,n)
! - - - Local Variables - - -
REAL(RK8) :: b(n,n), c, d, temp(n)
INTEGER :: i, j, k, m, imax(1), ipvt(n)
! - - - - - - - - - - - - - -
b = a
ipvt = (/ (i, i = 1, n) /)
DO k = 1,n
imax = MAXLOC(ABS(b(k:n,k)))
m = k-1+imax(1)
IF (m /= k) THEN
ipvt( (/m,k/) ) = ipvt( (/k,m/) )
b((/m,k/),:) = b((/k,m/),:)
END IF
d = 1/b(k,k)
temp = b(:,k)
DO j = 1, n
c = b(k,j)*d
b(:,j) = b(:,j)-temp*c
b(k,j) = c
END DO
b(:,k) = temp*(-d)
b(k,k) = d
END DO
a(:,ipvt) = b
END SUBROUTINE Gauss
gfcp is r163277, gfc is r163455
[macbook] lin/test% gfcp -Ofast -funroll-loops test_fpu_red.f90
[macbook] lin/test% time a.out
Test1 - Gauss 2000 (101x101) inverts 1.9 sec Err= 0.000000000000006
2.156u 0.064s 0:02.22 99.5% 0+0k 0+0io 0pf+0w
[macbook] lin/test% gfc -Ofast -funroll-loops test_fpu_red.f90
[macbook] lin/test% time a.out
Test1 - Gauss 2000 (101x101) inverts 2.7 sec Err= 0.000000000000006
2.906u 0.067s 0:02.99 98.9% 0+0k 0+0io 0pf+0w
--
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=45379
