LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
dget35.f
Go to the documentation of this file.
00001 *> \brief \b DGET35
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 DGET35( RMAX, LMAX, NINFO, KNT )
00012 * 
00013 *       .. Scalar Arguments ..
00014 *       INTEGER            KNT, LMAX, NINFO
00015 *       DOUBLE PRECISION   RMAX
00016 *       ..
00017 *  
00018 *
00019 *> \par Purpose:
00020 *  =============
00021 *>
00022 *> \verbatim
00023 *>
00024 *> DGET35 tests DTRSYL, 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 *  Authors:
00067 *  ========
00068 *
00069 *> \author Univ. of Tennessee 
00070 *> \author Univ. of California Berkeley 
00071 *> \author Univ. of Colorado Denver 
00072 *> \author NAG Ltd. 
00073 *
00074 *> \date November 2011
00075 *
00076 *> \ingroup double_eig
00077 *
00078 *  =====================================================================
00079       SUBROUTINE DGET35( RMAX, LMAX, NINFO, KNT )
00080 *
00081 *  -- LAPACK test routine (version 3.4.0) --
00082 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00083 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00084 *     November 2011
00085 *
00086 *     .. Scalar Arguments ..
00087       INTEGER            KNT, LMAX, NINFO
00088       DOUBLE PRECISION   RMAX
00089 *     ..
00090 *
00091 *  =====================================================================
00092 *
00093 *     .. Parameters ..
00094       DOUBLE PRECISION   ZERO, ONE
00095       PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
00096       DOUBLE PRECISION   TWO, FOUR
00097       PARAMETER          ( TWO = 2.0D0, FOUR = 4.0D0 )
00098 *     ..
00099 *     .. Local Scalars ..
00100       CHARACTER          TRANA, TRANB
00101       INTEGER            I, IMA, IMB, IMLDA1, IMLDA2, IMLDB1, IMLOFF,
00102      $                   INFO, ISGN, ITRANA, ITRANB, J, M, N
00103       DOUBLE PRECISION   BIGNUM, CNRM, EPS, RES, RES1, RMUL, SCALE,
00104      $                   SMLNUM, TNRM, XNRM
00105 *     ..
00106 *     .. Local Arrays ..
00107       INTEGER            IDIM( 8 ), IVAL( 6, 6, 8 )
00108       DOUBLE PRECISION   A( 6, 6 ), B( 6, 6 ), C( 6, 6 ), CC( 6, 6 ),
00109      $                   DUM( 1 ), VM1( 3 ), VM2( 3 )
00110 *     ..
00111 *     .. External Functions ..
00112       DOUBLE PRECISION   DLAMCH, DLANGE
00113       EXTERNAL           DLAMCH, DLANGE
00114 *     ..
00115 *     .. External Subroutines ..
00116       EXTERNAL           DGEMM, DLABAD, DTRSYL
00117 *     ..
00118 *     .. Intrinsic Functions ..
00119       INTRINSIC          ABS, DBLE, MAX, SIN, SQRT
00120 *     ..
00121 *     .. Data statements ..
00122       DATA               IDIM / 1, 2, 3, 4, 3, 3, 6, 4 /
00123       DATA               IVAL / 1, 35*0, 1, 2, 4*0, -2, 0, 28*0, 1, 5*0,
00124      $                   5, 1, 2, 3*0, -8, -2, 1, 21*0, 3, 4, 4*0, -5,
00125      $                   3, 4*0, 1, 2, 1, 4, 2*0, -3, -9, -1, 1, 14*0,
00126      $                   1, 5*0, 2, 3, 4*0, 5, 6, 7, 21*0, 1, 5*0, 1, 3,
00127      $                   -4, 3*0, 2, 5, 2, 21*0, 1, 2, 4*0, -2, 0, 4*0,
00128      $                   5, 6, 3, 4, 2*0, -1, -9, -5, 2, 2*0, 4*8, 5, 6,
00129      $                   4*9, -7, 5, 1, 5*0, 1, 5, 2, 3*0, 2, -21, 5,
00130      $                   3*0, 1, 2, 3, 4, 14*0 /
00131 *     ..
00132 *     .. Executable Statements ..
00133 *
00134 *     Get machine parameters
00135 *
00136       EPS = DLAMCH( 'P' )
00137       SMLNUM = DLAMCH( 'S' )*FOUR / EPS
00138       BIGNUM = ONE / SMLNUM
00139       CALL DLABAD( SMLNUM, BIGNUM )
00140 *
00141 *     Set up test case parameters
00142 *
00143       VM1( 1 ) = SQRT( SMLNUM )
00144       VM1( 2 ) = ONE
00145       VM1( 3 ) = SQRT( BIGNUM )
00146       VM2( 1 ) = ONE
00147       VM2( 2 ) = ONE + TWO*EPS
00148       VM2( 3 ) = TWO
00149 *
00150       KNT = 0
00151       NINFO = 0
00152       LMAX = 0
00153       RMAX = ZERO
00154 *
00155 *     Begin test loop
00156 *
00157       DO 150 ITRANA = 1, 2
00158          DO 140 ITRANB = 1, 2
00159             DO 130 ISGN = -1, 1, 2
00160                DO 120 IMA = 1, 8
00161                   DO 110 IMLDA1 = 1, 3
00162                      DO 100 IMLDA2 = 1, 3
00163                         DO 90 IMLOFF = 1, 2
00164                            DO 80 IMB = 1, 8
00165                               DO 70 IMLDB1 = 1, 3
00166                                  IF( ITRANA.EQ.1 )
00167      $                              TRANA = 'N'
00168                                  IF( ITRANA.EQ.2 )
00169      $                              TRANA = 'T'
00170                                  IF( ITRANB.EQ.1 )
00171      $                              TRANB = 'N'
00172                                  IF( ITRANB.EQ.2 )
00173      $                              TRANB = 'T'
00174                                  M = IDIM( IMA )
00175                                  N = IDIM( IMB )
00176                                  TNRM = ZERO
00177                                  DO 20 I = 1, M
00178                                     DO 10 J = 1, M
00179                                        A( I, J ) = IVAL( I, J, IMA )
00180                                        IF( ABS( I-J ).LE.1 ) THEN
00181                                           A( I, J ) = A( I, J )*
00182      $                                                VM1( IMLDA1 )
00183                                           A( I, J ) = A( I, J )*
00184      $                                                VM2( IMLDA2 )
00185                                        ELSE
00186                                           A( I, J ) = A( I, J )*
00187      $                                                VM1( IMLOFF )
00188                                        END IF
00189                                        TNRM = MAX( TNRM,
00190      $                                        ABS( A( I, J ) ) )
00191    10                               CONTINUE
00192    20                            CONTINUE
00193                                  DO 40 I = 1, N
00194                                     DO 30 J = 1, N
00195                                        B( I, J ) = IVAL( I, J, IMB )
00196                                        IF( ABS( I-J ).LE.1 ) THEN
00197                                           B( I, J ) = B( I, J )*
00198      $                                                VM1( IMLDB1 )
00199                                        ELSE
00200                                           B( I, J ) = B( I, J )*
00201      $                                                VM1( IMLOFF )
00202                                        END IF
00203                                        TNRM = MAX( TNRM,
00204      $                                        ABS( B( I, J ) ) )
00205    30                               CONTINUE
00206    40                            CONTINUE
00207                                  CNRM = ZERO
00208                                  DO 60 I = 1, M
00209                                     DO 50 J = 1, N
00210                                        C( I, J ) = SIN( DBLE( I*J ) )
00211                                        CNRM = MAX( CNRM, C( I, J ) )
00212                                        CC( I, J ) = C( I, J )
00213    50                               CONTINUE
00214    60                            CONTINUE
00215                                  KNT = KNT + 1
00216                                  CALL DTRSYL( TRANA, TRANB, ISGN, M, N,
00217      $                                        A, 6, B, 6, C, 6, SCALE,
00218      $                                        INFO )
00219                                  IF( INFO.NE.0 )
00220      $                              NINFO = NINFO + 1
00221                                  XNRM = DLANGE( 'M', M, N, C, 6, DUM )
00222                                  RMUL = ONE
00223                                  IF( XNRM.GT.ONE .AND. TNRM.GT.ONE )
00224      $                                THEN
00225                                     IF( XNRM.GT.BIGNUM / TNRM ) THEN
00226                                        RMUL = ONE / MAX( XNRM, TNRM )
00227                                     END IF
00228                                  END IF
00229                                  CALL DGEMM( TRANA, 'N', M, N, M, RMUL,
00230      $                                       A, 6, C, 6, -SCALE*RMUL,
00231      $                                       CC, 6 )
00232                                  CALL DGEMM( 'N', TRANB, M, N, N,
00233      $                                       DBLE( ISGN )*RMUL, C, 6, B,
00234      $                                       6, ONE, CC, 6 )
00235                                  RES1 = DLANGE( 'M', M, N, CC, 6, DUM )
00236                                  RES = RES1 / MAX( SMLNUM, SMLNUM*XNRM,
00237      $                                 ( ( RMUL*TNRM )*EPS )*XNRM )
00238                                  IF( RES.GT.RMAX ) THEN
00239                                     LMAX = KNT
00240                                     RMAX = RES
00241                                  END IF
00242    70                         CONTINUE
00243    80                      CONTINUE
00244    90                   CONTINUE
00245   100                CONTINUE
00246   110             CONTINUE
00247   120          CONTINUE
00248   130       CONTINUE
00249   140    CONTINUE
00250   150 CONTINUE
00251 *
00252       RETURN
00253 *
00254 *     End of DGET35
00255 *
00256       END
 All Files Functions