LAPACK: TESTING/EIG/dget32.f Source File

Go to the documentation of this file.
00001       SUBROUTINE DGET32( 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, NINFO
00009       DOUBLE PRECISION   RMAX
00010 *     ..
00011 *
00012 *  Purpose
00013 *  =======
00014 *
00015 *  DGET32 tests DLASY2, a routine for solving
00016 *
00017 *          op(TL)*X + ISGN*X*op(TR) = SCALE*B
00018 *
00019 *  where TL is N1 by N1, TR is N2 by N2, and N1,N2 =1 or 2 only.
00020 *  X and B are N1 by N2, op() is an optional transpose, an
00021 *  ISGN = 1 or -1. SCALE is chosen less than or equal to 1 to
00022 *  avoid overflow in X.
00023 *
00024 *  The test condition is that the scaled residual
00025 *
00026 *  norm( op(TL)*X + ISGN*X*op(TR) = SCALE*B )
00027 *       / ( max( ulp*norm(TL), ulp*norm(TR)) * norm(X), SMLNUM )
00028 *
00029 *  should be on the order of 1. Here, ulp is the machine precision.
00030 *  Also, it is verified that SCALE is less than or equal to 1, and
00031 *  that XNORM = infinity-norm(X).
00032 *
00033 *  Arguments
00034 *  ==========
00035 *
00036 *  RMAX    (output) DOUBLE PRECISION
00037 *          Value of the largest test ratio.
00038 *
00039 *  LMAX    (output) INTEGER
00040 *          Example number where largest test ratio achieved.
00041 *
00042 *  NINFO   (output) INTEGER
00043 *          Number of examples returned with INFO.NE.0.
00044 *
00045 *  KNT     (output) INTEGER
00046 *          Total number of examples tested.
00047 *
00048 *  =====================================================================
00049 *
00050 *     .. Parameters ..
00051       DOUBLE PRECISION   ZERO, ONE
00052       PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
00053       DOUBLE PRECISION   TWO, FOUR, EIGHT
00054       PARAMETER          ( TWO = 2.0D0, FOUR = 4.0D0, EIGHT = 8.0D0 )
00055 *     ..
00056 *     .. Local Scalars ..
00057       LOGICAL            LTRANL, LTRANR
00058       INTEGER            IB, IB1, IB2, IB3, INFO, ISGN, ITL, ITLSCL,
00059      $                   ITR, ITRANL, ITRANR, ITRSCL, N1, N2
00060       DOUBLE PRECISION   BIGNUM, DEN, EPS, RES, SCALE, SGN, SMLNUM, TMP,
00061      $                   TNRM, XNORM, XNRM
00062 *     ..
00063 *     .. Local Arrays ..
00064       INTEGER            ITVAL( 2, 2, 8 )
00065       DOUBLE PRECISION   B( 2, 2 ), TL( 2, 2 ), TR( 2, 2 ), VAL( 3 ),
00066      $                   X( 2, 2 )
00067 *     ..
00068 *     .. External Functions ..
00069       DOUBLE PRECISION   DLAMCH
00070       EXTERNAL           DLAMCH
00071 *     ..
00072 *     .. External Subroutines ..
00073       EXTERNAL           DLABAD, DLASY2
00074 *     ..
00075 *     .. Intrinsic Functions ..
00076       INTRINSIC          ABS, MAX, MIN, SQRT
00077 *     ..
00078 *     .. Data statements ..
00079       DATA               ITVAL / 8, 4, 2, 1, 4, 8, 1, 2, 2, 1, 8, 4, 1,
00080      $                   2, 4, 8, 9, 4, 2, 1, 4, 9, 1, 2, 2, 1, 9, 4, 1,
00081      $                   2, 4, 9 /
00082 *     ..
00083 *     .. Executable Statements ..
00084 *
00085 *     Get machine parameters
00086 *
00087       EPS = DLAMCH( 'P' )
00088       SMLNUM = DLAMCH( 'S' ) / EPS
00089       BIGNUM = ONE / SMLNUM
00090       CALL DLABAD( SMLNUM, BIGNUM )
00091 *
00092 *     Set up test case parameters
00093 *
00094       VAL( 1 ) = SQRT( SMLNUM )
00095       VAL( 2 ) = ONE
00096       VAL( 3 ) = SQRT( BIGNUM )
00097 *
00098       KNT = 0
00099       NINFO = 0
00100       LMAX = 0
00101       RMAX = ZERO
00102 *
00103 *     Begin test loop
00104 *
00105       DO 230 ITRANL = 0, 1
00106          DO 220 ITRANR = 0, 1
00107             DO 210 ISGN = -1, 1, 2
00108                SGN = ISGN
00109                LTRANL = ITRANL.EQ.1
00110                LTRANR = ITRANR.EQ.1
00111 *
00112                N1 = 1
00113                N2 = 1
00114                DO 30 ITL = 1, 3
00115                   DO 20 ITR = 1, 3
00116                      DO 10 IB = 1, 3
00117                         TL( 1, 1 ) = VAL( ITL )
00118                         TR( 1, 1 ) = VAL( ITR )
00119                         B( 1, 1 ) = VAL( IB )
00120                         KNT = KNT + 1
00121                         CALL DLASY2( LTRANL, LTRANR, ISGN, N1, N2, TL,
00122      $                               2, TR, 2, B, 2, SCALE, X, 2, XNORM,
00123      $                               INFO )
00124                         IF( INFO.NE.0 )
00125      $                     NINFO = NINFO + 1
00126                         RES = ABS( ( TL( 1, 1 )+SGN*TR( 1, 1 ) )*
00127      $                        X( 1, 1 )-SCALE*B( 1, 1 ) )
00128                         IF( INFO.EQ.0 ) THEN
00129                            DEN = MAX( EPS*( ( ABS( TR( 1,
00130      $                           1 ) )+ABS( TL( 1, 1 ) ) )*ABS( X( 1,
00131      $                           1 ) ) ), SMLNUM )
00132                         ELSE
00133                            DEN = SMLNUM*MAX( ABS( X( 1, 1 ) ), ONE )
00134                         END IF
00135                         RES = RES / DEN
00136                         IF( SCALE.GT.ONE )
00137      $                     RES = RES + ONE / EPS
00138                         RES = RES + ABS( XNORM-ABS( X( 1, 1 ) ) ) /
00139      $                        MAX( SMLNUM, XNORM ) / EPS
00140                         IF( INFO.NE.0 .AND. INFO.NE.1 )
00141      $                     RES = RES + ONE / EPS
00142                         IF( RES.GT.RMAX ) THEN
00143                            LMAX = KNT
00144                            RMAX = RES
00145                         END IF
00146    10                CONTINUE
00147    20             CONTINUE
00148    30          CONTINUE
00149 *
00150                N1 = 2
00151                N2 = 1
00152                DO 80 ITL = 1, 8
00153                   DO 70 ITLSCL = 1, 3
00154                      DO 60 ITR = 1, 3
00155                         DO 50 IB1 = 1, 3
00156                            DO 40 IB2 = 1, 3
00157                               B( 1, 1 ) = VAL( IB1 )
00158                               B( 2, 1 ) = -FOUR*VAL( IB2 )
00159                               TL( 1, 1 ) = ITVAL( 1, 1, ITL )*
00160      $                                     VAL( ITLSCL )
00161                               TL( 2, 1 ) = ITVAL( 2, 1, ITL )*
00162      $                                     VAL( ITLSCL )
00163                               TL( 1, 2 ) = ITVAL( 1, 2, ITL )*
00164      $                                     VAL( ITLSCL )
00165                               TL( 2, 2 ) = ITVAL( 2, 2, ITL )*
00166      $                                     VAL( ITLSCL )
00167                               TR( 1, 1 ) = VAL( ITR )
00168                               KNT = KNT + 1
00169                               CALL DLASY2( LTRANL, LTRANR, ISGN, N1, N2,
00170      $                                     TL, 2, TR, 2, B, 2, SCALE, X,
00171      $                                     2, XNORM, INFO )
00172                               IF( INFO.NE.0 )
00173      $                           NINFO = NINFO + 1
00174                               IF( LTRANL ) THEN
00175                                  TMP = TL( 1, 2 )
00176                                  TL( 1, 2 ) = TL( 2, 1 )
00177                                  TL( 2, 1 ) = TMP
00178                               END IF
00179                               RES = ABS( ( TL( 1, 1 )+SGN*TR( 1, 1 ) )*
00180      $                              X( 1, 1 )+TL( 1, 2 )*X( 2, 1 )-
00181      $                              SCALE*B( 1, 1 ) )
00182                               RES = RES + ABS( ( TL( 2, 2 )+SGN*TR( 1,
00183      $                              1 ) )*X( 2, 1 )+TL( 2, 1 )*
00184      $                              X( 1, 1 )-SCALE*B( 2, 1 ) )
00185                               TNRM = ABS( TR( 1, 1 ) ) +
00186      $                               ABS( TL( 1, 1 ) ) +
00187      $                               ABS( TL( 1, 2 ) ) +
00188      $                               ABS( TL( 2, 1 ) ) +
00189      $                               ABS( TL( 2, 2 ) )
00190                               XNRM = MAX( ABS( X( 1, 1 ) ),
00191      $                               ABS( X( 2, 1 ) ) )
00192                               DEN = MAX( SMLNUM, SMLNUM*XNRM,
00193      $                              ( TNRM*EPS )*XNRM )
00194                               RES = RES / DEN
00195                               IF( SCALE.GT.ONE )
00196      $                           RES = RES + ONE / EPS
00197                               RES = RES + ABS( XNORM-XNRM ) /
00198      $                              MAX( SMLNUM, XNORM ) / EPS
00199                               IF( RES.GT.RMAX ) THEN
00200                                  LMAX = KNT
00201                                  RMAX = RES
00202                               END IF
00203    40                      CONTINUE
00204    50                   CONTINUE
00205    60                CONTINUE
00206    70             CONTINUE
00207    80          CONTINUE
00208 *
00209                N1 = 1
00210                N2 = 2
00211                DO 130 ITR = 1, 8
00212                   DO 120 ITRSCL = 1, 3
00213                      DO 110 ITL = 1, 3
00214                         DO 100 IB1 = 1, 3
00215                            DO 90 IB2 = 1, 3
00216                               B( 1, 1 ) = VAL( IB1 )
00217                               B( 1, 2 ) = -TWO*VAL( IB2 )
00218                               TR( 1, 1 ) = ITVAL( 1, 1, ITR )*
00219      $                                     VAL( ITRSCL )
00220                               TR( 2, 1 ) = ITVAL( 2, 1, ITR )*
00221      $                                     VAL( ITRSCL )
00222                               TR( 1, 2 ) = ITVAL( 1, 2, ITR )*
00223      $                                     VAL( ITRSCL )
00224                               TR( 2, 2 ) = ITVAL( 2, 2, ITR )*
00225      $                                     VAL( ITRSCL )
00226                               TL( 1, 1 ) = VAL( ITL )
00227                               KNT = KNT + 1
00228                               CALL DLASY2( LTRANL, LTRANR, ISGN, N1, N2,
00229      $                                     TL, 2, TR, 2, B, 2, SCALE, X,
00230      $                                     2, XNORM, INFO )
00231                               IF( INFO.NE.0 )
00232      $                           NINFO = NINFO + 1
00233                               IF( LTRANR ) THEN
00234                                  TMP = TR( 1, 2 )
00235                                  TR( 1, 2 ) = TR( 2, 1 )
00236                                  TR( 2, 1 ) = TMP
00237                               END IF
00238                               TNRM = ABS( TL( 1, 1 ) ) +
00239      $                               ABS( TR( 1, 1 ) ) +
00240      $                               ABS( TR( 1, 2 ) ) +
00241      $                               ABS( TR( 2, 2 ) ) +
00242      $                               ABS( TR( 2, 1 ) )
00243                               XNRM = ABS( X( 1, 1 ) ) + ABS( X( 1, 2 ) )
00244                               RES = ABS( ( ( TL( 1, 1 )+SGN*TR( 1,
00245      $                              1 ) ) )*( X( 1, 1 ) )+
00246      $                              ( SGN*TR( 2, 1 ) )*( X( 1, 2 ) )-
00247      $                              ( SCALE*B( 1, 1 ) ) )
00248                               RES = RES + ABS( ( ( TL( 1, 1 )+SGN*TR( 2,
00249      $                              2 ) ) )*( X( 1, 2 ) )+
00250      $                              ( SGN*TR( 1, 2 ) )*( X( 1, 1 ) )-
00251      $                              ( SCALE*B( 1, 2 ) ) )
00252                               DEN = MAX( SMLNUM, SMLNUM*XNRM,
00253      $                              ( TNRM*EPS )*XNRM )
00254                               RES = RES / DEN
00255                               IF( SCALE.GT.ONE )
00256      $                           RES = RES + ONE / EPS
00257                               RES = RES + ABS( XNORM-XNRM ) /
00258      $                              MAX( SMLNUM, XNORM ) / EPS
00259                               IF( RES.GT.RMAX ) THEN
00260                                  LMAX = KNT
00261                                  RMAX = RES
00262                               END IF
00263    90                      CONTINUE
00264   100                   CONTINUE
00265   110                CONTINUE
00266   120             CONTINUE
00267   130          CONTINUE
00268 *
00269                N1 = 2
00270                N2 = 2
00271                DO 200 ITR = 1, 8
00272                   DO 190 ITRSCL = 1, 3
00273                      DO 180 ITL = 1, 8
00274                         DO 170 ITLSCL = 1, 3
00275                            DO 160 IB1 = 1, 3
00276                               DO 150 IB2 = 1, 3
00277                                  DO 140 IB3 = 1, 3
00278                                     B( 1, 1 ) = VAL( IB1 )
00279                                     B( 2, 1 ) = -FOUR*VAL( IB2 )
00280                                     B( 1, 2 ) = -TWO*VAL( IB3 )
00281                                     B( 2, 2 ) = EIGHT*
00282      $                                          MIN( VAL( IB1 ), VAL
00283      $                                          ( IB2 ), VAL( IB3 ) )
00284                                     TR( 1, 1 ) = ITVAL( 1, 1, ITR )*
00285      $                                           VAL( ITRSCL )
00286                                     TR( 2, 1 ) = ITVAL( 2, 1, ITR )*
00287      $                                           VAL( ITRSCL )
00288                                     TR( 1, 2 ) = ITVAL( 1, 2, ITR )*
00289      $                                           VAL( ITRSCL )
00290                                     TR( 2, 2 ) = ITVAL( 2, 2, ITR )*
00291      $                                           VAL( ITRSCL )
00292                                     TL( 1, 1 ) = ITVAL( 1, 1, ITL )*
00293      $                                           VAL( ITLSCL )
00294                                     TL( 2, 1 ) = ITVAL( 2, 1, ITL )*
00295      $                                           VAL( ITLSCL )
00296                                     TL( 1, 2 ) = ITVAL( 1, 2, ITL )*
00297      $                                           VAL( ITLSCL )
00298                                     TL( 2, 2 ) = ITVAL( 2, 2, ITL )*
00299      $                                           VAL( ITLSCL )
00300                                     KNT = KNT + 1
00301                                     CALL DLASY2( LTRANL, LTRANR, ISGN,
00302      $                                           N1, N2, TL, 2, TR, 2,
00303      $                                           B, 2, SCALE, X, 2,
00304      $                                           XNORM, INFO )
00305                                     IF( INFO.NE.0 )
00306      $                                 NINFO = NINFO + 1
00307                                     IF( LTRANR ) THEN
00308                                        TMP = TR( 1, 2 )
00309                                        TR( 1, 2 ) = TR( 2, 1 )
00310                                        TR( 2, 1 ) = TMP
00311                                     END IF
00312                                     IF( LTRANL ) THEN
00313                                        TMP = TL( 1, 2 )
00314                                        TL( 1, 2 ) = TL( 2, 1 )
00315                                        TL( 2, 1 ) = TMP
00316                                     END IF
00317                                     TNRM = ABS( TR( 1, 1 ) ) +
00318      $                                     ABS( TR( 2, 1 ) ) +
00319      $                                     ABS( TR( 1, 2 ) ) +
00320      $                                     ABS( TR( 2, 2 ) ) +
00321      $                                     ABS( TL( 1, 1 ) ) +
00322      $                                     ABS( TL( 2, 1 ) ) +
00323      $                                     ABS( TL( 1, 2 ) ) +
00324      $                                     ABS( TL( 2, 2 ) )
00325                                     XNRM = MAX( ABS( X( 1, 1 ) )+
00326      $                                     ABS( X( 1, 2 ) ),
00327      $                                     ABS( X( 2, 1 ) )+
00328      $                                     ABS( X( 2, 2 ) ) )
00329                                     RES = ABS( ( ( TL( 1, 1 )+SGN*TR( 1,
00330      $                                    1 ) ) )*( X( 1, 1 ) )+
00331      $                                    ( SGN*TR( 2, 1 ) )*
00332      $                                    ( X( 1, 2 ) )+( TL( 1, 2 ) )*
00333      $                                    ( X( 2, 1 ) )-
00334      $                                    ( SCALE*B( 1, 1 ) ) )
00335                                     RES = RES + ABS( ( TL( 1, 1 ) )*
00336      $                                    ( X( 1, 2 ) )+
00337      $                                    ( SGN*TR( 1, 2 ) )*
00338      $                                    ( X( 1, 1 ) )+
00339      $                                    ( SGN*TR( 2, 2 ) )*
00340      $                                    ( X( 1, 2 ) )+( TL( 1, 2 ) )*
00341      $                                    ( X( 2, 2 ) )-
00342      $                                    ( SCALE*B( 1, 2 ) ) )
00343                                     RES = RES + ABS( ( TL( 2, 1 ) )*
00344      $                                    ( X( 1, 1 ) )+
00345      $                                    ( SGN*TR( 1, 1 ) )*
00346      $                                    ( X( 2, 1 ) )+
00347      $                                    ( SGN*TR( 2, 1 ) )*
00348      $                                    ( X( 2, 2 ) )+( TL( 2, 2 ) )*
00349      $                                    ( X( 2, 1 ) )-
00350      $                                    ( SCALE*B( 2, 1 ) ) )
00351                                     RES = RES + ABS( ( ( TL( 2,
00352      $                                    2 )+SGN*TR( 2, 2 ) ) )*
00353      $                                    ( X( 2, 2 ) )+
00354      $                                    ( SGN*TR( 1, 2 ) )*
00355      $                                    ( X( 2, 1 ) )+( TL( 2, 1 ) )*
00356      $                                    ( X( 1, 2 ) )-
00357      $                                    ( SCALE*B( 2, 2 ) ) )
00358                                     DEN = MAX( SMLNUM, SMLNUM*XNRM,
00359      $                                    ( TNRM*EPS )*XNRM )
00360                                     RES = RES / DEN
00361                                     IF( SCALE.GT.ONE )
00362      $                                 RES = RES + ONE / EPS
00363                                     RES = RES + ABS( XNORM-XNRM ) /
00364      $                                    MAX( SMLNUM, XNORM ) / EPS
00365                                     IF( RES.GT.RMAX ) THEN
00366                                        LMAX = KNT
00367                                        RMAX = RES
00368                                     END IF
00369   140                            CONTINUE
00370   150                         CONTINUE
00371   160                      CONTINUE
00372   170                   CONTINUE
00373   180                CONTINUE
00374   190             CONTINUE
00375   200          CONTINUE
00376   210       CONTINUE
00377   220    CONTINUE
00378   230 CONTINUE
00379 *
00380       RETURN
00381 *
00382 *     End of DGET32
00383 *
00384       END