LAPACK: TESTING/EIG/dget31.f Source File

Go to the documentation of this file.
00001       SUBROUTINE DGET31( RMAX, LMAX, NINFO, KNT )
00002 *
00003 *  -- LAPACK test routine (version 3.1) --
00004 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
00005 *     November 2006
00006 *
00007 *     .. Scalar Arguments ..
00008       INTEGER            KNT, LMAX
00009       DOUBLE PRECISION   RMAX
00010 *     ..
00011 *     .. Array Arguments ..
00012       INTEGER            NINFO( 2 )
00013 *     ..
00014 *
00015 *  Purpose
00016 *  =======
00017 *
00018 *  DGET31 tests DLALN2, a routine for solving
00019 *
00020 *     (ca A - w D)X = sB
00021 *
00022 *  where A is an NA by NA matrix (NA=1 or 2 only), w is a real (NW=1) or
00023 *  complex (NW=2) constant, ca is a real constant, D is an NA by NA real
00024 *  diagonal matrix, and B is an NA by NW matrix (when NW=2 the second
00025 *  column of B contains the imaginary part of the solution).  The code
00026 *  returns X and s, where s is a scale factor, less than or equal to 1,
00027 *  which is chosen to avoid overflow in X.
00028 *
00029 *  If any singular values of ca A-w D are less than another input
00030 *  parameter SMIN, they are perturbed up to SMIN.
00031 *
00032 *  The test condition is that the scaled residual
00033 *
00034 *      norm( (ca A-w D)*X - s*B ) /
00035 *            ( max( ulp*norm(ca A-w D), SMIN )*norm(X) )
00036 *
00037 *  should be on the order of 1.  Here, ulp is the machine precision.
00038 *  Also, it is verified that SCALE is less than or equal to 1, and that
00039 *  XNORM = infinity-norm(X).
00040 *
00041 *  Arguments
00042 *  ==========
00043 *
00044 *  RMAX    (output) DOUBLE PRECISION
00045 *          Value of the largest test ratio.
00046 *
00047 *  LMAX    (output) INTEGER
00048 *          Example number where largest test ratio achieved.
00049 *
00050 *  NINFO   (output) INTEGER array, dimension (3)
00051 *          NINFO(1) = number of examples with INFO less than 0
00052 *          NINFO(2) = number of examples with INFO greater than 0
00053 *
00054 *  KNT     (output) INTEGER
00055 *          Total number of examples tested.
00056 *
00057 *  =====================================================================
00058 *
00059 *     .. Parameters ..
00060       DOUBLE PRECISION   ZERO, HALF, ONE
00061       PARAMETER          ( ZERO = 0.0D0, HALF = 0.5D0, ONE = 1.0D0 )
00062       DOUBLE PRECISION   TWO, THREE, FOUR
00063       PARAMETER          ( TWO = 2.0D0, THREE = 3.0D0, FOUR = 4.0D0 )
00064       DOUBLE PRECISION   SEVEN, TEN
00065       PARAMETER          ( SEVEN = 7.0D0, TEN = 10.0D0 )
00066       DOUBLE PRECISION   TWNONE
00067       PARAMETER          ( TWNONE = 21.0D0 )
00068 *     ..
00069 *     .. Local Scalars ..
00070       INTEGER            IA, IB, ICA, ID1, ID2, INFO, ISMIN, ITRANS,
00071      $                   IWI, IWR, NA, NW
00072       DOUBLE PRECISION   BIGNUM, CA, D1, D2, DEN, EPS, RES, SCALE, SMIN,
00073      $                   SMLNUM, TMP, UNFL, WI, WR, XNORM
00074 *     ..
00075 *     .. Local Arrays ..
00076       LOGICAL            LTRANS( 0: 1 )
00077       DOUBLE PRECISION   A( 2, 2 ), B( 2, 2 ), VAB( 3 ), VCA( 5 ),
00078      $                   VDD( 4 ), VSMIN( 4 ), VWI( 4 ), VWR( 4 ),
00079      $                   X( 2, 2 )
00080 *     ..
00081 *     .. External Functions ..
00082       DOUBLE PRECISION   DLAMCH
00083       EXTERNAL           DLAMCH
00084 *     ..
00085 *     .. External Subroutines ..
00086       EXTERNAL           DLABAD, DLALN2
00087 *     ..
00088 *     .. Intrinsic Functions ..
00089       INTRINSIC          ABS, MAX, SQRT
00090 *     ..
00091 *     .. Data statements ..
00092       DATA               LTRANS / .FALSE., .TRUE. /
00093 *     ..
00094 *     .. Executable Statements ..
00095 *
00096 *     Get machine parameters
00097 *
00098       EPS = DLAMCH( 'P' )
00099       UNFL = DLAMCH( 'U' )
00100       SMLNUM = DLAMCH( 'S' ) / EPS
00101       BIGNUM = ONE / SMLNUM
00102       CALL DLABAD( SMLNUM, BIGNUM )
00103 *
00104 *     Set up test case parameters
00105 *
00106       VSMIN( 1 ) = SMLNUM
00107       VSMIN( 2 ) = EPS
00108       VSMIN( 3 ) = ONE / ( TEN*TEN )
00109       VSMIN( 4 ) = ONE / EPS
00110       VAB( 1 ) = SQRT( SMLNUM )
00111       VAB( 2 ) = ONE
00112       VAB( 3 ) = SQRT( BIGNUM )
00113       VWR( 1 ) = ZERO
00114       VWR( 2 ) = HALF
00115       VWR( 3 ) = TWO
00116       VWR( 4 ) = ONE
00117       VWI( 1 ) = SMLNUM
00118       VWI( 2 ) = EPS
00119       VWI( 3 ) = ONE
00120       VWI( 4 ) = TWO
00121       VDD( 1 ) = SQRT( SMLNUM )
00122       VDD( 2 ) = ONE
00123       VDD( 3 ) = TWO
00124       VDD( 4 ) = SQRT( BIGNUM )
00125       VCA( 1 ) = ZERO
00126       VCA( 2 ) = SQRT( SMLNUM )
00127       VCA( 3 ) = EPS
00128       VCA( 4 ) = HALF
00129       VCA( 5 ) = ONE
00130 *
00131       KNT = 0
00132       NINFO( 1 ) = 0
00133       NINFO( 2 ) = 0
00134       LMAX = 0
00135       RMAX = ZERO
00136 *
00137 *     Begin test loop
00138 *
00139       DO 190 ID1 = 1, 4
00140          D1 = VDD( ID1 )
00141          DO 180 ID2 = 1, 4
00142             D2 = VDD( ID2 )
00143             DO 170 ICA = 1, 5
00144                CA = VCA( ICA )
00145                DO 160 ITRANS = 0, 1
00146                   DO 150 ISMIN = 1, 4
00147                      SMIN = VSMIN( ISMIN )
00148 *
00149                      NA = 1
00150                      NW = 1
00151                      DO 30 IA = 1, 3
00152                         A( 1, 1 ) = VAB( IA )
00153                         DO 20 IB = 1, 3
00154                            B( 1, 1 ) = VAB( IB )
00155                            DO 10 IWR = 1, 4
00156                               IF( D1.EQ.ONE .AND. D2.EQ.ONE .AND. CA.EQ.
00157      $                            ONE ) THEN
00158                                  WR = VWR( IWR )*A( 1, 1 )
00159                               ELSE
00160                                  WR = VWR( IWR )
00161                               END IF
00162                               WI = ZERO
00163                               CALL DLALN2( LTRANS( ITRANS ), NA, NW,
00164      $                                     SMIN, CA, A, 2, D1, D2, B, 2,
00165      $                                     WR, WI, X, 2, SCALE, XNORM,
00166      $                                     INFO )
00167                               IF( INFO.LT.0 )
00168      $                           NINFO( 1 ) = NINFO( 1 ) + 1
00169                               IF( INFO.GT.0 )
00170      $                           NINFO( 2 ) = NINFO( 2 ) + 1
00171                               RES = ABS( ( CA*A( 1, 1 )-WR*D1 )*
00172      $                              X( 1, 1 )-SCALE*B( 1, 1 ) )
00173                               IF( INFO.EQ.0 ) THEN
00174                                  DEN = MAX( EPS*( ABS( ( CA*A( 1,
00175      $                                 1 )-WR*D1 )*X( 1, 1 ) ) ),
00176      $                                 SMLNUM )
00177                               ELSE
00178                                  DEN = MAX( SMIN*ABS( X( 1, 1 ) ),
00179      $                                 SMLNUM )
00180                               END IF
00181                               RES = RES / DEN
00182                               IF( ABS( X( 1, 1 ) ).LT.UNFL .AND.
00183      $                            ABS( B( 1, 1 ) ).LE.SMLNUM*
00184      $                            ABS( CA*A( 1, 1 )-WR*D1 ) )RES = ZERO
00185                               IF( SCALE.GT.ONE )
00186      $                           RES = RES + ONE / EPS
00187                               RES = RES + ABS( XNORM-ABS( X( 1, 1 ) ) )
00188      $                               / MAX( SMLNUM, XNORM ) / EPS
00189                               IF( INFO.NE.0 .AND. INFO.NE.1 )
00190      $                           RES = RES + ONE / EPS
00191                               KNT = KNT + 1
00192                               IF( RES.GT.RMAX ) THEN
00193                                  LMAX = KNT
00194                                  RMAX = RES
00195                               END IF
00196    10                      CONTINUE
00197    20                   CONTINUE
00198    30                CONTINUE
00199 *
00200                      NA = 1
00201                      NW = 2
00202                      DO 70 IA = 1, 3
00203                         A( 1, 1 ) = VAB( IA )
00204                         DO 60 IB = 1, 3
00205                            B( 1, 1 ) = VAB( IB )
00206                            B( 1, 2 ) = -HALF*VAB( IB )
00207                            DO 50 IWR = 1, 4
00208                               IF( D1.EQ.ONE .AND. D2.EQ.ONE .AND. CA.EQ.
00209      $                            ONE ) THEN
00210                                  WR = VWR( IWR )*A( 1, 1 )
00211                               ELSE
00212                                  WR = VWR( IWR )
00213                               END IF
00214                               DO 40 IWI = 1, 4
00215                                  IF( D1.EQ.ONE .AND. D2.EQ.ONE .AND.
00216      $                               CA.EQ.ONE ) THEN
00217                                     WI = VWI( IWI )*A( 1, 1 )
00218                                  ELSE
00219                                     WI = VWI( IWI )
00220                                  END IF
00221                                  CALL DLALN2( LTRANS( ITRANS ), NA, NW,
00222      $                                        SMIN, CA, A, 2, D1, D2, B,
00223      $                                        2, WR, WI, X, 2, SCALE,
00224      $                                        XNORM, INFO )
00225                                  IF( INFO.LT.0 )
00226      $                              NINFO( 1 ) = NINFO( 1 ) + 1
00227                                  IF( INFO.GT.0 )
00228      $                              NINFO( 2 ) = NINFO( 2 ) + 1
00229                                  RES = ABS( ( CA*A( 1, 1 )-WR*D1 )*
00230      $                                 X( 1, 1 )+( WI*D1 )*X( 1, 2 )-
00231      $                                 SCALE*B( 1, 1 ) )
00232                                  RES = RES + ABS( ( -WI*D1 )*X( 1, 1 )+
00233      $                                 ( CA*A( 1, 1 )-WR*D1 )*X( 1, 2 )-
00234      $                                 SCALE*B( 1, 2 ) )
00235                                  IF( INFO.EQ.0 ) THEN
00236                                     DEN = MAX( EPS*( MAX( ABS( CA*A( 1,
00237      $                                    1 )-WR*D1 ), ABS( D1*WI ) )*
00238      $                                    ( ABS( X( 1, 1 ) )+ABS( X( 1,
00239      $                                    2 ) ) ) ), SMLNUM )
00240                                  ELSE
00241                                     DEN = MAX( SMIN*( ABS( X( 1,
00242      $                                    1 ) )+ABS( X( 1, 2 ) ) ),
00243      $                                    SMLNUM )
00244                                  END IF
00245                                  RES = RES / DEN
00246                                  IF( ABS( X( 1, 1 ) ).LT.UNFL .AND.
00247      $                               ABS( X( 1, 2 ) ).LT.UNFL .AND.
00248      $                               ABS( B( 1, 1 ) ).LE.SMLNUM*
00249      $                               ABS( CA*A( 1, 1 )-WR*D1 ) )
00250      $                               RES = ZERO
00251                                  IF( SCALE.GT.ONE )
00252      $                              RES = RES + ONE / EPS
00253                                  RES = RES + ABS( XNORM-
00254      $                                 ABS( X( 1, 1 ) )-
00255      $                                 ABS( X( 1, 2 ) ) ) /
00256      $                                 MAX( SMLNUM, XNORM ) / EPS
00257                                  IF( INFO.NE.0 .AND. INFO.NE.1 )
00258      $                              RES = RES + ONE / EPS
00259                                  KNT = KNT + 1
00260                                  IF( RES.GT.RMAX ) THEN
00261                                     LMAX = KNT
00262                                     RMAX = RES
00263                                  END IF
00264    40                         CONTINUE
00265    50                      CONTINUE
00266    60                   CONTINUE
00267    70                CONTINUE
00268 *
00269                      NA = 2
00270                      NW = 1
00271                      DO 100 IA = 1, 3
00272                         A( 1, 1 ) = VAB( IA )
00273                         A( 1, 2 ) = -THREE*VAB( IA )
00274                         A( 2, 1 ) = -SEVEN*VAB( IA )
00275                         A( 2, 2 ) = TWNONE*VAB( IA )
00276                         DO 90 IB = 1, 3
00277                            B( 1, 1 ) = VAB( IB )
00278                            B( 2, 1 ) = -TWO*VAB( IB )
00279                            DO 80 IWR = 1, 4
00280                               IF( D1.EQ.ONE .AND. D2.EQ.ONE .AND. CA.EQ.
00281      $                            ONE ) THEN
00282                                  WR = VWR( IWR )*A( 1, 1 )
00283                               ELSE
00284                                  WR = VWR( IWR )
00285                               END IF
00286                               WI = ZERO
00287                               CALL DLALN2( LTRANS( ITRANS ), NA, NW,
00288      $                                     SMIN, CA, A, 2, D1, D2, B, 2,
00289      $                                     WR, WI, X, 2, SCALE, XNORM,
00290      $                                     INFO )
00291                               IF( INFO.LT.0 )
00292      $                           NINFO( 1 ) = NINFO( 1 ) + 1
00293                               IF( INFO.GT.0 )
00294      $                           NINFO( 2 ) = NINFO( 2 ) + 1
00295                               IF( ITRANS.EQ.1 ) THEN
00296                                  TMP = A( 1, 2 )
00297                                  A( 1, 2 ) = A( 2, 1 )
00298                                  A( 2, 1 ) = TMP
00299                               END IF
00300                               RES = ABS( ( CA*A( 1, 1 )-WR*D1 )*
00301      $                              X( 1, 1 )+( CA*A( 1, 2 ) )*
00302      $                              X( 2, 1 )-SCALE*B( 1, 1 ) )
00303                               RES = RES + ABS( ( CA*A( 2, 1 ) )*
00304      $                              X( 1, 1 )+( CA*A( 2, 2 )-WR*D2 )*
00305      $                              X( 2, 1 )-SCALE*B( 2, 1 ) )
00306                               IF( INFO.EQ.0 ) THEN
00307                                  DEN = MAX( EPS*( MAX( ABS( CA*A( 1,
00308      $                                 1 )-WR*D1 )+ABS( CA*A( 1, 2 ) ),
00309      $                                 ABS( CA*A( 2, 1 ) )+ABS( CA*A( 2,
00310      $                                 2 )-WR*D2 ) )*MAX( ABS( X( 1,
00311      $                                 1 ) ), ABS( X( 2, 1 ) ) ) ),
00312      $                                 SMLNUM )
00313                               ELSE
00314                                  DEN = MAX( EPS*( MAX( SMIN / EPS,
00315      $                                 MAX( ABS( CA*A( 1,
00316      $                                 1 )-WR*D1 )+ABS( CA*A( 1, 2 ) ),
00317      $                                 ABS( CA*A( 2, 1 ) )+ABS( CA*A( 2,
00318      $                                 2 )-WR*D2 ) ) )*MAX( ABS( X( 1,
00319      $                                 1 ) ), ABS( X( 2, 1 ) ) ) ),
00320      $                                 SMLNUM )
00321                               END IF
00322                               RES = RES / DEN
00323                               IF( ABS( X( 1, 1 ) ).LT.UNFL .AND.
00324      $                            ABS( X( 2, 1 ) ).LT.UNFL .AND.
00325      $                            ABS( B( 1, 1 ) )+ABS( B( 2, 1 ) ).LE.
00326      $                            SMLNUM*( ABS( CA*A( 1,
00327      $                            1 )-WR*D1 )+ABS( CA*A( 1,
00328      $                            2 ) )+ABS( CA*A( 2,
00329      $                            1 ) )+ABS( CA*A( 2, 2 )-WR*D2 ) ) )
00330      $                            RES = ZERO
00331                               IF( SCALE.GT.ONE )
00332      $                           RES = RES + ONE / EPS
00333                               RES = RES + ABS( XNORM-
00334      $                              MAX( ABS( X( 1, 1 ) ), ABS( X( 2,
00335      $                              1 ) ) ) ) / MAX( SMLNUM, XNORM ) /
00336      $                              EPS
00337                               IF( INFO.NE.0 .AND. INFO.NE.1 )
00338      $                           RES = RES + ONE / EPS
00339                               KNT = KNT + 1
00340                               IF( RES.GT.RMAX ) THEN
00341                                  LMAX = KNT
00342                                  RMAX = RES
00343                               END IF
00344    80                      CONTINUE
00345    90                   CONTINUE
00346   100                CONTINUE
00347 *
00348                      NA = 2
00349                      NW = 2
00350                      DO 140 IA = 1, 3
00351                         A( 1, 1 ) = VAB( IA )*TWO
00352                         A( 1, 2 ) = -THREE*VAB( IA )
00353                         A( 2, 1 ) = -SEVEN*VAB( IA )
00354                         A( 2, 2 ) = TWNONE*VAB( IA )
00355                         DO 130 IB = 1, 3
00356                            B( 1, 1 ) = VAB( IB )
00357                            B( 2, 1 ) = -TWO*VAB( IB )
00358                            B( 1, 2 ) = FOUR*VAB( IB )
00359                            B( 2, 2 ) = -SEVEN*VAB( IB )
00360                            DO 120 IWR = 1, 4
00361                               IF( D1.EQ.ONE .AND. D2.EQ.ONE .AND. CA.EQ.
00362      $                            ONE ) THEN
00363                                  WR = VWR( IWR )*A( 1, 1 )
00364                               ELSE
00365                                  WR = VWR( IWR )
00366                               END IF
00367                               DO 110 IWI = 1, 4
00368                                  IF( D1.EQ.ONE .AND. D2.EQ.ONE .AND.
00369      $                               CA.EQ.ONE ) THEN
00370                                     WI = VWI( IWI )*A( 1, 1 )
00371                                  ELSE
00372                                     WI = VWI( IWI )
00373                                  END IF
00374                                  CALL DLALN2( LTRANS( ITRANS ), NA, NW,
00375      $                                        SMIN, CA, A, 2, D1, D2, B,
00376      $                                        2, WR, WI, X, 2, SCALE,
00377      $                                        XNORM, INFO )
00378                                  IF( INFO.LT.0 )
00379      $                              NINFO( 1 ) = NINFO( 1 ) + 1
00380                                  IF( INFO.GT.0 )
00381      $                              NINFO( 2 ) = NINFO( 2 ) + 1
00382                                  IF( ITRANS.EQ.1 ) THEN
00383                                     TMP = A( 1, 2 )
00384                                     A( 1, 2 ) = A( 2, 1 )
00385                                     A( 2, 1 ) = TMP
00386                                  END IF
00387                                  RES = ABS( ( CA*A( 1, 1 )-WR*D1 )*
00388      $                                 X( 1, 1 )+( CA*A( 1, 2 ) )*
00389      $                                 X( 2, 1 )+( WI*D1 )*X( 1, 2 )-
00390      $                                 SCALE*B( 1, 1 ) )
00391                                  RES = RES + ABS( ( CA*A( 1,
00392      $                                 1 )-WR*D1 )*X( 1, 2 )+
00393      $                                 ( CA*A( 1, 2 ) )*X( 2, 2 )-
00394      $                                 ( WI*D1 )*X( 1, 1 )-SCALE*
00395      $                                 B( 1, 2 ) )
00396                                  RES = RES + ABS( ( CA*A( 2, 1 ) )*
00397      $                                 X( 1, 1 )+( CA*A( 2, 2 )-WR*D2 )*
00398      $                                 X( 2, 1 )+( WI*D2 )*X( 2, 2 )-
00399      $                                 SCALE*B( 2, 1 ) )
00400                                  RES = RES + ABS( ( CA*A( 2, 1 ) )*
00401      $                                 X( 1, 2 )+( CA*A( 2, 2 )-WR*D2 )*
00402      $                                 X( 2, 2 )-( WI*D2 )*X( 2, 1 )-
00403      $                                 SCALE*B( 2, 2 ) )
00404                                  IF( INFO.EQ.0 ) THEN
00405                                     DEN = MAX( EPS*( MAX( ABS( CA*A( 1,
00406      $                                    1 )-WR*D1 )+ABS( CA*A( 1,
00407      $                                    2 ) )+ABS( WI*D1 ),
00408      $                                    ABS( CA*A( 2,
00409      $                                    1 ) )+ABS( CA*A( 2,
00410      $                                    2 )-WR*D2 )+ABS( WI*D2 ) )*
00411      $                                    MAX( ABS( X( 1,
00412      $                                    1 ) )+ABS( X( 2, 1 ) ),
00413      $                                    ABS( X( 1, 2 ) )+ABS( X( 2,
00414      $                                    2 ) ) ) ), SMLNUM )
00415                                  ELSE
00416                                     DEN = MAX( EPS*( MAX( SMIN / EPS,
00417      $                                    MAX( ABS( CA*A( 1,
00418      $                                    1 )-WR*D1 )+ABS( CA*A( 1,
00419      $                                    2 ) )+ABS( WI*D1 ),
00420      $                                    ABS( CA*A( 2,
00421      $                                    1 ) )+ABS( CA*A( 2,
00422      $                                    2 )-WR*D2 )+ABS( WI*D2 ) ) )*
00423      $                                    MAX( ABS( X( 1,
00424      $                                    1 ) )+ABS( X( 2, 1 ) ),
00425      $                                    ABS( X( 1, 2 ) )+ABS( X( 2,
00426      $                                    2 ) ) ) ), SMLNUM )
00427                                  END IF
00428                                  RES = RES / DEN
00429                                  IF( ABS( X( 1, 1 ) ).LT.UNFL .AND.
00430      $                               ABS( X( 2, 1 ) ).LT.UNFL .AND.
00431      $                               ABS( X( 1, 2 ) ).LT.UNFL .AND.
00432      $                               ABS( X( 2, 2 ) ).LT.UNFL .AND.
00433      $                               ABS( B( 1, 1 ) )+
00434      $                               ABS( B( 2, 1 ) ).LE.SMLNUM*
00435      $                               ( ABS( CA*A( 1, 1 )-WR*D1 )+
00436      $                               ABS( CA*A( 1, 2 ) )+ABS( CA*A( 2,
00437      $                               1 ) )+ABS( CA*A( 2,
00438      $                               2 )-WR*D2 )+ABS( WI*D2 )+ABS( WI*
00439      $                               D1 ) ) )RES = ZERO
00440                                  IF( SCALE.GT.ONE )
00441      $                              RES = RES + ONE / EPS
00442                                  RES = RES + ABS( XNORM-
00443      $                                 MAX( ABS( X( 1, 1 ) )+ABS( X( 1,
00444      $                                 2 ) ), ABS( X( 2,
00445      $                                 1 ) )+ABS( X( 2, 2 ) ) ) ) /
00446      $                                 MAX( SMLNUM, XNORM ) / EPS
00447                                  IF( INFO.NE.0 .AND. INFO.NE.1 )
00448      $                              RES = RES + ONE / EPS
00449                                  KNT = KNT + 1
00450                                  IF( RES.GT.RMAX ) THEN
00451                                     LMAX = KNT
00452                                     RMAX = RES
00453                                  END IF
00454   110                         CONTINUE
00455   120                      CONTINUE
00456   130                   CONTINUE
00457   140                CONTINUE
00458   150             CONTINUE
00459   160          CONTINUE
00460   170       CONTINUE
00461   180    CONTINUE
00462   190 CONTINUE
00463 *
00464       RETURN
00465 *
00466 *     End of DGET31
00467 *
00468       END