LAPACK 3.3.0

zla_syrcond_x.f

Go to the documentation of this file.
00001       DOUBLE PRECISION FUNCTION ZLA_SYRCOND_X( UPLO, N, A, LDA, AF,
00002      $                                         LDAF, IPIV, X, INFO,
00003      $                                         WORK, RWORK )
00004 *
00005 *     -- LAPACK routine (version 3.2.1)                                 --
00006 *     -- Contributed by James Demmel, Deaglan Halligan, Yozo Hida and --
00007 *     -- Jason Riedy of Univ. of California Berkeley.                 --
00008 *     -- April 2009                                                   --
00009 *
00010 *     -- LAPACK is a software package provided by Univ. of Tennessee, --
00011 *     -- Univ. of California Berkeley and NAG Ltd.                    --
00012 *
00013       IMPLICIT NONE
00014 *     ..
00015 *     .. Scalar Arguments ..
00016       CHARACTER          UPLO
00017       INTEGER            N, LDA, LDAF, INFO
00018 *     ..
00019 *     .. Array Arguments ..
00020       INTEGER            IPIV( * )
00021       COMPLEX*16         A( LDA, * ), AF( LDAF, * ), WORK( * ), X( * )
00022       DOUBLE PRECISION   RWORK( * )
00023 *     ..
00024 *
00025 *  Purpose
00026 *  =======
00027 *
00028 *     ZLA_SYRCOND_X Computes the infinity norm condition number of
00029 *     op(A) * diag(X) where X is a COMPLEX*16 vector.
00030 *
00031 *  Arguments
00032 *  =========
00033 *
00034 *     UPLO    (input) CHARACTER*1
00035 *       = 'U':  Upper triangle of A is stored;
00036 *       = 'L':  Lower triangle of A is stored.
00037 *
00038 *     N       (input) INTEGER
00039 *     The number of linear equations, i.e., the order of the
00040 *     matrix A.  N >= 0.
00041 *
00042 *     A       (input) COMPLEX*16 array, dimension (LDA,N)
00043 *     On entry, the N-by-N matrix A.
00044 *
00045 *     LDA     (input) INTEGER
00046 *     The leading dimension of the array A.  LDA >= max(1,N).
00047 *
00048 *     AF      (input) COMPLEX*16 array, dimension (LDAF,N)
00049 *     The block diagonal matrix D and the multipliers used to
00050 *     obtain the factor U or L as computed by ZSYTRF.
00051 *
00052 *     LDAF    (input) INTEGER
00053 *     The leading dimension of the array AF.  LDAF >= max(1,N).
00054 *
00055 *     IPIV    (input) INTEGER array, dimension (N)
00056 *     Details of the interchanges and the block structure of D
00057 *     as determined by ZSYTRF.
00058 *
00059 *     X       (input) COMPLEX*16 array, dimension (N)
00060 *     The vector X in the formula op(A) * diag(X).
00061 *
00062 *     INFO    (output) INTEGER
00063 *       = 0:  Successful exit.
00064 *     i > 0:  The ith argument is invalid.
00065 *
00066 *     WORK    (input) COMPLEX*16 array, dimension (2*N).
00067 *     Workspace.
00068 *
00069 *     RWORK   (input) DOUBLE PRECISION array, dimension (N).
00070 *     Workspace.
00071 *
00072 *  =====================================================================
00073 *
00074 *     .. Local Scalars ..
00075       INTEGER            KASE
00076       DOUBLE PRECISION   AINVNM, ANORM, TMP
00077       INTEGER            I, J
00078       LOGICAL            UP
00079       COMPLEX*16         ZDUM
00080 *     ..
00081 *     .. Local Arrays ..
00082       INTEGER            ISAVE( 3 )
00083 *     ..
00084 *     .. External Functions ..
00085       LOGICAL            LSAME
00086       EXTERNAL           LSAME
00087 *     ..
00088 *     .. External Subroutines ..
00089       EXTERNAL           ZLACN2, ZSYTRS, XERBLA
00090 *     ..
00091 *     .. Intrinsic Functions ..
00092       INTRINSIC          ABS, MAX
00093 *     ..
00094 *     .. Statement Functions ..
00095       DOUBLE PRECISION   CABS1
00096 *     ..
00097 *     .. Statement Function Definitions ..
00098       CABS1( ZDUM ) = ABS( DBLE( ZDUM ) ) + ABS( DIMAG( ZDUM ) )
00099 *     ..
00100 *     .. Executable Statements ..
00101 *
00102       ZLA_SYRCOND_X = 0.0D+0
00103 *
00104       INFO = 0
00105       IF( N.LT.0 ) THEN
00106          INFO = -2
00107       END IF
00108       IF( INFO.NE.0 ) THEN
00109          CALL XERBLA( 'ZLA_SYRCOND_X', -INFO )
00110          RETURN
00111       END IF
00112       UP = .FALSE.
00113       IF ( LSAME( UPLO, 'U' ) ) UP = .TRUE.
00114 *
00115 *     Compute norm of op(A)*op2(C).
00116 *
00117       ANORM = 0.0D+0
00118       IF ( UP ) THEN
00119          DO I = 1, N
00120             TMP = 0.0D+0
00121             DO J = 1, I
00122                TMP = TMP + CABS1( A( J, I ) * X( J ) )
00123             END DO
00124             DO J = I+1, N
00125                TMP = TMP + CABS1( A( I, J ) * X( J ) )
00126             END DO
00127             RWORK( I ) = TMP
00128             ANORM = MAX( ANORM, TMP )
00129          END DO
00130       ELSE
00131          DO I = 1, N
00132             TMP = 0.0D+0
00133             DO J = 1, I
00134                TMP = TMP + CABS1( A( I, J ) * X( J ) )
00135             END DO
00136             DO J = I+1, N
00137                TMP = TMP + CABS1( A( J, I ) * X( J ) )
00138             END DO
00139             RWORK( I ) = TMP
00140             ANORM = MAX( ANORM, TMP )
00141          END DO
00142       END IF
00143 *
00144 *     Quick return if possible.
00145 *
00146       IF( N.EQ.0 ) THEN
00147          ZLA_SYRCOND_X = 1.0D+0
00148          RETURN
00149       ELSE IF( ANORM .EQ. 0.0D+0 ) THEN
00150          RETURN
00151       END IF
00152 *
00153 *     Estimate the norm of inv(op(A)).
00154 *
00155       AINVNM = 0.0D+0
00156 *
00157       KASE = 0
00158    10 CONTINUE
00159       CALL ZLACN2( N, WORK( N+1 ), WORK, AINVNM, KASE, ISAVE )
00160       IF( KASE.NE.0 ) THEN
00161          IF( KASE.EQ.2 ) THEN
00162 *
00163 *           Multiply by R.
00164 *
00165             DO I = 1, N
00166                WORK( I ) = WORK( I ) * RWORK( I )
00167             END DO
00168 *
00169             IF ( UP ) THEN
00170                CALL ZSYTRS( 'U', N, 1, AF, LDAF, IPIV,
00171      $            WORK, N, INFO )
00172             ELSE
00173                CALL ZSYTRS( 'L', N, 1, AF, LDAF, IPIV,
00174      $            WORK, N, INFO )
00175             ENDIF
00176 *
00177 *           Multiply by inv(X).
00178 *
00179             DO I = 1, N
00180                WORK( I ) = WORK( I ) / X( I )
00181             END DO
00182          ELSE
00183 *
00184 *           Multiply by inv(X').
00185 *
00186             DO I = 1, N
00187                WORK( I ) = WORK( I ) / X( I )
00188             END DO
00189 *
00190             IF ( UP ) THEN
00191                CALL ZSYTRS( 'U', N, 1, AF, LDAF, IPIV,
00192      $            WORK, N, INFO )
00193             ELSE
00194                CALL ZSYTRS( 'L', N, 1, AF, LDAF, IPIV,
00195      $            WORK, N, INFO )
00196             END IF
00197 *
00198 *           Multiply by R.
00199 *
00200             DO I = 1, N
00201                WORK( I ) = WORK( I ) * RWORK( I )
00202             END DO
00203          END IF
00204          GO TO 10
00205       END IF
00206 *
00207 *     Compute the estimate of the reciprocal condition number.
00208 *
00209       IF( AINVNM .NE. 0.0D+0 )
00210      $   ZLA_SYRCOND_X = 1.0D+0 / AINVNM
00211 *
00212       RETURN
00213 *
00214       END
 All Files Functions