errchk.f

网络带宽测试工具

      Subroutine errchk( a, b, n, err, ok )
! ----------------------------------------------------------------------
      Use         numerics
      Implicit    None

      Integer  :: n
      Real(l_) :: a(n), b(n), err
      Logical  :: ok
      Integer  :: i
! ----------------------------------------------------------------------
!
! --- ERRCHK checks the errors made in the transformation of a
!     complex-to-complex FFT. ERRCHK is specific for the input
!     of this program.
!     The Real part is a full cycle of a cosine signal and the
!     Imaginary part is 0.0 everywhere.
!     The resulting transform should show values of N/2 for 
!     A(2) and A(N). All other entries should be 0.0.
!     This is checked below with a Floating-Point error
!     margin of ERR = ( 10.0*N Log N )*EPS, with EPS the
!     Floating-Point spacing of the machine tested.
! --- The Real part of A is stored in A(1), ..., A(N);
!     The Imaginary part in B(1), ..., B(N).
! ----------------------------------------------------------------------
      ok = .TRUE.
      If ( a(1) > err ) Then
         Print 1000, n, 1, a(1), err
         ok = .FALSE.
         Return
      End If

      Do i = 3, n - 1
         If ( a(i) > err ) Then
            Print 1010, n, i, a(i), err
            ok = .FALSE.
         End If
      End Do
      If ( .NOT. ok ) Return

      If ( Abs ( a(2) - Real( n/2, l_ ) ) > err ) Then
         Print 1020, n, 2, a(2), Real( n/2, l_ )
         ok = .FALSE.
         Return
      End If
      If ( Abs ( a(n) - Real( n/2, l_ ) ) > err ) Then
         Print 1030, n, n, a(n), Real( n/2, l_ )
         ok = .FALSE.
         Return
      End If
      Do i = 1, n
         If ( b(i) > err ) Then
            Print 1040, n, i, b(i), err
            ok = .FALSE.
         End If
      End Do
! ----------------------------------------------------------------------
 1000 Format ( 'First Real element,  n = ', 2i8, 2(g13.5) )
 1010 Format ( 'Real element,        n = ', 2i8, 2(g13.5) )
 1020 Format ( 'Second Real element, n = ', 2i8, 2(g13.5) )
 1030 Format ( 'N-th Real element,   n = ', 2i8, 2(g13.5) )
 1040 Format ( 'Imaginary element,   n = ', 2i8, 2(g13.5) )
! ----------------------------------------------------------------------
      End Subroutine errchk