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

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

@ -5,6 +5,7 @@ program example
integer, parameter :: n = 10
integer :: i, j
logical :: test_ok
real(8), allocatable :: a(:, :)
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)
test_ok = .true.
do i = 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
@ -30,6 +36,10 @@ program example
deallocate(b)
deallocate(c)
print *, 'dgemm test ok'
if (test_ok) then
print *, 'dgemm test ok'
else
print *, 'dgemm test failed'
end if
end program