AnotherFoxGuy/autocmake
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

nicer failure behavior for fc_blas text

Browse Source
This commit is contained in:
Radovan Bast 2015-08-02 11:54:04 +02:00
parent d1d488d07f
commit 289c5529eb
1 changed files with 12 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
test/fc_blas/src/example.f90
View File

@ -5,6 +5,7 @@ program example
integer, parameter :: n = 10 integer, parameter :: n = 10
integer :: i, j integer :: i, j
logical :: test_ok
real(8), allocatable :: a(:, :) real(8), allocatable :: a(:, :)
real(8), allocatable :: b(:, :) real(8), allocatable :: b(:, :)
@ -20,9 +21,14 @@ program example
call dgemm('n', 'n', n, n, n, 1.0d0, a, n, b, n, 0.0d0, c, n) call dgemm('n', 'n', n, n, n, 1.0d0, a, n, b, n, 0.0d0, c, n)
test_ok = .true.
do i = 1, n do i = 1, n
do j = 1, n do j = 1, n
if (dabs(c(i, j) - 20.0d0) > tiny(0.0d0)) return if (dabs(c(i, j) - 20.0d0) > tiny(0.0d0)) then
print *, 'ERROR: element', i, j, 'is', c(i, j)
test_ok = .false.
end if
end do end do
end do end do
@ -30,6 +36,10 @@ program example
deallocate(b) deallocate(b)
deallocate(c) deallocate(c)
if (test_ok) then
print *, 'dgemm test ok' print *, 'dgemm test ok'
else
print *, 'dgemm test failed'
end if
end program end program