Skip to content
zblat2.f 114 KiB
Newer Older
Luker's avatar
Luker committed
*> \brief \b ZBLAT2
*
*  =========== DOCUMENTATION ===========
*
* Online html documentation available at 
*            http://www.netlib.org/lapack/explore-html/ 
*
*  Definition:
*  ===========
*
*       PROGRAM ZBLAT2
* 
*
*> \par Purpose:
*  =============
*>
*> \verbatim
*>
*> Test program for the COMPLEX*16       Level 2 Blas.
*>
*> The program must be driven by a short data file. The first 18 records
*> of the file are read using list-directed input, the last 17 records
*> are read using the format ( A6, L2 ). An annotated example of a data
*> file can be obtained by deleting the first 3 characters from the
*> following 35 lines:
*> 'zblat2.out'      NAME OF SUMMARY OUTPUT FILE
*> 6                 UNIT NUMBER OF SUMMARY FILE
*> 'CBLA2T.SNAP'     NAME OF SNAPSHOT OUTPUT FILE
*> -1                UNIT NUMBER OF SNAPSHOT FILE (NOT USED IF .LT. 0)
*> F        LOGICAL FLAG, T TO REWIND SNAPSHOT FILE AFTER EACH RECORD.
*> F        LOGICAL FLAG, T TO STOP ON FAILURES.
*> T        LOGICAL FLAG, T TO TEST ERROR EXITS.
*> 16.0     THRESHOLD VALUE OF TEST RATIO
*> 6                 NUMBER OF VALUES OF N
*> 0 1 2 3 5 9       VALUES OF N
*> 4                 NUMBER OF VALUES OF K
*> 0 1 2 4           VALUES OF K
*> 4                 NUMBER OF VALUES OF INCX AND INCY
*> 1 2 -1 -2         VALUES OF INCX AND INCY
*> 3                 NUMBER OF VALUES OF ALPHA
*> (0.0,0.0) (1.0,0.0) (0.7,-0.9)       VALUES OF ALPHA
*> 3                 NUMBER OF VALUES OF BETA
*> (0.0,0.0) (1.0,0.0) (1.3,-1.1)       VALUES OF BETA
*> ZGEMV  T PUT F FOR NO TEST. SAME COLUMNS.
*> ZGBMV  T PUT F FOR NO TEST. SAME COLUMNS.
*> ZHEMV  T PUT F FOR NO TEST. SAME COLUMNS.
*> ZHBMV  T PUT F FOR NO TEST. SAME COLUMNS.
*> ZHPMV  T PUT F FOR NO TEST. SAME COLUMNS.
*> ZTRMV  T PUT F FOR NO TEST. SAME COLUMNS.
*> ZTBMV  T PUT F FOR NO TEST. SAME COLUMNS.
*> ZTPMV  T PUT F FOR NO TEST. SAME COLUMNS.
*> ZTRSV  T PUT F FOR NO TEST. SAME COLUMNS.
*> ZTBSV  T PUT F FOR NO TEST. SAME COLUMNS.
*> ZTPSV  T PUT F FOR NO TEST. SAME COLUMNS.
*> ZGERC  T PUT F FOR NO TEST. SAME COLUMNS.
*> ZGERU  T PUT F FOR NO TEST. SAME COLUMNS.
*> ZHER   T PUT F FOR NO TEST. SAME COLUMNS.
*> ZHPR   T PUT F FOR NO TEST. SAME COLUMNS.
*> ZHER2  T PUT F FOR NO TEST. SAME COLUMNS.
*> ZHPR2  T PUT F FOR NO TEST. SAME COLUMNS.
*>
*> Further Details
*> ===============
*>
*>    See:
*>
*>       Dongarra J. J., Du Croz J. J., Hammarling S.  and Hanson R. J..
*>       An  extended  set of Fortran  Basic Linear Algebra Subprograms.
*>
*>       Technical  Memoranda  Nos. 41 (revision 3) and 81,  Mathematics
*>       and  Computer Science  Division,  Argonne  National Laboratory,
*>       9700 South Cass Avenue, Argonne, Illinois 60439, US.
*>
*>       Or
*>
*>       NAG  Technical Reports TR3/87 and TR4/87,  Numerical Algorithms
*>       Group  Ltd.,  NAG  Central  Office,  256  Banbury  Road, Oxford
*>       OX2 7DE, UK,  and  Numerical Algorithms Group Inc.,  1101  31st
*>       Street,  Suite 100,  Downers Grove,  Illinois 60515-1263,  USA.
*>
*>
*> -- Written on 10-August-1987.
*>    Richard Hanson, Sandia National Labs.
*>    Jeremy Du Croz, NAG Central Office.
*>
*>    10-9-00:  Change STATUS='NEW' to 'UNKNOWN' so that the testers
*>              can be run multiple times without deleting generated
*>              output files (susan)
*> \endverbatim
*
*  Authors:
*  ========
*
*> \author Univ. of Tennessee 
*> \author Univ. of California Berkeley 
*> \author Univ. of Colorado Denver 
*> \author NAG Ltd. 
*
*> \date April 2012
*
*> \ingroup complex16_blas_testing
*
*  =====================================================================
Luker's avatar
Luker committed
      PROGRAM ZBLAT2
