LAPACK 3.3.1
Linear Algebra PACKage

zchkeq.f

Go to the documentation of this file.
00001       SUBROUTINE ZCHKEQ( THRESH, NOUT )
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            NOUT
00009       DOUBLE PRECISION   THRESH
00010 *     ..
00011 *
00012 *  Purpose
00013 *  =======
00014 *
00015 *  ZCHKEQ tests ZGEEQU, ZGBEQU, ZPOEQU, ZPPEQU and ZPBEQU
00016 *
00017 *  Arguments
00018 *  =========
00019 *
00020 *  THRESH  (input) DOUBLE PRECISION
00021 *          Threshold for testing routines. Should be between 2 and 10.
00022 *
00023 *  NOUT    (input) INTEGER
00024 *          The unit number for output.
00025 *
00026 *  =====================================================================
00027 *
00028 *     .. Parameters ..
00029       DOUBLE PRECISION   ZERO, ONE, TEN
00030       PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D+0, TEN = 1.0D1 )
00031       COMPLEX*16         CZERO
00032       PARAMETER          ( CZERO = ( 0.0D0, 0.0D0 ) )
00033       COMPLEX*16         CONE
00034       PARAMETER          ( CONE = ( 1.0D0, 0.0D0 ) )
00035       INTEGER            NSZ, NSZB
00036       PARAMETER          ( NSZ = 5, NSZB = 3*NSZ-2 )
00037       INTEGER            NSZP, NPOW
00038       PARAMETER          ( NSZP = ( NSZ*( NSZ+1 ) ) / 2,
00039      $                   NPOW = 2*NSZ+1 )
00040 *     ..
00041 *     .. Local Scalars ..
00042       LOGICAL            OK
00043       CHARACTER*3        PATH
00044       INTEGER            I, INFO, J, KL, KU, M, N
00045       DOUBLE PRECISION   CCOND, EPS, NORM, RATIO, RCMAX, RCMIN, RCOND
00046 *     ..
00047 *     .. Local Arrays ..
00048       DOUBLE PRECISION   C( NSZ ), POW( NPOW ), R( NSZ ), RESLTS( 5 ),
00049      $                   RPOW( NPOW )
00050       COMPLEX*16         A( NSZ, NSZ ), AB( NSZB, NSZ ), AP( NSZP )
00051 *     ..
00052 *     .. External Functions ..
00053       DOUBLE PRECISION   DLAMCH
00054       EXTERNAL           DLAMCH
00055 *     ..
00056 *     .. External Subroutines ..
00057       EXTERNAL           ZGBEQU, ZGEEQU, ZPBEQU, ZPOEQU, ZPPEQU
00058 *     ..
00059 *     .. Intrinsic Functions ..
00060       INTRINSIC          ABS, MAX, MIN
00061 *     ..
00062 *     .. Executable Statements ..
00063 *
00064       PATH( 1: 1 ) = 'Zomplex precision'
00065       PATH( 2: 3 ) = 'EQ'
00066 *
00067       EPS = DLAMCH( 'P' )
00068       DO 10 I = 1, 5
00069          RESLTS( I ) = ZERO
00070    10 CONTINUE
00071       DO 20 I = 1, NPOW
00072          POW( I ) = TEN**( I-1 )
00073          RPOW( I ) = ONE / POW( I )
00074    20 CONTINUE
00075 *
00076 *     Test ZGEEQU
00077 *
00078       DO 80 N = 0, NSZ
00079          DO 70 M = 0, NSZ
00080 *
00081             DO 40 J = 1, NSZ
00082                DO 30 I = 1, NSZ
00083                   IF( I.LE.M .AND. J.LE.N ) THEN
00084                      A( I, J ) = POW( I+J+1 )*( -1 )**( I+J )
00085                   ELSE
00086                      A( I, J ) = CZERO
00087                   END IF
00088    30          CONTINUE
00089    40       CONTINUE
00090 *
00091             CALL ZGEEQU( M, N, A, NSZ, R, C, RCOND, CCOND, NORM, INFO )
00092 *
00093             IF( INFO.NE.0 ) THEN
00094                RESLTS( 1 ) = ONE
00095             ELSE
00096                IF( N.NE.0 .AND. M.NE.0 ) THEN
00097                   RESLTS( 1 ) = MAX( RESLTS( 1 ),
00098      $                          ABS( ( RCOND-RPOW( M ) ) / RPOW( M ) ) )
00099                   RESLTS( 1 ) = MAX( RESLTS( 1 ),
00100      $                          ABS( ( CCOND-RPOW( N ) ) / RPOW( N ) ) )
00101                   RESLTS( 1 ) = MAX( RESLTS( 1 ),
00102      $                          ABS( ( NORM-POW( N+M+1 ) ) / POW( N+M+
00103      $                          1 ) ) )
00104                   DO 50 I = 1, M
00105                      RESLTS( 1 ) = MAX( RESLTS( 1 ),
00106      $                             ABS( ( R( I )-RPOW( I+N+1 ) ) /
00107      $                             RPOW( I+N+1 ) ) )
00108    50             CONTINUE
00109                   DO 60 J = 1, N
00110                      RESLTS( 1 ) = MAX( RESLTS( 1 ),
00111      $                             ABS( ( C( J )-POW( N-J+1 ) ) /
00112      $                             POW( N-J+1 ) ) )
00113    60             CONTINUE
00114                END IF
00115             END IF
00116 *
00117    70    CONTINUE
00118    80 CONTINUE
00119 *
00120 *     Test with zero rows and columns
00121 *
00122       DO 90 J = 1, NSZ
00123          A( MAX( NSZ-1, 1 ), J ) = CZERO
00124    90 CONTINUE
00125       CALL ZGEEQU( NSZ, NSZ, A, NSZ, R, C, RCOND, CCOND, NORM, INFO )
00126       IF( INFO.NE.MAX( NSZ-1, 1 ) )
00127      $   RESLTS( 1 ) = ONE
00128 *
00129       DO 100 J = 1, NSZ
00130          A( MAX( NSZ-1, 1 ), J ) = CONE
00131   100 CONTINUE
00132       DO 110 I = 1, NSZ
00133          A( I, MAX( NSZ-1, 1 ) ) = CZERO
00134   110 CONTINUE
00135       CALL ZGEEQU( NSZ, NSZ, A, NSZ, R, C, RCOND, CCOND, NORM, INFO )
00136       IF( INFO.NE.NSZ+MAX( NSZ-1, 1 ) )
00137      $   RESLTS( 1 ) = ONE
00138       RESLTS( 1 ) = RESLTS( 1 ) / EPS
00139 *
00140 *     Test ZGBEQU
00141 *
00142       DO 250 N = 0, NSZ
00143          DO 240 M = 0, NSZ
00144             DO 230 KL = 0, MAX( M-1, 0 )
00145                DO 220 KU = 0, MAX( N-1, 0 )
00146 *
00147                   DO 130 J = 1, NSZ
00148                      DO 120 I = 1, NSZB
00149                         AB( I, J ) = CZERO
00150   120                CONTINUE
00151   130             CONTINUE
00152                   DO 150 J = 1, N
00153                      DO 140 I = 1, M
00154                         IF( I.LE.MIN( M, J+KL ) .AND. I.GE.
00155      $                      MAX( 1, J-KU ) .AND. J.LE.N ) THEN
00156                            AB( KU+1+I-J, J ) = POW( I+J+1 )*
00157      $                                         ( -1 )**( I+J )
00158                         END IF
00159   140                CONTINUE
00160   150             CONTINUE
00161 *
00162                   CALL ZGBEQU( M, N, KL, KU, AB, NSZB, R, C, RCOND,
00163      $                         CCOND, NORM, INFO )
00164 *
00165                   IF( INFO.NE.0 ) THEN
00166                      IF( .NOT.( ( N+KL.LT.M .AND. INFO.EQ.N+KL+1 ) .OR.
00167      $                   ( M+KU.LT.N .AND. INFO.EQ.2*M+KU+1 ) ) ) THEN
00168                         RESLTS( 2 ) = ONE
00169                      END IF
00170                   ELSE
00171                      IF( N.NE.0 .AND. M.NE.0 ) THEN
00172 *
00173                         RCMIN = R( 1 )
00174                         RCMAX = R( 1 )
00175                         DO 160 I = 1, M
00176                            RCMIN = MIN( RCMIN, R( I ) )
00177                            RCMAX = MAX( RCMAX, R( I ) )
00178   160                   CONTINUE
00179                         RATIO = RCMIN / RCMAX
00180                         RESLTS( 2 ) = MAX( RESLTS( 2 ),
00181      $                                ABS( ( RCOND-RATIO ) / RATIO ) )
00182 *
00183                         RCMIN = C( 1 )
00184                         RCMAX = C( 1 )
00185                         DO 170 J = 1, N
00186                            RCMIN = MIN( RCMIN, C( J ) )
00187                            RCMAX = MAX( RCMAX, C( J ) )
00188   170                   CONTINUE
00189                         RATIO = RCMIN / RCMAX
00190                         RESLTS( 2 ) = MAX( RESLTS( 2 ),
00191      $                                ABS( ( CCOND-RATIO ) / RATIO ) )
00192 *
00193                         RESLTS( 2 ) = MAX( RESLTS( 2 ),
00194      $                                ABS( ( NORM-POW( N+M+1 ) ) /
00195      $                                POW( N+M+1 ) ) )
00196                         DO 190 I = 1, M
00197                            RCMAX = ZERO
00198                            DO 180 J = 1, N
00199                               IF( I.LE.J+KL .AND. I.GE.J-KU ) THEN
00200                                  RATIO = ABS( R( I )*POW( I+J+1 )*
00201      $                                   C( J ) )
00202                                  RCMAX = MAX( RCMAX, RATIO )
00203                               END IF
00204   180                      CONTINUE
00205                            RESLTS( 2 ) = MAX( RESLTS( 2 ),
00206      $                                   ABS( ONE-RCMAX ) )
00207   190                   CONTINUE
00208 *
00209                         DO 210 J = 1, N
00210                            RCMAX = ZERO
00211                            DO 200 I = 1, M
00212                               IF( I.LE.J+KL .AND. I.GE.J-KU ) THEN
00213                                  RATIO = ABS( R( I )*POW( I+J+1 )*
00214      $                                   C( J ) )
00215                                  RCMAX = MAX( RCMAX, RATIO )
00216                               END IF
00217   200                      CONTINUE
00218                            RESLTS( 2 ) = MAX( RESLTS( 2 ),
00219      $                                   ABS( ONE-RCMAX ) )
00220   210                   CONTINUE
00221                      END IF
00222                   END IF
00223 *
00224   220          CONTINUE
00225   230       CONTINUE
00226   240    CONTINUE
00227   250 CONTINUE
00228       RESLTS( 2 ) = RESLTS( 2 ) / EPS
00229 *
00230 *     Test ZPOEQU
00231 *
00232       DO 290 N = 0, NSZ
00233 *
00234          DO 270 I = 1, NSZ
00235             DO 260 J = 1, NSZ
00236                IF( I.LE.N .AND. J.EQ.I ) THEN
00237                   A( I, J ) = POW( I+J+1 )*( -1 )**( I+J )
00238                ELSE
00239                   A( I, J ) = CZERO
00240                END IF
00241   260       CONTINUE
00242   270    CONTINUE
00243 *
00244          CALL ZPOEQU( N, A, NSZ, R, RCOND, NORM, INFO )
00245 *
00246          IF( INFO.NE.0 ) THEN
00247             RESLTS( 3 ) = ONE
00248          ELSE
00249             IF( N.NE.0 ) THEN
00250                RESLTS( 3 ) = MAX( RESLTS( 3 ),
00251      $                       ABS( ( RCOND-RPOW( N ) ) / RPOW( N ) ) )
00252                RESLTS( 3 ) = MAX( RESLTS( 3 ),
00253      $                       ABS( ( NORM-POW( 2*N+1 ) ) / POW( 2*N+
00254      $                       1 ) ) )
00255                DO 280 I = 1, N
00256                   RESLTS( 3 ) = MAX( RESLTS( 3 ),
00257      $                          ABS( ( R( I )-RPOW( I+1 ) ) / RPOW( I+
00258      $                          1 ) ) )
00259   280          CONTINUE
00260             END IF
00261          END IF
00262   290 CONTINUE
00263       A( MAX( NSZ-1, 1 ), MAX( NSZ-1, 1 ) ) = -CONE
00264       CALL ZPOEQU( NSZ, A, NSZ, R, RCOND, NORM, INFO )
00265       IF( INFO.NE.MAX( NSZ-1, 1 ) )
00266      $   RESLTS( 3 ) = ONE
00267       RESLTS( 3 ) = RESLTS( 3 ) / EPS
00268 *
00269 *     Test ZPPEQU
00270 *
00271       DO 360 N = 0, NSZ
00272 *
00273 *        Upper triangular packed storage
00274 *
00275          DO 300 I = 1, ( N*( N+1 ) ) / 2
00276             AP( I ) = CZERO
00277   300    CONTINUE
00278          DO 310 I = 1, N
00279             AP( ( I*( I+1 ) ) / 2 ) = POW( 2*I+1 )
00280   310    CONTINUE
00281 *
00282          CALL ZPPEQU( 'U', N, AP, R, RCOND, NORM, INFO )
00283 *
00284          IF( INFO.NE.0 ) THEN
00285             RESLTS( 4 ) = ONE
00286          ELSE
00287             IF( N.NE.0 ) THEN
00288                RESLTS( 4 ) = MAX( RESLTS( 4 ),
00289      $                       ABS( ( RCOND-RPOW( N ) ) / RPOW( N ) ) )
00290                RESLTS( 4 ) = MAX( RESLTS( 4 ),
00291      $                       ABS( ( NORM-POW( 2*N+1 ) ) / POW( 2*N+
00292      $                       1 ) ) )
00293                DO 320 I = 1, N
00294                   RESLTS( 4 ) = MAX( RESLTS( 4 ),
00295      $                          ABS( ( R( I )-RPOW( I+1 ) ) / RPOW( I+
00296      $                          1 ) ) )
00297   320          CONTINUE
00298             END IF
00299          END IF
00300 *
00301 *        Lower triangular packed storage
00302 *
00303          DO 330 I = 1, ( N*( N+1 ) ) / 2
00304             AP( I ) = CZERO
00305   330    CONTINUE
00306          J = 1
00307          DO 340 I = 1, N
00308             AP( J ) = POW( 2*I+1 )
00309             J = J + ( N-I+1 )
00310   340    CONTINUE
00311 *
00312          CALL ZPPEQU( 'L', N, AP, R, RCOND, NORM, INFO )
00313 *
00314          IF( INFO.NE.0 ) THEN
00315             RESLTS( 4 ) = ONE
00316          ELSE
00317             IF( N.NE.0 ) THEN
00318                RESLTS( 4 ) = MAX( RESLTS( 4 ),
00319      $                       ABS( ( RCOND-RPOW( N ) ) / RPOW( N ) ) )
00320                RESLTS( 4 ) = MAX( RESLTS( 4 ),
00321      $                       ABS( ( NORM-POW( 2*N+1 ) ) / POW( 2*N+
00322      $                       1 ) ) )
00323                DO 350 I = 1, N
00324                   RESLTS( 4 ) = MAX( RESLTS( 4 ),
00325      $                          ABS( ( R( I )-RPOW( I+1 ) ) / RPOW( I+
00326      $                          1 ) ) )
00327   350          CONTINUE
00328             END IF
00329          END IF
00330 *
00331   360 CONTINUE
00332       I = ( NSZ*( NSZ+1 ) ) / 2 - 2
00333       AP( I ) = -CONE
00334       CALL ZPPEQU( 'L', NSZ, AP, R, RCOND, NORM, INFO )
00335       IF( INFO.NE.MAX( NSZ-1, 1 ) )
00336      $   RESLTS( 4 ) = ONE
00337       RESLTS( 4 ) = RESLTS( 4 ) / EPS
00338 *
00339 *     Test ZPBEQU
00340 *
00341       DO 460 N = 0, NSZ
00342          DO 450 KL = 0, MAX( N-1, 0 )
00343 *
00344 *           Test upper triangular storage
00345 *
00346             DO 380 J = 1, NSZ
00347                DO 370 I = 1, NSZB
00348                   AB( I, J ) = CZERO
00349   370          CONTINUE
00350   380       CONTINUE
00351             DO 390 J = 1, N
00352                AB( KL+1, J ) = POW( 2*J+1 )
00353   390       CONTINUE
00354 *
00355             CALL ZPBEQU( 'U', N, KL, AB, NSZB, R, RCOND, NORM, INFO )
00356 *
00357             IF( INFO.NE.0 ) THEN
00358                RESLTS( 5 ) = ONE
00359             ELSE
00360                IF( N.NE.0 ) THEN
00361                   RESLTS( 5 ) = MAX( RESLTS( 5 ),
00362      $                          ABS( ( RCOND-RPOW( N ) ) / RPOW( N ) ) )
00363                   RESLTS( 5 ) = MAX( RESLTS( 5 ),
00364      $                          ABS( ( NORM-POW( 2*N+1 ) ) / POW( 2*N+
00365      $                          1 ) ) )
00366                   DO 400 I = 1, N
00367                      RESLTS( 5 ) = MAX( RESLTS( 5 ),
00368      $                             ABS( ( R( I )-RPOW( I+1 ) ) /
00369      $                             RPOW( I+1 ) ) )
00370   400             CONTINUE
00371                END IF
00372             END IF
00373             IF( N.NE.0 ) THEN
00374                AB( KL+1, MAX( N-1, 1 ) ) = -CONE
00375                CALL ZPBEQU( 'U', N, KL, AB, NSZB, R, RCOND, NORM, INFO )
00376                IF( INFO.NE.MAX( N-1, 1 ) )
00377      $            RESLTS( 5 ) = ONE
00378             END IF
00379 *
00380 *           Test lower triangular storage
00381 *
00382             DO 420 J = 1, NSZ
00383                DO 410 I = 1, NSZB
00384                   AB( I, J ) = CZERO
00385   410          CONTINUE
00386   420       CONTINUE
00387             DO 430 J = 1, N
00388                AB( 1, J ) = POW( 2*J+1 )
00389   430       CONTINUE
00390 *
00391             CALL ZPBEQU( 'L', N, KL, AB, NSZB, R, RCOND, NORM, INFO )
00392 *
00393             IF( INFO.NE.0 ) THEN
00394                RESLTS( 5 ) = ONE
00395             ELSE
00396                IF( N.NE.0 ) THEN
00397                   RESLTS( 5 ) = MAX( RESLTS( 5 ),
00398      $                          ABS( ( RCOND-RPOW( N ) ) / RPOW( N ) ) )
00399                   RESLTS( 5 ) = MAX( RESLTS( 5 ),
00400      $                          ABS( ( NORM-POW( 2*N+1 ) ) / POW( 2*N+
00401      $                          1 ) ) )
00402                   DO 440 I = 1, N
00403                      RESLTS( 5 ) = MAX( RESLTS( 5 ),
00404      $                             ABS( ( R( I )-RPOW( I+1 ) ) /
00405      $                             RPOW( I+1 ) ) )
00406   440             CONTINUE
00407                END IF
00408             END IF
00409             IF( N.NE.0 ) THEN
00410                AB( 1, MAX( N-1, 1 ) ) = -CONE
00411                CALL ZPBEQU( 'L', N, KL, AB, NSZB, R, RCOND, NORM, INFO )
00412                IF( INFO.NE.MAX( N-1, 1 ) )
00413      $            RESLTS( 5 ) = ONE
00414             END IF
00415   450    CONTINUE
00416   460 CONTINUE
00417       RESLTS( 5 ) = RESLTS( 5 ) / EPS
00418       OK = ( RESLTS( 1 ).LE.THRESH ) .AND.
00419      $     ( RESLTS( 2 ).LE.THRESH ) .AND.
00420      $     ( RESLTS( 3 ).LE.THRESH ) .AND.
00421      $     ( RESLTS( 4 ).LE.THRESH ) .AND. ( RESLTS( 5 ).LE.THRESH )
00422       WRITE( NOUT, FMT = * )
00423       IF( OK ) THEN
00424          WRITE( NOUT, FMT = 9999 )PATH
00425       ELSE
00426          IF( RESLTS( 1 ).GT.THRESH )
00427      $      WRITE( NOUT, FMT = 9998 )RESLTS( 1 ), THRESH
00428          IF( RESLTS( 2 ).GT.THRESH )
00429      $      WRITE( NOUT, FMT = 9997 )RESLTS( 2 ), THRESH
00430          IF( RESLTS( 3 ).GT.THRESH )
00431      $      WRITE( NOUT, FMT = 9996 )RESLTS( 3 ), THRESH
00432          IF( RESLTS( 4 ).GT.THRESH )
00433      $      WRITE( NOUT, FMT = 9995 )RESLTS( 4 ), THRESH
00434          IF( RESLTS( 5 ).GT.THRESH )
00435      $      WRITE( NOUT, FMT = 9994 )RESLTS( 5 ), THRESH
00436       END IF
00437  9999 FORMAT( 1X, 'All tests for ', A3,
00438      $      ' routines passed the threshold' )
00439  9998 FORMAT( ' ZGEEQU failed test with value ', D10.3, ' exceeding',
00440      $      ' threshold ', D10.3 )
00441  9997 FORMAT( ' ZGBEQU failed test with value ', D10.3, ' exceeding',
00442      $      ' threshold ', D10.3 )
00443  9996 FORMAT( ' ZPOEQU failed test with value ', D10.3, ' exceeding',
00444      $      ' threshold ', D10.3 )
00445  9995 FORMAT( ' ZPPEQU failed test with value ', D10.3, ' exceeding',
00446      $      ' threshold ', D10.3 )
00447  9994 FORMAT( ' ZPBEQU failed test with value ', D10.3, ' exceeding',
00448      $      ' threshold ', D10.3 )
00449       RETURN
00450 *
00451 *     End of ZCHKEQ
00452 *
00453       END
 All Files Functions