LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
clatm4.f
Go to the documentation of this file.
00001 *> \brief \b CLATM4
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 CLATM4( ITYPE, N, NZ1, NZ2, RSIGN, AMAGN, RCOND,
00012 *                          TRIANG, IDIST, ISEED, A, LDA )
00013 * 
00014 *       .. Scalar Arguments ..
00015 *       LOGICAL            RSIGN
00016 *       INTEGER            IDIST, ITYPE, LDA, N, NZ1, NZ2
00017 *       REAL               AMAGN, RCOND, TRIANG
00018 *       ..
00019 *       .. Array Arguments ..
00020 *       INTEGER            ISEED( 4 )
00021 *       COMPLEX            A( LDA, * )
00022 *       ..
00023 *  
00024 *
00025 *> \par Purpose:
00026 *  =============
00027 *>
00028 *> \verbatim
00029 *>
00030 *> CLATM4 generates basic square matrices, which may later be
00031 *> multiplied by others in order to produce test matrices.  It is
00032 *> intended mainly to be used to test the generalized eigenvalue
00033 *> routines.
00034 *>
00035 *> It first generates the diagonal and (possibly) subdiagonal,
00036 *> according to the value of ITYPE, NZ1, NZ2, RSIGN, AMAGN, and RCOND.
00037 *> It then fills in the upper triangle with random numbers, if TRIANG is
00038 *> non-zero.
00039 *> \endverbatim
00040 *
00041 *  Arguments:
00042 *  ==========
00043 *
00044 *> \param[in] ITYPE
00045 *> \verbatim
00046 *>          ITYPE is INTEGER
00047 *>          The "type" of matrix on the diagonal and sub-diagonal.
00048 *>          If ITYPE < 0, then type abs(ITYPE) is generated and then
00049 *>             swapped end for end (A(I,J) := A'(N-J,N-I).)  See also
00050 *>             the description of AMAGN and RSIGN.
00051 *>
00052 *>          Special types:
00053 *>          = 0:  the zero matrix.
00054 *>          = 1:  the identity.
00055 *>          = 2:  a transposed Jordan block.
00056 *>          = 3:  If N is odd, then a k+1 x k+1 transposed Jordan block
00057 *>                followed by a k x k identity block, where k=(N-1)/2.
00058 *>                If N is even, then k=(N-2)/2, and a zero diagonal entry
00059 *>                is tacked onto the end.
00060 *>
00061 *>          Diagonal types.  The diagonal consists of NZ1 zeros, then
00062 *>             k=N-NZ1-NZ2 nonzeros.  The subdiagonal is zero.  ITYPE
00063 *>             specifies the nonzero diagonal entries as follows:
00064 *>          = 4:  1, ..., k
00065 *>          = 5:  1, RCOND, ..., RCOND
00066 *>          = 6:  1, ..., 1, RCOND
00067 *>          = 7:  1, a, a^2, ..., a^(k-1)=RCOND
00068 *>          = 8:  1, 1-d, 1-2*d, ..., 1-(k-1)*d=RCOND
00069 *>          = 9:  random numbers chosen from (RCOND,1)
00070 *>          = 10: random numbers with distribution IDIST (see CLARND.)
00071 *> \endverbatim
00072 *>
00073 *> \param[in] N
00074 *> \verbatim
00075 *>          N is INTEGER
00076 *>          The order of the matrix.
00077 *> \endverbatim
00078 *>
00079 *> \param[in] NZ1
00080 *> \verbatim
00081 *>          NZ1 is INTEGER
00082 *>          If abs(ITYPE) > 3, then the first NZ1 diagonal entries will
00083 *>          be zero.
00084 *> \endverbatim
00085 *>
00086 *> \param[in] NZ2
00087 *> \verbatim
00088 *>          NZ2 is INTEGER
00089 *>          If abs(ITYPE) > 3, then the last NZ2 diagonal entries will
00090 *>          be zero.
00091 *> \endverbatim
00092 *>
00093 *> \param[in] RSIGN
00094 *> \verbatim
00095 *>          RSIGN is LOGICAL
00096 *>          = .TRUE.:  The diagonal and subdiagonal entries will be
00097 *>                     multiplied by random numbers of magnitude 1.
00098 *>          = .FALSE.: The diagonal and subdiagonal entries will be
00099 *>                     left as they are (usually non-negative real.)
00100 *> \endverbatim
00101 *>
00102 *> \param[in] AMAGN
00103 *> \verbatim
00104 *>          AMAGN is REAL
00105 *>          The diagonal and subdiagonal entries will be multiplied by
00106 *>          AMAGN.
00107 *> \endverbatim
00108 *>
00109 *> \param[in] RCOND
00110 *> \verbatim
00111 *>          RCOND is REAL
00112 *>          If abs(ITYPE) > 4, then the smallest diagonal entry will be
00113 *>          RCOND.  RCOND must be between 0 and 1.
00114 *> \endverbatim
00115 *>
00116 *> \param[in] TRIANG
00117 *> \verbatim
00118 *>          TRIANG is REAL
00119 *>          The entries above the diagonal will be random numbers with
00120 *>          magnitude bounded by TRIANG (i.e., random numbers multiplied
00121 *>          by TRIANG.)
00122 *> \endverbatim
00123 *>
00124 *> \param[in] IDIST
00125 *> \verbatim
00126 *>          IDIST is INTEGER
00127 *>          On entry, DIST specifies the type of distribution to be used
00128 *>          to generate a random matrix .
00129 *>          = 1: real and imaginary parts each UNIFORM( 0, 1 )
00130 *>          = 2: real and imaginary parts each UNIFORM( -1, 1 )
00131 *>          = 3: real and imaginary parts each NORMAL( 0, 1 )
00132 *>          = 4: complex number uniform in DISK( 0, 1 )
00133 *> \endverbatim
00134 *>
00135 *> \param[in,out] ISEED
00136 *> \verbatim
00137 *>          ISEED is INTEGER array, dimension (4)
00138 *>          On entry ISEED specifies the seed of the random number
00139 *>          generator.  The values of ISEED are changed on exit, and can
00140 *>          be used in the next call to CLATM4 to continue the same
00141 *>          random number sequence.
00142 *>          Note: ISEED(4) should be odd, for the random number generator
00143 *>          used at present.
00144 *> \endverbatim
00145 *>
00146 *> \param[out] A
00147 *> \verbatim
00148 *>          A is COMPLEX array, dimension (LDA, N)
00149 *>          Array to be computed.
00150 *> \endverbatim
00151 *>
00152 *> \param[in] LDA
00153 *> \verbatim
00154 *>          LDA is INTEGER
00155 *>          Leading dimension of A.  Must be at least 1 and at least N.
00156 *> \endverbatim
00157 *
00158 *  Authors:
00159 *  ========
00160 *
00161 *> \author Univ. of Tennessee 
00162 *> \author Univ. of California Berkeley 
00163 *> \author Univ. of Colorado Denver 
00164 *> \author NAG Ltd. 
00165 *
00166 *> \date November 2011
00167 *
00168 *> \ingroup complex_eig
00169 *
00170 *  =====================================================================
00171       SUBROUTINE CLATM4( ITYPE, N, NZ1, NZ2, RSIGN, AMAGN, RCOND,
00172      $                   TRIANG, IDIST, ISEED, A, LDA )
00173 *
00174 *  -- LAPACK test routine (version 3.4.0) --
00175 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00176 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00177 *     November 2011
00178 *
00179 *     .. Scalar Arguments ..
00180       LOGICAL            RSIGN
00181       INTEGER            IDIST, ITYPE, LDA, N, NZ1, NZ2
00182       REAL               AMAGN, RCOND, TRIANG
00183 *     ..
00184 *     .. Array Arguments ..
00185       INTEGER            ISEED( 4 )
00186       COMPLEX            A( LDA, * )
00187 *     ..
00188 *
00189 *  =====================================================================
00190 *
00191 *     .. Parameters ..
00192       REAL               ZERO, ONE
00193       PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0 )
00194       COMPLEX            CZERO, CONE
00195       PARAMETER          ( CZERO = ( 0.0E+0, 0.0E+0 ),
00196      $                   CONE = ( 1.0E+0, 0.0E+0 ) )
00197 *     ..
00198 *     .. Local Scalars ..
00199       INTEGER            I, ISDB, ISDE, JC, JD, JR, K, KBEG, KEND, KLEN
00200       REAL               ALPHA
00201       COMPLEX            CTEMP
00202 *     ..
00203 *     .. External Functions ..
00204       REAL               SLARAN
00205       COMPLEX            CLARND
00206       EXTERNAL           SLARAN, CLARND
00207 *     ..
00208 *     .. External Subroutines ..
00209       EXTERNAL           CLASET
00210 *     ..
00211 *     .. Intrinsic Functions ..
00212       INTRINSIC          ABS, CMPLX, EXP, LOG, MAX, MIN, MOD, REAL
00213 *     ..
00214 *     .. Executable Statements ..
00215 *
00216       IF( N.LE.0 )
00217      $   RETURN
00218       CALL CLASET( 'Full', N, N, CZERO, CZERO, A, LDA )
00219 *
00220 *     Insure a correct ISEED
00221 *
00222       IF( MOD( ISEED( 4 ), 2 ).NE.1 )
00223      $   ISEED( 4 ) = ISEED( 4 ) + 1
00224 *
00225 *     Compute diagonal and subdiagonal according to ITYPE, NZ1, NZ2,
00226 *     and RCOND
00227 *
00228       IF( ITYPE.NE.0 ) THEN
00229          IF( ABS( ITYPE ).GE.4 ) THEN
00230             KBEG = MAX( 1, MIN( N, NZ1+1 ) )
00231             KEND = MAX( KBEG, MIN( N, N-NZ2 ) )
00232             KLEN = KEND + 1 - KBEG
00233          ELSE
00234             KBEG = 1
00235             KEND = N
00236             KLEN = N
00237          END IF
00238          ISDB = 1
00239          ISDE = 0
00240          GO TO ( 10, 30, 50, 80, 100, 120, 140, 160,
00241      $           180, 200 )ABS( ITYPE )
00242 *
00243 *        abs(ITYPE) = 1: Identity
00244 *
00245    10    CONTINUE
00246          DO 20 JD = 1, N
00247             A( JD, JD ) = CONE
00248    20    CONTINUE
00249          GO TO 220
00250 *
00251 *        abs(ITYPE) = 2: Transposed Jordan block
00252 *
00253    30    CONTINUE
00254          DO 40 JD = 1, N - 1
00255             A( JD+1, JD ) = CONE
00256    40    CONTINUE
00257          ISDB = 1
00258          ISDE = N - 1
00259          GO TO 220
00260 *
00261 *        abs(ITYPE) = 3: Transposed Jordan block, followed by the
00262 *                        identity.
00263 *
00264    50    CONTINUE
00265          K = ( N-1 ) / 2
00266          DO 60 JD = 1, K
00267             A( JD+1, JD ) = CONE
00268    60    CONTINUE
00269          ISDB = 1
00270          ISDE = K
00271          DO 70 JD = K + 2, 2*K + 1
00272             A( JD, JD ) = CONE
00273    70    CONTINUE
00274          GO TO 220
00275 *
00276 *        abs(ITYPE) = 4: 1,...,k
00277 *
00278    80    CONTINUE
00279          DO 90 JD = KBEG, KEND
00280             A( JD, JD ) = CMPLX( JD-NZ1 )
00281    90    CONTINUE
00282          GO TO 220
00283 *
00284 *        abs(ITYPE) = 5: One large D value:
00285 *
00286   100    CONTINUE
00287          DO 110 JD = KBEG + 1, KEND
00288             A( JD, JD ) = CMPLX( RCOND )
00289   110    CONTINUE
00290          A( KBEG, KBEG ) = CONE
00291          GO TO 220
00292 *
00293 *        abs(ITYPE) = 6: One small D value:
00294 *
00295   120    CONTINUE
00296          DO 130 JD = KBEG, KEND - 1
00297             A( JD, JD ) = CONE
00298   130    CONTINUE
00299          A( KEND, KEND ) = CMPLX( RCOND )
00300          GO TO 220
00301 *
00302 *        abs(ITYPE) = 7: Exponentially distributed D values:
00303 *
00304   140    CONTINUE
00305          A( KBEG, KBEG ) = CONE
00306          IF( KLEN.GT.1 ) THEN
00307             ALPHA = RCOND**( ONE / REAL( KLEN-1 ) )
00308             DO 150 I = 2, KLEN
00309                A( NZ1+I, NZ1+I ) = CMPLX( ALPHA**REAL( I-1 ) )
00310   150       CONTINUE
00311          END IF
00312          GO TO 220
00313 *
00314 *        abs(ITYPE) = 8: Arithmetically distributed D values:
00315 *
00316   160    CONTINUE
00317          A( KBEG, KBEG ) = CONE
00318          IF( KLEN.GT.1 ) THEN
00319             ALPHA = ( ONE-RCOND ) / REAL( KLEN-1 )
00320             DO 170 I = 2, KLEN
00321                A( NZ1+I, NZ1+I ) = CMPLX( REAL( KLEN-I )*ALPHA+RCOND )
00322   170       CONTINUE
00323          END IF
00324          GO TO 220
00325 *
00326 *        abs(ITYPE) = 9: Randomly distributed D values on ( RCOND, 1):
00327 *
00328   180    CONTINUE
00329          ALPHA = LOG( RCOND )
00330          DO 190 JD = KBEG, KEND
00331             A( JD, JD ) = EXP( ALPHA*SLARAN( ISEED ) )
00332   190    CONTINUE
00333          GO TO 220
00334 *
00335 *        abs(ITYPE) = 10: Randomly distributed D values from DIST
00336 *
00337   200    CONTINUE
00338          DO 210 JD = KBEG, KEND
00339             A( JD, JD ) = CLARND( IDIST, ISEED )
00340   210    CONTINUE
00341 *
00342   220    CONTINUE
00343 *
00344 *        Scale by AMAGN
00345 *
00346          DO 230 JD = KBEG, KEND
00347             A( JD, JD ) = AMAGN*REAL( A( JD, JD ) )
00348   230    CONTINUE
00349          DO 240 JD = ISDB, ISDE
00350             A( JD+1, JD ) = AMAGN*REAL( A( JD+1, JD ) )
00351   240    CONTINUE
00352 *
00353 *        If RSIGN = .TRUE., assign random signs to diagonal and
00354 *        subdiagonal
00355 *
00356          IF( RSIGN ) THEN
00357             DO 250 JD = KBEG, KEND
00358                IF( REAL( A( JD, JD ) ).NE.ZERO ) THEN
00359                   CTEMP = CLARND( 3, ISEED )
00360                   CTEMP = CTEMP / ABS( CTEMP )
00361                   A( JD, JD ) = CTEMP*REAL( A( JD, JD ) )
00362                END IF
00363   250       CONTINUE
00364             DO 260 JD = ISDB, ISDE
00365                IF( REAL( A( JD+1, JD ) ).NE.ZERO ) THEN
00366                   CTEMP = CLARND( 3, ISEED )
00367                   CTEMP = CTEMP / ABS( CTEMP )
00368                   A( JD+1, JD ) = CTEMP*REAL( A( JD+1, JD ) )
00369                END IF
00370   260       CONTINUE
00371          END IF
00372 *
00373 *        Reverse if ITYPE < 0
00374 *
00375          IF( ITYPE.LT.0 ) THEN
00376             DO 270 JD = KBEG, ( KBEG+KEND-1 ) / 2
00377                CTEMP = A( JD, JD )
00378                A( JD, JD ) = A( KBEG+KEND-JD, KBEG+KEND-JD )
00379                A( KBEG+KEND-JD, KBEG+KEND-JD ) = CTEMP
00380   270       CONTINUE
00381             DO 280 JD = 1, ( N-1 ) / 2
00382                CTEMP = A( JD+1, JD )
00383                A( JD+1, JD ) = A( N+1-JD, N-JD )
00384                A( N+1-JD, N-JD ) = CTEMP
00385   280       CONTINUE
00386          END IF
00387 *
00388       END IF
00389 *
00390 *     Fill in upper triangle
00391 *
00392       IF( TRIANG.NE.ZERO ) THEN
00393          DO 300 JC = 2, N
00394             DO 290 JR = 1, JC - 1
00395                A( JR, JC ) = TRIANG*CLARND( IDIST, ISEED )
00396   290       CONTINUE
00397   300    CONTINUE
00398       END IF
00399 *
00400       RETURN
00401 *
00402 *     End of CLATM4
00403 *
00404       END
 All Files Functions