LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
zget35.f
Go to the documentation of this file.
00001 *> \brief \b ZGET35
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *  Definition:
00009 *  ===========
00010 *
00011 *       SUBROUTINE ZGET35( RMAX, LMAX, NINFO, KNT, NIN )
00012 * 
00013 *       .. Scalar Arguments ..
00014 *       INTEGER            KNT, LMAX, NIN, NINFO
00015 *       DOUBLE PRECISION   RMAX
00016 *       ..
00017 *  
00018 *
00019 *> \par Purpose:
00020 *  =============
00021 *>
00022 *> \verbatim
00023 *>
00024 *> ZGET35 tests ZTRSYL, a routine for solving the Sylvester matrix
00025 *> equation
00026 *>
00027 *>    op(A)*X + ISGN*X*op(B) = scale*C,
00028 *>
00029 *> A and B are assumed to be in Schur canonical form, op() represents an
00030 *> optional transpose, and ISGN can be -1 or +1.  Scale is an output
00031 *> less than or equal to 1, chosen to avoid overflow in X.
00032 *>
00033 *> The test code verifies that the following residual is order 1:
00034 *>
00035 *>    norm(op(A)*X + ISGN*X*op(B) - scale*C) /
00036 *>        (EPS*max(norm(A),norm(B))*norm(X))
00037 *> \endverbatim
00038 *
00039 *  Arguments:
00040 *  ==========
00041 *
00042 *> \param[out] RMAX
00043 *> \verbatim
00044 *>          RMAX is DOUBLE PRECISION
00045 *>          Value of the largest test ratio.
00046 *> \endverbatim
00047 *>
00048 *> \param[out] LMAX
00049 *> \verbatim
00050 *>          LMAX is INTEGER
00051 *>          Example number where largest test ratio achieved.
00052 *> \endverbatim
00053 *>
00054 *> \param[out] NINFO
00055 *> \verbatim
00056 *>          NINFO is INTEGER
00057 *>          Number of examples where INFO is nonzero.
00058 *> \endverbatim
00059 *>
00060 *> \param[out] KNT
00061 *> \verbatim
00062 *>          KNT is INTEGER
00063 *>          Total number of examples tested.
00064 *> \endverbatim
00065 *>
00066 *> \param[in] NIN
00067 *> \verbatim
00068 *>          NIN is INTEGER
00069 *>          Input logical unit number.
00070 *> \endverbatim
00071 *
00072 *  Authors:
00073 *  ========
00074 *
00075 *> \author Univ. of Tennessee 
00076 *> \author Univ. of California Berkeley 
00077 *> \author Univ. of Colorado Denver 
00078 *> \author NAG Ltd. 
00079 *
00080 *> \date November 2011
00081 *
00082 *> \ingroup complex16_eig
00083 *
00084 *  =====================================================================
00085       SUBROUTINE ZGET35( RMAX, LMAX, NINFO, KNT, NIN )
00086 *
00087 *  -- LAPACK test routine (version 3.4.0) --
00088 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00089 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00090 *     November 2011
00091 *
00092 *     .. Scalar Arguments ..
00093       INTEGER            KNT, LMAX, NIN, NINFO
00094       DOUBLE PRECISION   RMAX
00095 *     ..
00096 *
00097 *  =====================================================================
00098 *
00099 *     .. Parameters ..
00100       INTEGER            LDT
00101       PARAMETER          ( LDT = 10 )
00102       DOUBLE PRECISION   ZERO, ONE, TWO
00103       PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0, TWO = 2.0D0 )
00104       DOUBLE PRECISION   LARGE
00105       PARAMETER          ( LARGE = 1.0D6 )
00106       COMPLEX*16         CONE
00107       PARAMETER          ( CONE = 1.0D0 )
00108 *     ..
00109 *     .. Local Scalars ..
00110       CHARACTER          TRANA, TRANB
00111       INTEGER            I, IMLA, IMLAD, IMLB, IMLC, INFO, ISGN, ITRANA,
00112      $                   ITRANB, J, M, N
00113       DOUBLE PRECISION   BIGNUM, EPS, RES, RES1, SCALE, SMLNUM, TNRM,
00114      $                   XNRM
00115       COMPLEX*16         RMUL
00116 *     ..
00117 *     .. Local Arrays ..
00118       DOUBLE PRECISION   DUM( 1 ), VM1( 3 ), VM2( 3 )
00119       COMPLEX*16         A( LDT, LDT ), ATMP( LDT, LDT ), B( LDT, LDT ),
00120      $                   BTMP( LDT, LDT ), C( LDT, LDT ),
00121      $                   CSAV( LDT, LDT ), CTMP( LDT, LDT )
00122 *     ..
00123 *     .. External Functions ..
00124       DOUBLE PRECISION   DLAMCH, ZLANGE
00125       EXTERNAL           DLAMCH, ZLANGE
00126 *     ..
00127 *     .. External Subroutines ..
00128       EXTERNAL           DLABAD, ZGEMM, ZTRSYL
00129 *     ..
00130 *     .. Intrinsic Functions ..
00131       INTRINSIC          ABS, DBLE, MAX, SQRT
00132 *     ..
00133 *     .. Executable Statements ..
00134 *
00135 *     Get machine parameters
00136 *
00137       EPS = DLAMCH( 'P' )
00138       SMLNUM = DLAMCH( 'S' ) / EPS
00139       BIGNUM = ONE / SMLNUM
00140       CALL DLABAD( SMLNUM, BIGNUM )
00141 *
00142 *     Set up test case parameters
00143 *
00144       VM1( 1 ) = SQRT( SMLNUM )
00145       VM1( 2 ) = ONE
00146       VM1( 3 ) = LARGE
00147       VM2( 1 ) = ONE
00148       VM2( 2 ) = ONE + TWO*EPS
00149       VM2( 3 ) = TWO
00150 *
00151       KNT = 0
00152       NINFO = 0
00153       LMAX = 0
00154       RMAX = ZERO
00155 *
00156 *     Begin test loop
00157 *
00158    10 CONTINUE
00159       READ( NIN, FMT = * )M, N
00160       IF( N.EQ.0 )
00161      $   RETURN
00162       DO 20 I = 1, M
00163          READ( NIN, FMT = * )( ATMP( I, J ), J = 1, M )
00164    20 CONTINUE
00165       DO 30 I = 1, N
00166          READ( NIN, FMT = * )( BTMP( I, J ), J = 1, N )
00167    30 CONTINUE
00168       DO 40 I = 1, M
00169          READ( NIN, FMT = * )( CTMP( I, J ), J = 1, N )
00170    40 CONTINUE
00171       DO 170 IMLA = 1, 3
00172          DO 160 IMLAD = 1, 3
00173             DO 150 IMLB = 1, 3
00174                DO 140 IMLC = 1, 3
00175                   DO 130 ITRANA = 1, 2
00176                      DO 120 ITRANB = 1, 2
00177                         DO 110 ISGN = -1, 1, 2
00178                            IF( ITRANA.EQ.1 )
00179      $                        TRANA = 'N'
00180                            IF( ITRANA.EQ.2 )
00181      $                        TRANA = 'C'
00182                            IF( ITRANB.EQ.1 )
00183      $                        TRANB = 'N'
00184                            IF( ITRANB.EQ.2 )
00185      $                        TRANB = 'C'
00186                            TNRM = ZERO
00187                            DO 60 I = 1, M
00188                               DO 50 J = 1, M
00189                                  A( I, J ) = ATMP( I, J )*VM1( IMLA )
00190                                  TNRM = MAX( TNRM, ABS( A( I, J ) ) )
00191    50                         CONTINUE
00192                               A( I, I ) = A( I, I )*VM2( IMLAD )
00193                               TNRM = MAX( TNRM, ABS( A( I, I ) ) )
00194    60                      CONTINUE
00195                            DO 80 I = 1, N
00196                               DO 70 J = 1, N
00197                                  B( I, J ) = BTMP( I, J )*VM1( IMLB )
00198                                  TNRM = MAX( TNRM, ABS( B( I, J ) ) )
00199    70                         CONTINUE
00200    80                      CONTINUE
00201                            IF( TNRM.EQ.ZERO )
00202      $                        TNRM = ONE
00203                            DO 100 I = 1, M
00204                               DO 90 J = 1, N
00205                                  C( I, J ) = CTMP( I, J )*VM1( IMLC )
00206                                  CSAV( I, J ) = C( I, J )
00207    90                         CONTINUE
00208   100                      CONTINUE
00209                            KNT = KNT + 1
00210                            CALL ZTRSYL( TRANA, TRANB, ISGN, M, N, A,
00211      $                                  LDT, B, LDT, C, LDT, SCALE,
00212      $                                  INFO )
00213                            IF( INFO.NE.0 )
00214      $                        NINFO = NINFO + 1
00215                            XNRM = ZLANGE( 'M', M, N, C, LDT, DUM )
00216                            RMUL = CONE
00217                            IF( XNRM.GT.ONE .AND. TNRM.GT.ONE ) THEN
00218                               IF( XNRM.GT.BIGNUM / TNRM ) THEN
00219                                  RMUL = MAX( XNRM, TNRM )
00220                                  RMUL = CONE / RMUL
00221                               END IF
00222                            END IF
00223                            CALL ZGEMM( TRANA, 'N', M, N, M, RMUL, A,
00224      $                                 LDT, C, LDT, -SCALE*RMUL, CSAV,
00225      $                                 LDT )
00226                            CALL ZGEMM( 'N', TRANB, M, N, N,
00227      $                                 DBLE( ISGN )*RMUL, C, LDT, B,
00228      $                                 LDT, CONE, CSAV, LDT )
00229                            RES1 = ZLANGE( 'M', M, N, CSAV, LDT, DUM )
00230                            RES = RES1 / MAX( SMLNUM, SMLNUM*XNRM,
00231      $                           ( ( ABS( RMUL )*TNRM )*EPS )*XNRM )
00232                            IF( RES.GT.RMAX ) THEN
00233                               LMAX = KNT
00234                               RMAX = RES
00235                            END IF
00236   110                   CONTINUE
00237   120                CONTINUE
00238   130             CONTINUE
00239   140          CONTINUE
00240   150       CONTINUE
00241   160    CONTINUE
00242   170 CONTINUE
00243       GO TO 10
00244 *
00245 *     End of ZGET35
00246 *
00247       END
 All Files Functions