LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
sckglm.f
Go to the documentation of this file.
00001 *> \brief \b SCKGLM
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 SCKGLM( NN, MVAL, PVAL, NVAL, NMATS, ISEED, THRESH,
00012 *                          NMAX, A, AF, B, BF, X, WORK, RWORK, NIN, NOUT,
00013 *                          INFO )
00014 * 
00015 *       .. Scalar Arguments ..
00016 *       INTEGER            INFO, NIN, NMATS, NMAX, NN, NOUT
00017 *       REAL               THRESH
00018 *       ..
00019 *       .. Array Arguments ..
00020 *       INTEGER            ISEED( 4 ), MVAL( * ), NVAL( * ), PVAL( * )
00021 *       REAL               A( * ), AF( * ), B( * ), BF( * ), RWORK( * ),
00022 *      $                   WORK( * ), X( * )
00023 *       ..
00024 *  
00025 *
00026 *> \par Purpose:
00027 *  =============
00028 *>
00029 *> \verbatim
00030 *>
00031 *> SCKGLM tests SGGGLM - subroutine for solving generalized linear
00032 *>                       model problem.
00033 *> \endverbatim
00034 *
00035 *  Arguments:
00036 *  ==========
00037 *
00038 *> \param[in] NN
00039 *> \verbatim
00040 *>          NN is INTEGER
00041 *>          The number of values of N, M and P contained in the vectors
00042 *>          NVAL, MVAL and PVAL.
00043 *> \endverbatim
00044 *>
00045 *> \param[in] MVAL
00046 *> \verbatim
00047 *>          MVAL is INTEGER array, dimension (NN)
00048 *>          The values of the matrix column dimension M.
00049 *> \endverbatim
00050 *>
00051 *> \param[in] PVAL
00052 *> \verbatim
00053 *>          PVAL is INTEGER array, dimension (NN)
00054 *>          The values of the matrix column dimension P.
00055 *> \endverbatim
00056 *>
00057 *> \param[in] NVAL
00058 *> \verbatim
00059 *>          NVAL is INTEGER array, dimension (NN)
00060 *>          The values of the matrix row dimension N.
00061 *> \endverbatim
00062 *>
00063 *> \param[in] NMATS
00064 *> \verbatim
00065 *>          NMATS is INTEGER
00066 *>          The number of matrix types to be tested for each combination
00067 *>          of matrix dimensions.  If NMATS >= NTYPES (the maximum
00068 *>          number of matrix types), then all the different types are
00069 *>          generated for testing.  If NMATS < NTYPES, another input line
00070 *>          is read to get the numbers of the matrix types to be used.
00071 *> \endverbatim
00072 *>
00073 *> \param[in,out] ISEED
00074 *> \verbatim
00075 *>          ISEED is INTEGER array, dimension (4)
00076 *>          On entry, the seed of the random number generator.  The array
00077 *>          elements should be between 0 and 4095, otherwise they will be
00078 *>          reduced mod 4096, and ISEED(4) must be odd.
00079 *>          On exit, the next seed in the random number sequence after
00080 *>          all the test matrices have been generated.
00081 *> \endverbatim
00082 *>
00083 *> \param[in] THRESH
00084 *> \verbatim
00085 *>          THRESH is REAL
00086 *>          The threshold value for the test ratios.  A result is
00087 *>          included in the output file if RESID >= THRESH.  To have
00088 *>          every test ratio printed, use THRESH = 0.
00089 *> \endverbatim
00090 *>
00091 *> \param[in] NMAX
00092 *> \verbatim
00093 *>          NMAX is INTEGER
00094 *>          The maximum value permitted for M or N, used in dimensioning
00095 *>          the work arrays.
00096 *> \endverbatim
00097 *>
00098 *> \param[out] A
00099 *> \verbatim
00100 *>          A is REAL array, dimension (NMAX*NMAX)
00101 *> \endverbatim
00102 *>
00103 *> \param[out] AF
00104 *> \verbatim
00105 *>          AF is REAL array, dimension (NMAX*NMAX)
00106 *> \endverbatim
00107 *>
00108 *> \param[out] B
00109 *> \verbatim
00110 *>          B is REAL array, dimension (NMAX*NMAX)
00111 *> \endverbatim
00112 *>
00113 *> \param[out] BF
00114 *> \verbatim
00115 *>          BF is REAL array, dimension (NMAX*NMAX)
00116 *> \endverbatim
00117 *>
00118 *> \param[out] X
00119 *> \verbatim
00120 *>          X is REAL array, dimension (4*NMAX)
00121 *> \endverbatim
00122 *>
00123 *> \param[out] RWORK
00124 *> \verbatim
00125 *>          RWORK is REAL array, dimension (NMAX)
00126 *> \endverbatim
00127 *>
00128 *> \param[out] WORK
00129 *> \verbatim
00130 *>          WORK is REAL array, dimension (NMAX*NMAX)
00131 *> \endverbatim
00132 *>
00133 *> \param[in] NIN
00134 *> \verbatim
00135 *>          NIN is INTEGER
00136 *>          The unit number for input.
00137 *> \endverbatim
00138 *>
00139 *> \param[in] NOUT
00140 *> \verbatim
00141 *>          NOUT is INTEGER
00142 *>          The unit number for output.
00143 *> \endverbatim
00144 *>
00145 *> \param[out] INFO
00146 *> \verbatim
00147 *>          INFO is INTEGER
00148 *>          = 0 :  successful exit
00149 *>          > 0 :  If SLATMS returns an error code, the absolute value
00150 *>                 of it is returned.
00151 *> \endverbatim
00152 *
00153 *  Authors:
00154 *  ========
00155 *
00156 *> \author Univ. of Tennessee 
00157 *> \author Univ. of California Berkeley 
00158 *> \author Univ. of Colorado Denver 
00159 *> \author NAG Ltd. 
00160 *
00161 *> \date November 2011
00162 *
00163 *> \ingroup single_eig
00164 *
00165 *  =====================================================================
00166       SUBROUTINE SCKGLM( NN, MVAL, PVAL, NVAL, NMATS, ISEED, THRESH,
00167      $                   NMAX, A, AF, B, BF, X, WORK, RWORK, NIN, NOUT,
00168      $                   INFO )
00169 *
00170 *  -- LAPACK test routine (version 3.4.0) --
00171 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00172 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00173 *     November 2011
00174 *
00175 *     .. Scalar Arguments ..
00176       INTEGER            INFO, NIN, NMATS, NMAX, NN, NOUT
00177       REAL               THRESH
00178 *     ..
00179 *     .. Array Arguments ..
00180       INTEGER            ISEED( 4 ), MVAL( * ), NVAL( * ), PVAL( * )
00181       REAL               A( * ), AF( * ), B( * ), BF( * ), RWORK( * ),
00182      $                   WORK( * ), X( * )
00183 *     ..
00184 *
00185 *  =====================================================================
00186 *
00187 *     .. Parameters ..
00188       INTEGER            NTYPES
00189       PARAMETER          ( NTYPES = 8 )
00190 *     ..
00191 *     .. Local Scalars ..
00192       LOGICAL            FIRSTT
00193       CHARACTER          DISTA, DISTB, TYPE
00194       CHARACTER*3        PATH
00195       INTEGER            I, IINFO, IK, IMAT, KLA, KLB, KUA, KUB, LDA,
00196      $                   LDB, LWORK, M, MODEA, MODEB, N, NFAIL, NRUN, P
00197       REAL               ANORM, BNORM, CNDNMA, CNDNMB, RESID
00198 *     ..
00199 *     .. Local Arrays ..
00200       LOGICAL            DOTYPE( NTYPES )
00201 *     ..
00202 *     .. External Functions ..
00203       REAL               SLARND
00204       EXTERNAL           SLARND
00205 *     ..
00206 *     .. External Subroutines ..
00207       EXTERNAL           ALAHDG, ALAREQ, ALASUM, SGLMTS, SLATB9, SLATMS
00208 *     ..
00209 *     .. Intrinsic Functions ..
00210       INTRINSIC          ABS
00211 *     ..
00212 *     .. Executable Statements ..
00213 *
00214 *     Initialize constants.
00215 *
00216       PATH( 1: 3 ) = 'GLM'
00217       INFO = 0
00218       NRUN = 0
00219       NFAIL = 0
00220       FIRSTT = .TRUE.
00221       CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
00222       LDA = NMAX
00223       LDB = NMAX
00224       LWORK = NMAX*NMAX
00225 *
00226 *     Check for valid input values.
00227 *
00228       DO 10 IK = 1, NN
00229          M = MVAL( IK )
00230          P = PVAL( IK )
00231          N = NVAL( IK )
00232          IF( M.GT.N .OR. N.GT.M+P ) THEN
00233             IF( FIRSTT ) THEN
00234                WRITE( NOUT, FMT = * )
00235                FIRSTT = .FALSE.
00236             END IF
00237             WRITE( NOUT, FMT = 9997 )M, P, N
00238          END IF
00239    10 CONTINUE
00240       FIRSTT = .TRUE.
00241 *
00242 *     Do for each value of M in MVAL.
00243 *
00244       DO 40 IK = 1, NN
00245          M = MVAL( IK )
00246          P = PVAL( IK )
00247          N = NVAL( IK )
00248          IF( M.GT.N .OR. N.GT.M+P )
00249      $      GO TO 40
00250 *
00251          DO 30 IMAT = 1, NTYPES
00252 *
00253 *           Do the tests only if DOTYPE( IMAT ) is true.
00254 *
00255             IF( .NOT.DOTYPE( IMAT ) )
00256      $         GO TO 30
00257 *
00258 *           Set up parameters with SLATB9 and generate test
00259 *           matrices A and B with SLATMS.
00260 *
00261             CALL SLATB9( PATH, IMAT, M, P, N, TYPE, KLA, KUA, KLB, KUB,
00262      $                   ANORM, BNORM, MODEA, MODEB, CNDNMA, CNDNMB,
00263      $                   DISTA, DISTB )
00264 *
00265             CALL SLATMS( N, M, DISTA, ISEED, TYPE, RWORK, MODEA, CNDNMA,
00266      $                   ANORM, KLA, KUA, 'No packing', A, LDA, WORK,
00267      $                   IINFO )
00268             IF( IINFO.NE.0 ) THEN
00269                WRITE( NOUT, FMT = 9999 )IINFO
00270                INFO = ABS( IINFO )
00271                GO TO 30
00272             END IF
00273 *
00274             CALL SLATMS( N, P, DISTB, ISEED, TYPE, RWORK, MODEB, CNDNMB,
00275      $                   BNORM, KLB, KUB, 'No packing', B, LDB, WORK,
00276      $                   IINFO )
00277             IF( IINFO.NE.0 ) THEN
00278                WRITE( NOUT, FMT = 9999 )IINFO
00279                INFO = ABS( IINFO )
00280                GO TO 30
00281             END IF
00282 *
00283 *           Generate random left hand side vector of GLM
00284 *
00285             DO 20 I = 1, N
00286                X( I ) = SLARND( 2, ISEED )
00287    20       CONTINUE
00288 *
00289             CALL SGLMTS( N, M, P, A, AF, LDA, B, BF, LDB, X,
00290      $                   X( NMAX+1 ), X( 2*NMAX+1 ), X( 3*NMAX+1 ),
00291      $                   WORK, LWORK, RWORK, RESID )
00292 *
00293 *           Print information about the tests that did not
00294 *           pass the threshold.
00295 *
00296             IF( RESID.GE.THRESH ) THEN
00297                IF( NFAIL.EQ.0 .AND. FIRSTT ) THEN
00298                   FIRSTT = .FALSE.
00299                   CALL ALAHDG( NOUT, PATH )
00300                END IF
00301                WRITE( NOUT, FMT = 9998 )N, M, P, IMAT, 1, RESID
00302                NFAIL = NFAIL + 1
00303             END IF
00304             NRUN = NRUN + 1
00305 *
00306    30    CONTINUE
00307    40 CONTINUE
00308 *
00309 *     Print a summary of the results.
00310 *
00311       CALL ALASUM( PATH, NOUT, NFAIL, NRUN, 0 )
00312 *
00313  9999 FORMAT( ' SLATMS in SCKGLM INFO = ', I5 )
00314  9998 FORMAT( ' N=', I4, ' M=', I4, ', P=', I4, ', type ', I2,
00315      $      ', test ', I2, ', ratio=', G13.6 )
00316  9997 FORMAT( ' *** Invalid input  for GLM:  M = ', I6, ', P = ', I6,
00317      $      ', N = ', I6, ';', / '     must satisfy M <= N <= M+P  ',
00318      $      '(this set of values will be skipped)' )
00319       RETURN
00320 *
00321 *     End of SCKGLM
00322 *
00323       END
 All Files Functions