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.

zlatms.f 46 kB

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