LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
clatsy.f
Go to the documentation of this file.
00001 *> \brief \b CLATSY
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 CLATSY( UPLO, N, X, LDX, ISEED )
00012 * 
00013 *       .. Scalar Arguments ..
00014 *       CHARACTER          UPLO
00015 *       INTEGER            LDX, N
00016 *       ..
00017 *       .. Array Arguments ..
00018 *       INTEGER            ISEED( * )
00019 *       COMPLEX            X( LDX, * )
00020 *       ..
00021 *  
00022 *
00023 *> \par Purpose:
00024 *  =============
00025 *>
00026 *> \verbatim
00027 *>
00028 *> CLATSY generates a special test matrix for the complex symmetric
00029 *> (indefinite) factorization.  The pivot blocks of the generated matrix
00030 *> will be in the following order:
00031 *>    2x2 pivot block, non diagonalizable
00032 *>    1x1 pivot block
00033 *>    2x2 pivot block, diagonalizable
00034 *>    (cycle repeats)
00035 *> A row interchange is required for each non-diagonalizable 2x2 block.
00036 *> \endverbatim
00037 *
00038 *  Arguments:
00039 *  ==========
00040 *
00041 *> \param[in] UPLO
00042 *> \verbatim
00043 *>          UPLO is CHARACTER
00044 *>          Specifies whether the generated matrix is to be upper or
00045 *>          lower triangular.
00046 *>          = 'U':  Upper triangular
00047 *>          = 'L':  Lower triangular
00048 *> \endverbatim
00049 *>
00050 *> \param[in] N
00051 *> \verbatim
00052 *>          N is INTEGER
00053 *>          The dimension of the matrix to be generated.
00054 *> \endverbatim
00055 *>
00056 *> \param[out] X
00057 *> \verbatim
00058 *>          X is COMPLEX array, dimension (LDX,N)
00059 *>          The generated matrix, consisting of 3x3 and 2x2 diagonal
00060 *>          blocks which result in the pivot sequence given above.
00061 *>          The matrix outside of these diagonal blocks is zero.
00062 *> \endverbatim
00063 *>
00064 *> \param[in] LDX
00065 *> \verbatim
00066 *>          LDX is INTEGER
00067 *>          The leading dimension of the array X.
00068 *> \endverbatim
00069 *>
00070 *> \param[in,out] ISEED
00071 *> \verbatim
00072 *>          ISEED is INTEGER array, dimension (4)
00073 *>          On entry, the seed for the random number generator.  The last
00074 *>          of the four integers must be odd.  (modified on exit)
00075 *> \endverbatim
00076 *
00077 *  Authors:
00078 *  ========
00079 *
00080 *> \author Univ. of Tennessee 
00081 *> \author Univ. of California Berkeley 
00082 *> \author Univ. of Colorado Denver 
00083 *> \author NAG Ltd. 
00084 *
00085 *> \date November 2011
00086 *
00087 *> \ingroup complex_lin
00088 *
00089 *  =====================================================================
00090       SUBROUTINE CLATSY( UPLO, N, X, LDX, ISEED )
00091 *
00092 *  -- LAPACK test routine (version 3.4.0) --
00093 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00094 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00095 *     November 2011
00096 *
00097 *     .. Scalar Arguments ..
00098       CHARACTER          UPLO
00099       INTEGER            LDX, N
00100 *     ..
00101 *     .. Array Arguments ..
00102       INTEGER            ISEED( * )
00103       COMPLEX            X( LDX, * )
00104 *     ..
00105 *
00106 *  =====================================================================
00107 *
00108 *     .. Parameters ..
00109       COMPLEX            EYE
00110       PARAMETER          ( EYE = ( 0.0, 1.0 ) )
00111 *     ..
00112 *     .. Local Scalars ..
00113       INTEGER            I, J, N5
00114       REAL               ALPHA, ALPHA3, BETA
00115       COMPLEX            A, B, C, R
00116 *     ..
00117 *     .. External Functions ..
00118       COMPLEX            CLARND
00119       EXTERNAL           CLARND
00120 *     ..
00121 *     .. Intrinsic Functions ..
00122       INTRINSIC          ABS, SQRT
00123 *     ..
00124 *     .. Executable Statements ..
00125 *
00126 *     Initialize constants
00127 *
00128       ALPHA = ( 1.+SQRT( 17. ) ) / 8.
00129       BETA = ALPHA - 1. / 1000.
00130       ALPHA3 = ALPHA*ALPHA*ALPHA
00131 *
00132 *     UPLO = 'U':  Upper triangular storage
00133 *
00134       IF( UPLO.EQ.'U' ) THEN
00135 *
00136 *        Fill the upper triangle of the matrix with zeros.
00137 *
00138          DO 20 J = 1, N
00139             DO 10 I = 1, J
00140                X( I, J ) = 0.0
00141    10       CONTINUE
00142    20    CONTINUE
00143          N5 = N / 5
00144          N5 = N - 5*N5 + 1
00145 *
00146          DO 30 I = N, N5, -5
00147             A = ALPHA3*CLARND( 5, ISEED )
00148             B = CLARND( 5, ISEED ) / ALPHA
00149             C = A - 2.*B*EYE
00150             R = C / BETA
00151             X( I, I ) = A
00152             X( I-2, I ) = B
00153             X( I-2, I-1 ) = R
00154             X( I-2, I-2 ) = C
00155             X( I-1, I-1 ) = CLARND( 2, ISEED )
00156             X( I-3, I-3 ) = CLARND( 2, ISEED )
00157             X( I-4, I-4 ) = CLARND( 2, ISEED )
00158             IF( ABS( X( I-3, I-3 ) ).GT.ABS( X( I-4, I-4 ) ) ) THEN
00159                X( I-4, I-3 ) = 2.0*X( I-3, I-3 )
00160             ELSE
00161                X( I-4, I-3 ) = 2.0*X( I-4, I-4 )
00162             END IF
00163    30    CONTINUE
00164 *
00165 *        Clean-up for N not a multiple of 5.
00166 *
00167          I = N5 - 1
00168          IF( I.GT.2 ) THEN
00169             A = ALPHA3*CLARND( 5, ISEED )
00170             B = CLARND( 5, ISEED ) / ALPHA
00171             C = A - 2.*B*EYE
00172             R = C / BETA
00173             X( I, I ) = A
00174             X( I-2, I ) = B
00175             X( I-2, I-1 ) = R
00176             X( I-2, I-2 ) = C
00177             X( I-1, I-1 ) = CLARND( 2, ISEED )
00178             I = I - 3
00179          END IF
00180          IF( I.GT.1 ) THEN
00181             X( I, I ) = CLARND( 2, ISEED )
00182             X( I-1, I-1 ) = CLARND( 2, ISEED )
00183             IF( ABS( X( I, I ) ).GT.ABS( X( I-1, I-1 ) ) ) THEN
00184                X( I-1, I ) = 2.0*X( I, I )
00185             ELSE
00186                X( I-1, I ) = 2.0*X( I-1, I-1 )
00187             END IF
00188             I = I - 2
00189          ELSE IF( I.EQ.1 ) THEN
00190             X( I, I ) = CLARND( 2, ISEED )
00191             I = I - 1
00192          END IF
00193 *
00194 *     UPLO = 'L':  Lower triangular storage
00195 *
00196       ELSE
00197 *
00198 *        Fill the lower triangle of the matrix with zeros.
00199 *
00200          DO 50 J = 1, N
00201             DO 40 I = J, N
00202                X( I, J ) = 0.0
00203    40       CONTINUE
00204    50    CONTINUE
00205          N5 = N / 5
00206          N5 = N5*5
00207 *
00208          DO 60 I = 1, N5, 5
00209             A = ALPHA3*CLARND( 5, ISEED )
00210             B = CLARND( 5, ISEED ) / ALPHA
00211             C = A - 2.*B*EYE
00212             R = C / BETA
00213             X( I, I ) = A
00214             X( I+2, I ) = B
00215             X( I+2, I+1 ) = R
00216             X( I+2, I+2 ) = C
00217             X( I+1, I+1 ) = CLARND( 2, ISEED )
00218             X( I+3, I+3 ) = CLARND( 2, ISEED )
00219             X( I+4, I+4 ) = CLARND( 2, ISEED )
00220             IF( ABS( X( I+3, I+3 ) ).GT.ABS( X( I+4, I+4 ) ) ) THEN
00221                X( I+4, I+3 ) = 2.0*X( I+3, I+3 )
00222             ELSE
00223                X( I+4, I+3 ) = 2.0*X( I+4, I+4 )
00224             END IF
00225    60    CONTINUE
00226 *
00227 *        Clean-up for N not a multiple of 5.
00228 *
00229          I = N5 + 1
00230          IF( I.LT.N-1 ) THEN
00231             A = ALPHA3*CLARND( 5, ISEED )
00232             B = CLARND( 5, ISEED ) / ALPHA
00233             C = A - 2.*B*EYE
00234             R = C / BETA
00235             X( I, I ) = A
00236             X( I+2, I ) = B
00237             X( I+2, I+1 ) = R
00238             X( I+2, I+2 ) = C
00239             X( I+1, I+1 ) = CLARND( 2, ISEED )
00240             I = I + 3
00241          END IF
00242          IF( I.LT.N ) THEN
00243             X( I, I ) = CLARND( 2, ISEED )
00244             X( I+1, I+1 ) = CLARND( 2, ISEED )
00245             IF( ABS( X( I, I ) ).GT.ABS( X( I+1, I+1 ) ) ) THEN
00246                X( I+1, I ) = 2.0*X( I, I )
00247             ELSE
00248                X( I+1, I ) = 2.0*X( I+1, I+1 )
00249             END IF
00250             I = I + 2
00251          ELSE IF( I.EQ.N ) THEN
00252             X( I, I ) = CLARND( 2, ISEED )
00253             I = I + 1
00254          END IF
00255       END IF
00256 *
00257       RETURN
00258 *
00259 *     End of CLATSY
00260 *
00261       END
 All Files Functions