LAPACK: TESTING/LIN/zerrab.f Source File

Go to the documentation of this file.
00001       SUBROUTINE ZERRAB( NUNIT )
00002 *
00003 *  -- LAPACK test routine (version 3.1.1) --
00004 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
00005 *     January 2007
00006 *
00007 *     .. Scalar Arguments ..
00008       INTEGER            NUNIT
00009 *     ..
00010 *
00011 *  Purpose
00012 *  =======
00013 *
00014 *  DERRAB tests the error exits for ZCGESV.
00015 *
00016 *  Arguments
00017 *  =========
00018 *
00019 *  NUNIT   (input) INTEGER
00020 *          The unit number for output.
00021 *
00022 *  =====================================================================
00023 *
00024 *     .. Parameters ..
00025       INTEGER            NMAX
00026       PARAMETER          ( NMAX = 4 )
00027 *     ..
00028 *     .. Local Scalars ..
00029       INTEGER            I, INFO, ITER, J
00030 *     ..
00031 *     .. Local Arrays ..
00032       INTEGER            IP( NMAX )
00033       COMPLEX*16         A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
00034      $                   C( NMAX ), R( NMAX ), R1( NMAX ), R2( NMAX ),
00035      $                   W( 2*NMAX ), X( NMAX )
00036       COMPLEX*16         WORK(1)
00037       COMPLEX            SWORK(1)
00038       DOUBLE PRECISION   RWORK(1)
00039 *     ..
00040 *     .. External Functions ..
00041 *     ..
00042 *     .. External Subroutines ..
00043       EXTERNAL           CHKXER, ZCGESV
00044 *     ..
00045 *     .. Scalars in Common ..
00046       LOGICAL            LERR, OK
00047       CHARACTER*32       SRNAMT
00048       INTEGER            INFOT, NOUT
00049 *     ..
00050 *     .. Common blocks ..
00051       COMMON             / INFOC / INFOT, NOUT, OK, LERR
00052       COMMON             / SRNAMC / SRNAMT
00053 *     ..
00054 *     .. Intrinsic Functions ..
00055       INTRINSIC          DBLE
00056 *     ..
00057 *     .. Executable Statements ..
00058 *
00059       NOUT = NUNIT
00060       WRITE( NOUT, FMT = * )
00061 *
00062 *     Set the variables to innocuous values.
00063 *
00064       DO 20 J = 1, NMAX
00065          DO 10 I = 1, NMAX
00066             A( I, J ) = 1.D0 / DBLE( I+J )
00067             AF( I, J ) = 1.D0 / DBLE( I+J )
00068    10    CONTINUE
00069          B( J ) = 0.D0
00070          R1( J ) = 0.D0
00071          R2( J ) = 0.D0
00072          W( J ) = 0.D0
00073          X( J ) = 0.D0
00074          C( J ) = 0.D0
00075          R( J ) = 0.D0
00076          IP( J ) = J
00077    20 CONTINUE
00078       OK = .TRUE.
00079 *
00080       SRNAMT = 'ZCGESV'
00081       INFOT = 1
00082       CALL ZCGESV(-1,0,A,1,IP,B,1,X,1,WORK,SWORK,RWORK,ITER,INFO)
00083       CALL CHKXER( 'ZCGESV', INFOT, NOUT, LERR, OK )
00084       INFOT = 2
00085       CALL ZCGESV(0,-1,A,1,IP,B,1,X,1,WORK,SWORK,RWORK,ITER,INFO)
00086       CALL CHKXER( 'ZCGESV', INFOT, NOUT, LERR, OK )
00087       INFOT = 4
00088       CALL ZCGESV(2,1,A,1,IP,B,2,X,2,WORK,SWORK,RWORK,ITER,INFO)
00089       CALL CHKXER( 'ZCGESV', INFOT, NOUT, LERR, OK )
00090       INFOT = 7
00091       CALL ZCGESV(2,1,A,2,IP,B,1,X,2,WORK,SWORK,RWORK,ITER,INFO)
00092       CALL CHKXER( 'ZCGESV', INFOT, NOUT, LERR, OK )
00093       INFOT = 9
00094       CALL ZCGESV(2,1,A,2,IP,B,2,X,1,WORK,SWORK,RWORK,ITER,INFO)
00095       CALL CHKXER( 'ZCGESV', INFOT, NOUT, LERR, OK )
00096 *
00097 *     Print a summary line.
00098 *
00099       IF( OK ) THEN
00100          WRITE( NOUT, FMT = 9999 )'ZCGESV'
00101       ELSE
00102          WRITE( NOUT, FMT = 9998 )'ZCGESV'
00103       END IF
00104 *
00105  9999 FORMAT( 1X, A6, ' drivers passed the tests of the error exits' )
00106  9998 FORMAT( ' *** ', A6, ' drivers failed the tests of the error ',
00107      $      'exits ***' )
00108 *
00109       RETURN
00110 *
00111 *     End of ZERRAB
00112 *
00113       END