You can not select more than 25 topics Topics must start with a chinese character,a letter or number, can include dashes ('-') and can be up to 35 characters long.

zlatmt.f 46 kB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262
  1. *> \brief \b ZLATMT
  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 ZLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX,
  12. * RANK, KL, KU, PACK, A, LDA, WORK, INFO )
  13. *
  14. * .. Scalar Arguments ..
  15. * DOUBLE PRECISION COND, DMAX
  16. * INTEGER INFO, KL, KU, LDA, M, MODE, N, RANK
  17. * CHARACTER DIST, PACK, SYM
  18. * ..
  19. * .. Array Arguments ..
  20. * COMPLEX*16 A( LDA, * ), WORK( * )
  21. * DOUBLE PRECISION D( * )
  22. * INTEGER ISEED( 4 )
  23. * ..
  24. *
  25. *
  26. *> \par Purpose:
  27. * =============
  28. *>
  29. *> \verbatim
  30. *>
  31. *> ZLATMT generates random matrices with specified singular values
  32. *> (or hermitian with specified eigenvalues)
  33. *> for testing LAPACK programs.
  34. *>
  35. *> ZLATMT operates by applying the following sequence of
  36. *> operations:
  37. *>
  38. *> Set the diagonal to D, where D may be input or
  39. *> computed according to MODE, COND, DMAX, and SYM
  40. *> as described below.
  41. *>
  42. *> Generate a matrix with the appropriate band structure, by one
  43. *> of two methods:
  44. *>
  45. *> Method A:
  46. *> Generate a dense M x N matrix by multiplying D on the left
  47. *> and the right by random unitary matrices, then:
  48. *>
  49. *> Reduce the bandwidth according to KL and KU, using
  50. *> Householder transformations.
  51. *>
  52. *> Method B:
  53. *> Convert the bandwidth-0 (i.e., diagonal) matrix to a
  54. *> bandwidth-1 matrix using Givens rotations, "chasing"
  55. *> out-of-band elements back, much as in QR; then convert
  56. *> the bandwidth-1 to a bandwidth-2 matrix, etc. Note
  57. *> that for reasonably small bandwidths (relative to M and
  58. *> N) this requires less storage, as a dense matrix is not
  59. *> generated. Also, for hermitian or symmetric matrices,
  60. *> only one triangle is generated.
  61. *>
  62. *> Method A is chosen if the bandwidth is a large fraction of the
  63. *> order of the matrix, and LDA is at least M (so a dense
  64. *> matrix can be stored.) Method B is chosen if the bandwidth
  65. *> is small (< 1/2 N for hermitian or symmetric, < .3 N+M for
  66. *> non-symmetric), or LDA is less than M and not less than the
  67. *> bandwidth.
  68. *>
  69. *> Pack the matrix if desired. Options specified by PACK are:
  70. *> no packing
  71. *> zero out upper half (if hermitian)
  72. *> zero out lower half (if hermitian)
  73. *> store the upper half columnwise (if hermitian or upper
  74. *> triangular)
  75. *> store the lower half columnwise (if hermitian or lower
  76. *> triangular)
  77. *> store the lower triangle in banded format (if hermitian or
  78. *> lower triangular)
  79. *> store the upper triangle in banded format (if hermitian or
  80. *> upper triangular)
  81. *> store the entire matrix in banded format
  82. *> If Method B is chosen, and band format is specified, then the
  83. *> matrix will be generated in the band format, so no repacking
  84. *> will be necessary.
  85. *> \endverbatim
  86. *
  87. * Arguments:
  88. * ==========
  89. *
  90. *> \param[in] M
  91. *> \verbatim
  92. *> M is INTEGER
  93. *> The number of rows of A. Not modified.
  94. *> \endverbatim
  95. *>
  96. *> \param[in] N
  97. *> \verbatim
  98. *> N is INTEGER
  99. *> The number of columns of A. N must equal M if the matrix
  100. *> is symmetric or hermitian (i.e., if SYM is not 'N')
  101. *> Not modified.
  102. *> \endverbatim
  103. *>
  104. *> \param[in] DIST
  105. *> \verbatim
  106. *> DIST is CHARACTER*1
  107. *> On entry, DIST specifies the type of distribution to be used
  108. *> to generate the random eigen-/singular values.
  109. *> 'U' => UNIFORM( 0, 1 ) ( 'U' for uniform )
  110. *> 'S' => UNIFORM( -1, 1 ) ( 'S' for symmetric )
  111. *> 'N' => NORMAL( 0, 1 ) ( 'N' for normal )
  112. *> Not modified.
  113. *> \endverbatim
  114. *>
  115. *> \param[in,out] ISEED
  116. *> \verbatim
  117. *> ISEED is INTEGER array, dimension ( 4 )
  118. *> On entry ISEED specifies the seed of the random number
  119. *> generator. They should lie between 0 and 4095 inclusive,
  120. *> and ISEED(4) should be odd. The random number generator
  121. *> uses a linear congruential sequence limited to small
  122. *> integers, and so should produce machine independent
  123. *> random numbers. The values of ISEED are changed on
  124. *> exit, and can be used in the next call to ZLATMT
  125. *> to continue the same random number sequence.
  126. *> Changed on exit.
  127. *> \endverbatim
  128. *>
  129. *> \param[in] SYM
  130. *> \verbatim
  131. *> SYM is CHARACTER*1
  132. *> If SYM='H', the generated matrix is hermitian, with
  133. *> eigenvalues specified by D, COND, MODE, and DMAX; they
  134. *> may be positive, negative, or zero.
  135. *> If SYM='P', the generated matrix is hermitian, with
  136. *> eigenvalues (= singular values) specified by D, COND,
  137. *> MODE, and DMAX; they will not be negative.
  138. *> If SYM='N', the generated matrix is nonsymmetric, with
  139. *> singular values specified by D, COND, MODE, and DMAX;
  140. *> they will not be negative.
  141. *> If SYM='S', the generated matrix is (complex) symmetric,
  142. *> with singular values specified by D, COND, MODE, and
  143. *> DMAX; they will not be negative.
  144. *> Not modified.
  145. *> \endverbatim
  146. *>
  147. *> \param[in,out] D
  148. *> \verbatim
  149. *> D is DOUBLE PRECISION array, dimension ( MIN( M, N ) )
  150. *> This array is used to specify the singular values or
  151. *> eigenvalues of A (see SYM, above.) If MODE=0, then D is
  152. *> assumed to contain the singular/eigenvalues, otherwise
  153. *> they will be computed according to MODE, COND, and DMAX,
  154. *> and placed in D.
  155. *> Modified if MODE is nonzero.
  156. *> \endverbatim
  157. *>
  158. *> \param[in] MODE
  159. *> \verbatim
  160. *> MODE is INTEGER
  161. *> On entry this describes how the singular/eigenvalues are to
  162. *> be specified:
  163. *> MODE = 0 means use D as input
  164. *> MODE = 1 sets D(1)=1 and D(2:RANK)=1.0/COND
  165. *> MODE = 2 sets D(1:RANK-1)=1 and D(RANK)=1.0/COND
  166. *> MODE = 3 sets D(I)=COND**(-(I-1)/(RANK-1))
  167. *> MODE = 4 sets D(i)=1 - (i-1)/(N-1)*(1 - 1/COND)
  168. *> MODE = 5 sets D to random numbers in the range
  169. *> ( 1/COND , 1 ) such that their logarithms
  170. *> are uniformly distributed.
  171. *> MODE = 6 set D to random numbers from same distribution
  172. *> as the rest of the matrix.
  173. *> MODE < 0 has the same meaning as ABS(MODE), except that
  174. *> the order of the elements of D is reversed.
  175. *> Thus if MODE is positive, D has entries ranging from
  176. *> 1 to 1/COND, if negative, from 1/COND to 1,
  177. *> If SYM='H', and MODE is neither 0, 6, nor -6, then
  178. *> the elements of D will also be multiplied by a random
  179. *> sign (i.e., +1 or -1.)
  180. *> Not modified.
  181. *> \endverbatim
  182. *>
  183. *> \param[in] COND
  184. *> \verbatim
  185. *> COND is DOUBLE PRECISION
  186. *> On entry, this is used as described under MODE above.
  187. *> If used, it must be >= 1. Not modified.
  188. *> \endverbatim
  189. *>
  190. *> \param[in] DMAX
  191. *> \verbatim
  192. *> DMAX is DOUBLE PRECISION
  193. *> If MODE is neither -6, 0 nor 6, the contents of D, as
  194. *> computed according to MODE and COND, will be scaled by
  195. *> DMAX / max(abs(D(i))); thus, the maximum absolute eigen- or
  196. *> singular value (which is to say the norm) will be abs(DMAX).
  197. *> Note that DMAX need not be positive: if DMAX is negative
  198. *> (or zero), D will be scaled by a negative number (or zero).
  199. *> Not modified.
  200. *> \endverbatim
  201. *>
  202. *> \param[in] RANK
  203. *> \verbatim
  204. *> RANK is INTEGER
  205. *> The rank of matrix to be generated for modes 1,2,3 only.
  206. *> D( RANK+1:N ) = 0.
  207. *> Not modified.
  208. *> \endverbatim
  209. *>
  210. *> \param[in] KL
  211. *> \verbatim
  212. *> KL is INTEGER
  213. *> This specifies the lower bandwidth of the matrix. For
  214. *> example, KL=0 implies upper triangular, KL=1 implies upper
  215. *> Hessenberg, and KL being at least M-1 means that the matrix
  216. *> has full lower bandwidth. KL must equal KU if the matrix
  217. *> is symmetric or hermitian.
  218. *> Not modified.
  219. *> \endverbatim
  220. *>
  221. *> \param[in] KU
  222. *> \verbatim
  223. *> KU is INTEGER
  224. *> This specifies the upper bandwidth of the matrix. For
  225. *> example, KU=0 implies lower triangular, KU=1 implies lower
  226. *> Hessenberg, and KU being at least N-1 means that the matrix
  227. *> has full upper bandwidth. KL must equal KU if the matrix
  228. *> is symmetric or hermitian.
  229. *> Not modified.
  230. *> \endverbatim
  231. *>
  232. *> \param[in] PACK
  233. *> \verbatim
  234. *> PACK is CHARACTER*1
  235. *> This specifies packing of matrix as follows:
  236. *> 'N' => no packing
  237. *> 'U' => zero out all subdiagonal entries (if symmetric
  238. *> or hermitian)
  239. *> 'L' => zero out all superdiagonal entries (if symmetric
  240. *> or hermitian)
  241. *> 'C' => store the upper triangle columnwise (only if the
  242. *> matrix is symmetric, hermitian, or upper triangular)
  243. *> 'R' => store the lower triangle columnwise (only if the
  244. *> matrix is symmetric, hermitian, or lower triangular)
  245. *> 'B' => store the lower triangle in band storage scheme
  246. *> (only if the matrix is symmetric, hermitian, or
  247. *> lower triangular)
  248. *> 'Q' => store the upper triangle in band storage scheme
  249. *> (only if the matrix is symmetric, hermitian, or
  250. *> upper triangular)
  251. *> 'Z' => store the entire matrix in band storage scheme
  252. *> (pivoting can be provided for by using this
  253. *> option to store A in the trailing rows of
  254. *> the allocated storage)
  255. *>
  256. *> Using these options, the various LAPACK packed and banded
  257. *> storage schemes can be obtained:
  258. *> GB - use 'Z'
  259. *> PB, SB, HB, or TB - use 'B' or 'Q'
  260. *> PP, SP, HB, or TP - use 'C' or 'R'
  261. *>
  262. *> If two calls to ZLATMT differ only in the PACK parameter,
  263. *> they will generate mathematically equivalent matrices.
  264. *> Not modified.
  265. *> \endverbatim
  266. *>
  267. *> \param[in,out] A
  268. *> \verbatim
  269. *> A is COMPLEX*16 array, dimension ( LDA, N )
  270. *> On exit A is the desired test matrix. A is first generated
  271. *> in full (unpacked) form, and then packed, if so specified
  272. *> by PACK. Thus, the first M elements of the first N
  273. *> columns will always be modified. If PACK specifies a
  274. *> packed or banded storage scheme, all LDA elements of the
  275. *> first N columns will be modified; the elements of the
  276. *> array which do not correspond to elements of the generated
  277. *> matrix are set to zero.
  278. *> Modified.
  279. *> \endverbatim
  280. *>
  281. *> \param[in] LDA
  282. *> \verbatim
  283. *> LDA is INTEGER
  284. *> LDA specifies the first dimension of A as declared in the
  285. *> calling program. If PACK='N', 'U', 'L', 'C', or 'R', then
  286. *> LDA must be at least M. If PACK='B' or 'Q', then LDA must
  287. *> be at least MIN( KL, M-1) (which is equal to MIN(KU,N-1)).
  288. *> If PACK='Z', LDA must be large enough to hold the packed
  289. *> array: MIN( KU, N-1) + MIN( KL, M-1) + 1.
  290. *> Not modified.
  291. *> \endverbatim
  292. *>
  293. *> \param[out] WORK
  294. *> \verbatim
  295. *> WORK is COMPLEX*16 array, dimension ( 3*MAX( N, M ) )
  296. *> Workspace.
  297. *> Modified.
  298. *> \endverbatim
  299. *>
  300. *> \param[out] INFO
  301. *> \verbatim
  302. *> INFO is INTEGER
  303. *> Error code. On exit, INFO will be set to one of the
  304. *> following values:
  305. *> 0 => normal return
  306. *> -1 => M negative or unequal to N and SYM='S', 'H', or 'P'
  307. *> -2 => N negative
  308. *> -3 => DIST illegal string
  309. *> -5 => SYM illegal string
  310. *> -7 => MODE not in range -6 to 6
  311. *> -8 => COND less than 1.0, and MODE neither -6, 0 nor 6
  312. *> -10 => KL negative
  313. *> -11 => KU negative, or SYM is not 'N' and KU is not equal to
  314. *> KL
  315. *> -12 => PACK illegal string, or PACK='U' or 'L', and SYM='N';
  316. *> or PACK='C' or 'Q' and SYM='N' and KL is not zero;
  317. *> or PACK='R' or 'B' and SYM='N' and KU is not zero;
  318. *> or PACK='U', 'L', 'C', 'R', 'B', or 'Q', and M is not
  319. *> N.
  320. *> -14 => LDA is less than M, or PACK='Z' and LDA is less than
  321. *> MIN(KU,N-1) + MIN(KL,M-1) + 1.
  322. *> 1 => Error return from DLATM7
  323. *> 2 => Cannot scale to DMAX (max. sing. value is 0)
  324. *> 3 => Error return from ZLAGGE, ZLAGHE or ZLAGSY
  325. *> \endverbatim
  326. *
  327. * Authors:
  328. * ========
  329. *
  330. *> \author Univ. of Tennessee
  331. *> \author Univ. of California Berkeley
  332. *> \author Univ. of Colorado Denver
  333. *> \author NAG Ltd.
  334. *
  335. *> \ingroup complex16_matgen
  336. *
  337. * =====================================================================
  338. SUBROUTINE ZLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX,
  339. $ RANK, KL, KU, PACK, A, LDA, WORK, INFO )
  340. *
  341. * -- LAPACK computational routine --
  342. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  343. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  344. *
  345. * .. Scalar Arguments ..
  346. DOUBLE PRECISION COND, DMAX
  347. INTEGER INFO, KL, KU, LDA, M, MODE, N, RANK
  348. CHARACTER DIST, PACK, SYM
  349. * ..
  350. * .. Array Arguments ..
  351. COMPLEX*16 A( LDA, * ), WORK( * )
  352. DOUBLE PRECISION D( * )
  353. INTEGER ISEED( 4 )
  354. * ..
  355. *
  356. * =====================================================================
  357. *
  358. * .. Parameters ..
  359. DOUBLE PRECISION ZERO
  360. PARAMETER ( ZERO = 0.0D+0 )
  361. DOUBLE PRECISION ONE
  362. PARAMETER ( ONE = 1.0D+0 )
  363. COMPLEX*16 CZERO
  364. PARAMETER ( CZERO = ( 0.0D+0, 0.0D+0 ) )
  365. DOUBLE PRECISION TWOPI
  366. PARAMETER ( TWOPI = 6.28318530717958647692528676655900576839D+0 )
  367. * ..
  368. * .. Local Scalars ..
  369. COMPLEX*16 C, CT, DUMMY, EXTRA, S, ST, ZTEMP
  370. DOUBLE PRECISION ALPHA, ANGLE, REALC, TEMP
  371. INTEGER I, IC, ICOL, IDIST, IENDCH, IINFO, IL, ILDA,
  372. $ IOFFG, IOFFST, IPACK, IPACKG, IR, IR1, IR2,
  373. $ IROW, IRSIGN, ISKEW, ISYM, ISYMPK, J, JC, JCH,
  374. $ JKL, JKU, JR, K, LLB, MINLDA, MNMIN, MR, NC,
  375. $ UUB
  376. LOGICAL CSYM, GIVENS, ILEXTR, ILTEMP, TOPDWN
  377. * ..
  378. * .. External Functions ..
  379. COMPLEX*16 ZLARND
  380. DOUBLE PRECISION DLARND
  381. LOGICAL LSAME
  382. EXTERNAL ZLARND, DLARND, LSAME
  383. * ..
  384. * .. External Subroutines ..
  385. EXTERNAL DLATM7, DSCAL, XERBLA, ZLAGGE, ZLAGHE,
  386. $ ZLAGSY, ZLAROT, ZLARTG, ZLASET
  387. * ..
  388. * .. Intrinsic Functions ..
  389. INTRINSIC ABS, COS, DBLE, DCMPLX, DCONJG, MAX, MIN, MOD,
  390. $ SIN
  391. * ..
  392. * .. Executable Statements ..
  393. *
  394. * 1) Decode and Test the input parameters.
  395. * Initialize flags & seed.
  396. *
  397. INFO = 0
  398. *
  399. * Quick return if possible
  400. *
  401. IF( M.EQ.0 .OR. N.EQ.0 )
  402. $ RETURN
  403. *
  404. * Decode DIST
  405. *
  406. IF( LSAME( DIST, 'U' ) ) THEN
  407. IDIST = 1
  408. ELSE IF( LSAME( DIST, 'S' ) ) THEN
  409. IDIST = 2
  410. ELSE IF( LSAME( DIST, 'N' ) ) THEN
  411. IDIST = 3
  412. ELSE
  413. IDIST = -1
  414. END IF
  415. *
  416. * Decode SYM
  417. *
  418. IF( LSAME( SYM, 'N' ) ) THEN
  419. ISYM = 1
  420. IRSIGN = 0
  421. CSYM = .FALSE.
  422. ELSE IF( LSAME( SYM, 'P' ) ) THEN
  423. ISYM = 2
  424. IRSIGN = 0
  425. CSYM = .FALSE.
  426. ELSE IF( LSAME( SYM, 'S' ) ) THEN
  427. ISYM = 2
  428. IRSIGN = 0
  429. CSYM = .TRUE.
  430. ELSE IF( LSAME( SYM, 'H' ) ) THEN
  431. ISYM = 2
  432. IRSIGN = 1
  433. CSYM = .FALSE.
  434. ELSE
  435. ISYM = -1
  436. END IF
  437. *
  438. * Decode PACK
  439. *
  440. ISYMPK = 0
  441. IF( LSAME( PACK, 'N' ) ) THEN
  442. IPACK = 0
  443. ELSE IF( LSAME( PACK, 'U' ) ) THEN
  444. IPACK = 1
  445. ISYMPK = 1
  446. ELSE IF( LSAME( PACK, 'L' ) ) THEN
  447. IPACK = 2
  448. ISYMPK = 1
  449. ELSE IF( LSAME( PACK, 'C' ) ) THEN
  450. IPACK = 3
  451. ISYMPK = 2
  452. ELSE IF( LSAME( PACK, 'R' ) ) THEN
  453. IPACK = 4
  454. ISYMPK = 3
  455. ELSE IF( LSAME( PACK, 'B' ) ) THEN
  456. IPACK = 5
  457. ISYMPK = 3
  458. ELSE IF( LSAME( PACK, 'Q' ) ) THEN
  459. IPACK = 6
  460. ISYMPK = 2
  461. ELSE IF( LSAME( PACK, 'Z' ) ) THEN
  462. IPACK = 7
  463. ELSE
  464. IPACK = -1
  465. END IF
  466. *
  467. * Set certain internal parameters
  468. *
  469. MNMIN = MIN( M, N )
  470. LLB = MIN( KL, M-1 )
  471. UUB = MIN( KU, N-1 )
  472. MR = MIN( M, N+LLB )
  473. NC = MIN( N, M+UUB )
  474. *
  475. IF( IPACK.EQ.5 .OR. IPACK.EQ.6 ) THEN
  476. MINLDA = UUB + 1
  477. ELSE IF( IPACK.EQ.7 ) THEN
  478. MINLDA = LLB + UUB + 1
  479. ELSE
  480. MINLDA = M
  481. END IF
  482. *
  483. * Use Givens rotation method if bandwidth small enough,
  484. * or if LDA is too small to store the matrix unpacked.
  485. *
  486. GIVENS = .FALSE.
  487. IF( ISYM.EQ.1 ) THEN
  488. IF( DBLE( LLB+UUB ).LT.0.3D0*DBLE( MAX( 1, MR+NC ) ) )
  489. $ GIVENS = .TRUE.
  490. ELSE
  491. IF( 2*LLB.LT.M )
  492. $ GIVENS = .TRUE.
  493. END IF
  494. IF( LDA.LT.M .AND. LDA.GE.MINLDA )
  495. $ GIVENS = .TRUE.
  496. *
  497. * Set INFO if an error
  498. *
  499. IF( M.LT.0 ) THEN
  500. INFO = -1
  501. ELSE IF( M.NE.N .AND. ISYM.NE.1 ) THEN
  502. INFO = -1
  503. ELSE IF( N.LT.0 ) THEN
  504. INFO = -2
  505. ELSE IF( IDIST.EQ.-1 ) THEN
  506. INFO = -3
  507. ELSE IF( ISYM.EQ.-1 ) THEN
  508. INFO = -5
  509. ELSE IF( ABS( MODE ).GT.6 ) THEN
  510. INFO = -7
  511. ELSE IF( ( MODE.NE.0 .AND. ABS( MODE ).NE.6 ) .AND. COND.LT.ONE )
  512. $ THEN
  513. INFO = -8
  514. ELSE IF( KL.LT.0 ) THEN
  515. INFO = -10
  516. ELSE IF( KU.LT.0 .OR. ( ISYM.NE.1 .AND. KL.NE.KU ) ) THEN
  517. INFO = -11
  518. ELSE IF( IPACK.EQ.-1 .OR. ( ISYMPK.EQ.1 .AND. ISYM.EQ.1 ) .OR.
  519. $ ( ISYMPK.EQ.2 .AND. ISYM.EQ.1 .AND. KL.GT.0 ) .OR.
  520. $ ( ISYMPK.EQ.3 .AND. ISYM.EQ.1 .AND. KU.GT.0 ) .OR.
  521. $ ( ISYMPK.NE.0 .AND. M.NE.N ) ) THEN
  522. INFO = -12
  523. ELSE IF( LDA.LT.MAX( 1, MINLDA ) ) THEN
  524. INFO = -14
  525. END IF
  526. *
  527. IF( INFO.NE.0 ) THEN
  528. CALL XERBLA( 'ZLATMT', -INFO )
  529. RETURN
  530. END IF
  531. *
  532. * Initialize random number generator
  533. *
  534. DO 100 I = 1, 4
  535. ISEED( I ) = MOD( ABS( ISEED( I ) ), 4096 )
  536. 100 CONTINUE
  537. *
  538. IF( MOD( ISEED( 4 ), 2 ).NE.1 )
  539. $ ISEED( 4 ) = ISEED( 4 ) + 1
  540. *
  541. * 2) Set up D if indicated.
  542. *
  543. * Compute D according to COND and MODE
  544. *
  545. CALL DLATM7( MODE, COND, IRSIGN, IDIST, ISEED, D, MNMIN, RANK,
  546. $ IINFO )
  547. IF( IINFO.NE.0 ) THEN
  548. INFO = 1
  549. RETURN
  550. END IF
  551. *
  552. * Choose Top-Down if D is (apparently) increasing,
  553. * Bottom-Up if D is (apparently) decreasing.
  554. *
  555. IF( ABS( D( 1 ) ).LE.ABS( D( RANK ) ) ) THEN
  556. TOPDWN = .TRUE.
  557. ELSE
  558. TOPDWN = .FALSE.
  559. END IF
  560. *
  561. IF( MODE.NE.0 .AND. ABS( MODE ).NE.6 ) THEN
  562. *
  563. * Scale by DMAX
  564. *
  565. TEMP = ABS( D( 1 ) )
  566. DO 110 I = 2, RANK
  567. TEMP = MAX( TEMP, ABS( D( I ) ) )
  568. 110 CONTINUE
  569. *
  570. IF( TEMP.GT.ZERO ) THEN
  571. ALPHA = DMAX / TEMP
  572. ELSE
  573. INFO = 2
  574. RETURN
  575. END IF
  576. *
  577. CALL DSCAL( RANK, ALPHA, D, 1 )
  578. *
  579. END IF
  580. *
  581. CALL ZLASET( 'Full', LDA, N, CZERO, CZERO, A, LDA )
  582. *
  583. * 3) Generate Banded Matrix using Givens rotations.
  584. * Also the special case of UUB=LLB=0
  585. *
  586. * Compute Addressing constants to cover all
  587. * storage formats. Whether GE, HE, SY, GB, HB, or SB,
  588. * upper or lower triangle or both,
  589. * the (i,j)-th element is in
  590. * A( i - ISKEW*j + IOFFST, j )
  591. *
  592. IF( IPACK.GT.4 ) THEN
  593. ILDA = LDA - 1
  594. ISKEW = 1
  595. IF( IPACK.GT.5 ) THEN
  596. IOFFST = UUB + 1
  597. ELSE
  598. IOFFST = 1
  599. END IF
  600. ELSE
  601. ILDA = LDA
  602. ISKEW = 0
  603. IOFFST = 0
  604. END IF
  605. *
  606. * IPACKG is the format that the matrix is generated in. If this is
  607. * different from IPACK, then the matrix must be repacked at the
  608. * end. It also signals how to compute the norm, for scaling.
  609. *
  610. IPACKG = 0
  611. *
  612. * Diagonal Matrix -- We are done, unless it
  613. * is to be stored HP/SP/PP/TP (PACK='R' or 'C')
  614. *
  615. IF( LLB.EQ.0 .AND. UUB.EQ.0 ) THEN
  616. DO 120 J = 1, MNMIN
  617. A( ( 1-ISKEW )*J+IOFFST, J ) = DCMPLX( D( J ) )
  618. 120 CONTINUE
  619. *
  620. IF( IPACK.LE.2 .OR. IPACK.GE.5 )
  621. $ IPACKG = IPACK
  622. *
  623. ELSE IF( GIVENS ) THEN
  624. *
  625. * Check whether to use Givens rotations,
  626. * Householder transformations, or nothing.
  627. *
  628. IF( ISYM.EQ.1 ) THEN
  629. *
  630. * Non-symmetric -- A = U D V
  631. *
  632. IF( IPACK.GT.4 ) THEN
  633. IPACKG = IPACK
  634. ELSE
  635. IPACKG = 0
  636. END IF
  637. *
  638. DO 130 J = 1, MNMIN
  639. A( ( 1-ISKEW )*J+IOFFST, J ) = DCMPLX( D( J ) )
  640. 130 CONTINUE
  641. *
  642. IF( TOPDWN ) THEN
  643. JKL = 0
  644. DO 160 JKU = 1, UUB
  645. *
  646. * Transform from bandwidth JKL, JKU-1 to JKL, JKU
  647. *
  648. * Last row actually rotated is M
  649. * Last column actually rotated is MIN( M+JKU, N )
  650. *
  651. DO 150 JR = 1, MIN( M+JKU, N ) + JKL - 1
  652. EXTRA = CZERO
  653. ANGLE = TWOPI*DLARND( 1, ISEED )
  654. C = COS( ANGLE )*ZLARND( 5, ISEED )
  655. S = SIN( ANGLE )*ZLARND( 5, ISEED )
  656. ICOL = MAX( 1, JR-JKL )
  657. IF( JR.LT.M ) THEN
  658. IL = MIN( N, JR+JKU ) + 1 - ICOL
  659. CALL ZLAROT( .TRUE., JR.GT.JKL, .FALSE., IL, C,
  660. $ S, A( JR-ISKEW*ICOL+IOFFST, ICOL ),
  661. $ ILDA, EXTRA, DUMMY )
  662. END IF
  663. *
  664. * Chase "EXTRA" back up
  665. *
  666. IR = JR
  667. IC = ICOL
  668. DO 140 JCH = JR - JKL, 1, -JKL - JKU
  669. IF( IR.LT.M ) THEN
  670. CALL ZLARTG( A( IR+1-ISKEW*( IC+1 )+IOFFST,
  671. $ IC+1 ), EXTRA, REALC, S, DUMMY )
  672. DUMMY = DLARND( 5, ISEED )
  673. C = DCONJG( REALC*DUMMY )
  674. S = DCONJG( -S*DUMMY )
  675. END IF
  676. IROW = MAX( 1, JCH-JKU )
  677. IL = IR + 2 - IROW
  678. ZTEMP = CZERO
  679. ILTEMP = JCH.GT.JKU
  680. CALL ZLAROT( .FALSE., ILTEMP, .TRUE., IL, C, S,
  681. $ A( IROW-ISKEW*IC+IOFFST, IC ),
  682. $ ILDA, ZTEMP, EXTRA )
  683. IF( ILTEMP ) THEN
  684. CALL ZLARTG( A( IROW+1-ISKEW*( IC+1 )+IOFFST,
  685. $ IC+1 ), ZTEMP, REALC, S, DUMMY )
  686. DUMMY = ZLARND( 5, ISEED )
  687. C = DCONJG( REALC*DUMMY )
  688. S = DCONJG( -S*DUMMY )
  689. *
  690. ICOL = MAX( 1, JCH-JKU-JKL )
  691. IL = IC + 2 - ICOL
  692. EXTRA = CZERO
  693. CALL ZLAROT( .TRUE., JCH.GT.JKU+JKL, .TRUE.,
  694. $ IL, C, S, A( IROW-ISKEW*ICOL+
  695. $ IOFFST, ICOL ), ILDA, EXTRA,
  696. $ ZTEMP )
  697. IC = ICOL
  698. IR = IROW
  699. END IF
  700. 140 CONTINUE
  701. 150 CONTINUE
  702. 160 CONTINUE
  703. *
  704. JKU = UUB
  705. DO 190 JKL = 1, LLB
  706. *
  707. * Transform from bandwidth JKL-1, JKU to JKL, JKU
  708. *
  709. DO 180 JC = 1, MIN( N+JKL, M ) + JKU - 1
  710. EXTRA = CZERO
  711. ANGLE = TWOPI*DLARND( 1, ISEED )
  712. C = COS( ANGLE )*ZLARND( 5, ISEED )
  713. S = SIN( ANGLE )*ZLARND( 5, ISEED )
  714. IROW = MAX( 1, JC-JKU )
  715. IF( JC.LT.N ) THEN
  716. IL = MIN( M, JC+JKL ) + 1 - IROW
  717. CALL ZLAROT( .FALSE., JC.GT.JKU, .FALSE., IL, C,
  718. $ S, A( IROW-ISKEW*JC+IOFFST, JC ),
  719. $ ILDA, EXTRA, DUMMY )
  720. END IF
  721. *
  722. * Chase "EXTRA" back up
  723. *
  724. IC = JC
  725. IR = IROW
  726. DO 170 JCH = JC - JKU, 1, -JKL - JKU
  727. IF( IC.LT.N ) THEN
  728. CALL ZLARTG( A( IR+1-ISKEW*( IC+1 )+IOFFST,
  729. $ IC+1 ), EXTRA, REALC, S, DUMMY )
  730. DUMMY = ZLARND( 5, ISEED )
  731. C = DCONJG( REALC*DUMMY )
  732. S = DCONJG( -S*DUMMY )
  733. END IF
  734. ICOL = MAX( 1, JCH-JKL )
  735. IL = IC + 2 - ICOL
  736. ZTEMP = CZERO
  737. ILTEMP = JCH.GT.JKL
  738. CALL ZLAROT( .TRUE., ILTEMP, .TRUE., IL, C, S,
  739. $ A( IR-ISKEW*ICOL+IOFFST, ICOL ),
  740. $ ILDA, ZTEMP, EXTRA )
  741. IF( ILTEMP ) THEN
  742. CALL ZLARTG( A( IR+1-ISKEW*( ICOL+1 )+IOFFST,
  743. $ ICOL+1 ), ZTEMP, REALC, S,
  744. $ DUMMY )
  745. DUMMY = ZLARND( 5, ISEED )
  746. C = DCONJG( REALC*DUMMY )
  747. S = DCONJG( -S*DUMMY )
  748. IROW = MAX( 1, JCH-JKL-JKU )
  749. IL = IR + 2 - IROW
  750. EXTRA = CZERO
  751. CALL ZLAROT( .FALSE., JCH.GT.JKL+JKU, .TRUE.,
  752. $ IL, C, S, A( IROW-ISKEW*ICOL+
  753. $ IOFFST, ICOL ), ILDA, EXTRA,
  754. $ ZTEMP )
  755. IC = ICOL
  756. IR = IROW
  757. END IF
  758. 170 CONTINUE
  759. 180 CONTINUE
  760. 190 CONTINUE
  761. *
  762. ELSE
  763. *
  764. * Bottom-Up -- Start at the bottom right.
  765. *
  766. JKL = 0
  767. DO 220 JKU = 1, UUB
  768. *
  769. * Transform from bandwidth JKL, JKU-1 to JKL, JKU
  770. *
  771. * First row actually rotated is M
  772. * First column actually rotated is MIN( M+JKU, N )
  773. *
  774. IENDCH = MIN( M, N+JKL ) - 1
  775. DO 210 JC = MIN( M+JKU, N ) - 1, 1 - JKL, -1
  776. EXTRA = CZERO
  777. ANGLE = TWOPI*DLARND( 1, ISEED )
  778. C = COS( ANGLE )*ZLARND( 5, ISEED )
  779. S = SIN( ANGLE )*ZLARND( 5, ISEED )
  780. IROW = MAX( 1, JC-JKU+1 )
  781. IF( JC.GT.0 ) THEN
  782. IL = MIN( M, JC+JKL+1 ) + 1 - IROW
  783. CALL ZLAROT( .FALSE., .FALSE., JC+JKL.LT.M, IL,
  784. $ C, S, A( IROW-ISKEW*JC+IOFFST,
  785. $ JC ), ILDA, DUMMY, EXTRA )
  786. END IF
  787. *
  788. * Chase "EXTRA" back down
  789. *
  790. IC = JC
  791. DO 200 JCH = JC + JKL, IENDCH, JKL + JKU
  792. ILEXTR = IC.GT.0
  793. IF( ILEXTR ) THEN
  794. CALL ZLARTG( A( JCH-ISKEW*IC+IOFFST, IC ),
  795. $ EXTRA, REALC, S, DUMMY )
  796. DUMMY = ZLARND( 5, ISEED )
  797. C = REALC*DUMMY
  798. S = S*DUMMY
  799. END IF
  800. IC = MAX( 1, IC )
  801. ICOL = MIN( N-1, JCH+JKU )
  802. ILTEMP = JCH + JKU.LT.N
  803. ZTEMP = CZERO
  804. CALL ZLAROT( .TRUE., ILEXTR, ILTEMP, ICOL+2-IC,
  805. $ C, S, A( JCH-ISKEW*IC+IOFFST, IC ),
  806. $ ILDA, EXTRA, ZTEMP )
  807. IF( ILTEMP ) THEN
  808. CALL ZLARTG( A( JCH-ISKEW*ICOL+IOFFST,
  809. $ ICOL ), ZTEMP, REALC, S, DUMMY )
  810. DUMMY = ZLARND( 5, ISEED )
  811. C = REALC*DUMMY
  812. S = S*DUMMY
  813. IL = MIN( IENDCH, JCH+JKL+JKU ) + 2 - JCH
  814. EXTRA = CZERO
  815. CALL ZLAROT( .FALSE., .TRUE.,
  816. $ JCH+JKL+JKU.LE.IENDCH, IL, C, S,
  817. $ A( JCH-ISKEW*ICOL+IOFFST,
  818. $ ICOL ), ILDA, ZTEMP, EXTRA )
  819. IC = ICOL
  820. END IF
  821. 200 CONTINUE
  822. 210 CONTINUE
  823. 220 CONTINUE
  824. *
  825. JKU = UUB
  826. DO 250 JKL = 1, LLB
  827. *
  828. * Transform from bandwidth JKL-1, JKU to JKL, JKU
  829. *
  830. * First row actually rotated is MIN( N+JKL, M )
  831. * First column actually rotated is N
  832. *
  833. IENDCH = MIN( N, M+JKU ) - 1
  834. DO 240 JR = MIN( N+JKL, M ) - 1, 1 - JKU, -1
  835. EXTRA = CZERO
  836. ANGLE = TWOPI*DLARND( 1, ISEED )
  837. C = COS( ANGLE )*ZLARND( 5, ISEED )
  838. S = SIN( ANGLE )*ZLARND( 5, ISEED )
  839. ICOL = MAX( 1, JR-JKL+1 )
  840. IF( JR.GT.0 ) THEN
  841. IL = MIN( N, JR+JKU+1 ) + 1 - ICOL
  842. CALL ZLAROT( .TRUE., .FALSE., JR+JKU.LT.N, IL,
  843. $ C, S, A( JR-ISKEW*ICOL+IOFFST,
  844. $ ICOL ), ILDA, DUMMY, EXTRA )
  845. END IF
  846. *
  847. * Chase "EXTRA" back down
  848. *
  849. IR = JR
  850. DO 230 JCH = JR + JKU, IENDCH, JKL + JKU
  851. ILEXTR = IR.GT.0
  852. IF( ILEXTR ) THEN
  853. CALL ZLARTG( A( IR-ISKEW*JCH+IOFFST, JCH ),
  854. $ EXTRA, REALC, S, DUMMY )
  855. DUMMY = ZLARND( 5, ISEED )
  856. C = REALC*DUMMY
  857. S = S*DUMMY
  858. END IF
  859. IR = MAX( 1, IR )
  860. IROW = MIN( M-1, JCH+JKL )
  861. ILTEMP = JCH + JKL.LT.M
  862. ZTEMP = CZERO
  863. CALL ZLAROT( .FALSE., ILEXTR, ILTEMP, IROW+2-IR,
  864. $ C, S, A( IR-ISKEW*JCH+IOFFST,
  865. $ JCH ), ILDA, EXTRA, ZTEMP )
  866. IF( ILTEMP ) THEN
  867. CALL ZLARTG( A( IROW-ISKEW*JCH+IOFFST, JCH ),
  868. $ ZTEMP, REALC, S, DUMMY )
  869. DUMMY = ZLARND( 5, ISEED )
  870. C = REALC*DUMMY
  871. S = S*DUMMY
  872. IL = MIN( IENDCH, JCH+JKL+JKU ) + 2 - JCH
  873. EXTRA = CZERO
  874. CALL ZLAROT( .TRUE., .TRUE.,
  875. $ JCH+JKL+JKU.LE.IENDCH, IL, C, S,
  876. $ A( IROW-ISKEW*JCH+IOFFST, JCH ),
  877. $ ILDA, ZTEMP, EXTRA )
  878. IR = IROW
  879. END IF
  880. 230 CONTINUE
  881. 240 CONTINUE
  882. 250 CONTINUE
  883. *
  884. END IF
  885. *
  886. ELSE
  887. *
  888. * Symmetric -- A = U D U'
  889. * Hermitian -- A = U D U*
  890. *
  891. IPACKG = IPACK
  892. IOFFG = IOFFST
  893. *
  894. IF( TOPDWN ) THEN
  895. *
  896. * Top-Down -- Generate Upper triangle only
  897. *
  898. IF( IPACK.GE.5 ) THEN
  899. IPACKG = 6
  900. IOFFG = UUB + 1
  901. ELSE
  902. IPACKG = 1
  903. END IF
  904. *
  905. DO 260 J = 1, MNMIN
  906. A( ( 1-ISKEW )*J+IOFFG, J ) = DCMPLX( D( J ) )
  907. 260 CONTINUE
  908. *
  909. DO 290 K = 1, UUB
  910. DO 280 JC = 1, N - 1
  911. IROW = MAX( 1, JC-K )
  912. IL = MIN( JC+1, K+2 )
  913. EXTRA = CZERO
  914. ZTEMP = A( JC-ISKEW*( JC+1 )+IOFFG, JC+1 )
  915. ANGLE = TWOPI*DLARND( 1, ISEED )
  916. C = COS( ANGLE )*ZLARND( 5, ISEED )
  917. S = SIN( ANGLE )*ZLARND( 5, ISEED )
  918. IF( CSYM ) THEN
  919. CT = C
  920. ST = S
  921. ELSE
  922. ZTEMP = DCONJG( ZTEMP )
  923. CT = DCONJG( C )
  924. ST = DCONJG( S )
  925. END IF
  926. CALL ZLAROT( .FALSE., JC.GT.K, .TRUE., IL, C, S,
  927. $ A( IROW-ISKEW*JC+IOFFG, JC ), ILDA,
  928. $ EXTRA, ZTEMP )
  929. CALL ZLAROT( .TRUE., .TRUE., .FALSE.,
  930. $ MIN( K, N-JC )+1, CT, ST,
  931. $ A( ( 1-ISKEW )*JC+IOFFG, JC ), ILDA,
  932. $ ZTEMP, DUMMY )
  933. *
  934. * Chase EXTRA back up the matrix
  935. *
  936. ICOL = JC
  937. DO 270 JCH = JC - K, 1, -K
  938. CALL ZLARTG( A( JCH+1-ISKEW*( ICOL+1 )+IOFFG,
  939. $ ICOL+1 ), EXTRA, REALC, S, DUMMY )
  940. DUMMY = ZLARND( 5, ISEED )
  941. C = DCONJG( REALC*DUMMY )
  942. S = DCONJG( -S*DUMMY )
  943. ZTEMP = A( JCH-ISKEW*( JCH+1 )+IOFFG, JCH+1 )
  944. IF( CSYM ) THEN
  945. CT = C
  946. ST = S
  947. ELSE
  948. ZTEMP = DCONJG( ZTEMP )
  949. CT = DCONJG( C )
  950. ST = DCONJG( S )
  951. END IF
  952. CALL ZLAROT( .TRUE., .TRUE., .TRUE., K+2, C, S,
  953. $ A( ( 1-ISKEW )*JCH+IOFFG, JCH ),
  954. $ ILDA, ZTEMP, EXTRA )
  955. IROW = MAX( 1, JCH-K )
  956. IL = MIN( JCH+1, K+2 )
  957. EXTRA = CZERO
  958. CALL ZLAROT( .FALSE., JCH.GT.K, .TRUE., IL, CT,
  959. $ ST, A( IROW-ISKEW*JCH+IOFFG, JCH ),
  960. $ ILDA, EXTRA, ZTEMP )
  961. ICOL = JCH
  962. 270 CONTINUE
  963. 280 CONTINUE
  964. 290 CONTINUE
  965. *
  966. * If we need lower triangle, copy from upper. Note that
  967. * the order of copying is chosen to work for 'q' -> 'b'
  968. *
  969. IF( IPACK.NE.IPACKG .AND. IPACK.NE.3 ) THEN
  970. DO 320 JC = 1, N
  971. IROW = IOFFST - ISKEW*JC
  972. IF( CSYM ) THEN
  973. DO 300 JR = JC, MIN( N, JC+UUB )
  974. A( JR+IROW, JC ) = A( JC-ISKEW*JR+IOFFG, JR )
  975. 300 CONTINUE
  976. ELSE
  977. DO 310 JR = JC, MIN( N, JC+UUB )
  978. A( JR+IROW, JC ) = DCONJG( A( JC-ISKEW*JR+
  979. $ IOFFG, JR ) )
  980. 310 CONTINUE
  981. END IF
  982. 320 CONTINUE
  983. IF( IPACK.EQ.5 ) THEN
  984. DO 340 JC = N - UUB + 1, N
  985. DO 330 JR = N + 2 - JC, UUB + 1
  986. A( JR, JC ) = CZERO
  987. 330 CONTINUE
  988. 340 CONTINUE
  989. END IF
  990. IF( IPACKG.EQ.6 ) THEN
  991. IPACKG = IPACK
  992. ELSE
  993. IPACKG = 0
  994. END IF
  995. END IF
  996. ELSE
  997. *
  998. * Bottom-Up -- Generate Lower triangle only
  999. *
  1000. IF( IPACK.GE.5 ) THEN
  1001. IPACKG = 5
  1002. IF( IPACK.EQ.6 )
  1003. $ IOFFG = 1
  1004. ELSE
  1005. IPACKG = 2
  1006. END IF
  1007. *
  1008. DO 350 J = 1, MNMIN
  1009. A( ( 1-ISKEW )*J+IOFFG, J ) = DCMPLX( D( J ) )
  1010. 350 CONTINUE
  1011. *
  1012. DO 380 K = 1, UUB
  1013. DO 370 JC = N - 1, 1, -1
  1014. IL = MIN( N+1-JC, K+2 )
  1015. EXTRA = CZERO
  1016. ZTEMP = A( 1+( 1-ISKEW )*JC+IOFFG, JC )
  1017. ANGLE = TWOPI*DLARND( 1, ISEED )
  1018. C = COS( ANGLE )*ZLARND( 5, ISEED )
  1019. S = SIN( ANGLE )*ZLARND( 5, ISEED )
  1020. IF( CSYM ) THEN
  1021. CT = C
  1022. ST = S
  1023. ELSE
  1024. ZTEMP = DCONJG( ZTEMP )
  1025. CT = DCONJG( C )
  1026. ST = DCONJG( S )
  1027. END IF
  1028. CALL ZLAROT( .FALSE., .TRUE., N-JC.GT.K, IL, C, S,
  1029. $ A( ( 1-ISKEW )*JC+IOFFG, JC ), ILDA,
  1030. $ ZTEMP, EXTRA )
  1031. ICOL = MAX( 1, JC-K+1 )
  1032. CALL ZLAROT( .TRUE., .FALSE., .TRUE., JC+2-ICOL,
  1033. $ CT, ST, A( JC-ISKEW*ICOL+IOFFG,
  1034. $ ICOL ), ILDA, DUMMY, ZTEMP )
  1035. *
  1036. * Chase EXTRA back down the matrix
  1037. *
  1038. ICOL = JC
  1039. DO 360 JCH = JC + K, N - 1, K
  1040. CALL ZLARTG( A( JCH-ISKEW*ICOL+IOFFG, ICOL ),
  1041. $ EXTRA, REALC, S, DUMMY )
  1042. DUMMY = ZLARND( 5, ISEED )
  1043. C = REALC*DUMMY
  1044. S = S*DUMMY
  1045. ZTEMP = A( 1+( 1-ISKEW )*JCH+IOFFG, JCH )
  1046. IF( CSYM ) THEN
  1047. CT = C
  1048. ST = S
  1049. ELSE
  1050. ZTEMP = DCONJG( ZTEMP )
  1051. CT = DCONJG( C )
  1052. ST = DCONJG( S )
  1053. END IF
  1054. CALL ZLAROT( .TRUE., .TRUE., .TRUE., K+2, C, S,
  1055. $ A( JCH-ISKEW*ICOL+IOFFG, ICOL ),
  1056. $ ILDA, EXTRA, ZTEMP )
  1057. IL = MIN( N+1-JCH, K+2 )
  1058. EXTRA = CZERO
  1059. CALL ZLAROT( .FALSE., .TRUE., N-JCH.GT.K, IL,
  1060. $ CT, ST, A( ( 1-ISKEW )*JCH+IOFFG,
  1061. $ JCH ), ILDA, ZTEMP, EXTRA )
  1062. ICOL = JCH
  1063. 360 CONTINUE
  1064. 370 CONTINUE
  1065. 380 CONTINUE
  1066. *
  1067. * If we need upper triangle, copy from lower. Note that
  1068. * the order of copying is chosen to work for 'b' -> 'q'
  1069. *
  1070. IF( IPACK.NE.IPACKG .AND. IPACK.NE.4 ) THEN
  1071. DO 410 JC = N, 1, -1
  1072. IROW = IOFFST - ISKEW*JC
  1073. IF( CSYM ) THEN
  1074. DO 390 JR = JC, MAX( 1, JC-UUB ), -1
  1075. A( JR+IROW, JC ) = A( JC-ISKEW*JR+IOFFG, JR )
  1076. 390 CONTINUE
  1077. ELSE
  1078. DO 400 JR = JC, MAX( 1, JC-UUB ), -1
  1079. A( JR+IROW, JC ) = DCONJG( A( JC-ISKEW*JR+
  1080. $ IOFFG, JR ) )
  1081. 400 CONTINUE
  1082. END IF
  1083. 410 CONTINUE
  1084. IF( IPACK.EQ.6 ) THEN
  1085. DO 430 JC = 1, UUB
  1086. DO 420 JR = 1, UUB + 1 - JC
  1087. A( JR, JC ) = CZERO
  1088. 420 CONTINUE
  1089. 430 CONTINUE
  1090. END IF
  1091. IF( IPACKG.EQ.5 ) THEN
  1092. IPACKG = IPACK
  1093. ELSE
  1094. IPACKG = 0
  1095. END IF
  1096. END IF
  1097. END IF
  1098. *
  1099. * Ensure that the diagonal is real if Hermitian
  1100. *
  1101. IF( .NOT.CSYM ) THEN
  1102. DO 440 JC = 1, N
  1103. IROW = IOFFST + ( 1-ISKEW )*JC
  1104. A( IROW, JC ) = DCMPLX( DBLE( A( IROW, JC ) ) )
  1105. 440 CONTINUE
  1106. END IF
  1107. *
  1108. END IF
  1109. *
  1110. ELSE
  1111. *
  1112. * 4) Generate Banded Matrix by first
  1113. * Rotating by random Unitary matrices,
  1114. * then reducing the bandwidth using Householder
  1115. * transformations.
  1116. *
  1117. * Note: we should get here only if LDA .ge. N
  1118. *
  1119. IF( ISYM.EQ.1 ) THEN
  1120. *
  1121. * Non-symmetric -- A = U D V
  1122. *
  1123. CALL ZLAGGE( MR, NC, LLB, UUB, D, A, LDA, ISEED, WORK,
  1124. $ IINFO )
  1125. ELSE
  1126. *
  1127. * Symmetric -- A = U D U' or
  1128. * Hermitian -- A = U D U*
  1129. *
  1130. IF( CSYM ) THEN
  1131. CALL ZLAGSY( M, LLB, D, A, LDA, ISEED, WORK, IINFO )
  1132. ELSE
  1133. CALL ZLAGHE( M, LLB, D, A, LDA, ISEED, WORK, IINFO )
  1134. END IF
  1135. END IF
  1136. *
  1137. IF( IINFO.NE.0 ) THEN
  1138. INFO = 3
  1139. RETURN
  1140. END IF
  1141. END IF
  1142. *
  1143. * 5) Pack the matrix
  1144. *
  1145. IF( IPACK.NE.IPACKG ) THEN
  1146. IF( IPACK.EQ.1 ) THEN
  1147. *
  1148. * 'U' -- Upper triangular, not packed
  1149. *
  1150. DO 460 J = 1, M
  1151. DO 450 I = J + 1, M
  1152. A( I, J ) = CZERO
  1153. 450 CONTINUE
  1154. 460 CONTINUE
  1155. *
  1156. ELSE IF( IPACK.EQ.2 ) THEN
  1157. *
  1158. * 'L' -- Lower triangular, not packed
  1159. *
  1160. DO 480 J = 2, M
  1161. DO 470 I = 1, J - 1
  1162. A( I, J ) = CZERO
  1163. 470 CONTINUE
  1164. 480 CONTINUE
  1165. *
  1166. ELSE IF( IPACK.EQ.3 ) THEN
  1167. *
  1168. * 'C' -- Upper triangle packed Columnwise.
  1169. *
  1170. ICOL = 1
  1171. IROW = 0
  1172. DO 500 J = 1, M
  1173. DO 490 I = 1, J
  1174. IROW = IROW + 1
  1175. IF( IROW.GT.LDA ) THEN
  1176. IROW = 1
  1177. ICOL = ICOL + 1
  1178. END IF
  1179. A( IROW, ICOL ) = A( I, J )
  1180. 490 CONTINUE
  1181. 500 CONTINUE
  1182. *
  1183. ELSE IF( IPACK.EQ.4 ) THEN
  1184. *
  1185. * 'R' -- Lower triangle packed Columnwise.
  1186. *
  1187. ICOL = 1
  1188. IROW = 0
  1189. DO 520 J = 1, M
  1190. DO 510 I = J, M
  1191. IROW = IROW + 1
  1192. IF( IROW.GT.LDA ) THEN
  1193. IROW = 1
  1194. ICOL = ICOL + 1
  1195. END IF
  1196. A( IROW, ICOL ) = A( I, J )
  1197. 510 CONTINUE
  1198. 520 CONTINUE
  1199. *
  1200. ELSE IF( IPACK.GE.5 ) THEN
  1201. *
  1202. * 'B' -- The lower triangle is packed as a band matrix.
  1203. * 'Q' -- The upper triangle is packed as a band matrix.
  1204. * 'Z' -- The whole matrix is packed as a band matrix.
  1205. *
  1206. IF( IPACK.EQ.5 )
  1207. $ UUB = 0
  1208. IF( IPACK.EQ.6 )
  1209. $ LLB = 0
  1210. *
  1211. DO 540 J = 1, UUB
  1212. DO 530 I = MIN( J+LLB, M ), 1, -1
  1213. A( I-J+UUB+1, J ) = A( I, J )
  1214. 530 CONTINUE
  1215. 540 CONTINUE
  1216. *
  1217. DO 560 J = UUB + 2, N
  1218. DO 550 I = J - UUB, MIN( J+LLB, M )
  1219. A( I-J+UUB+1, J ) = A( I, J )
  1220. 550 CONTINUE
  1221. 560 CONTINUE
  1222. END IF
  1223. *
  1224. * If packed, zero out extraneous elements.
  1225. *
  1226. * Symmetric/Triangular Packed --
  1227. * zero out everything after A(IROW,ICOL)
  1228. *
  1229. IF( IPACK.EQ.3 .OR. IPACK.EQ.4 ) THEN
  1230. DO 580 JC = ICOL, M
  1231. DO 570 JR = IROW + 1, LDA
  1232. A( JR, JC ) = CZERO
  1233. 570 CONTINUE
  1234. IROW = 0
  1235. 580 CONTINUE
  1236. *
  1237. ELSE IF( IPACK.GE.5 ) THEN
  1238. *
  1239. * Packed Band --
  1240. * 1st row is now in A( UUB+2-j, j), zero above it
  1241. * m-th row is now in A( M+UUB-j,j), zero below it
  1242. * last non-zero diagonal is now in A( UUB+LLB+1,j ),
  1243. * zero below it, too.
  1244. *
  1245. IR1 = UUB + LLB + 2
  1246. IR2 = UUB + M + 2
  1247. DO 610 JC = 1, N
  1248. DO 590 JR = 1, UUB + 1 - JC
  1249. A( JR, JC ) = CZERO
  1250. 590 CONTINUE
  1251. DO 600 JR = MAX( 1, MIN( IR1, IR2-JC ) ), LDA
  1252. A( JR, JC ) = CZERO
  1253. 600 CONTINUE
  1254. 610 CONTINUE
  1255. END IF
  1256. END IF
  1257. *
  1258. RETURN
  1259. *
  1260. * End of ZLATMT
  1261. *
  1262. END