*
Luker's avatar
Luker committed
*  -- Reference BLAS test routine (version 3.4.1) --
*  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*     April 2012
Luker's avatar
Luker committed
*
Luker's avatar
Luker committed
*  =====================================================================
Luker's avatar
Luker committed
*
*     .. Parameters ..
      INTEGER            NIN
      PARAMETER          ( NIN = 5 )
      INTEGER            NSUBS
      PARAMETER          ( NSUBS = 17 )
      COMPLEX*16         ZERO, ONE
      PARAMETER          ( ZERO = ( 0.0D0, 0.0D0 ),
     $                   ONE = ( 1.0D0, 0.0D0 ) )
Luker's avatar
Luker committed
      DOUBLE PRECISION   RZERO
      PARAMETER          ( RZERO = 0.0D0 )
Luker's avatar
Luker committed
      INTEGER            NMAX, INCMAX
      PARAMETER          ( NMAX = 65, INCMAX = 2 )
      INTEGER            NINMAX, NIDMAX, NKBMAX, NALMAX, NBEMAX
      PARAMETER          ( NINMAX = 7, NIDMAX = 9, NKBMAX = 7,
     $                   NALMAX = 7, NBEMAX = 7 )
*     .. Local Scalars ..
      DOUBLE PRECISION   EPS, ERR, THRESH
      INTEGER            I, ISNUM, J, N, NALF, NBET, NIDIM, NINC, NKB,
     $                   NOUT, NTRA
      LOGICAL            FATAL, LTESTT, REWI, SAME, SFATAL, TRACE,
     $                   TSTERR
      CHARACTER*1        TRANS
      CHARACTER*6        SNAMET
      CHARACTER*32       SNAPS, SUMMRY
*     .. Local Arrays ..
      COMPLEX*16         A( NMAX, NMAX ), AA( NMAX*NMAX ),
     $                   ALF( NALMAX ), AS( NMAX*NMAX ), BET( NBEMAX ),
     $                   X( NMAX ), XS( NMAX*INCMAX ),
     $                   XX( NMAX*INCMAX ), Y( NMAX ),
     $                   YS( NMAX*INCMAX ), YT( NMAX ),
     $                   YY( NMAX*INCMAX ), Z( 2*NMAX )
      DOUBLE PRECISION   G( NMAX )
      INTEGER            IDIM( NIDMAX ), INC( NINMAX ), KB( NKBMAX )
      LOGICAL            LTEST( NSUBS )
      CHARACTER*6        SNAMES( NSUBS )
*     .. External Functions ..
      DOUBLE PRECISION   DDIFF
      LOGICAL            LZE
      EXTERNAL           DDIFF, LZE
*     .. External Subroutines ..
      EXTERNAL           ZCHK1, ZCHK2, ZCHK3, ZCHK4, ZCHK5, ZCHK6,
     $                   ZCHKE, ZMVCH
*     .. Intrinsic Functions ..
      INTRINSIC          ABS, MAX, MIN
*     .. Scalars in Common ..
      INTEGER            INFOT, NOUTC
      LOGICAL            LERR, OK
      CHARACTER*6        SRNAMT
*     .. Common blocks ..
      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
      COMMON             /SRNAMC/SRNAMT
*     .. Data statements ..
      DATA               SNAMES/'ZGEMV ', 'ZGBMV ', 'ZHEMV ', 'ZHBMV ',
     $                   'ZHPMV ', 'ZTRMV ', 'ZTBMV ', 'ZTPMV ',
     $                   'ZTRSV ', 'ZTBSV ', 'ZTPSV ', 'ZGERC ',
     $                   'ZGERU ', 'ZHER  ', 'ZHPR  ', 'ZHER2 ',
     $                   'ZHPR2 '/
*     .. Executable Statements ..
*
*     Read name and unit number for summary output file and open file.
*
      READ( NIN, FMT = * )SUMMRY
      READ( NIN, FMT = * )NOUT
Luker's avatar
Luker committed
      OPEN( NOUT, FILE = SUMMRY, STATUS = 'UNKNOWN' )
Luker's avatar
Luker committed
      NOUTC = NOUT
*
*     Read name and unit number for snapshot output file and open file.
*
      READ( NIN, FMT = * )SNAPS
      READ( NIN, FMT = * )NTRA
      TRACE = NTRA.GE.0
      IF( TRACE )THEN
Luker's avatar
Luker committed
         OPEN( NTRA, FILE = SNAPS, STATUS = 'UNKNOWN' )
Luker's avatar
Luker committed
      END IF
*     Read the flag that directs rewinding of the snapshot file.
      READ( NIN, FMT = * )REWI
      REWI = REWI.AND.TRACE
*     Read the flag that directs stopping on any failure.
      READ( NIN, FMT = * )SFATAL
*     Read the flag that indicates whether error exits are to be tested.
      READ( NIN, FMT = * )TSTERR
*     Read the threshold value of the test ratio
      READ( NIN, FMT = * )THRESH
*
*     Read and check the parameter values for the tests.
*
*     Values of N
      READ( NIN, FMT = * )NIDIM
Loading full blame...