LAPACK: TESTING/EIG/ccklse.f Source File

Go to the documentation of this file.
00001       SUBROUTINE CCKLSE( NN, MVAL, PVAL, NVAL, NMATS, ISEED, THRESH,
00002      $                   NMAX, A, AF, B, BF, X, WORK, RWORK, NIN, NOUT,
00003      $                   INFO )
00004 *
00005 *  -- LAPACK test routine (version 3.1) --
00006 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
00007 *     November 2006
00008 *
00009 *     .. Scalar Arguments ..
00010       INTEGER            INFO, NIN, NMATS, NMAX, NN, NOUT
00011       REAL               THRESH
00012 *     ..
00013 *     .. Array Arguments ..
00014       INTEGER            ISEED( 4 ), MVAL( * ), NVAL( * ), PVAL( * )
00015       REAL               RWORK( * )
00016       COMPLEX            A( * ), AF( * ), B( * ), BF( * ), WORK( * ),
00017      $                   X( * )
00018 *     ..
00019 *
00020 *  Purpose
00021 *  =======
00022 *
00023 *  CCKLSE tests CGGLSE - a subroutine for solving linear equality
00024 *  constrained least square problem (LSE).
00025 *
00026 *  Arguments
00027 *  =========
00028 *
00029 *  NN      (input) INTEGER
00030 *          The number of values of (M,P,N) contained in the vectors
00031 *          (MVAL, PVAL, NVAL).
00032 *
00033 *  MVAL    (input) INTEGER array, dimension (NN)
00034 *          The values of the matrix row(column) dimension M.
00035 *
00036 *  PVAL    (input) INTEGER array, dimension (NN)
00037 *          The values of the matrix row(column) dimension P.
00038 *
00039 *  NVAL    (input) INTEGER array, dimension (NN)
00040 *          The values of the matrix column(row) dimension N.
00041 *
00042 *  NMATS   (input) INTEGER
00043 *          The number of matrix types to be tested for each combination
00044 *          of matrix dimensions.  If NMATS >= NTYPES (the maximum
00045 *          number of matrix types), then all the different types are
00046 *          generated for testing.  If NMATS < NTYPES, another input line
00047 *          is read to get the numbers of the matrix types to be used.
00048 *
00049 *  ISEED   (input/output) INTEGER array, dimension (4)
00050 *          On entry, the seed of the random number generator.  The array
00051 *          elements should be between 0 and 4095, otherwise they will be
00052 *          reduced mod 4096, and ISEED(4) must be odd.
00053 *          On exit, the next seed in the random number sequence after
00054 *          all the test matrices have been generated.
00055 *
00056 *  THRESH  (input) REAL
00057 *          The threshold value for the test ratios.  A result is
00058 *          included in the output file if RESULT >= THRESH.  To have
00059 *          every test ratio printed, use THRESH = 0.
00060 *
00061 *  NMAX    (input) INTEGER
00062 *          The maximum value permitted for M or N, used in dimensioning
00063 *          the work arrays.
00064 *
00065 *  A       (workspace) COMPLEX array, dimension (NMAX*NMAX)
00066 *
00067 *  AF      (workspace) COMPLEX array, dimension (NMAX*NMAX)
00068 *
00069 *  B       (workspace) COMPLEX array, dimension (NMAX*NMAX)
00070 *
00071 *  BF      (workspace) COMPLEX array, dimension (NMAX*NMAX)
00072 *
00073 *  X       (workspace) COMPLEX array, dimension (5*NMAX)
00074 *
00075 *  WORK    (workspace) COMPLEX array, dimension (NMAX*NMAX)
00076 *
00077 *  RWORK   (workspace) REAL array, dimension (NMAX)
00078 *
00079 *  NIN     (input) INTEGER
00080 *          The unit number for input.
00081 *
00082 *  NOUT    (input) INTEGER
00083 *          The unit number for output.
00084 *
00085 *  INFO    (output) INTEGER
00086 *          = 0 :  successful exit
00087 *          > 0 :  If CLATMS returns an error code, the absolute value
00088 *                 of it is returned.
00089 *
00090 *  =====================================================================
00091 *
00092 *     .. Parameters ..
00093       INTEGER            NTESTS
00094       PARAMETER          ( NTESTS = 7 )
00095       INTEGER            NTYPES
00096       PARAMETER          ( NTYPES = 8 )
00097 *     ..
00098 *     .. Local Scalars ..
00099       LOGICAL            FIRSTT
00100       CHARACTER          DISTA, DISTB, TYPE
00101       CHARACTER*3        PATH
00102       INTEGER            I, IINFO, IK, IMAT, KLA, KLB, KUA, KUB, LDA,
00103      $                   LDB, LWORK, M, MODEA, MODEB, N, NFAIL, NRUN,
00104      $                   NT, P
00105       REAL               ANORM, BNORM, CNDNMA, CNDNMB
00106 *     ..
00107 *     .. Local Arrays ..
00108       LOGICAL            DOTYPE( NTYPES )
00109       REAL               RESULT( NTESTS )
00110 *     ..
00111 *     .. External Subroutines ..
00112       EXTERNAL           ALAHDG, ALAREQ, ALASUM, CLARHS, CLATMS, CLSETS,
00113      $                   SLATB9
00114 *     ..
00115 *     .. Intrinsic Functions ..
00116       INTRINSIC          ABS, MAX
00117 *     ..
00118 *     .. Executable Statements ..
00119 *
00120 *     Initialize constants and the random number seed.
00121 *
00122       PATH( 1: 3 ) = 'LSE'
00123       INFO = 0
00124       NRUN = 0
00125       NFAIL = 0
00126       FIRSTT = .TRUE.
00127       CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
00128       LDA = NMAX
00129       LDB = NMAX
00130       LWORK = NMAX*NMAX
00131 *
00132 *     Check for valid input values.
00133 *
00134       DO 10 IK = 1, NN
00135          M = MVAL( IK )
00136          P = PVAL( IK )
00137          N = NVAL( IK )
00138          IF( P.GT.N .OR. N.GT.M+P ) THEN
00139             IF( FIRSTT ) THEN
00140                WRITE( NOUT, FMT = * )
00141                FIRSTT = .FALSE.
00142             END IF
00143             WRITE( NOUT, FMT = 9997 )M, P, N
00144          END IF
00145    10 CONTINUE
00146       FIRSTT = .TRUE.
00147 *
00148 *     Do for each value of M in MVAL.
00149 *
00150       DO 40 IK = 1, NN
00151          M = MVAL( IK )
00152          P = PVAL( IK )
00153          N = NVAL( IK )
00154          IF( P.GT.N .OR. N.GT.M+P )
00155      $      GO TO 40
00156 *
00157          DO 30 IMAT = 1, NTYPES
00158 *
00159 *           Do the tests only if DOTYPE( IMAT ) is true.
00160 *
00161             IF( .NOT.DOTYPE( IMAT ) )
00162      $         GO TO 30
00163 *
00164 *           Set up parameters with SLATB9 and generate test
00165 *           matrices A and B with CLATMS.
00166 *
00167             CALL SLATB9( PATH, IMAT, M, P, N, TYPE, KLA, KUA, KLB, KUB,
00168      $                   ANORM, BNORM, MODEA, MODEB, CNDNMA, CNDNMB,
00169      $                   DISTA, DISTB )
00170 *
00171             CALL CLATMS( M, N, DISTA, ISEED, TYPE, RWORK, MODEA, CNDNMA,
00172      $                   ANORM, KLA, KUA, 'No packing', A, LDA, WORK,
00173      $                   IINFO )
00174             IF( IINFO.NE.0 ) THEN
00175                WRITE( NOUT, FMT = 9999 )IINFO
00176                INFO = ABS( IINFO )
00177                GO TO 30
00178             END IF
00179 *
00180             CALL CLATMS( P, N, DISTB, ISEED, TYPE, RWORK, MODEB, CNDNMB,
00181      $                   BNORM, KLB, KUB, 'No packing', B, LDB, WORK,
00182      $                   IINFO )
00183             IF( IINFO.NE.0 ) THEN
00184                WRITE( NOUT, FMT = 9999 )IINFO
00185                INFO = ABS( IINFO )
00186                GO TO 30
00187             END IF
00188 *
00189 *           Generate the right-hand sides C and D for the LSE.
00190 *
00191             CALL CLARHS( 'CGE', 'New solution', 'Upper', 'N', M, N,
00192      $                   MAX( M-1, 0 ), MAX( N-1, 0 ), 1, A, LDA,
00193      $                   X( 4*NMAX+1 ), MAX( N, 1 ), X, MAX( M, 1 ),
00194      $                   ISEED, IINFO )
00195 *
00196             CALL CLARHS( 'CGE', 'Computed', 'Upper', 'N', P, N,
00197      $                   MAX( P-1, 0 ), MAX( N-1, 0 ), 1, B, LDB,
00198      $                   X( 4*NMAX+1 ), MAX( N, 1 ), X( 2*NMAX+1 ),
00199      $                   MAX( P, 1 ), ISEED, IINFO )
00200 *
00201             NT = 2
00202 *
00203             CALL CLSETS( M, P, N, A, AF, LDA, B, BF, LDB, X,
00204      $                   X( NMAX+1 ), X( 2*NMAX+1 ), X( 3*NMAX+1 ),
00205      $                   X( 4*NMAX+1 ), WORK, LWORK, RWORK,
00206      $                   RESULT( 1 ) )
00207 *
00208 *           Print information about the tests that did not
00209 *           pass the threshold.
00210 *
00211             DO 20 I = 1, NT
00212                IF( RESULT( I ).GE.THRESH ) THEN
00213                   IF( NFAIL.EQ.0 .AND. FIRSTT ) THEN
00214                      FIRSTT = .FALSE.
00215                      CALL ALAHDG( NOUT, PATH )
00216                   END IF
00217                   WRITE( NOUT, FMT = 9998 )M, P, N, IMAT, I,
00218      $               RESULT( I )
00219                   NFAIL = NFAIL + 1
00220                END IF
00221    20       CONTINUE
00222             NRUN = NRUN + NT
00223 *
00224    30    CONTINUE
00225    40 CONTINUE
00226 *
00227 *     Print a summary of the results.
00228 *
00229       CALL ALASUM( PATH, NOUT, NFAIL, NRUN, 0 )
00230 *
00231  9999 FORMAT( ' CLATMS in CCKLSE   INFO = ', I5 )
00232  9998 FORMAT( ' M=', I4, ' P=', I4, ', N=', I4, ', type ', I2,
00233      $      ', test ', I2, ', ratio=', G13.6 )
00234  9997 FORMAT( ' *** Invalid input  for LSE:  M = ', I6, ', P = ', I6,
00235      $      ', N = ', I6, ';', / '     must satisfy P <= N <= P+M  ',
00236      $      '(this set of values will be skipped)' )
00237       RETURN
00238 *
00239 *     End of CCKLSE
00240 *
00241       END