TESTING/LIN/zpot06.f

   1 *> \brief \b ZPOT06
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *  Definition:
   9 *  ===========
  10 *
  11 *       SUBROUTINE ZPOT06( UPLO, N, NRHS, A, LDA, X, LDX, B, LDB,
  12 *                          RWORK, RESID )
  13 *
  14 *       .. Scalar Arguments ..
  15 *       CHARACTER          UPLO
  16 *       INTEGER            LDA, LDB, LDX, N, NRHS
  17 *       DOUBLE PRECISION   RESID
  18 *       ..
  19 *       .. Array Arguments ..
  20 *       DOUBLE PRECISION   RWORK( * )
  21 *       COMPLEX*16         A( LDA, * ), B( LDB, * ), X( LDX, * )
  22 *       ..
  23 *
  24 *
  25 *> \par Purpose:
  26 *  =============
  27 *>
  28 *> \verbatim
  29 *>
  30 *> ZPOT06 computes the residual for a solution of a system of linear
  31 *> equations  A*x = b :
  32 *>    RESID = norm(B - A*X,inf) / ( norm(A,inf) * norm(X,inf) * EPS ),
  33 *> where EPS is the machine epsilon.
  34 *> \endverbatim
  35 *
  36 *  Arguments:
  37 *  ==========
  38 *
  39 *> \param[in] UPLO
  40 *> \verbatim
  41 *>          UPLO is CHARACTER*1
  42 *>          Specifies whether the upper or lower triangular part of the
  43 *>          symmetric matrix A is stored:
  44 *>          = 'U':  Upper triangular
  45 *>          = 'L':  Lower triangular
  46 *> \endverbatim
  47 *>
  48 *> \param[in] N
  49 *> \verbatim
  50 *>          N is INTEGER
  51 *>          The number of rows and columns of the matrix A.  N >= 0.
  52 *> \endverbatim
  53 *>
  54 *> \param[in] NRHS
  55 *> \verbatim
  56 *>          NRHS is INTEGER
  57 *>          The number of columns of B, the matrix of right hand sides.
  58 *>          NRHS >= 0.
  59 *> \endverbatim
  60 *>
  61 *> \param[in] A
  62 *> \verbatim
  63 *>          A is COMPLEX*16 array, dimension (LDA,N)
  64 *>          The original M x N matrix A.
  65 *> \endverbatim
  66 *>
  67 *> \param[in] LDA
  68 *> \verbatim
  69 *>          LDA is INTEGER
  70 *>          The leading dimension of the array A.  LDA >= max(1,N).
  71 *> \endverbatim
  72 *>
  73 *> \param[in] X
  74 *> \verbatim
  75 *>          X is COMPLEX*16 array, dimension (LDX,NRHS)
  76 *>          The computed solution vectors for the system of linear
  77 *>          equations.
  78 *> \endverbatim
  79 *>
  80 *> \param[in] LDX
  81 *> \verbatim
  82 *>          LDX is INTEGER
  83 *>          The leading dimension of the array X.  If TRANS = 'N',
  84 *>          LDX >= max(1,N); if TRANS = 'T' or 'C', LDX >= max(1,N).
  85 *> \endverbatim
  86 *>
  87 *> \param[in,out] B
  88 *> \verbatim
  89 *>          B is COMPLEX*16 array, dimension (LDB,NRHS)
  90 *>          On entry, the right hand side vectors for the system of
  91 *>          linear equations.
  92 *>          On exit, B is overwritten with the difference B - A*X.
  93 *> \endverbatim
  94 *>
  95 *> \param[in] LDB
  96 *> \verbatim
  97 *>          LDB is INTEGER
  98 *>          The leading dimension of the array B.  IF TRANS = 'N',
  99 *>          LDB >= max(1,M); if TRANS = 'T' or 'C', LDB >= max(1,N).
 100 *> \endverbatim
 101 *>
 102 *> \param[out] RWORK
 103 *> \verbatim
 104 *>          RWORK is DOUBLE PRECISION array, dimension (N)
 105 *> \endverbatim
 106 *>
 107 *> \param[out] RESID
 108 *> \verbatim
 109 *>          RESID is DOUBLE PRECISION
 110 *>          The maximum over the number of right hand sides of
 111 *>          norm(B - A*X) / ( norm(A) * norm(X) * EPS ).
 112 *> \endverbatim
 113 *
 114 *  Authors:
 115 *  ========
 116 *
 117 *> \author Univ. of Tennessee
 118 *> \author Univ. of California Berkeley
 119 *> \author Univ. of Colorado Denver
 120 *> \author NAG Ltd.
 121 *
 122 *> \date November 2011
 123 *
 124 *> \ingroup complex16_lin
 125 *
 126 *  =====================================================================
 127       SUBROUTINE ZPOT06( UPLO, N, NRHS, A, LDA, X, LDX, B, LDB,
 128      $                   RWORK, RESID )
 129 *
 130 *  -- LAPACK test routine (version 3.4.0) --
 131 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 132 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 133 *     November 2011
 134 *
 135 *     .. Scalar Arguments ..
 136       CHARACTER          UPLO
 137       INTEGER            LDA, LDB, LDX, N, NRHS
 138       DOUBLE PRECISION   RESID
 139 *     ..
 140 *     .. Array Arguments ..
 141       DOUBLE PRECISION   RWORK( * )
 142       COMPLEX*16         A( LDA, * ), B( LDB, * ), X( LDX, * )
 143 *     ..
 144 *
 145 *  =====================================================================
 146 *
 147 *     .. Parameters ..
 148       DOUBLE PRECISION   ZERO, ONE
 149       PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
 150       COMPLEX*16         CONE, NEGCONE
 151       PARAMETER          ( CONE = ( 1.0D+0, 0.0D+0 ) )
 152       PARAMETER          ( NEGCONE = ( -1.0D+0, 0.0D+0 ) )
 153 *     ..
 154 *     .. Local Scalars ..
 155       INTEGER            IFAIL, J
 156       DOUBLE PRECISION   ANORM, BNORM, EPS, XNORM
 157       COMPLEX*16         ZDUM
 158 *     ..
 159 *     .. External Functions ..
 160       LOGICAL            LSAME
 161       INTEGER            IZAMAX
 162       DOUBLE PRECISION   DLAMCH, ZLANSY
 163       EXTERNAL           LSAME, IZAMAX, DLAMCH, ZLANSY
 164 *     ..
 165 *     .. External Subroutines ..
 166       EXTERNAL           ZHEMM
 167 *     ..
 168 *     .. Intrinsic Functions ..
 169       INTRINSIC          ABS, DBLE, DIMAG, MAX
 170 *     ..
 171 *     .. Statement Functions ..
 172       DOUBLE PRECISION   CABS1
 173 *     ..
 174 *     .. Statement Function definitions ..
 175       CABS1( ZDUM ) = ABS( DBLE( ZDUM ) ) + ABS( DIMAG( ZDUM ) )
 176 *     ..
 177 *     ..
 178 *     .. Executable Statements ..
 179 *
 180 *     Quick exit if N = 0 or NRHS = 0
 181 *
 182       IF( N.LE.0 .OR. NRHS.EQ.0 ) THEN
 183          RESID = ZERO
 184          RETURN
 185       END IF
 186 *
 187 *     Exit with RESID = 1/EPS if ANORM = 0.
 188 *
 189       EPS = DLAMCH( 'Epsilon' )
 190       ANORM = ZLANSY( 'I', UPLO, N, A, LDA, RWORK )
 191       IF( ANORM.LE.ZERO ) THEN
 192          RESID = ONE / EPS
 193          RETURN
 194       END IF
 195 *
 196 *     Compute  B - A*X  and store in B.
 197       IFAIL=0
 198 *
 199       CALL ZHEMM( 'Left', UPLO, N, NRHS, NEGCONE, A, LDA, X,
 200      $            LDX, CONE, B, LDB )
 201 *
 202 *     Compute the maximum over the number of right hand sides of
 203 *        norm(B - A*X) / ( norm(A) * norm(X) * EPS ) .
 204 *
 205       RESID = ZERO
 206       DO 10 J = 1, NRHS
 207          BNORM = CABS1(B(IZAMAX( N, B( 1, J ), 1 ),J))
 208          XNORM = CABS1(X(IZAMAX( N, X( 1, J ), 1 ),J))
 209          IF( XNORM.LE.ZERO ) THEN
 210             RESID = ONE / EPS
 211          ELSE
 212             RESID = MAX( RESID, ( ( BNORM / ANORM ) / XNORM ) / EPS )
 213          END IF
 214    10 CONTINUE
 215 *
 216       RETURN
 217 *
 218 *     End of ZPOT06
 219 *
 220       END