check.f

来自「网络带宽测试工具」· F 代码 · 共 33 行

      Subroutine check( c, m, l, n , ok )
! ---------------------------------------------------------------------
! --- Routine 'check' checks some random elements of result matrix 'c' 
!     after matrix-multiplication 'ab = c'. The check is possible
!     because of the special stucture of 'a' & 'b'.
! ---------------------------------------------------------------------
      Use                   numerics
      Implicit              None
      Integer            :: m, l, n
      Real(l_)           :: c(m,n)
      Logical            :: ok

      Integer            :: base, i, j, k, ll
      Integer, Parameter :: nchecks = 10
      Real(l_)           :: dummy, eps, sum
! ---------------------------------------------------------------------
      eps = 20.0_l_*Real( l, l_ )*Epsilon( 1.0_l_ )
      Do k = 1, nchecks
         Call random_number( dummy )
         i = Int( m*dummy + 1 )
         Call random_number( dummy )
         j = Int( n*dummy + 1 )
         sum = 0.0_l_
         base = ( j - 1 )*l
         Do ll = 1, l
            sum = sum + Real( i + ( ll - 1 )*m, l_ )*
     &            Real( base + ll, l_ )
         End Do
         ok = ok .AND. ( Abs( sum - c(i,j) ) <= eps )
      End Do
! ---------------------------------------------------------------------
      End Subroutine check