1*> \brief \b CLATM4
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*  Definition:
9*  ===========
10*
11*       SUBROUTINE CLATM4( ITYPE, N, NZ1, NZ2, RSIGN, AMAGN, RCOND,
12*                          TRIANG, IDIST, ISEED, A, LDA )
13*
14*       .. Scalar Arguments ..
15*       LOGICAL            RSIGN
16*       INTEGER            IDIST, ITYPE, LDA, N, NZ1, NZ2
17*       REAL               AMAGN, RCOND, TRIANG
18*       ..
19*       .. Array Arguments ..
20*       INTEGER            ISEED( 4 )
21*       COMPLEX            A( LDA, * )
22*       ..
23*
24*
25*> \par Purpose:
26*  =============
27*>
28*> \verbatim
29*>
30*> CLATM4 generates basic square matrices, which may later be
31*> multiplied by others in order to produce test matrices.  It is
32*> intended mainly to be used to test the generalized eigenvalue
33*> routines.
34*>
35*> It first generates the diagonal and (possibly) subdiagonal,
36*> according to the value of ITYPE, NZ1, NZ2, RSIGN, AMAGN, and RCOND.
37*> It then fills in the upper triangle with random numbers, if TRIANG is
38*> non-zero.
39*> \endverbatim
40*
41*  Arguments:
42*  ==========
43*
44*> \param[in] ITYPE
45*> \verbatim
46*>          ITYPE is INTEGER
47*>          The "type" of matrix on the diagonal and sub-diagonal.
48*>          If ITYPE < 0, then type abs(ITYPE) is generated and then
49*>             swapped end for end (A(I,J) := A'(N-J,N-I).)  See also
50*>             the description of AMAGN and RSIGN.
51*>
52*>          Special types:
53*>          = 0:  the zero matrix.
54*>          = 1:  the identity.
55*>          = 2:  a transposed Jordan block.
56*>          = 3:  If N is odd, then a k+1 x k+1 transposed Jordan block
57*>                followed by a k x k identity block, where k=(N-1)/2.
58*>                If N is even, then k=(N-2)/2, and a zero diagonal entry
59*>                is tacked onto the end.
60*>
61*>          Diagonal types.  The diagonal consists of NZ1 zeros, then
62*>             k=N-NZ1-NZ2 nonzeros.  The subdiagonal is zero.  ITYPE
63*>             specifies the nonzero diagonal entries as follows:
64*>          = 4:  1, ..., k
65*>          = 5:  1, RCOND, ..., RCOND
66*>          = 6:  1, ..., 1, RCOND
67*>          = 7:  1, a, a^2, ..., a^(k-1)=RCOND
68*>          = 8:  1, 1-d, 1-2*d, ..., 1-(k-1)*d=RCOND
69*>          = 9:  random numbers chosen from (RCOND,1)
70*>          = 10: random numbers with distribution IDIST (see CLARND.)
71*> \endverbatim
72*>
73*> \param[in] N
74*> \verbatim
75*>          N is INTEGER
76*>          The order of the matrix.
77*> \endverbatim
78*>
79*> \param[in] NZ1
80*> \verbatim
81*>          NZ1 is INTEGER
82*>          If abs(ITYPE) > 3, then the first NZ1 diagonal entries will
83*>          be zero.
84*> \endverbatim
85*>
86*> \param[in] NZ2
87*> \verbatim
88*>          NZ2 is INTEGER
89*>          If abs(ITYPE) > 3, then the last NZ2 diagonal entries will
90*>          be zero.
91*> \endverbatim
92*>
93*> \param[in] RSIGN
94*> \verbatim
95*>          RSIGN is LOGICAL
96*>          = .TRUE.:  The diagonal and subdiagonal entries will be
97*>                     multiplied by random numbers of magnitude 1.
98*>          = .FALSE.: The diagonal and subdiagonal entries will be
99*>                     left as they are (usually non-negative real.)
100*> \endverbatim
101*>
102*> \param[in] AMAGN
103*> \verbatim
104*>          AMAGN is REAL
105*>          The diagonal and subdiagonal entries will be multiplied by
106*>          AMAGN.
107*> \endverbatim
108*>
109*> \param[in] RCOND
110*> \verbatim
111*>          RCOND is REAL
112*>          If abs(ITYPE) > 4, then the smallest diagonal entry will be
113*>          RCOND.  RCOND must be between 0 and 1.
114*> \endverbatim
115*>
116*> \param[in] TRIANG
117*> \verbatim
118*>          TRIANG is REAL
119*>          The entries above the diagonal will be random numbers with
120*>          magnitude bounded by TRIANG (i.e., random numbers multiplied
121*>          by TRIANG.)
122*> \endverbatim
123*>
124*> \param[in] IDIST
125*> \verbatim
126*>          IDIST is INTEGER
127*>          On entry, DIST specifies the type of distribution to be used
128*>          to generate a random matrix .
129*>          = 1: real and imaginary parts each UNIFORM( 0, 1 )
130*>          = 2: real and imaginary parts each UNIFORM( -1, 1 )
131*>          = 3: real and imaginary parts each NORMAL( 0, 1 )
132*>          = 4: complex number uniform in DISK( 0, 1 )
133*> \endverbatim
134*>
135*> \param[in,out] ISEED
136*> \verbatim
137*>          ISEED is INTEGER array, dimension (4)
138*>          On entry ISEED specifies the seed of the random number
139*>          generator.  The values of ISEED are changed on exit, and can
140*>          be used in the next call to CLATM4 to continue the same
141*>          random number sequence.
142*>          Note: ISEED(4) should be odd, for the random number generator
143*>          used at present.
144*> \endverbatim
145*>
146*> \param[out] A
147*> \verbatim
148*>          A is COMPLEX array, dimension (LDA, N)
149*>          Array to be computed.
150*> \endverbatim
151*>
152*> \param[in] LDA
153*> \verbatim
154*>          LDA is INTEGER
155*>          Leading dimension of A.  Must be at least 1 and at least N.
156*> \endverbatim
157*
158*  Authors:
159*  ========
160*
161*> \author Univ. of Tennessee
162*> \author Univ. of California Berkeley
163*> \author Univ. of Colorado Denver
164*> \author NAG Ltd.
165*
166*> \ingroup complex_eig
167*
168*  =====================================================================
169      SUBROUTINE CLATM4( ITYPE, N, NZ1, NZ2, RSIGN, AMAGN, RCOND,
170     $                   TRIANG, IDIST, ISEED, A, LDA )
171*
172*  -- LAPACK test routine --
173*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
174*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
175*
176*     .. Scalar Arguments ..
177      LOGICAL            RSIGN
178      INTEGER            IDIST, ITYPE, LDA, N, NZ1, NZ2
179      REAL               AMAGN, RCOND, TRIANG
180*     ..
181*     .. Array Arguments ..
182      INTEGER            ISEED( 4 )
183      COMPLEX            A( LDA, * )
184*     ..
185*
186*  =====================================================================
187*
188*     .. Parameters ..
189      REAL               ZERO, ONE
190      PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0 )
191      COMPLEX            CZERO, CONE
192      PARAMETER          ( CZERO = ( 0.0E+0, 0.0E+0 ),
193     $                   CONE = ( 1.0E+0, 0.0E+0 ) )
194*     ..
195*     .. Local Scalars ..
196      INTEGER            I, ISDB, ISDE, JC, JD, JR, K, KBEG, KEND, KLEN
197      REAL               ALPHA
198      COMPLEX            CTEMP
199*     ..
200*     .. External Functions ..
201      REAL               SLARAN
202      COMPLEX            CLARND
203      EXTERNAL           SLARAN, CLARND
204*     ..
205*     .. External Subroutines ..
206      EXTERNAL           CLASET
207*     ..
208*     .. Intrinsic Functions ..
209      INTRINSIC          ABS, CMPLX, EXP, LOG, MAX, MIN, MOD, REAL
210*     ..
211*     .. Executable Statements ..
212*
213      IF( N.LE.0 )
214     $   RETURN
215      CALL CLASET( 'Full', N, N, CZERO, CZERO, A, LDA )
216*
217*     Insure a correct ISEED
218*
219      IF( MOD( ISEED( 4 ), 2 ).NE.1 )
220     $   ISEED( 4 ) = ISEED( 4 ) + 1
221*
222*     Compute diagonal and subdiagonal according to ITYPE, NZ1, NZ2,
223*     and RCOND
224*
225      IF( ITYPE.NE.0 ) THEN
226         IF( ABS( ITYPE ).GE.4 ) THEN
227            KBEG = MAX( 1, MIN( N, NZ1+1 ) )
228            KEND = MAX( KBEG, MIN( N, N-NZ2 ) )
229            KLEN = KEND + 1 - KBEG
230         ELSE
231            KBEG = 1
232            KEND = N
233            KLEN = N
234         END IF
235         ISDB = 1
236         ISDE = 0
237         GO TO ( 10, 30, 50, 80, 100, 120, 140, 160,
238     $           180, 200 )ABS( ITYPE )
239*
240*        abs(ITYPE) = 1: Identity
241*
242   10    CONTINUE
243         DO 20 JD = 1, N
244            A( JD, JD ) = CONE
245   20    CONTINUE
246         GO TO 220
247*
248*        abs(ITYPE) = 2: Transposed Jordan block
249*
250   30    CONTINUE
251         DO 40 JD = 1, N - 1
252            A( JD+1, JD ) = CONE
253   40    CONTINUE
254         ISDB = 1
255         ISDE = N - 1
256         GO TO 220
257*
258*        abs(ITYPE) = 3: Transposed Jordan block, followed by the
259*                        identity.
260*
261   50    CONTINUE
262         K = ( N-1 ) / 2
263         DO 60 JD = 1, K
264            A( JD+1, JD ) = CONE
265   60    CONTINUE
266         ISDB = 1
267         ISDE = K
268         DO 70 JD = K + 2, 2*K + 1
269            A( JD, JD ) = CONE
270   70    CONTINUE
271         GO TO 220
272*
273*        abs(ITYPE) = 4: 1,...,k
274*
275   80    CONTINUE
276         DO 90 JD = KBEG, KEND
277            A( JD, JD ) = CMPLX( JD-NZ1 )
278   90    CONTINUE
279         GO TO 220
280*
281*        abs(ITYPE) = 5: One large D value:
282*
283  100    CONTINUE
284         DO 110 JD = KBEG + 1, KEND
285            A( JD, JD ) = CMPLX( RCOND )
286  110    CONTINUE
287         A( KBEG, KBEG ) = CONE
288         GO TO 220
289*
290*        abs(ITYPE) = 6: One small D value:
291*
292  120    CONTINUE
293         DO 130 JD = KBEG, KEND - 1
294            A( JD, JD ) = CONE
295  130    CONTINUE
296         A( KEND, KEND ) = CMPLX( RCOND )
297         GO TO 220
298*
299*        abs(ITYPE) = 7: Exponentially distributed D values:
300*
301  140    CONTINUE
302         A( KBEG, KBEG ) = CONE
303         IF( KLEN.GT.1 ) THEN
304            ALPHA = RCOND**( ONE / REAL( KLEN-1 ) )
305            DO 150 I = 2, KLEN
306               A( NZ1+I, NZ1+I ) = CMPLX( ALPHA**REAL( I-1 ) )
307  150       CONTINUE
308         END IF
309         GO TO 220
310*
311*        abs(ITYPE) = 8: Arithmetically distributed D values:
312*
313  160    CONTINUE
314         A( KBEG, KBEG ) = CONE
315         IF( KLEN.GT.1 ) THEN
316            ALPHA = ( ONE-RCOND ) / REAL( KLEN-1 )
317            DO 170 I = 2, KLEN
318               A( NZ1+I, NZ1+I ) = CMPLX( REAL( KLEN-I )*ALPHA+RCOND )
319  170       CONTINUE
320         END IF
321         GO TO 220
322*
323*        abs(ITYPE) = 9: Randomly distributed D values on ( RCOND, 1):
324*
325  180    CONTINUE
326         ALPHA = LOG( RCOND )
327         DO 190 JD = KBEG, KEND
328            A( JD, JD ) = EXP( ALPHA*SLARAN( ISEED ) )
329  190    CONTINUE
330         GO TO 220
331*
332*        abs(ITYPE) = 10: Randomly distributed D values from DIST
333*
334  200    CONTINUE
335         DO 210 JD = KBEG, KEND
336            A( JD, JD ) = CLARND( IDIST, ISEED )
337  210    CONTINUE
338*
339  220    CONTINUE
340*
341*        Scale by AMAGN
342*
343         DO 230 JD = KBEG, KEND
344            A( JD, JD ) = AMAGN*REAL( A( JD, JD ) )
345  230    CONTINUE
346         DO 240 JD = ISDB, ISDE
347            A( JD+1, JD ) = AMAGN*REAL( A( JD+1, JD ) )
348  240    CONTINUE
349*
350*        If RSIGN = .TRUE., assign random signs to diagonal and
351*        subdiagonal
352*
353         IF( RSIGN ) THEN
354            DO 250 JD = KBEG, KEND
355               IF( REAL( A( JD, JD ) ).NE.ZERO ) THEN
356                  CTEMP = CLARND( 3, ISEED )
357                  CTEMP = CTEMP / ABS( CTEMP )
358                  A( JD, JD ) = CTEMP*REAL( A( JD, JD ) )
359               END IF
360  250       CONTINUE
361            DO 260 JD = ISDB, ISDE
362               IF( REAL( A( JD+1, JD ) ).NE.ZERO ) THEN
363                  CTEMP = CLARND( 3, ISEED )
364                  CTEMP = CTEMP / ABS( CTEMP )
365                  A( JD+1, JD ) = CTEMP*REAL( A( JD+1, JD ) )
366               END IF
367  260       CONTINUE
368         END IF
369*
370*        Reverse if ITYPE < 0
371*
372         IF( ITYPE.LT.0 ) THEN
373            DO 270 JD = KBEG, ( KBEG+KEND-1 ) / 2
374               CTEMP = A( JD, JD )
375               A( JD, JD ) = A( KBEG+KEND-JD, KBEG+KEND-JD )
376               A( KBEG+KEND-JD, KBEG+KEND-JD ) = CTEMP
377  270       CONTINUE
378            DO 280 JD = 1, ( N-1 ) / 2
379               CTEMP = A( JD+1, JD )
380               A( JD+1, JD ) = A( N+1-JD, N-JD )
381               A( N+1-JD, N-JD ) = CTEMP
382  280       CONTINUE
383         END IF
384*
385      END IF
386*
387*     Fill in upper triangle
388*
389      IF( TRIANG.NE.ZERO ) THEN
390         DO 300 JC = 2, N
391            DO 290 JR = 1, JC - 1
392               A( JR, JC ) = TRIANG*CLARND( IDIST, ISEED )
393  290       CONTINUE
394  300    CONTINUE
395      END IF
396*
397      RETURN
398*
399*     End of CLATM4
400*
401      END
402