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