--- rpl/lapack/lapack/dla_syrfsx_extended.f 2011/11/21 20:42:54 1.5 +++ rpl/lapack/lapack/dla_syrfsx_extended.f 2018/05/29 07:17:55 1.16 @@ -1,19 +1,19 @@ -*> \brief \b DLA_SYRFSX_EXTENDED +*> \brief \b DLA_SYRFSX_EXTENDED improves the computed solution to a system of linear equations for symmetric indefinite matrices by performing extra-precise iterative refinement and provides error bounds and backward error estimates for the solution. * * =========== DOCUMENTATION =========== * -* Online html documentation available at -* http://www.netlib.org/lapack/explore-html/ +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ * *> \htmlonly -*> Download DLA_SYRFSX_EXTENDED + dependencies -*> -*> [TGZ] -*> -*> [ZIP] -*> +*> Download DLA_SYRFSX_EXTENDED + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> *> [TXT] -*> \endhtmlonly +*> \endhtmlonly * * Definition: * =========== @@ -25,7 +25,7 @@ * AYB, DY, Y_TAIL, RCOND, ITHRESH, * RTHRESH, DZ_UB, IGNORE_CWISE, * INFO ) -* +* * .. Scalar Arguments .. * INTEGER INFO, LDA, LDAF, LDB, LDY, N, NRHS, PREC_TYPE, * $ N_NORMS, ITHRESH @@ -41,14 +41,14 @@ * $ ERR_BNDS_NORM( NRHS, * ), * $ ERR_BNDS_COMP( NRHS, * ) * .. -* +* * *> \par Purpose: * ============= *> *> \verbatim *> -*> +*> *> DLA_SYRFSX_EXTENDED improves the computed solution to a system of *> linear equations by performing extra-precise iterative refinement *> and provides error bounds and backward error estimates for the solution. @@ -162,8 +162,7 @@ *> *> \param[in,out] Y *> \verbatim -*> Y is DOUBLE PRECISION array, dimension -*> (LDY,NRHS) +*> Y is DOUBLE PRECISION array, dimension (LDY,NRHS) *> On entry, the solution matrix X, as computed by DSYTRS. *> On exit, the improved solution matrix Y. *> \endverbatim @@ -195,8 +194,7 @@ *> *> \param[in,out] ERR_BNDS_NORM *> \verbatim -*> ERR_BNDS_NORM is DOUBLE PRECISION array, dimension -*> (NRHS, N_ERR_BNDS) +*> ERR_BNDS_NORM is DOUBLE PRECISION array, dimension (NRHS, N_ERR_BNDS) *> For each right-hand side, this array contains information about *> various error bounds and condition numbers corresponding to the *> normwise relative error, which is defined as follows: @@ -242,8 +240,7 @@ *> *> \param[in,out] ERR_BNDS_COMP *> \verbatim -*> ERR_BNDS_COMP is DOUBLE PRECISION array, dimension -*> (NRHS, N_ERR_BNDS) +*> ERR_BNDS_COMP is DOUBLE PRECISION array, dimension (NRHS, N_ERR_BNDS) *> For each right-hand side, this array contains information about *> various error bounds and condition numbers corresponding to the *> componentwise relative error, which is defined as follows: @@ -374,19 +371,19 @@ *> \verbatim *> INFO is INTEGER *> = 0: Successful exit. -*> < 0: if INFO = -i, the ith argument to DSYTRS had an illegal +*> < 0: if INFO = -i, the ith argument to DLA_SYRFSX_EXTENDED had an illegal *> value *> \endverbatim * * Authors: * ======== * -*> \author Univ. of Tennessee -*> \author Univ. of California Berkeley -*> \author Univ. of Colorado Denver -*> \author NAG Ltd. +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2017 * *> \ingroup doubleSYcomputational * @@ -399,10 +396,10 @@ $ RTHRESH, DZ_UB, IGNORE_CWISE, $ INFO ) * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.7.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2017 * * .. Scalar Arguments .. INTEGER INFO, LDA, LDAF, LDB, LDY, N, NRHS, PREC_TYPE, @@ -428,7 +425,7 @@ $ DZRAT, PREVNORMDX, PREV_DZ_Z, DXRATMAX, $ DZRATMAX, DX_X, DZ_Z, FINAL_DX_X, FINAL_DZ_Z, $ EPS, HUGEVAL, INCR_THRESH - LOGICAL INCR_PREC + LOGICAL INCR_PREC, UPPER * .. * .. Parameters .. INTEGER UNSTABLE_STATE, WORKING_STATE, CONV_STATE, @@ -472,7 +469,27 @@ * .. * .. Executable Statements .. * - IF ( INFO.NE.0 ) RETURN + INFO = 0 + UPPER = LSAME( UPLO, 'U' ) + IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + INFO = -2 + ELSE IF( N.LT.0 ) THEN + INFO = -3 + ELSE IF( NRHS.LT.0 ) THEN + INFO = -4 + ELSE IF( LDA.LT.MAX( 1, N ) ) THEN + INFO = -6 + ELSE IF( LDAF.LT.MAX( 1, N ) ) THEN + INFO = -8 + ELSE IF( LDB.LT.MAX( 1, N ) ) THEN + INFO = -13 + ELSE IF( LDY.LT.MAX( 1, N ) ) THEN + INFO = -15 + END IF + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'DLA_SYRFSX_EXTENDED', -INFO ) + RETURN + END IF EPS = DLAMCH( 'Epsilon' ) HUGEVAL = DLAMCH( 'Overflow' ) * Force HUGEVAL to Inf @@ -525,7 +542,7 @@ CALL BLAS_DSYMV2_X(UPLO2, N, -1.0D+0, A, LDA, $ Y(1, J), Y_TAIL, 1, 1.0D+0, RES, 1, PREC_TYPE) END IF - + ! XXX: RES is no longer needed. CALL DCOPY( N, RES, 1, DY, 1 ) CALL DSYTRS( UPLO, N, 1, AF, LDAF, IPIV, DY, N, INFO ) @@ -537,11 +554,11 @@ NORMDX = 0.0D+0 DZ_Z = 0.0D+0 YMIN = HUGEVAL - + DO I = 1, N YK = ABS( Y( I, J ) ) DYK = ABS( DY( I ) ) - + IF ( YK .NE. 0.0D+0 ) THEN DZ_Z = MAX( DZ_Z, DYK / YK ) ELSE IF ( DYK .NE. 0.0D+0 ) THEN @@ -640,7 +657,7 @@ ELSE CALL DLA_WWADDW( N, Y(1,J), Y_TAIL, DY ) END IF - + END DO * Target of "IF (Z_STOP .AND. X_STOP)". Sun's f77 won't EXIT. 666 CONTINUE @@ -669,9 +686,9 @@ * Compute residual RES = B_s - op(A_s) * Y, * op(A) = A, A**T, or A**H depending on TRANS (and type). CALL DCOPY( N, B( 1, J ), 1, RES, 1 ) - CALL DSYMV( UPLO, N, -1.0D+0, A, LDA, Y(1,J), 1, 1.0D+0, RES, + CALL DSYMV( UPLO, N, -1.0D+0, A, LDA, Y(1,J), 1, 1.0D+0, RES, $ 1 ) - + DO I = 1, N AYB( I ) = ABS( B( I, J ) ) END DO @@ -680,7 +697,7 @@ * CALL DLA_SYAMV( UPLO2, N, 1.0D+0, $ A, LDA, Y(1, J), 1, 1.0D+0, AYB, 1 ) - + CALL DLA_LIN_BERR( N, N, 1, RES, AYB, BERR_OUT( J ) ) * * End of loop for each RHS.