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.

zlatmr.f 48 kB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339
  1. *> \brief \b ZLATMR
  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 ZLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX,
  12. * RSIGN, GRADE, DL, MODEL, CONDL, DR, MODER,
  13. * CONDR, PIVTNG, IPIVOT, KL, KU, SPARSE, ANORM,
  14. * PACK, A, LDA, IWORK, INFO )
  15. *
  16. * .. Scalar Arguments ..
  17. * CHARACTER DIST, GRADE, PACK, PIVTNG, RSIGN, SYM
  18. * INTEGER INFO, KL, KU, LDA, M, MODE, MODEL, MODER, N
  19. * DOUBLE PRECISION ANORM, COND, CONDL, CONDR, SPARSE
  20. * COMPLEX*16 DMAX
  21. * ..
  22. * .. Array Arguments ..
  23. * INTEGER IPIVOT( * ), ISEED( 4 ), IWORK( * )
  24. * COMPLEX*16 A( LDA, * ), D( * ), DL( * ), DR( * )
  25. * ..
  26. *
  27. *
  28. *> \par Purpose:
  29. * =============
  30. *>
  31. *> \verbatim
  32. *>
  33. *> ZLATMR generates random matrices of various types for testing
  34. *> LAPACK programs.
  35. *>
  36. *> ZLATMR operates by applying the following sequence of
  37. *> operations:
  38. *>
  39. *> Generate a matrix A with random entries of distribution DIST
  40. *> which is symmetric if SYM='S', Hermitian if SYM='H', and
  41. *> nonsymmetric if SYM='N'.
  42. *>
  43. *> Set the diagonal to D, where D may be input or
  44. *> computed according to MODE, COND, DMAX and RSIGN
  45. *> as described below.
  46. *>
  47. *> Grade the matrix, if desired, from the left and/or right
  48. *> as specified by GRADE. The inputs DL, MODEL, CONDL, DR,
  49. *> MODER and CONDR also determine the grading as described
  50. *> below.
  51. *>
  52. *> Permute, if desired, the rows and/or columns as specified by
  53. *> PIVTNG and IPIVOT.
  54. *>
  55. *> Set random entries to zero, if desired, to get a random sparse
  56. *> matrix as specified by SPARSE.
  57. *>
  58. *> Make A a band matrix, if desired, by zeroing out the matrix
  59. *> outside a band of lower bandwidth KL and upper bandwidth KU.
  60. *>
  61. *> Scale A, if desired, to have maximum entry ANORM.
  62. *>
  63. *> Pack the matrix if desired. Options specified by PACK are:
  64. *> no packing
  65. *> zero out upper half (if symmetric or Hermitian)
  66. *> zero out lower half (if symmetric or Hermitian)
  67. *> store the upper half columnwise (if symmetric or Hermitian
  68. *> or square upper triangular)
  69. *> store the lower half columnwise (if symmetric or Hermitian
  70. *> or square lower triangular)
  71. *> same as upper half rowwise if symmetric
  72. *> same as conjugate upper half rowwise if Hermitian
  73. *> store the lower triangle in banded format
  74. *> (if symmetric or Hermitian)
  75. *> store the upper triangle in banded format
  76. *> (if symmetric or Hermitian)
  77. *> store the entire matrix in banded format
  78. *>
  79. *> Note: If two calls to ZLATMR differ only in the PACK parameter,
  80. *> they will generate mathematically equivalent matrices.
  81. *>
  82. *> If two calls to ZLATMR both have full bandwidth (KL = M-1
  83. *> and KU = N-1), and differ only in the PIVTNG and PACK
  84. *> parameters, then the matrices generated will differ only
  85. *> in the order of the rows and/or columns, and otherwise
  86. *> contain the same data. This consistency cannot be and
  87. *> is not maintained with less than full bandwidth.
  88. *> \endverbatim
  89. *
  90. * Arguments:
  91. * ==========
  92. *
  93. *> \param[in] M
  94. *> \verbatim
  95. *> M is INTEGER
  96. *> Number of rows of A. Not modified.
  97. *> \endverbatim
  98. *>
  99. *> \param[in] N
  100. *> \verbatim
  101. *> N is INTEGER
  102. *> Number of columns of A. Not modified.
  103. *> \endverbatim
  104. *>
  105. *> \param[in] DIST
  106. *> \verbatim
  107. *> DIST is CHARACTER*1
  108. *> On entry, DIST specifies the type of distribution to be used
  109. *> to generate a random matrix .
  110. *> 'U' => real and imaginary parts are independent
  111. *> UNIFORM( 0, 1 ) ( 'U' for uniform )
  112. *> 'S' => real and imaginary parts are independent
  113. *> UNIFORM( -1, 1 ) ( 'S' for symmetric )
  114. *> 'N' => real and imaginary parts are independent
  115. *> NORMAL( 0, 1 ) ( 'N' for normal )
  116. *> 'D' => uniform on interior of unit disk ( 'D' for disk )
  117. *> Not modified.
  118. *> \endverbatim
  119. *>
  120. *> \param[in,out] ISEED
  121. *> \verbatim
  122. *> ISEED is INTEGER array, dimension (4)
  123. *> On entry ISEED specifies the seed of the random number
  124. *> generator. They should lie between 0 and 4095 inclusive,
  125. *> and ISEED(4) should be odd. The random number generator
  126. *> uses a linear congruential sequence limited to small
  127. *> integers, and so should produce machine independent
  128. *> random numbers. The values of ISEED are changed on
  129. *> exit, and can be used in the next call to ZLATMR
  130. *> to continue the same random number sequence.
  131. *> Changed on exit.
  132. *> \endverbatim
  133. *>
  134. *> \param[in] SYM
  135. *> \verbatim
  136. *> SYM is CHARACTER*1
  137. *> If SYM='S', generated matrix is symmetric.
  138. *> If SYM='H', generated matrix is Hermitian.
  139. *> If SYM='N', generated matrix is nonsymmetric.
  140. *> Not modified.
  141. *> \endverbatim
  142. *>
  143. *> \param[in,out] D
  144. *> \verbatim
  145. *> D is COMPLEX*16 array, dimension (min(M,N))
  146. *> On entry this array specifies the diagonal entries
  147. *> of the diagonal of A. D may either be specified
  148. *> on entry, or set according to MODE and COND as described
  149. *> below. If the matrix is Hermitian, the real part of D
  150. *> will be taken. May be changed on exit if MODE is nonzero.
  151. *> \endverbatim
  152. *>
  153. *> \param[in] MODE
  154. *> \verbatim
  155. *> MODE is INTEGER
  156. *> On entry describes how D is to be used:
  157. *> MODE = 0 means use D as input
  158. *> MODE = 1 sets D(1)=1 and D(2:N)=1.0/COND
  159. *> MODE = 2 sets D(1:N-1)=1 and D(N)=1.0/COND
  160. *> MODE = 3 sets D(I)=COND**(-(I-1)/(N-1))
  161. *> MODE = 4 sets D(i)=1 - (i-1)/(N-1)*(1 - 1/COND)
  162. *> MODE = 5 sets D to random numbers in the range
  163. *> ( 1/COND , 1 ) such that their logarithms
  164. *> are uniformly distributed.
  165. *> MODE = 6 set D to random numbers from same distribution
  166. *> as the rest of the matrix.
  167. *> MODE < 0 has the same meaning as ABS(MODE), except that
  168. *> the order of the elements of D is reversed.
  169. *> Thus if MODE is positive, D has entries ranging from
  170. *> 1 to 1/COND, if negative, from 1/COND to 1,
  171. *> Not modified.
  172. *> \endverbatim
  173. *>
  174. *> \param[in] COND
  175. *> \verbatim
  176. *> COND is DOUBLE PRECISION
  177. *> On entry, used as described under MODE above.
  178. *> If used, it must be >= 1. Not modified.
  179. *> \endverbatim
  180. *>
  181. *> \param[in] DMAX
  182. *> \verbatim
  183. *> DMAX is COMPLEX*16
  184. *> If MODE neither -6, 0 nor 6, the diagonal is scaled by
  185. *> DMAX / max(abs(D(i))), so that maximum absolute entry
  186. *> of diagonal is abs(DMAX). If DMAX is complex (or zero),
  187. *> diagonal will be scaled by a complex number (or zero).
  188. *> \endverbatim
  189. *>
  190. *> \param[in] RSIGN
  191. *> \verbatim
  192. *> RSIGN is CHARACTER*1
  193. *> If MODE neither -6, 0 nor 6, specifies sign of diagonal
  194. *> as follows:
  195. *> 'T' => diagonal entries are multiplied by a random complex
  196. *> number uniformly distributed with absolute value 1
  197. *> 'F' => diagonal unchanged
  198. *> Not modified.
  199. *> \endverbatim
  200. *>
  201. *> \param[in] GRADE
  202. *> \verbatim
  203. *> GRADE is CHARACTER*1
  204. *> Specifies grading of matrix as follows:
  205. *> 'N' => no grading
  206. *> 'L' => matrix premultiplied by diag( DL )
  207. *> (only if matrix nonsymmetric)
  208. *> 'R' => matrix postmultiplied by diag( DR )
  209. *> (only if matrix nonsymmetric)
  210. *> 'B' => matrix premultiplied by diag( DL ) and
  211. *> postmultiplied by diag( DR )
  212. *> (only if matrix nonsymmetric)
  213. *> 'H' => matrix premultiplied by diag( DL ) and
  214. *> postmultiplied by diag( CONJG(DL) )
  215. *> (only if matrix Hermitian or nonsymmetric)
  216. *> 'S' => matrix premultiplied by diag( DL ) and
  217. *> postmultiplied by diag( DL )
  218. *> (only if matrix symmetric or nonsymmetric)
  219. *> 'E' => matrix premultiplied by diag( DL ) and
  220. *> postmultiplied by inv( diag( DL ) )
  221. *> ( 'S' for similarity )
  222. *> (only if matrix nonsymmetric)
  223. *> Note: if GRADE='S', then M must equal N.
  224. *> Not modified.
  225. *> \endverbatim
  226. *>
  227. *> \param[in,out] DL
  228. *> \verbatim
  229. *> DL is COMPLEX*16 array, dimension (M)
  230. *> If MODEL=0, then on entry this array specifies the diagonal
  231. *> entries of a diagonal matrix used as described under GRADE
  232. *> above. If MODEL is not zero, then DL will be set according
  233. *> to MODEL and CONDL, analogous to the way D is set according
  234. *> to MODE and COND (except there is no DMAX parameter for DL).
  235. *> If GRADE='E', then DL cannot have zero entries.
  236. *> Not referenced if GRADE = 'N' or 'R'. Changed on exit.
  237. *> \endverbatim
  238. *>
  239. *> \param[in] MODEL
  240. *> \verbatim
  241. *> MODEL is INTEGER
  242. *> This specifies how the diagonal array DL is to be computed,
  243. *> just as MODE specifies how D is to be computed.
  244. *> Not modified.
  245. *> \endverbatim
  246. *>
  247. *> \param[in] CONDL
  248. *> \verbatim
  249. *> CONDL is DOUBLE PRECISION
  250. *> When MODEL is not zero, this specifies the condition number
  251. *> of the computed DL. Not modified.
  252. *> \endverbatim
  253. *>
  254. *> \param[in,out] DR
  255. *> \verbatim
  256. *> DR is COMPLEX*16 array, dimension (N)
  257. *> If MODER=0, then on entry this array specifies the diagonal
  258. *> entries of a diagonal matrix used as described under GRADE
  259. *> above. If MODER is not zero, then DR will be set according
  260. *> to MODER and CONDR, analogous to the way D is set according
  261. *> to MODE and COND (except there is no DMAX parameter for DR).
  262. *> Not referenced if GRADE = 'N', 'L', 'H' or 'S'.
  263. *> Changed on exit.
  264. *> \endverbatim
  265. *>
  266. *> \param[in] MODER
  267. *> \verbatim
  268. *> MODER is INTEGER
  269. *> This specifies how the diagonal array DR is to be computed,
  270. *> just as MODE specifies how D is to be computed.
  271. *> Not modified.
  272. *> \endverbatim
  273. *>
  274. *> \param[in] CONDR
  275. *> \verbatim
  276. *> CONDR is DOUBLE PRECISION
  277. *> When MODER is not zero, this specifies the condition number
  278. *> of the computed DR. Not modified.
  279. *> \endverbatim
  280. *>
  281. *> \param[in] PIVTNG
  282. *> \verbatim
  283. *> PIVTNG is CHARACTER*1
  284. *> On entry specifies pivoting permutations as follows:
  285. *> 'N' or ' ' => none.
  286. *> 'L' => left or row pivoting (matrix must be nonsymmetric).
  287. *> 'R' => right or column pivoting (matrix must be
  288. *> nonsymmetric).
  289. *> 'B' or 'F' => both or full pivoting, i.e., on both sides.
  290. *> In this case, M must equal N
  291. *>
  292. *> If two calls to ZLATMR both have full bandwidth (KL = M-1
  293. *> and KU = N-1), and differ only in the PIVTNG and PACK
  294. *> parameters, then the matrices generated will differ only
  295. *> in the order of the rows and/or columns, and otherwise
  296. *> contain the same data. This consistency cannot be
  297. *> maintained with less than full bandwidth.
  298. *> \endverbatim
  299. *>
  300. *> \param[in] IPIVOT
  301. *> \verbatim
  302. *> IPIVOT is INTEGER array, dimension (N or M)
  303. *> This array specifies the permutation used. After the
  304. *> basic matrix is generated, the rows, columns, or both
  305. *> are permuted. If, say, row pivoting is selected, ZLATMR
  306. *> starts with the *last* row and interchanges the M-th and
  307. *> IPIVOT(M)-th rows, then moves to the next-to-last row,
  308. *> interchanging the (M-1)-th and the IPIVOT(M-1)-th rows,
  309. *> and so on. In terms of "2-cycles", the permutation is
  310. *> (1 IPIVOT(1)) (2 IPIVOT(2)) ... (M IPIVOT(M))
  311. *> where the rightmost cycle is applied first. This is the
  312. *> *inverse* of the effect of pivoting in LINPACK. The idea
  313. *> is that factoring (with pivoting) an identity matrix
  314. *> which has been inverse-pivoted in this way should
  315. *> result in a pivot vector identical to IPIVOT.
  316. *> Not referenced if PIVTNG = 'N'. Not modified.
  317. *> \endverbatim
  318. *>
  319. *> \param[in] KL
  320. *> \verbatim
  321. *> KL is INTEGER
  322. *> On entry specifies the lower bandwidth of the matrix. For
  323. *> example, KL=0 implies upper triangular, KL=1 implies upper
  324. *> Hessenberg, and KL at least M-1 implies the matrix is not
  325. *> banded. Must equal KU if matrix is symmetric or Hermitian.
  326. *> Not modified.
  327. *> \endverbatim
  328. *>
  329. *> \param[in] KU
  330. *> \verbatim
  331. *> KU is INTEGER
  332. *> On entry specifies the upper bandwidth of the matrix. For
  333. *> example, KU=0 implies lower triangular, KU=1 implies lower
  334. *> Hessenberg, and KU at least N-1 implies the matrix is not
  335. *> banded. Must equal KL if matrix is symmetric or Hermitian.
  336. *> Not modified.
  337. *> \endverbatim
  338. *>
  339. *> \param[in] SPARSE
  340. *> \verbatim
  341. *> SPARSE is DOUBLE PRECISION
  342. *> On entry specifies the sparsity of the matrix if a sparse
  343. *> matrix is to be generated. SPARSE should lie between
  344. *> 0 and 1. To generate a sparse matrix, for each matrix entry
  345. *> a uniform ( 0, 1 ) random number x is generated and
  346. *> compared to SPARSE; if x is larger the matrix entry
  347. *> is unchanged and if x is smaller the entry is set
  348. *> to zero. Thus on the average a fraction SPARSE of the
  349. *> entries will be set to zero.
  350. *> Not modified.
  351. *> \endverbatim
  352. *>
  353. *> \param[in] ANORM
  354. *> \verbatim
  355. *> ANORM is DOUBLE PRECISION
  356. *> On entry specifies maximum entry of output matrix
  357. *> (output matrix will by multiplied by a constant so that
  358. *> its largest absolute entry equal ANORM)
  359. *> if ANORM is nonnegative. If ANORM is negative no scaling
  360. *> is done. Not modified.
  361. *> \endverbatim
  362. *>
  363. *> \param[in] PACK
  364. *> \verbatim
  365. *> PACK is CHARACTER*1
  366. *> On entry specifies packing of matrix as follows:
  367. *> 'N' => no packing
  368. *> 'U' => zero out all subdiagonal entries
  369. *> (if symmetric or Hermitian)
  370. *> 'L' => zero out all superdiagonal entries
  371. *> (if symmetric or Hermitian)
  372. *> 'C' => store the upper triangle columnwise
  373. *> (only if matrix symmetric or Hermitian or
  374. *> square upper triangular)
  375. *> 'R' => store the lower triangle columnwise
  376. *> (only if matrix symmetric or Hermitian or
  377. *> square lower triangular)
  378. *> (same as upper half rowwise if symmetric)
  379. *> (same as conjugate upper half rowwise if Hermitian)
  380. *> 'B' => store the lower triangle in band storage scheme
  381. *> (only if matrix symmetric or Hermitian)
  382. *> 'Q' => store the upper triangle in band storage scheme
  383. *> (only if matrix symmetric or Hermitian)
  384. *> 'Z' => store the entire matrix in band storage scheme
  385. *> (pivoting can be provided for by using this
  386. *> option to store A in the trailing rows of
  387. *> the allocated storage)
  388. *>
  389. *> Using these options, the various LAPACK packed and banded
  390. *> storage schemes can be obtained:
  391. *> GB - use 'Z'
  392. *> PB, HB or TB - use 'B' or 'Q'
  393. *> PP, HP or TP - use 'C' or 'R'
  394. *>
  395. *> If two calls to ZLATMR differ only in the PACK parameter,
  396. *> they will generate mathematically equivalent matrices.
  397. *> Not modified.
  398. *> \endverbatim
  399. *>
  400. *> \param[in,out] A
  401. *> \verbatim
  402. *> A is COMPLEX*16 array, dimension (LDA,N)
  403. *> On exit A is the desired test matrix. Only those
  404. *> entries of A which are significant on output
  405. *> will be referenced (even if A is in packed or band
  406. *> storage format). The 'unoccupied corners' of A in
  407. *> band format will be zeroed out.
  408. *> \endverbatim
  409. *>
  410. *> \param[in] LDA
  411. *> \verbatim
  412. *> LDA is INTEGER
  413. *> on entry LDA specifies the first dimension of A as
  414. *> declared in the calling program.
  415. *> If PACK='N', 'U' or 'L', LDA must be at least max ( 1, M ).
  416. *> If PACK='C' or 'R', LDA must be at least 1.
  417. *> If PACK='B', or 'Q', LDA must be MIN ( KU+1, N )
  418. *> If PACK='Z', LDA must be at least KUU+KLL+1, where
  419. *> KUU = MIN ( KU, N-1 ) and KLL = MIN ( KL, M-1 )
  420. *> Not modified.
  421. *> \endverbatim
  422. *>
  423. *> \param[out] IWORK
  424. *> \verbatim
  425. *> IWORK is INTEGER array, dimension (N or M)
  426. *> Workspace. Not referenced if PIVTNG = 'N'. Changed on exit.
  427. *> \endverbatim
  428. *>
  429. *> \param[out] INFO
  430. *> \verbatim
  431. *> INFO is INTEGER
  432. *> Error parameter on exit:
  433. *> 0 => normal return
  434. *> -1 => M negative or unequal to N and SYM='S' or 'H'
  435. *> -2 => N negative
  436. *> -3 => DIST illegal string
  437. *> -5 => SYM illegal string
  438. *> -7 => MODE not in range -6 to 6
  439. *> -8 => COND less than 1.0, and MODE neither -6, 0 nor 6
  440. *> -10 => MODE neither -6, 0 nor 6 and RSIGN illegal string
  441. *> -11 => GRADE illegal string, or GRADE='E' and
  442. *> M not equal to N, or GRADE='L', 'R', 'B', 'S' or 'E'
  443. *> and SYM = 'H', or GRADE='L', 'R', 'B', 'H' or 'E'
  444. *> and SYM = 'S'
  445. *> -12 => GRADE = 'E' and DL contains zero
  446. *> -13 => MODEL not in range -6 to 6 and GRADE= 'L', 'B', 'H',
  447. *> 'S' or 'E'
  448. *> -14 => CONDL less than 1.0, GRADE='L', 'B', 'H', 'S' or 'E',
  449. *> and MODEL neither -6, 0 nor 6
  450. *> -16 => MODER not in range -6 to 6 and GRADE= 'R' or 'B'
  451. *> -17 => CONDR less than 1.0, GRADE='R' or 'B', and
  452. *> MODER neither -6, 0 nor 6
  453. *> -18 => PIVTNG illegal string, or PIVTNG='B' or 'F' and
  454. *> M not equal to N, or PIVTNG='L' or 'R' and SYM='S'
  455. *> or 'H'
  456. *> -19 => IPIVOT contains out of range number and
  457. *> PIVTNG not equal to 'N'
  458. *> -20 => KL negative
  459. *> -21 => KU negative, or SYM='S' or 'H' and KU not equal to KL
  460. *> -22 => SPARSE not in range 0. to 1.
  461. *> -24 => PACK illegal string, or PACK='U', 'L', 'B' or 'Q'
  462. *> and SYM='N', or PACK='C' and SYM='N' and either KL
  463. *> not equal to 0 or N not equal to M, or PACK='R' and
  464. *> SYM='N', and either KU not equal to 0 or N not equal
  465. *> to M
  466. *> -26 => LDA too small
  467. *> 1 => Error return from ZLATM1 (computing D)
  468. *> 2 => Cannot scale diagonal to DMAX (max. entry is 0)
  469. *> 3 => Error return from ZLATM1 (computing DL)
  470. *> 4 => Error return from ZLATM1 (computing DR)
  471. *> 5 => ANORM is positive, but matrix constructed prior to
  472. *> attempting to scale it to have norm ANORM, is zero
  473. *> \endverbatim
  474. *
  475. * Authors:
  476. * ========
  477. *
  478. *> \author Univ. of Tennessee
  479. *> \author Univ. of California Berkeley
  480. *> \author Univ. of Colorado Denver
  481. *> \author NAG Ltd.
  482. *
  483. *> \ingroup complex16_matgen
  484. *
  485. * =====================================================================
  486. SUBROUTINE ZLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX,
  487. $ RSIGN, GRADE, DL, MODEL, CONDL, DR, MODER,
  488. $ CONDR, PIVTNG, IPIVOT, KL, KU, SPARSE, ANORM,
  489. $ PACK, A, LDA, IWORK, INFO )
  490. *
  491. * -- LAPACK computational routine --
  492. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  493. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  494. *
  495. * .. Scalar Arguments ..
  496. CHARACTER DIST, GRADE, PACK, PIVTNG, RSIGN, SYM
  497. INTEGER INFO, KL, KU, LDA, M, MODE, MODEL, MODER, N
  498. DOUBLE PRECISION ANORM, COND, CONDL, CONDR, SPARSE
  499. COMPLEX*16 DMAX
  500. * ..
  501. * .. Array Arguments ..
  502. INTEGER IPIVOT( * ), ISEED( 4 ), IWORK( * )
  503. COMPLEX*16 A( LDA, * ), D( * ), DL( * ), DR( * )
  504. * ..
  505. *
  506. * =====================================================================
  507. *
  508. * .. Parameters ..
  509. DOUBLE PRECISION ZERO
  510. PARAMETER ( ZERO = 0.0D0 )
  511. DOUBLE PRECISION ONE
  512. PARAMETER ( ONE = 1.0D0 )
  513. COMPLEX*16 CONE
  514. PARAMETER ( CONE = ( 1.0D0, 0.0D0 ) )
  515. COMPLEX*16 CZERO
  516. PARAMETER ( CZERO = ( 0.0D0, 0.0D0 ) )
  517. * ..
  518. * .. Local Scalars ..
  519. LOGICAL BADPVT, DZERO, FULBND
  520. INTEGER I, IDIST, IGRADE, IISUB, IPACK, IPVTNG, IRSIGN,
  521. $ ISUB, ISYM, J, JJSUB, JSUB, K, KLL, KUU, MNMIN,
  522. $ MNSUB, MXSUB, NPVTS
  523. DOUBLE PRECISION ONORM, TEMP
  524. COMPLEX*16 CALPHA, CTEMP
  525. * ..
  526. * .. Local Arrays ..
  527. DOUBLE PRECISION TEMPA( 1 )
  528. * ..
  529. * .. External Functions ..
  530. LOGICAL LSAME
  531. DOUBLE PRECISION ZLANGB, ZLANGE, ZLANSB, ZLANSP, ZLANSY
  532. COMPLEX*16 ZLATM2, ZLATM3
  533. EXTERNAL LSAME, ZLANGB, ZLANGE, ZLANSB, ZLANSP, ZLANSY,
  534. $ ZLATM2, ZLATM3
  535. * ..
  536. * .. External Subroutines ..
  537. EXTERNAL XERBLA, ZDSCAL, ZLATM1
  538. * ..
  539. * .. Intrinsic Functions ..
  540. INTRINSIC ABS, DBLE, DCONJG, MAX, MIN, MOD
  541. * ..
  542. * .. Executable Statements ..
  543. *
  544. * 1) Decode and Test the input parameters.
  545. * Initialize flags & seed.
  546. *
  547. INFO = 0
  548. *
  549. * Quick return if possible
  550. *
  551. IF( M.EQ.0 .OR. N.EQ.0 )
  552. $ RETURN
  553. *
  554. * Decode DIST
  555. *
  556. IF( LSAME( DIST, 'U' ) ) THEN
  557. IDIST = 1
  558. ELSE IF( LSAME( DIST, 'S' ) ) THEN
  559. IDIST = 2
  560. ELSE IF( LSAME( DIST, 'N' ) ) THEN
  561. IDIST = 3
  562. ELSE IF( LSAME( DIST, 'D' ) ) THEN
  563. IDIST = 4
  564. ELSE
  565. IDIST = -1
  566. END IF
  567. *
  568. * Decode SYM
  569. *
  570. IF( LSAME( SYM, 'H' ) ) THEN
  571. ISYM = 0
  572. ELSE IF( LSAME( SYM, 'N' ) ) THEN
  573. ISYM = 1
  574. ELSE IF( LSAME( SYM, 'S' ) ) THEN
  575. ISYM = 2
  576. ELSE
  577. ISYM = -1
  578. END IF
  579. *
  580. * Decode RSIGN
  581. *
  582. IF( LSAME( RSIGN, 'F' ) ) THEN
  583. IRSIGN = 0
  584. ELSE IF( LSAME( RSIGN, 'T' ) ) THEN
  585. IRSIGN = 1
  586. ELSE
  587. IRSIGN = -1
  588. END IF
  589. *
  590. * Decode PIVTNG
  591. *
  592. IF( LSAME( PIVTNG, 'N' ) ) THEN
  593. IPVTNG = 0
  594. ELSE IF( LSAME( PIVTNG, ' ' ) ) THEN
  595. IPVTNG = 0
  596. ELSE IF( LSAME( PIVTNG, 'L' ) ) THEN
  597. IPVTNG = 1
  598. NPVTS = M
  599. ELSE IF( LSAME( PIVTNG, 'R' ) ) THEN
  600. IPVTNG = 2
  601. NPVTS = N
  602. ELSE IF( LSAME( PIVTNG, 'B' ) ) THEN
  603. IPVTNG = 3
  604. NPVTS = MIN( N, M )
  605. ELSE IF( LSAME( PIVTNG, 'F' ) ) THEN
  606. IPVTNG = 3
  607. NPVTS = MIN( N, M )
  608. ELSE
  609. IPVTNG = -1
  610. END IF
  611. *
  612. * Decode GRADE
  613. *
  614. IF( LSAME( GRADE, 'N' ) ) THEN
  615. IGRADE = 0
  616. ELSE IF( LSAME( GRADE, 'L' ) ) THEN
  617. IGRADE = 1
  618. ELSE IF( LSAME( GRADE, 'R' ) ) THEN
  619. IGRADE = 2
  620. ELSE IF( LSAME( GRADE, 'B' ) ) THEN
  621. IGRADE = 3
  622. ELSE IF( LSAME( GRADE, 'E' ) ) THEN
  623. IGRADE = 4
  624. ELSE IF( LSAME( GRADE, 'H' ) ) THEN
  625. IGRADE = 5
  626. ELSE IF( LSAME( GRADE, 'S' ) ) THEN
  627. IGRADE = 6
  628. ELSE
  629. IGRADE = -1
  630. END IF
  631. *
  632. * Decode PACK
  633. *
  634. IF( LSAME( PACK, 'N' ) ) THEN
  635. IPACK = 0
  636. ELSE IF( LSAME( PACK, 'U' ) ) THEN
  637. IPACK = 1
  638. ELSE IF( LSAME( PACK, 'L' ) ) THEN
  639. IPACK = 2
  640. ELSE IF( LSAME( PACK, 'C' ) ) THEN
  641. IPACK = 3
  642. ELSE IF( LSAME( PACK, 'R' ) ) THEN
  643. IPACK = 4
  644. ELSE IF( LSAME( PACK, 'B' ) ) THEN
  645. IPACK = 5
  646. ELSE IF( LSAME( PACK, 'Q' ) ) THEN
  647. IPACK = 6
  648. ELSE IF( LSAME( PACK, 'Z' ) ) THEN
  649. IPACK = 7
  650. ELSE
  651. IPACK = -1
  652. END IF
  653. *
  654. * Set certain internal parameters
  655. *
  656. MNMIN = MIN( M, N )
  657. KLL = MIN( KL, M-1 )
  658. KUU = MIN( KU, N-1 )
  659. *
  660. * If inv(DL) is used, check to see if DL has a zero entry.
  661. *
  662. DZERO = .FALSE.
  663. IF( IGRADE.EQ.4 .AND. MODEL.EQ.0 ) THEN
  664. DO 10 I = 1, M
  665. IF( DL( I ).EQ.CZERO )
  666. $ DZERO = .TRUE.
  667. 10 CONTINUE
  668. END IF
  669. *
  670. * Check values in IPIVOT
  671. *
  672. BADPVT = .FALSE.
  673. IF( IPVTNG.GT.0 ) THEN
  674. DO 20 J = 1, NPVTS
  675. IF( IPIVOT( J ).LE.0 .OR. IPIVOT( J ).GT.NPVTS )
  676. $ BADPVT = .TRUE.
  677. 20 CONTINUE
  678. END IF
  679. *
  680. * Set INFO if an error
  681. *
  682. IF( M.LT.0 ) THEN
  683. INFO = -1
  684. ELSE IF( M.NE.N .AND. ( ISYM.EQ.0 .OR. ISYM.EQ.2 ) ) THEN
  685. INFO = -1
  686. ELSE IF( N.LT.0 ) THEN
  687. INFO = -2
  688. ELSE IF( IDIST.EQ.-1 ) THEN
  689. INFO = -3
  690. ELSE IF( ISYM.EQ.-1 ) THEN
  691. INFO = -5
  692. ELSE IF( MODE.LT.-6 .OR. MODE.GT.6 ) THEN
  693. INFO = -7
  694. ELSE IF( ( MODE.NE.-6 .AND. MODE.NE.0 .AND. MODE.NE.6 ) .AND.
  695. $ COND.LT.ONE ) THEN
  696. INFO = -8
  697. ELSE IF( ( MODE.NE.-6 .AND. MODE.NE.0 .AND. MODE.NE.6 ) .AND.
  698. $ IRSIGN.EQ.-1 ) THEN
  699. INFO = -10
  700. ELSE IF( IGRADE.EQ.-1 .OR. ( IGRADE.EQ.4 .AND. M.NE.N ) .OR.
  701. $ ( ( IGRADE.EQ.1 .OR. IGRADE.EQ.2 .OR. IGRADE.EQ.3 .OR.
  702. $ IGRADE.EQ.4 .OR. IGRADE.EQ.6 ) .AND. ISYM.EQ.0 ) .OR.
  703. $ ( ( IGRADE.EQ.1 .OR. IGRADE.EQ.2 .OR. IGRADE.EQ.3 .OR.
  704. $ IGRADE.EQ.4 .OR. IGRADE.EQ.5 ) .AND. ISYM.EQ.2 ) ) THEN
  705. INFO = -11
  706. ELSE IF( IGRADE.EQ.4 .AND. DZERO ) THEN
  707. INFO = -12
  708. ELSE IF( ( IGRADE.EQ.1 .OR. IGRADE.EQ.3 .OR. IGRADE.EQ.4 .OR.
  709. $ IGRADE.EQ.5 .OR. IGRADE.EQ.6 ) .AND.
  710. $ ( MODEL.LT.-6 .OR. MODEL.GT.6 ) ) THEN
  711. INFO = -13
  712. ELSE IF( ( IGRADE.EQ.1 .OR. IGRADE.EQ.3 .OR. IGRADE.EQ.4 .OR.
  713. $ IGRADE.EQ.5 .OR. IGRADE.EQ.6 ) .AND.
  714. $ ( MODEL.NE.-6 .AND. MODEL.NE.0 .AND. MODEL.NE.6 ) .AND.
  715. $ CONDL.LT.ONE ) THEN
  716. INFO = -14
  717. ELSE IF( ( IGRADE.EQ.2 .OR. IGRADE.EQ.3 ) .AND.
  718. $ ( MODER.LT.-6 .OR. MODER.GT.6 ) ) THEN
  719. INFO = -16
  720. ELSE IF( ( IGRADE.EQ.2 .OR. IGRADE.EQ.3 ) .AND.
  721. $ ( MODER.NE.-6 .AND. MODER.NE.0 .AND. MODER.NE.6 ) .AND.
  722. $ CONDR.LT.ONE ) THEN
  723. INFO = -17
  724. ELSE IF( IPVTNG.EQ.-1 .OR. ( IPVTNG.EQ.3 .AND. M.NE.N ) .OR.
  725. $ ( ( IPVTNG.EQ.1 .OR. IPVTNG.EQ.2 ) .AND. ( ISYM.EQ.0 .OR.
  726. $ ISYM.EQ.2 ) ) ) THEN
  727. INFO = -18
  728. ELSE IF( IPVTNG.NE.0 .AND. BADPVT ) THEN
  729. INFO = -19
  730. ELSE IF( KL.LT.0 ) THEN
  731. INFO = -20
  732. ELSE IF( KU.LT.0 .OR. ( ( ISYM.EQ.0 .OR. ISYM.EQ.2 ) .AND. KL.NE.
  733. $ KU ) ) THEN
  734. INFO = -21
  735. ELSE IF( SPARSE.LT.ZERO .OR. SPARSE.GT.ONE ) THEN
  736. INFO = -22
  737. ELSE IF( IPACK.EQ.-1 .OR. ( ( IPACK.EQ.1 .OR. IPACK.EQ.2 .OR.
  738. $ IPACK.EQ.5 .OR. IPACK.EQ.6 ) .AND. ISYM.EQ.1 ) .OR.
  739. $ ( IPACK.EQ.3 .AND. ISYM.EQ.1 .AND. ( KL.NE.0 .OR. M.NE.
  740. $ N ) ) .OR. ( IPACK.EQ.4 .AND. ISYM.EQ.1 .AND. ( KU.NE.
  741. $ 0 .OR. M.NE.N ) ) ) THEN
  742. INFO = -24
  743. ELSE IF( ( ( IPACK.EQ.0 .OR. IPACK.EQ.1 .OR. IPACK.EQ.2 ) .AND.
  744. $ LDA.LT.MAX( 1, M ) ) .OR. ( ( IPACK.EQ.3 .OR. IPACK.EQ.
  745. $ 4 ) .AND. LDA.LT.1 ) .OR. ( ( IPACK.EQ.5 .OR. IPACK.EQ.
  746. $ 6 ) .AND. LDA.LT.KUU+1 ) .OR.
  747. $ ( IPACK.EQ.7 .AND. LDA.LT.KLL+KUU+1 ) ) THEN
  748. INFO = -26
  749. END IF
  750. *
  751. IF( INFO.NE.0 ) THEN
  752. CALL XERBLA( 'ZLATMR', -INFO )
  753. RETURN
  754. END IF
  755. *
  756. * Decide if we can pivot consistently
  757. *
  758. FULBND = .FALSE.
  759. IF( KUU.EQ.N-1 .AND. KLL.EQ.M-1 )
  760. $ FULBND = .TRUE.
  761. *
  762. * Initialize random number generator
  763. *
  764. DO 30 I = 1, 4
  765. ISEED( I ) = MOD( ABS( ISEED( I ) ), 4096 )
  766. 30 CONTINUE
  767. *
  768. ISEED( 4 ) = 2*( ISEED( 4 ) / 2 ) + 1
  769. *
  770. * 2) Set up D, DL, and DR, if indicated.
  771. *
  772. * Compute D according to COND and MODE
  773. *
  774. CALL ZLATM1( MODE, COND, IRSIGN, IDIST, ISEED, D, MNMIN, INFO )
  775. IF( INFO.NE.0 ) THEN
  776. INFO = 1
  777. RETURN
  778. END IF
  779. IF( MODE.NE.0 .AND. MODE.NE.-6 .AND. MODE.NE.6 ) THEN
  780. *
  781. * Scale by DMAX
  782. *
  783. TEMP = ABS( D( 1 ) )
  784. DO 40 I = 2, MNMIN
  785. TEMP = MAX( TEMP, ABS( D( I ) ) )
  786. 40 CONTINUE
  787. IF( TEMP.EQ.ZERO .AND. DMAX.NE.CZERO ) THEN
  788. INFO = 2
  789. RETURN
  790. END IF
  791. IF( TEMP.NE.ZERO ) THEN
  792. CALPHA = DMAX / TEMP
  793. ELSE
  794. CALPHA = CONE
  795. END IF
  796. DO 50 I = 1, MNMIN
  797. D( I ) = CALPHA*D( I )
  798. 50 CONTINUE
  799. *
  800. END IF
  801. *
  802. * If matrix Hermitian, make D real
  803. *
  804. IF( ISYM.EQ.0 ) THEN
  805. DO 60 I = 1, MNMIN
  806. D( I ) = DBLE( D( I ) )
  807. 60 CONTINUE
  808. END IF
  809. *
  810. * Compute DL if grading set
  811. *
  812. IF( IGRADE.EQ.1 .OR. IGRADE.EQ.3 .OR. IGRADE.EQ.4 .OR. IGRADE.EQ.
  813. $ 5 .OR. IGRADE.EQ.6 ) THEN
  814. CALL ZLATM1( MODEL, CONDL, 0, IDIST, ISEED, DL, M, INFO )
  815. IF( INFO.NE.0 ) THEN
  816. INFO = 3
  817. RETURN
  818. END IF
  819. END IF
  820. *
  821. * Compute DR if grading set
  822. *
  823. IF( IGRADE.EQ.2 .OR. IGRADE.EQ.3 ) THEN
  824. CALL ZLATM1( MODER, CONDR, 0, IDIST, ISEED, DR, N, INFO )
  825. IF( INFO.NE.0 ) THEN
  826. INFO = 4
  827. RETURN
  828. END IF
  829. END IF
  830. *
  831. * 3) Generate IWORK if pivoting
  832. *
  833. IF( IPVTNG.GT.0 ) THEN
  834. DO 70 I = 1, NPVTS
  835. IWORK( I ) = I
  836. 70 CONTINUE
  837. IF( FULBND ) THEN
  838. DO 80 I = 1, NPVTS
  839. K = IPIVOT( I )
  840. J = IWORK( I )
  841. IWORK( I ) = IWORK( K )
  842. IWORK( K ) = J
  843. 80 CONTINUE
  844. ELSE
  845. DO 90 I = NPVTS, 1, -1
  846. K = IPIVOT( I )
  847. J = IWORK( I )
  848. IWORK( I ) = IWORK( K )
  849. IWORK( K ) = J
  850. 90 CONTINUE
  851. END IF
  852. END IF
  853. *
  854. * 4) Generate matrices for each kind of PACKing
  855. * Always sweep matrix columnwise (if symmetric, upper
  856. * half only) so that matrix generated does not depend
  857. * on PACK
  858. *
  859. IF( FULBND ) THEN
  860. *
  861. * Use ZLATM3 so matrices generated with differing PIVOTing only
  862. * differ only in the order of their rows and/or columns.
  863. *
  864. IF( IPACK.EQ.0 ) THEN
  865. IF( ISYM.EQ.0 ) THEN
  866. DO 110 J = 1, N
  867. DO 100 I = 1, J
  868. CTEMP = ZLATM3( M, N, I, J, ISUB, JSUB, KL, KU,
  869. $ IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG,
  870. $ IWORK, SPARSE )
  871. A( ISUB, JSUB ) = CTEMP
  872. A( JSUB, ISUB ) = DCONJG( CTEMP )
  873. 100 CONTINUE
  874. 110 CONTINUE
  875. ELSE IF( ISYM.EQ.1 ) THEN
  876. DO 130 J = 1, N
  877. DO 120 I = 1, M
  878. CTEMP = ZLATM3( M, N, I, J, ISUB, JSUB, KL, KU,
  879. $ IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG,
  880. $ IWORK, SPARSE )
  881. A( ISUB, JSUB ) = CTEMP
  882. 120 CONTINUE
  883. 130 CONTINUE
  884. ELSE IF( ISYM.EQ.2 ) THEN
  885. DO 150 J = 1, N
  886. DO 140 I = 1, J
  887. CTEMP = ZLATM3( M, N, I, J, ISUB, JSUB, KL, KU,
  888. $ IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG,
  889. $ IWORK, SPARSE )
  890. A( ISUB, JSUB ) = CTEMP
  891. A( JSUB, ISUB ) = CTEMP
  892. 140 CONTINUE
  893. 150 CONTINUE
  894. END IF
  895. *
  896. ELSE IF( IPACK.EQ.1 ) THEN
  897. *
  898. DO 170 J = 1, N
  899. DO 160 I = 1, J
  900. CTEMP = ZLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST,
  901. $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK,
  902. $ SPARSE )
  903. MNSUB = MIN( ISUB, JSUB )
  904. MXSUB = MAX( ISUB, JSUB )
  905. IF( MXSUB.EQ.ISUB .AND. ISYM.EQ.0 ) THEN
  906. A( MNSUB, MXSUB ) = DCONJG( CTEMP )
  907. ELSE
  908. A( MNSUB, MXSUB ) = CTEMP
  909. END IF
  910. IF( MNSUB.NE.MXSUB )
  911. $ A( MXSUB, MNSUB ) = CZERO
  912. 160 CONTINUE
  913. 170 CONTINUE
  914. *
  915. ELSE IF( IPACK.EQ.2 ) THEN
  916. *
  917. DO 190 J = 1, N
  918. DO 180 I = 1, J
  919. CTEMP = ZLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST,
  920. $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK,
  921. $ SPARSE )
  922. MNSUB = MIN( ISUB, JSUB )
  923. MXSUB = MAX( ISUB, JSUB )
  924. IF( MXSUB.EQ.JSUB .AND. ISYM.EQ.0 ) THEN
  925. A( MXSUB, MNSUB ) = DCONJG( CTEMP )
  926. ELSE
  927. A( MXSUB, MNSUB ) = CTEMP
  928. END IF
  929. IF( MNSUB.NE.MXSUB )
  930. $ A( MNSUB, MXSUB ) = CZERO
  931. 180 CONTINUE
  932. 190 CONTINUE
  933. *
  934. ELSE IF( IPACK.EQ.3 ) THEN
  935. *
  936. DO 210 J = 1, N
  937. DO 200 I = 1, J
  938. CTEMP = ZLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST,
  939. $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK,
  940. $ SPARSE )
  941. *
  942. * Compute K = location of (ISUB,JSUB) entry in packed
  943. * array
  944. *
  945. MNSUB = MIN( ISUB, JSUB )
  946. MXSUB = MAX( ISUB, JSUB )
  947. K = MXSUB*( MXSUB-1 ) / 2 + MNSUB
  948. *
  949. * Convert K to (IISUB,JJSUB) location
  950. *
  951. JJSUB = ( K-1 ) / LDA + 1
  952. IISUB = K - LDA*( JJSUB-1 )
  953. *
  954. IF( MXSUB.EQ.ISUB .AND. ISYM.EQ.0 ) THEN
  955. A( IISUB, JJSUB ) = DCONJG( CTEMP )
  956. ELSE
  957. A( IISUB, JJSUB ) = CTEMP
  958. END IF
  959. 200 CONTINUE
  960. 210 CONTINUE
  961. *
  962. ELSE IF( IPACK.EQ.4 ) THEN
  963. *
  964. DO 230 J = 1, N
  965. DO 220 I = 1, J
  966. CTEMP = ZLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST,
  967. $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK,
  968. $ SPARSE )
  969. *
  970. * Compute K = location of (I,J) entry in packed array
  971. *
  972. MNSUB = MIN( ISUB, JSUB )
  973. MXSUB = MAX( ISUB, JSUB )
  974. IF( MNSUB.EQ.1 ) THEN
  975. K = MXSUB
  976. ELSE
  977. K = N*( N+1 ) / 2 - ( N-MNSUB+1 )*( N-MNSUB+2 ) /
  978. $ 2 + MXSUB - MNSUB + 1
  979. END IF
  980. *
  981. * Convert K to (IISUB,JJSUB) location
  982. *
  983. JJSUB = ( K-1 ) / LDA + 1
  984. IISUB = K - LDA*( JJSUB-1 )
  985. *
  986. IF( MXSUB.EQ.JSUB .AND. ISYM.EQ.0 ) THEN
  987. A( IISUB, JJSUB ) = DCONJG( CTEMP )
  988. ELSE
  989. A( IISUB, JJSUB ) = CTEMP
  990. END IF
  991. 220 CONTINUE
  992. 230 CONTINUE
  993. *
  994. ELSE IF( IPACK.EQ.5 ) THEN
  995. *
  996. DO 250 J = 1, N
  997. DO 240 I = J - KUU, J
  998. IF( I.LT.1 ) THEN
  999. A( J-I+1, I+N ) = CZERO
  1000. ELSE
  1001. CTEMP = ZLATM3( M, N, I, J, ISUB, JSUB, KL, KU,
  1002. $ IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG,
  1003. $ IWORK, SPARSE )
  1004. MNSUB = MIN( ISUB, JSUB )
  1005. MXSUB = MAX( ISUB, JSUB )
  1006. IF( MXSUB.EQ.JSUB .AND. ISYM.EQ.0 ) THEN
  1007. A( MXSUB-MNSUB+1, MNSUB ) = DCONJG( CTEMP )
  1008. ELSE
  1009. A( MXSUB-MNSUB+1, MNSUB ) = CTEMP
  1010. END IF
  1011. END IF
  1012. 240 CONTINUE
  1013. 250 CONTINUE
  1014. *
  1015. ELSE IF( IPACK.EQ.6 ) THEN
  1016. *
  1017. DO 270 J = 1, N
  1018. DO 260 I = J - KUU, J
  1019. CTEMP = ZLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST,
  1020. $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK,
  1021. $ SPARSE )
  1022. MNSUB = MIN( ISUB, JSUB )
  1023. MXSUB = MAX( ISUB, JSUB )
  1024. IF( MXSUB.EQ.ISUB .AND. ISYM.EQ.0 ) THEN
  1025. A( MNSUB-MXSUB+KUU+1, MXSUB ) = DCONJG( CTEMP )
  1026. ELSE
  1027. A( MNSUB-MXSUB+KUU+1, MXSUB ) = CTEMP
  1028. END IF
  1029. 260 CONTINUE
  1030. 270 CONTINUE
  1031. *
  1032. ELSE IF( IPACK.EQ.7 ) THEN
  1033. *
  1034. IF( ISYM.NE.1 ) THEN
  1035. DO 290 J = 1, N
  1036. DO 280 I = J - KUU, J
  1037. CTEMP = ZLATM3( M, N, I, J, ISUB, JSUB, KL, KU,
  1038. $ IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG,
  1039. $ IWORK, SPARSE )
  1040. MNSUB = MIN( ISUB, JSUB )
  1041. MXSUB = MAX( ISUB, JSUB )
  1042. IF( I.LT.1 )
  1043. $ A( J-I+1+KUU, I+N ) = CZERO
  1044. IF( MXSUB.EQ.ISUB .AND. ISYM.EQ.0 ) THEN
  1045. A( MNSUB-MXSUB+KUU+1, MXSUB ) = DCONJG( CTEMP )
  1046. ELSE
  1047. A( MNSUB-MXSUB+KUU+1, MXSUB ) = CTEMP
  1048. END IF
  1049. IF( I.GE.1 .AND. MNSUB.NE.MXSUB ) THEN
  1050. IF( MNSUB.EQ.ISUB .AND. ISYM.EQ.0 ) THEN
  1051. A( MXSUB-MNSUB+1+KUU,
  1052. $ MNSUB ) = DCONJG( CTEMP )
  1053. ELSE
  1054. A( MXSUB-MNSUB+1+KUU, MNSUB ) = CTEMP
  1055. END IF
  1056. END IF
  1057. 280 CONTINUE
  1058. 290 CONTINUE
  1059. ELSE IF( ISYM.EQ.1 ) THEN
  1060. DO 310 J = 1, N
  1061. DO 300 I = J - KUU, J + KLL
  1062. CTEMP = ZLATM3( M, N, I, J, ISUB, JSUB, KL, KU,
  1063. $ IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG,
  1064. $ IWORK, SPARSE )
  1065. A( ISUB-JSUB+KUU+1, JSUB ) = CTEMP
  1066. 300 CONTINUE
  1067. 310 CONTINUE
  1068. END IF
  1069. *
  1070. END IF
  1071. *
  1072. ELSE
  1073. *
  1074. * Use ZLATM2
  1075. *
  1076. IF( IPACK.EQ.0 ) THEN
  1077. IF( ISYM.EQ.0 ) THEN
  1078. DO 330 J = 1, N
  1079. DO 320 I = 1, J
  1080. A( I, J ) = ZLATM2( M, N, I, J, KL, KU, IDIST,
  1081. $ ISEED, D, IGRADE, DL, DR, IPVTNG,
  1082. $ IWORK, SPARSE )
  1083. A( J, I ) = DCONJG( A( I, J ) )
  1084. 320 CONTINUE
  1085. 330 CONTINUE
  1086. ELSE IF( ISYM.EQ.1 ) THEN
  1087. DO 350 J = 1, N
  1088. DO 340 I = 1, M
  1089. A( I, J ) = ZLATM2( M, N, I, J, KL, KU, IDIST,
  1090. $ ISEED, D, IGRADE, DL, DR, IPVTNG,
  1091. $ IWORK, SPARSE )
  1092. 340 CONTINUE
  1093. 350 CONTINUE
  1094. ELSE IF( ISYM.EQ.2 ) THEN
  1095. DO 370 J = 1, N
  1096. DO 360 I = 1, J
  1097. A( I, J ) = ZLATM2( M, N, I, J, KL, KU, IDIST,
  1098. $ ISEED, D, IGRADE, DL, DR, IPVTNG,
  1099. $ IWORK, SPARSE )
  1100. A( J, I ) = A( I, J )
  1101. 360 CONTINUE
  1102. 370 CONTINUE
  1103. END IF
  1104. *
  1105. ELSE IF( IPACK.EQ.1 ) THEN
  1106. *
  1107. DO 390 J = 1, N
  1108. DO 380 I = 1, J
  1109. A( I, J ) = ZLATM2( M, N, I, J, KL, KU, IDIST, ISEED,
  1110. $ D, IGRADE, DL, DR, IPVTNG, IWORK, SPARSE )
  1111. IF( I.NE.J )
  1112. $ A( J, I ) = CZERO
  1113. 380 CONTINUE
  1114. 390 CONTINUE
  1115. *
  1116. ELSE IF( IPACK.EQ.2 ) THEN
  1117. *
  1118. DO 410 J = 1, N
  1119. DO 400 I = 1, J
  1120. IF( ISYM.EQ.0 ) THEN
  1121. A( J, I ) = DCONJG( ZLATM2( M, N, I, J, KL, KU,
  1122. $ IDIST, ISEED, D, IGRADE, DL, DR,
  1123. $ IPVTNG, IWORK, SPARSE ) )
  1124. ELSE
  1125. A( J, I ) = ZLATM2( M, N, I, J, KL, KU, IDIST,
  1126. $ ISEED, D, IGRADE, DL, DR, IPVTNG,
  1127. $ IWORK, SPARSE )
  1128. END IF
  1129. IF( I.NE.J )
  1130. $ A( I, J ) = CZERO
  1131. 400 CONTINUE
  1132. 410 CONTINUE
  1133. *
  1134. ELSE IF( IPACK.EQ.3 ) THEN
  1135. *
  1136. ISUB = 0
  1137. JSUB = 1
  1138. DO 430 J = 1, N
  1139. DO 420 I = 1, J
  1140. ISUB = ISUB + 1
  1141. IF( ISUB.GT.LDA ) THEN
  1142. ISUB = 1
  1143. JSUB = JSUB + 1
  1144. END IF
  1145. A( ISUB, JSUB ) = ZLATM2( M, N, I, J, KL, KU, IDIST,
  1146. $ ISEED, D, IGRADE, DL, DR, IPVTNG,
  1147. $ IWORK, SPARSE )
  1148. 420 CONTINUE
  1149. 430 CONTINUE
  1150. *
  1151. ELSE IF( IPACK.EQ.4 ) THEN
  1152. *
  1153. IF( ISYM.EQ.0 .OR. ISYM.EQ.2 ) THEN
  1154. DO 450 J = 1, N
  1155. DO 440 I = 1, J
  1156. *
  1157. * Compute K = location of (I,J) entry in packed array
  1158. *
  1159. IF( I.EQ.1 ) THEN
  1160. K = J
  1161. ELSE
  1162. K = N*( N+1 ) / 2 - ( N-I+1 )*( N-I+2 ) / 2 +
  1163. $ J - I + 1
  1164. END IF
  1165. *
  1166. * Convert K to (ISUB,JSUB) location
  1167. *
  1168. JSUB = ( K-1 ) / LDA + 1
  1169. ISUB = K - LDA*( JSUB-1 )
  1170. *
  1171. A( ISUB, JSUB ) = ZLATM2( M, N, I, J, KL, KU,
  1172. $ IDIST, ISEED, D, IGRADE, DL, DR,
  1173. $ IPVTNG, IWORK, SPARSE )
  1174. IF( ISYM.EQ.0 )
  1175. $ A( ISUB, JSUB ) = DCONJG( A( ISUB, JSUB ) )
  1176. 440 CONTINUE
  1177. 450 CONTINUE
  1178. ELSE
  1179. ISUB = 0
  1180. JSUB = 1
  1181. DO 470 J = 1, N
  1182. DO 460 I = J, M
  1183. ISUB = ISUB + 1
  1184. IF( ISUB.GT.LDA ) THEN
  1185. ISUB = 1
  1186. JSUB = JSUB + 1
  1187. END IF
  1188. A( ISUB, JSUB ) = ZLATM2( M, N, I, J, KL, KU,
  1189. $ IDIST, ISEED, D, IGRADE, DL, DR,
  1190. $ IPVTNG, IWORK, SPARSE )
  1191. 460 CONTINUE
  1192. 470 CONTINUE
  1193. END IF
  1194. *
  1195. ELSE IF( IPACK.EQ.5 ) THEN
  1196. *
  1197. DO 490 J = 1, N
  1198. DO 480 I = J - KUU, J
  1199. IF( I.LT.1 ) THEN
  1200. A( J-I+1, I+N ) = CZERO
  1201. ELSE
  1202. IF( ISYM.EQ.0 ) THEN
  1203. A( J-I+1, I ) = DCONJG( ZLATM2( M, N, I, J, KL,
  1204. $ KU, IDIST, ISEED, D, IGRADE, DL,
  1205. $ DR, IPVTNG, IWORK, SPARSE ) )
  1206. ELSE
  1207. A( J-I+1, I ) = ZLATM2( M, N, I, J, KL, KU,
  1208. $ IDIST, ISEED, D, IGRADE, DL, DR,
  1209. $ IPVTNG, IWORK, SPARSE )
  1210. END IF
  1211. END IF
  1212. 480 CONTINUE
  1213. 490 CONTINUE
  1214. *
  1215. ELSE IF( IPACK.EQ.6 ) THEN
  1216. *
  1217. DO 510 J = 1, N
  1218. DO 500 I = J - KUU, J
  1219. A( I-J+KUU+1, J ) = ZLATM2( M, N, I, J, KL, KU, IDIST,
  1220. $ ISEED, D, IGRADE, DL, DR, IPVTNG,
  1221. $ IWORK, SPARSE )
  1222. 500 CONTINUE
  1223. 510 CONTINUE
  1224. *
  1225. ELSE IF( IPACK.EQ.7 ) THEN
  1226. *
  1227. IF( ISYM.NE.1 ) THEN
  1228. DO 530 J = 1, N
  1229. DO 520 I = J - KUU, J
  1230. A( I-J+KUU+1, J ) = ZLATM2( M, N, I, J, KL, KU,
  1231. $ IDIST, ISEED, D, IGRADE, DL,
  1232. $ DR, IPVTNG, IWORK, SPARSE )
  1233. IF( I.LT.1 )
  1234. $ A( J-I+1+KUU, I+N ) = CZERO
  1235. IF( I.GE.1 .AND. I.NE.J ) THEN
  1236. IF( ISYM.EQ.0 ) THEN
  1237. A( J-I+1+KUU, I ) = DCONJG( A( I-J+KUU+1,
  1238. $ J ) )
  1239. ELSE
  1240. A( J-I+1+KUU, I ) = A( I-J+KUU+1, J )
  1241. END IF
  1242. END IF
  1243. 520 CONTINUE
  1244. 530 CONTINUE
  1245. ELSE IF( ISYM.EQ.1 ) THEN
  1246. DO 550 J = 1, N
  1247. DO 540 I = J - KUU, J + KLL
  1248. A( I-J+KUU+1, J ) = ZLATM2( M, N, I, J, KL, KU,
  1249. $ IDIST, ISEED, D, IGRADE, DL,
  1250. $ DR, IPVTNG, IWORK, SPARSE )
  1251. 540 CONTINUE
  1252. 550 CONTINUE
  1253. END IF
  1254. *
  1255. END IF
  1256. *
  1257. END IF
  1258. *
  1259. * 5) Scaling the norm
  1260. *
  1261. IF( IPACK.EQ.0 ) THEN
  1262. ONORM = ZLANGE( 'M', M, N, A, LDA, TEMPA )
  1263. ELSE IF( IPACK.EQ.1 ) THEN
  1264. ONORM = ZLANSY( 'M', 'U', N, A, LDA, TEMPA )
  1265. ELSE IF( IPACK.EQ.2 ) THEN
  1266. ONORM = ZLANSY( 'M', 'L', N, A, LDA, TEMPA )
  1267. ELSE IF( IPACK.EQ.3 ) THEN
  1268. ONORM = ZLANSP( 'M', 'U', N, A, TEMPA )
  1269. ELSE IF( IPACK.EQ.4 ) THEN
  1270. ONORM = ZLANSP( 'M', 'L', N, A, TEMPA )
  1271. ELSE IF( IPACK.EQ.5 ) THEN
  1272. ONORM = ZLANSB( 'M', 'L', N, KLL, A, LDA, TEMPA )
  1273. ELSE IF( IPACK.EQ.6 ) THEN
  1274. ONORM = ZLANSB( 'M', 'U', N, KUU, A, LDA, TEMPA )
  1275. ELSE IF( IPACK.EQ.7 ) THEN
  1276. ONORM = ZLANGB( 'M', N, KLL, KUU, A, LDA, TEMPA )
  1277. END IF
  1278. *
  1279. IF( ANORM.GE.ZERO ) THEN
  1280. *
  1281. IF( ANORM.GT.ZERO .AND. ONORM.EQ.ZERO ) THEN
  1282. *
  1283. * Desired scaling impossible
  1284. *
  1285. INFO = 5
  1286. RETURN
  1287. *
  1288. ELSE IF( ( ANORM.GT.ONE .AND. ONORM.LT.ONE ) .OR.
  1289. $ ( ANORM.LT.ONE .AND. ONORM.GT.ONE ) ) THEN
  1290. *
  1291. * Scale carefully to avoid over / underflow
  1292. *
  1293. IF( IPACK.LE.2 ) THEN
  1294. DO 560 J = 1, N
  1295. CALL ZDSCAL( M, ONE / ONORM, A( 1, J ), 1 )
  1296. CALL ZDSCAL( M, ANORM, A( 1, J ), 1 )
  1297. 560 CONTINUE
  1298. *
  1299. ELSE IF( IPACK.EQ.3 .OR. IPACK.EQ.4 ) THEN
  1300. *
  1301. CALL ZDSCAL( N*( N+1 ) / 2, ONE / ONORM, A, 1 )
  1302. CALL ZDSCAL( N*( N+1 ) / 2, ANORM, A, 1 )
  1303. *
  1304. ELSE IF( IPACK.GE.5 ) THEN
  1305. *
  1306. DO 570 J = 1, N
  1307. CALL ZDSCAL( KLL+KUU+1, ONE / ONORM, A( 1, J ), 1 )
  1308. CALL ZDSCAL( KLL+KUU+1, ANORM, A( 1, J ), 1 )
  1309. 570 CONTINUE
  1310. *
  1311. END IF
  1312. *
  1313. ELSE
  1314. *
  1315. * Scale straightforwardly
  1316. *
  1317. IF( IPACK.LE.2 ) THEN
  1318. DO 580 J = 1, N
  1319. CALL ZDSCAL( M, ANORM / ONORM, A( 1, J ), 1 )
  1320. 580 CONTINUE
  1321. *
  1322. ELSE IF( IPACK.EQ.3 .OR. IPACK.EQ.4 ) THEN
  1323. *
  1324. CALL ZDSCAL( N*( N+1 ) / 2, ANORM / ONORM, A, 1 )
  1325. *
  1326. ELSE IF( IPACK.GE.5 ) THEN
  1327. *
  1328. DO 590 J = 1, N
  1329. CALL ZDSCAL( KLL+KUU+1, ANORM / ONORM, A( 1, J ), 1 )
  1330. 590 CONTINUE
  1331. END IF
  1332. *
  1333. END IF
  1334. *
  1335. END IF
  1336. *
  1337. * End of ZLATMR
  1338. *
  1339. END