linful.f

网络带宽测试工具

      Program linful
! ----------------------------------------------------------------------
! **********************************************************************
! *** This program is part of the EuroBen Efficiency Benchmark       ***
! ***                                                                ***
! *** Copyright: EuroBen Group p/o                                   ***
! ***            Utrecht University, Computational Physics Dept.     ***
! ***            P.O. Box 80.000                                     ***
! ***            3508 TA Utrecht                                     ***
! ***            The Netherlands                                     ***
! ***                                                                ***
! *** Author of this program: Ruud van der Pas                       ***
! *** Date                    11/24/1988                             ***
! *** Modified by:            Peter de Rijk                          ***
! *** Date                    02/12/1993                             ***
! *** Modified by:            Aad van der Steen                      ***
! *** Date                    Spring 1999                            ***
! **********************************************************************
! ----------------------------------------------------------------------
! --- Purpose of program linful
!     -------------------------
!     This program solves a linear system Ax = b for a general matrix A
!     of orders as specified in the input file 'linful.in'.
!
! --- Remarks
!     -------
!     LAPACK and BLAS routines are used.
!
!     If (optimized) library versions for LAPACK and LINPACK are
!     available, you are asked to run a version of this program using
!     these versions.
! ----------------------------------------------------------------------
      Use                      numerics
      Implicit                 None

! --- Local Variables
!     ---------------
      Integer               :: i, lda, n, nrep, ierr
      Real(l_)              :: norma 
      Real(l_), Allocatable :: a(:,:), b(:)
      Integer, Allocatable  :: ipvt(:)
      Real(l_)              :: t1, time1, time2, totime, ops, speed
      Logical               :: ok

      Integer, Parameter    :: nmax = 50, k = 4
      Integer               :: ic
      Real(l_)              :: size(0:nmax-1), speedcase(0:nmax-1)
      Real(l_)              :: q(0:6,0:nmax+1), aw(0:3,0:3), d(0:3,0:3),
     &                         extra(0:1), result
      Real(l_), Parameter   :: eps = 5.0e-4, fraction = 0.2
      Real(l_)              :: low, up, tpp
      Real(l_)              :: tkn, bcoef
      Common /coeffs/          tkn(0:nmax+5), bcoef(0:nmax+1) 
!
! --- External Functions
!     ------------------
      External                 autint, spoint, wclock
      Real(l_)              :: autint, spoint, wclock
!
!-----------------------------------------------------------------------
!                                  ** Print status information & header.
      Call state ( 'linful  ' )
      Open( 1, File = 'linful.in' )

!-----------------------------------------------------------------------
!               ** We use the right-looking Level 3 BLAS LAPACK version.

      Read( 1, * ) tpp
      Read( 1, * ) low, up
      Print 1000,  low, up, tpp
      ic  = 0
   10 Read( 1, *, End = 20 ) n, nrep
      lda = n + 1
      Allocate( a(lda,n), b(n), ipvt(n) )
      ops = ((2.0_l_*n)*n*n)/3.0_l_ + (2.0_l_*n)*n
      time1 = 0.0_l_
      time2 = 0.0_l_

! --- Generate the matrix.

      Do i = 1, nrep

         Call matgen( a, lda, n, b, norma )
!
         t1    = wclock()
         Call dgetrf( n, n, a, lda, ipvt, ierr )
         time1 = time1 + ( wclock() - t1 )

! --- Stop on error.

         If ( ierr /= 0 ) Then
            Print 2000, 'DGETRF', ierr
            Stop
         End If
!
         t1    = wclock()
         Call dgetrs( 'N', n, 1, a, lda, ipvt, b, n, ierr )
         time2 = time2 + ( wclock() - t1 )

! --- Stop on error.

         If ( ierr /= 0 ) Then
            Print 2000, 'DGETRS', ierr
            Stop
         End If
      End Do

! --- Check correctness.

      ok = .TRUE.
      Call check( b, n, ok )
      time1  = time1/nrep
      time2  = time2/nrep
      totime = time1 + time2
      speed  = 1.0E-6_l_*ops/Max( 1.0E-9_l_, totime )
      Print 1010, n,  time1, time2, totime, speed, ok
      Deallocate( a, b, ipvt )
      size(ic) = Real( n, l_ )
      speedcase(ic) = speed
      ic = ic + 1
      Go To 10
   20 Print 1020
      Call bsplcf( size, speedcase, ic, k, 'FREE', extra, q, aw, d,
     &             tkn, bcoef )
      result = autint( spoint, low, up, eps )
      result = result/((up - low)*tpp)
      Print 1030, result, fraction
! -----------------------------------------------------------------------
 1000 Format( 'Dense linear solver test:'/
     &        'Lower bound       =', g13.5/
     &        'Upper bound       =', g13.5/
     &        'Theor. Peak Perf. =', g13.5, ' Mflop/s'/
     &        '-----------------------------------------------',
     &        '-------------------'/,
     &        ' Order |  Factoris. |  Solving   |    Total   |',
     &        '    Speed   |     |'/,
     &        '   n   |  Time (s)  |  Time (s)  |  Time (s)  |',
     &        '  (Mflop/s) | OK? |'/, 
     &        '-----------------------------------------------'
     &        '-------------------' )
 1010 Format( i6, ' |', g11.4, ' |', g11.4, ' |', g11.4,' |', g11.4,
     &        ' |', l3, '  |' )
 1020 Format( '-----------------------------------------------',
     &        '-------------------' )
 1030 Format( /'Fraction found = ', g11.4, '  Fraction required = ',
     &        g11.4 )
 2000 Format( i6 )
! -----------------------------------------------------------------------
      End Program linful