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.

clatmr.f 48 kB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342
  1. *> \brief \b CLATMR
  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 CLATMR( 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. * REAL ANORM, COND, CONDL, CONDR, SPARSE
  20. * COMPLEX DMAX
  21. * ..
  22. * .. Array Arguments ..
  23. * INTEGER IPIVOT( * ), ISEED( 4 ), IWORK( * )
  24. * COMPLEX A( LDA, * ), D( * ), DL( * ), DR( * )
  25. * ..
  26. *
  27. *
  28. *> \par Purpose:
  29. * =============
  30. *>
  31. *> \verbatim
  32. *>
  33. *> CLATMR generates random matrices of various types for testing
  34. *> LAPACK programs.
  35. *>
  36. *> CLATMR 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 CLATMR differ only in the PACK parameter,
  80. *> they will generate mathematically equivalent matrices.
  81. *>
  82. *> If two calls to CLATMR 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 CLATMR
  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 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 REAL
  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
  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 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 REAL
  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 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 REAL
  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 CLATMR 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, CLATMR
  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] SPARSE
  320. *> \verbatim
  321. *> SPARSE is REAL
  322. *> On entry specifies the sparsity of the matrix if a sparse
  323. *> matrix is to be generated. SPARSE should lie between
  324. *> 0 and 1. To generate a sparse matrix, for each matrix entry
  325. *> a uniform ( 0, 1 ) random number x is generated and
  326. *> compared to SPARSE; if x is larger the matrix entry
  327. *> is unchanged and if x is smaller the entry is set
  328. *> to zero. Thus on the average a fraction SPARSE of the
  329. *> entries will be set to zero.
  330. *> Not modified.
  331. *> \endverbatim
  332. *>
  333. *> \param[in] KL
  334. *> \verbatim
  335. *> KL is INTEGER
  336. *> On entry specifies the lower bandwidth of the matrix. For
  337. *> example, KL=0 implies upper triangular, KL=1 implies upper
  338. *> Hessenberg, and KL at least M-1 implies the matrix is not
  339. *> banded. Must equal KU if matrix is symmetric or Hermitian.
  340. *> Not modified.
  341. *> \endverbatim
  342. *>
  343. *> \param[in] KU
  344. *> \verbatim
  345. *> KU is INTEGER
  346. *> On entry specifies the upper bandwidth of the matrix. For
  347. *> example, KU=0 implies lower triangular, KU=1 implies lower
  348. *> Hessenberg, and KU at least N-1 implies the matrix is not
  349. *> banded. Must equal KL if matrix is symmetric or Hermitian.
  350. *> Not modified.
  351. *> \endverbatim
  352. *>
  353. *> \param[in] ANORM
  354. *> \verbatim
  355. *> ANORM is REAL
  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 CLATMR 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 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, N-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 CLATM1 (computing D)
  468. *> 2 => Cannot scale diagonal to DMAX (max. entry is 0)
  469. *> 3 => Error return from CLATM1 (computing DL)
  470. *> 4 => Error return from CLATM1 (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. *> \date December 2016
  484. *
  485. *> \ingroup complex_matgen
  486. *
  487. * =====================================================================
  488. SUBROUTINE CLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX,
  489. $ RSIGN, GRADE, DL, MODEL, CONDL, DR, MODER,
  490. $ CONDR, PIVTNG, IPIVOT, KL, KU, SPARSE, ANORM,
  491. $ PACK, A, LDA, IWORK, INFO )
  492. *
  493. * -- LAPACK computational routine (version 3.7.0) --
  494. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  495. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  496. * December 2016
  497. *
  498. * .. Scalar Arguments ..
  499. CHARACTER DIST, GRADE, PACK, PIVTNG, RSIGN, SYM
  500. INTEGER INFO, KL, KU, LDA, M, MODE, MODEL, MODER, N
  501. REAL ANORM, COND, CONDL, CONDR, SPARSE
  502. COMPLEX DMAX
  503. * ..
  504. * .. Array Arguments ..
  505. INTEGER IPIVOT( * ), ISEED( 4 ), IWORK( * )
  506. COMPLEX A( LDA, * ), D( * ), DL( * ), DR( * )
  507. * ..
  508. *
  509. * =====================================================================
  510. *
  511. * .. Parameters ..
  512. REAL ZERO
  513. PARAMETER ( ZERO = 0.0E0 )
  514. REAL ONE
  515. PARAMETER ( ONE = 1.0E0 )
  516. COMPLEX CONE
  517. PARAMETER ( CONE = ( 1.0E0, 0.0E0 ) )
  518. COMPLEX CZERO
  519. PARAMETER ( CZERO = ( 0.0E0, 0.0E0 ) )
  520. * ..
  521. * .. Local Scalars ..
  522. LOGICAL BADPVT, DZERO, FULBND
  523. INTEGER I, IDIST, IGRADE, IISUB, IPACK, IPVTNG, IRSIGN,
  524. $ ISUB, ISYM, J, JJSUB, JSUB, K, KLL, KUU, MNMIN,
  525. $ MNSUB, MXSUB, NPVTS
  526. REAL ONORM, TEMP
  527. COMPLEX CALPHA, CTEMP
  528. * ..
  529. * .. Local Arrays ..
  530. REAL TEMPA( 1 )
  531. * ..
  532. * .. External Functions ..
  533. LOGICAL LSAME
  534. REAL CLANGB, CLANGE, CLANSB, CLANSP, CLANSY
  535. COMPLEX CLATM2, CLATM3
  536. EXTERNAL LSAME, CLANGB, CLANGE, CLANSB, CLANSP, CLANSY,
  537. $ CLATM2, CLATM3
  538. * ..
  539. * .. External Subroutines ..
  540. EXTERNAL CLATM1, CSSCAL, XERBLA
  541. * ..
  542. * .. Intrinsic Functions ..
  543. INTRINSIC ABS, CONJG, MAX, MIN, MOD, REAL
  544. * ..
  545. * .. Executable Statements ..
  546. *
  547. * 1) Decode and Test the input parameters.
  548. * Initialize flags & seed.
  549. *
  550. INFO = 0
  551. *
  552. * Quick return if possible
  553. *
  554. IF( M.EQ.0 .OR. N.EQ.0 )
  555. $ RETURN
  556. *
  557. * Decode DIST
  558. *
  559. IF( LSAME( DIST, 'U' ) ) THEN
  560. IDIST = 1
  561. ELSE IF( LSAME( DIST, 'S' ) ) THEN
  562. IDIST = 2
  563. ELSE IF( LSAME( DIST, 'N' ) ) THEN
  564. IDIST = 3
  565. ELSE IF( LSAME( DIST, 'D' ) ) THEN
  566. IDIST = 4
  567. ELSE
  568. IDIST = -1
  569. END IF
  570. *
  571. * Decode SYM
  572. *
  573. IF( LSAME( SYM, 'H' ) ) THEN
  574. ISYM = 0
  575. ELSE IF( LSAME( SYM, 'N' ) ) THEN
  576. ISYM = 1
  577. ELSE IF( LSAME( SYM, 'S' ) ) THEN
  578. ISYM = 2
  579. ELSE
  580. ISYM = -1
  581. END IF
  582. *
  583. * Decode RSIGN
  584. *
  585. IF( LSAME( RSIGN, 'F' ) ) THEN
  586. IRSIGN = 0
  587. ELSE IF( LSAME( RSIGN, 'T' ) ) THEN
  588. IRSIGN = 1
  589. ELSE
  590. IRSIGN = -1
  591. END IF
  592. *
  593. * Decode PIVTNG
  594. *
  595. IF( LSAME( PIVTNG, 'N' ) ) THEN
  596. IPVTNG = 0
  597. ELSE IF( LSAME( PIVTNG, ' ' ) ) THEN
  598. IPVTNG = 0
  599. ELSE IF( LSAME( PIVTNG, 'L' ) ) THEN
  600. IPVTNG = 1
  601. NPVTS = M
  602. ELSE IF( LSAME( PIVTNG, 'R' ) ) THEN
  603. IPVTNG = 2
  604. NPVTS = N
  605. ELSE IF( LSAME( PIVTNG, 'B' ) ) THEN
  606. IPVTNG = 3
  607. NPVTS = MIN( N, M )
  608. ELSE IF( LSAME( PIVTNG, 'F' ) ) THEN
  609. IPVTNG = 3
  610. NPVTS = MIN( N, M )
  611. ELSE
  612. IPVTNG = -1
  613. END IF
  614. *
  615. * Decode GRADE
  616. *
  617. IF( LSAME( GRADE, 'N' ) ) THEN
  618. IGRADE = 0
  619. ELSE IF( LSAME( GRADE, 'L' ) ) THEN
  620. IGRADE = 1
  621. ELSE IF( LSAME( GRADE, 'R' ) ) THEN
  622. IGRADE = 2
  623. ELSE IF( LSAME( GRADE, 'B' ) ) THEN
  624. IGRADE = 3
  625. ELSE IF( LSAME( GRADE, 'E' ) ) THEN
  626. IGRADE = 4
  627. ELSE IF( LSAME( GRADE, 'H' ) ) THEN
  628. IGRADE = 5
  629. ELSE IF( LSAME( GRADE, 'S' ) ) THEN
  630. IGRADE = 6
  631. ELSE
  632. IGRADE = -1
  633. END IF
  634. *
  635. * Decode PACK
  636. *
  637. IF( LSAME( PACK, 'N' ) ) THEN
  638. IPACK = 0
  639. ELSE IF( LSAME( PACK, 'U' ) ) THEN
  640. IPACK = 1
  641. ELSE IF( LSAME( PACK, 'L' ) ) THEN
  642. IPACK = 2
  643. ELSE IF( LSAME( PACK, 'C' ) ) THEN
  644. IPACK = 3
  645. ELSE IF( LSAME( PACK, 'R' ) ) THEN
  646. IPACK = 4
  647. ELSE IF( LSAME( PACK, 'B' ) ) THEN
  648. IPACK = 5
  649. ELSE IF( LSAME( PACK, 'Q' ) ) THEN
  650. IPACK = 6
  651. ELSE IF( LSAME( PACK, 'Z' ) ) THEN
  652. IPACK = 7
  653. ELSE
  654. IPACK = -1
  655. END IF
  656. *
  657. * Set certain internal parameters
  658. *
  659. MNMIN = MIN( M, N )
  660. KLL = MIN( KL, M-1 )
  661. KUU = MIN( KU, N-1 )
  662. *
  663. * If inv(DL) is used, check to see if DL has a zero entry.
  664. *
  665. DZERO = .FALSE.
  666. IF( IGRADE.EQ.4 .AND. MODEL.EQ.0 ) THEN
  667. DO 10 I = 1, M
  668. IF( DL( I ).EQ.CZERO )
  669. $ DZERO = .TRUE.
  670. 10 CONTINUE
  671. END IF
  672. *
  673. * Check values in IPIVOT
  674. *
  675. BADPVT = .FALSE.
  676. IF( IPVTNG.GT.0 ) THEN
  677. DO 20 J = 1, NPVTS
  678. IF( IPIVOT( J ).LE.0 .OR. IPIVOT( J ).GT.NPVTS )
  679. $ BADPVT = .TRUE.
  680. 20 CONTINUE
  681. END IF
  682. *
  683. * Set INFO if an error
  684. *
  685. IF( M.LT.0 ) THEN
  686. INFO = -1
  687. ELSE IF( M.NE.N .AND. ( ISYM.EQ.0 .OR. ISYM.EQ.2 ) ) THEN
  688. INFO = -1
  689. ELSE IF( N.LT.0 ) THEN
  690. INFO = -2
  691. ELSE IF( IDIST.EQ.-1 ) THEN
  692. INFO = -3
  693. ELSE IF( ISYM.EQ.-1 ) THEN
  694. INFO = -5
  695. ELSE IF( MODE.LT.-6 .OR. MODE.GT.6 ) THEN
  696. INFO = -7
  697. ELSE IF( ( MODE.NE.-6 .AND. MODE.NE.0 .AND. MODE.NE.6 ) .AND.
  698. $ COND.LT.ONE ) THEN
  699. INFO = -8
  700. ELSE IF( ( MODE.NE.-6 .AND. MODE.NE.0 .AND. MODE.NE.6 ) .AND.
  701. $ IRSIGN.EQ.-1 ) THEN
  702. INFO = -10
  703. ELSE IF( IGRADE.EQ.-1 .OR. ( IGRADE.EQ.4 .AND. M.NE.N ) .OR.
  704. $ ( ( IGRADE.EQ.1 .OR. IGRADE.EQ.2 .OR. IGRADE.EQ.3 .OR.
  705. $ IGRADE.EQ.4 .OR. IGRADE.EQ.6 ) .AND. ISYM.EQ.0 ) .OR.
  706. $ ( ( IGRADE.EQ.1 .OR. IGRADE.EQ.2 .OR. IGRADE.EQ.3 .OR.
  707. $ IGRADE.EQ.4 .OR. IGRADE.EQ.5 ) .AND. ISYM.EQ.2 ) ) THEN
  708. INFO = -11
  709. ELSE IF( IGRADE.EQ.4 .AND. DZERO ) THEN
  710. INFO = -12
  711. ELSE IF( ( IGRADE.EQ.1 .OR. IGRADE.EQ.3 .OR. IGRADE.EQ.4 .OR.
  712. $ IGRADE.EQ.5 .OR. IGRADE.EQ.6 ) .AND.
  713. $ ( MODEL.LT.-6 .OR. MODEL.GT.6 ) ) THEN
  714. INFO = -13
  715. ELSE IF( ( IGRADE.EQ.1 .OR. IGRADE.EQ.3 .OR. IGRADE.EQ.4 .OR.
  716. $ IGRADE.EQ.5 .OR. IGRADE.EQ.6 ) .AND.
  717. $ ( MODEL.NE.-6 .AND. MODEL.NE.0 .AND. MODEL.NE.6 ) .AND.
  718. $ CONDL.LT.ONE ) THEN
  719. INFO = -14
  720. ELSE IF( ( IGRADE.EQ.2 .OR. IGRADE.EQ.3 ) .AND.
  721. $ ( MODER.LT.-6 .OR. MODER.GT.6 ) ) THEN
  722. INFO = -16
  723. ELSE IF( ( IGRADE.EQ.2 .OR. IGRADE.EQ.3 ) .AND.
  724. $ ( MODER.NE.-6 .AND. MODER.NE.0 .AND. MODER.NE.6 ) .AND.
  725. $ CONDR.LT.ONE ) THEN
  726. INFO = -17
  727. ELSE IF( IPVTNG.EQ.-1 .OR. ( IPVTNG.EQ.3 .AND. M.NE.N ) .OR.
  728. $ ( ( IPVTNG.EQ.1 .OR. IPVTNG.EQ.2 ) .AND. ( ISYM.EQ.0 .OR.
  729. $ ISYM.EQ.2 ) ) ) THEN
  730. INFO = -18
  731. ELSE IF( IPVTNG.NE.0 .AND. BADPVT ) THEN
  732. INFO = -19
  733. ELSE IF( KL.LT.0 ) THEN
  734. INFO = -20
  735. ELSE IF( KU.LT.0 .OR. ( ( ISYM.EQ.0 .OR. ISYM.EQ.2 ) .AND. KL.NE.
  736. $ KU ) ) THEN
  737. INFO = -21
  738. ELSE IF( SPARSE.LT.ZERO .OR. SPARSE.GT.ONE ) THEN
  739. INFO = -22
  740. ELSE IF( IPACK.EQ.-1 .OR. ( ( IPACK.EQ.1 .OR. IPACK.EQ.2 .OR.
  741. $ IPACK.EQ.5 .OR. IPACK.EQ.6 ) .AND. ISYM.EQ.1 ) .OR.
  742. $ ( IPACK.EQ.3 .AND. ISYM.EQ.1 .AND. ( KL.NE.0 .OR. M.NE.
  743. $ N ) ) .OR. ( IPACK.EQ.4 .AND. ISYM.EQ.1 .AND. ( KU.NE.
  744. $ 0 .OR. M.NE.N ) ) ) THEN
  745. INFO = -24
  746. ELSE IF( ( ( IPACK.EQ.0 .OR. IPACK.EQ.1 .OR. IPACK.EQ.2 ) .AND.
  747. $ LDA.LT.MAX( 1, M ) ) .OR. ( ( IPACK.EQ.3 .OR. IPACK.EQ.
  748. $ 4 ) .AND. LDA.LT.1 ) .OR. ( ( IPACK.EQ.5 .OR. IPACK.EQ.
  749. $ 6 ) .AND. LDA.LT.KUU+1 ) .OR.
  750. $ ( IPACK.EQ.7 .AND. LDA.LT.KLL+KUU+1 ) ) THEN
  751. INFO = -26
  752. END IF
  753. *
  754. IF( INFO.NE.0 ) THEN
  755. CALL XERBLA( 'CLATMR', -INFO )
  756. RETURN
  757. END IF
  758. *
  759. * Decide if we can pivot consistently
  760. *
  761. FULBND = .FALSE.
  762. IF( KUU.EQ.N-1 .AND. KLL.EQ.M-1 )
  763. $ FULBND = .TRUE.
  764. *
  765. * Initialize random number generator
  766. *
  767. DO 30 I = 1, 4
  768. ISEED( I ) = MOD( ABS( ISEED( I ) ), 4096 )
  769. 30 CONTINUE
  770. *
  771. ISEED( 4 ) = 2*( ISEED( 4 ) / 2 ) + 1
  772. *
  773. * 2) Set up D, DL, and DR, if indicated.
  774. *
  775. * Compute D according to COND and MODE
  776. *
  777. CALL CLATM1( MODE, COND, IRSIGN, IDIST, ISEED, D, MNMIN, INFO )
  778. IF( INFO.NE.0 ) THEN
  779. INFO = 1
  780. RETURN
  781. END IF
  782. IF( MODE.NE.0 .AND. MODE.NE.-6 .AND. MODE.NE.6 ) THEN
  783. *
  784. * Scale by DMAX
  785. *
  786. TEMP = ABS( D( 1 ) )
  787. DO 40 I = 2, MNMIN
  788. TEMP = MAX( TEMP, ABS( D( I ) ) )
  789. 40 CONTINUE
  790. IF( TEMP.EQ.ZERO .AND. DMAX.NE.CZERO ) THEN
  791. INFO = 2
  792. RETURN
  793. END IF
  794. IF( TEMP.NE.ZERO ) THEN
  795. CALPHA = DMAX / TEMP
  796. ELSE
  797. CALPHA = CONE
  798. END IF
  799. DO 50 I = 1, MNMIN
  800. D( I ) = CALPHA*D( I )
  801. 50 CONTINUE
  802. *
  803. END IF
  804. *
  805. * If matrix Hermitian, make D real
  806. *
  807. IF( ISYM.EQ.0 ) THEN
  808. DO 60 I = 1, MNMIN
  809. D( I ) = REAL( D( I ) )
  810. 60 CONTINUE
  811. END IF
  812. *
  813. * Compute DL if grading set
  814. *
  815. IF( IGRADE.EQ.1 .OR. IGRADE.EQ.3 .OR. IGRADE.EQ.4 .OR. IGRADE.EQ.
  816. $ 5 .OR. IGRADE.EQ.6 ) THEN
  817. CALL CLATM1( MODEL, CONDL, 0, IDIST, ISEED, DL, M, INFO )
  818. IF( INFO.NE.0 ) THEN
  819. INFO = 3
  820. RETURN
  821. END IF
  822. END IF
  823. *
  824. * Compute DR if grading set
  825. *
  826. IF( IGRADE.EQ.2 .OR. IGRADE.EQ.3 ) THEN
  827. CALL CLATM1( MODER, CONDR, 0, IDIST, ISEED, DR, N, INFO )
  828. IF( INFO.NE.0 ) THEN
  829. INFO = 4
  830. RETURN
  831. END IF
  832. END IF
  833. *
  834. * 3) Generate IWORK if pivoting
  835. *
  836. IF( IPVTNG.GT.0 ) THEN
  837. DO 70 I = 1, NPVTS
  838. IWORK( I ) = I
  839. 70 CONTINUE
  840. IF( FULBND ) THEN
  841. DO 80 I = 1, NPVTS
  842. K = IPIVOT( I )
  843. J = IWORK( I )
  844. IWORK( I ) = IWORK( K )
  845. IWORK( K ) = J
  846. 80 CONTINUE
  847. ELSE
  848. DO 90 I = NPVTS, 1, -1
  849. K = IPIVOT( I )
  850. J = IWORK( I )
  851. IWORK( I ) = IWORK( K )
  852. IWORK( K ) = J
  853. 90 CONTINUE
  854. END IF
  855. END IF
  856. *
  857. * 4) Generate matrices for each kind of PACKing
  858. * Always sweep matrix columnwise (if symmetric, upper
  859. * half only) so that matrix generated does not depend
  860. * on PACK
  861. *
  862. IF( FULBND ) THEN
  863. *
  864. * Use CLATM3 so matrices generated with differing PIVOTing only
  865. * differ only in the order of their rows and/or columns.
  866. *
  867. IF( IPACK.EQ.0 ) THEN
  868. IF( ISYM.EQ.0 ) THEN
  869. DO 110 J = 1, N
  870. DO 100 I = 1, J
  871. CTEMP = CLATM3( M, N, I, J, ISUB, JSUB, KL, KU,
  872. $ IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG,
  873. $ IWORK, SPARSE )
  874. A( ISUB, JSUB ) = CTEMP
  875. A( JSUB, ISUB ) = CONJG( CTEMP )
  876. 100 CONTINUE
  877. 110 CONTINUE
  878. ELSE IF( ISYM.EQ.1 ) THEN
  879. DO 130 J = 1, N
  880. DO 120 I = 1, M
  881. CTEMP = CLATM3( M, N, I, J, ISUB, JSUB, KL, KU,
  882. $ IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG,
  883. $ IWORK, SPARSE )
  884. A( ISUB, JSUB ) = CTEMP
  885. 120 CONTINUE
  886. 130 CONTINUE
  887. ELSE IF( ISYM.EQ.2 ) THEN
  888. DO 150 J = 1, N
  889. DO 140 I = 1, J
  890. CTEMP = CLATM3( M, N, I, J, ISUB, JSUB, KL, KU,
  891. $ IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG,
  892. $ IWORK, SPARSE )
  893. A( ISUB, JSUB ) = CTEMP
  894. A( JSUB, ISUB ) = CTEMP
  895. 140 CONTINUE
  896. 150 CONTINUE
  897. END IF
  898. *
  899. ELSE IF( IPACK.EQ.1 ) THEN
  900. *
  901. DO 170 J = 1, N
  902. DO 160 I = 1, J
  903. CTEMP = CLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST,
  904. $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK,
  905. $ SPARSE )
  906. MNSUB = MIN( ISUB, JSUB )
  907. MXSUB = MAX( ISUB, JSUB )
  908. IF( MXSUB.EQ.ISUB .AND. ISYM.EQ.0 ) THEN
  909. A( MNSUB, MXSUB ) = CONJG( CTEMP )
  910. ELSE
  911. A( MNSUB, MXSUB ) = CTEMP
  912. END IF
  913. IF( MNSUB.NE.MXSUB )
  914. $ A( MXSUB, MNSUB ) = CZERO
  915. 160 CONTINUE
  916. 170 CONTINUE
  917. *
  918. ELSE IF( IPACK.EQ.2 ) THEN
  919. *
  920. DO 190 J = 1, N
  921. DO 180 I = 1, J
  922. CTEMP = CLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST,
  923. $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK,
  924. $ SPARSE )
  925. MNSUB = MIN( ISUB, JSUB )
  926. MXSUB = MAX( ISUB, JSUB )
  927. IF( MXSUB.EQ.JSUB .AND. ISYM.EQ.0 ) THEN
  928. A( MXSUB, MNSUB ) = CONJG( CTEMP )
  929. ELSE
  930. A( MXSUB, MNSUB ) = CTEMP
  931. END IF
  932. IF( MNSUB.NE.MXSUB )
  933. $ A( MNSUB, MXSUB ) = CZERO
  934. 180 CONTINUE
  935. 190 CONTINUE
  936. *
  937. ELSE IF( IPACK.EQ.3 ) THEN
  938. *
  939. DO 210 J = 1, N
  940. DO 200 I = 1, J
  941. CTEMP = CLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST,
  942. $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK,
  943. $ SPARSE )
  944. *
  945. * Compute K = location of (ISUB,JSUB) entry in packed
  946. * array
  947. *
  948. MNSUB = MIN( ISUB, JSUB )
  949. MXSUB = MAX( ISUB, JSUB )
  950. K = MXSUB*( MXSUB-1 ) / 2 + MNSUB
  951. *
  952. * Convert K to (IISUB,JJSUB) location
  953. *
  954. JJSUB = ( K-1 ) / LDA + 1
  955. IISUB = K - LDA*( JJSUB-1 )
  956. *
  957. IF( MXSUB.EQ.ISUB .AND. ISYM.EQ.0 ) THEN
  958. A( IISUB, JJSUB ) = CONJG( CTEMP )
  959. ELSE
  960. A( IISUB, JJSUB ) = CTEMP
  961. END IF
  962. 200 CONTINUE
  963. 210 CONTINUE
  964. *
  965. ELSE IF( IPACK.EQ.4 ) THEN
  966. *
  967. DO 230 J = 1, N
  968. DO 220 I = 1, J
  969. CTEMP = CLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST,
  970. $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK,
  971. $ SPARSE )
  972. *
  973. * Compute K = location of (I,J) entry in packed array
  974. *
  975. MNSUB = MIN( ISUB, JSUB )
  976. MXSUB = MAX( ISUB, JSUB )
  977. IF( MNSUB.EQ.1 ) THEN
  978. K = MXSUB
  979. ELSE
  980. K = N*( N+1 ) / 2 - ( N-MNSUB+1 )*( N-MNSUB+2 ) /
  981. $ 2 + MXSUB - MNSUB + 1
  982. END IF
  983. *
  984. * Convert K to (IISUB,JJSUB) location
  985. *
  986. JJSUB = ( K-1 ) / LDA + 1
  987. IISUB = K - LDA*( JJSUB-1 )
  988. *
  989. IF( MXSUB.EQ.JSUB .AND. ISYM.EQ.0 ) THEN
  990. A( IISUB, JJSUB ) = CONJG( CTEMP )
  991. ELSE
  992. A( IISUB, JJSUB ) = CTEMP
  993. END IF
  994. 220 CONTINUE
  995. 230 CONTINUE
  996. *
  997. ELSE IF( IPACK.EQ.5 ) THEN
  998. *
  999. DO 250 J = 1, N
  1000. DO 240 I = J - KUU, J
  1001. IF( I.LT.1 ) THEN
  1002. A( J-I+1, I+N ) = CZERO
  1003. ELSE
  1004. CTEMP = CLATM3( M, N, I, J, ISUB, JSUB, KL, KU,
  1005. $ IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG,
  1006. $ IWORK, SPARSE )
  1007. MNSUB = MIN( ISUB, JSUB )
  1008. MXSUB = MAX( ISUB, JSUB )
  1009. IF( MXSUB.EQ.JSUB .AND. ISYM.EQ.0 ) THEN
  1010. A( MXSUB-MNSUB+1, MNSUB ) = CONJG( CTEMP )
  1011. ELSE
  1012. A( MXSUB-MNSUB+1, MNSUB ) = CTEMP
  1013. END IF
  1014. END IF
  1015. 240 CONTINUE
  1016. 250 CONTINUE
  1017. *
  1018. ELSE IF( IPACK.EQ.6 ) THEN
  1019. *
  1020. DO 270 J = 1, N
  1021. DO 260 I = J - KUU, J
  1022. CTEMP = CLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST,
  1023. $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK,
  1024. $ SPARSE )
  1025. MNSUB = MIN( ISUB, JSUB )
  1026. MXSUB = MAX( ISUB, JSUB )
  1027. IF( MXSUB.EQ.ISUB .AND. ISYM.EQ.0 ) THEN
  1028. A( MNSUB-MXSUB+KUU+1, MXSUB ) = CONJG( CTEMP )
  1029. ELSE
  1030. A( MNSUB-MXSUB+KUU+1, MXSUB ) = CTEMP
  1031. END IF
  1032. 260 CONTINUE
  1033. 270 CONTINUE
  1034. *
  1035. ELSE IF( IPACK.EQ.7 ) THEN
  1036. *
  1037. IF( ISYM.NE.1 ) THEN
  1038. DO 290 J = 1, N
  1039. DO 280 I = J - KUU, J
  1040. CTEMP = CLATM3( M, N, I, J, ISUB, JSUB, KL, KU,
  1041. $ IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG,
  1042. $ IWORK, SPARSE )
  1043. MNSUB = MIN( ISUB, JSUB )
  1044. MXSUB = MAX( ISUB, JSUB )
  1045. IF( I.LT.1 )
  1046. $ A( J-I+1+KUU, I+N ) = CZERO
  1047. IF( MXSUB.EQ.ISUB .AND. ISYM.EQ.0 ) THEN
  1048. A( MNSUB-MXSUB+KUU+1, MXSUB ) = CONJG( CTEMP )
  1049. ELSE
  1050. A( MNSUB-MXSUB+KUU+1, MXSUB ) = CTEMP
  1051. END IF
  1052. IF( I.GE.1 .AND. MNSUB.NE.MXSUB ) THEN
  1053. IF( MNSUB.EQ.ISUB .AND. ISYM.EQ.0 ) THEN
  1054. A( MXSUB-MNSUB+1+KUU,
  1055. $ MNSUB ) = CONJG( CTEMP )
  1056. ELSE
  1057. A( MXSUB-MNSUB+1+KUU, MNSUB ) = CTEMP
  1058. END IF
  1059. END IF
  1060. 280 CONTINUE
  1061. 290 CONTINUE
  1062. ELSE IF( ISYM.EQ.1 ) THEN
  1063. DO 310 J = 1, N
  1064. DO 300 I = J - KUU, J + KLL
  1065. CTEMP = CLATM3( M, N, I, J, ISUB, JSUB, KL, KU,
  1066. $ IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG,
  1067. $ IWORK, SPARSE )
  1068. A( ISUB-JSUB+KUU+1, JSUB ) = CTEMP
  1069. 300 CONTINUE
  1070. 310 CONTINUE
  1071. END IF
  1072. *
  1073. END IF
  1074. *
  1075. ELSE
  1076. *
  1077. * Use CLATM2
  1078. *
  1079. IF( IPACK.EQ.0 ) THEN
  1080. IF( ISYM.EQ.0 ) THEN
  1081. DO 330 J = 1, N
  1082. DO 320 I = 1, J
  1083. A( I, J ) = CLATM2( M, N, I, J, KL, KU, IDIST,
  1084. $ ISEED, D, IGRADE, DL, DR, IPVTNG,
  1085. $ IWORK, SPARSE )
  1086. A( J, I ) = CONJG( A( I, J ) )
  1087. 320 CONTINUE
  1088. 330 CONTINUE
  1089. ELSE IF( ISYM.EQ.1 ) THEN
  1090. DO 350 J = 1, N
  1091. DO 340 I = 1, M
  1092. A( I, J ) = CLATM2( M, N, I, J, KL, KU, IDIST,
  1093. $ ISEED, D, IGRADE, DL, DR, IPVTNG,
  1094. $ IWORK, SPARSE )
  1095. 340 CONTINUE
  1096. 350 CONTINUE
  1097. ELSE IF( ISYM.EQ.2 ) THEN
  1098. DO 370 J = 1, N
  1099. DO 360 I = 1, J
  1100. A( I, J ) = CLATM2( M, N, I, J, KL, KU, IDIST,
  1101. $ ISEED, D, IGRADE, DL, DR, IPVTNG,
  1102. $ IWORK, SPARSE )
  1103. A( J, I ) = A( I, J )
  1104. 360 CONTINUE
  1105. 370 CONTINUE
  1106. END IF
  1107. *
  1108. ELSE IF( IPACK.EQ.1 ) THEN
  1109. *
  1110. DO 390 J = 1, N
  1111. DO 380 I = 1, J
  1112. A( I, J ) = CLATM2( M, N, I, J, KL, KU, IDIST, ISEED,
  1113. $ D, IGRADE, DL, DR, IPVTNG, IWORK, SPARSE )
  1114. IF( I.NE.J )
  1115. $ A( J, I ) = CZERO
  1116. 380 CONTINUE
  1117. 390 CONTINUE
  1118. *
  1119. ELSE IF( IPACK.EQ.2 ) THEN
  1120. *
  1121. DO 410 J = 1, N
  1122. DO 400 I = 1, J
  1123. IF( ISYM.EQ.0 ) THEN
  1124. A( J, I ) = CONJG( CLATM2( M, N, I, J, KL, KU,
  1125. $ IDIST, ISEED, D, IGRADE, DL, DR,
  1126. $ IPVTNG, IWORK, SPARSE ) )
  1127. ELSE
  1128. A( J, I ) = CLATM2( M, N, I, J, KL, KU, IDIST,
  1129. $ ISEED, D, IGRADE, DL, DR, IPVTNG,
  1130. $ IWORK, SPARSE )
  1131. END IF
  1132. IF( I.NE.J )
  1133. $ A( I, J ) = CZERO
  1134. 400 CONTINUE
  1135. 410 CONTINUE
  1136. *
  1137. ELSE IF( IPACK.EQ.3 ) THEN
  1138. *
  1139. ISUB = 0
  1140. JSUB = 1
  1141. DO 430 J = 1, N
  1142. DO 420 I = 1, J
  1143. ISUB = ISUB + 1
  1144. IF( ISUB.GT.LDA ) THEN
  1145. ISUB = 1
  1146. JSUB = JSUB + 1
  1147. END IF
  1148. A( ISUB, JSUB ) = CLATM2( M, N, I, J, KL, KU, IDIST,
  1149. $ ISEED, D, IGRADE, DL, DR, IPVTNG,
  1150. $ IWORK, SPARSE )
  1151. 420 CONTINUE
  1152. 430 CONTINUE
  1153. *
  1154. ELSE IF( IPACK.EQ.4 ) THEN
  1155. *
  1156. IF( ISYM.EQ.0 .OR. ISYM.EQ.2 ) THEN
  1157. DO 450 J = 1, N
  1158. DO 440 I = 1, J
  1159. *
  1160. * Compute K = location of (I,J) entry in packed array
  1161. *
  1162. IF( I.EQ.1 ) THEN
  1163. K = J
  1164. ELSE
  1165. K = N*( N+1 ) / 2 - ( N-I+1 )*( N-I+2 ) / 2 +
  1166. $ J - I + 1
  1167. END IF
  1168. *
  1169. * Convert K to (ISUB,JSUB) location
  1170. *
  1171. JSUB = ( K-1 ) / LDA + 1
  1172. ISUB = K - LDA*( JSUB-1 )
  1173. *
  1174. A( ISUB, JSUB ) = CLATM2( M, N, I, J, KL, KU,
  1175. $ IDIST, ISEED, D, IGRADE, DL, DR,
  1176. $ IPVTNG, IWORK, SPARSE )
  1177. IF( ISYM.EQ.0 )
  1178. $ A( ISUB, JSUB ) = CONJG( A( ISUB, JSUB ) )
  1179. 440 CONTINUE
  1180. 450 CONTINUE
  1181. ELSE
  1182. ISUB = 0
  1183. JSUB = 1
  1184. DO 470 J = 1, N
  1185. DO 460 I = J, M
  1186. ISUB = ISUB + 1
  1187. IF( ISUB.GT.LDA ) THEN
  1188. ISUB = 1
  1189. JSUB = JSUB + 1
  1190. END IF
  1191. A( ISUB, JSUB ) = CLATM2( M, N, I, J, KL, KU,
  1192. $ IDIST, ISEED, D, IGRADE, DL, DR,
  1193. $ IPVTNG, IWORK, SPARSE )
  1194. 460 CONTINUE
  1195. 470 CONTINUE
  1196. END IF
  1197. *
  1198. ELSE IF( IPACK.EQ.5 ) THEN
  1199. *
  1200. DO 490 J = 1, N
  1201. DO 480 I = J - KUU, J
  1202. IF( I.LT.1 ) THEN
  1203. A( J-I+1, I+N ) = CZERO
  1204. ELSE
  1205. IF( ISYM.EQ.0 ) THEN
  1206. A( J-I+1, I ) = CONJG( CLATM2( M, N, I, J, KL,
  1207. $ KU, IDIST, ISEED, D, IGRADE, DL,
  1208. $ DR, IPVTNG, IWORK, SPARSE ) )
  1209. ELSE
  1210. A( J-I+1, I ) = CLATM2( M, N, I, J, KL, KU,
  1211. $ IDIST, ISEED, D, IGRADE, DL, DR,
  1212. $ IPVTNG, IWORK, SPARSE )
  1213. END IF
  1214. END IF
  1215. 480 CONTINUE
  1216. 490 CONTINUE
  1217. *
  1218. ELSE IF( IPACK.EQ.6 ) THEN
  1219. *
  1220. DO 510 J = 1, N
  1221. DO 500 I = J - KUU, J
  1222. A( I-J+KUU+1, J ) = CLATM2( M, N, I, J, KL, KU, IDIST,
  1223. $ ISEED, D, IGRADE, DL, DR, IPVTNG,
  1224. $ IWORK, SPARSE )
  1225. 500 CONTINUE
  1226. 510 CONTINUE
  1227. *
  1228. ELSE IF( IPACK.EQ.7 ) THEN
  1229. *
  1230. IF( ISYM.NE.1 ) THEN
  1231. DO 530 J = 1, N
  1232. DO 520 I = J - KUU, J
  1233. A( I-J+KUU+1, J ) = CLATM2( M, N, I, J, KL, KU,
  1234. $ IDIST, ISEED, D, IGRADE, DL,
  1235. $ DR, IPVTNG, IWORK, SPARSE )
  1236. IF( I.LT.1 )
  1237. $ A( J-I+1+KUU, I+N ) = CZERO
  1238. IF( I.GE.1 .AND. I.NE.J ) THEN
  1239. IF( ISYM.EQ.0 ) THEN
  1240. A( J-I+1+KUU, I ) = CONJG( A( I-J+KUU+1,
  1241. $ J ) )
  1242. ELSE
  1243. A( J-I+1+KUU, I ) = A( I-J+KUU+1, J )
  1244. END IF
  1245. END IF
  1246. 520 CONTINUE
  1247. 530 CONTINUE
  1248. ELSE IF( ISYM.EQ.1 ) THEN
  1249. DO 550 J = 1, N
  1250. DO 540 I = J - KUU, J + KLL
  1251. A( I-J+KUU+1, J ) = CLATM2( M, N, I, J, KL, KU,
  1252. $ IDIST, ISEED, D, IGRADE, DL,
  1253. $ DR, IPVTNG, IWORK, SPARSE )
  1254. 540 CONTINUE
  1255. 550 CONTINUE
  1256. END IF
  1257. *
  1258. END IF
  1259. *
  1260. END IF
  1261. *
  1262. * 5) Scaling the norm
  1263. *
  1264. IF( IPACK.EQ.0 ) THEN
  1265. ONORM = CLANGE( 'M', M, N, A, LDA, TEMPA )
  1266. ELSE IF( IPACK.EQ.1 ) THEN
  1267. ONORM = CLANSY( 'M', 'U', N, A, LDA, TEMPA )
  1268. ELSE IF( IPACK.EQ.2 ) THEN
  1269. ONORM = CLANSY( 'M', 'L', N, A, LDA, TEMPA )
  1270. ELSE IF( IPACK.EQ.3 ) THEN
  1271. ONORM = CLANSP( 'M', 'U', N, A, TEMPA )
  1272. ELSE IF( IPACK.EQ.4 ) THEN
  1273. ONORM = CLANSP( 'M', 'L', N, A, TEMPA )
  1274. ELSE IF( IPACK.EQ.5 ) THEN
  1275. ONORM = CLANSB( 'M', 'L', N, KLL, A, LDA, TEMPA )
  1276. ELSE IF( IPACK.EQ.6 ) THEN
  1277. ONORM = CLANSB( 'M', 'U', N, KUU, A, LDA, TEMPA )
  1278. ELSE IF( IPACK.EQ.7 ) THEN
  1279. ONORM = CLANGB( 'M', N, KLL, KUU, A, LDA, TEMPA )
  1280. END IF
  1281. *
  1282. IF( ANORM.GE.ZERO ) THEN
  1283. *
  1284. IF( ANORM.GT.ZERO .AND. ONORM.EQ.ZERO ) THEN
  1285. *
  1286. * Desired scaling impossible
  1287. *
  1288. INFO = 5
  1289. RETURN
  1290. *
  1291. ELSE IF( ( ANORM.GT.ONE .AND. ONORM.LT.ONE ) .OR.
  1292. $ ( ANORM.LT.ONE .AND. ONORM.GT.ONE ) ) THEN
  1293. *
  1294. * Scale carefully to avoid over / underflow
  1295. *
  1296. IF( IPACK.LE.2 ) THEN
  1297. DO 560 J = 1, N
  1298. CALL CSSCAL( M, ONE / ONORM, A( 1, J ), 1 )
  1299. CALL CSSCAL( M, ANORM, A( 1, J ), 1 )
  1300. 560 CONTINUE
  1301. *
  1302. ELSE IF( IPACK.EQ.3 .OR. IPACK.EQ.4 ) THEN
  1303. *
  1304. CALL CSSCAL( N*( N+1 ) / 2, ONE / ONORM, A, 1 )
  1305. CALL CSSCAL( N*( N+1 ) / 2, ANORM, A, 1 )
  1306. *
  1307. ELSE IF( IPACK.GE.5 ) THEN
  1308. *
  1309. DO 570 J = 1, N
  1310. CALL CSSCAL( KLL+KUU+1, ONE / ONORM, A( 1, J ), 1 )
  1311. CALL CSSCAL( KLL+KUU+1, ANORM, A( 1, J ), 1 )
  1312. 570 CONTINUE
  1313. *
  1314. END IF
  1315. *
  1316. ELSE
  1317. *
  1318. * Scale straightforwardly
  1319. *
  1320. IF( IPACK.LE.2 ) THEN
  1321. DO 580 J = 1, N
  1322. CALL CSSCAL( M, ANORM / ONORM, A( 1, J ), 1 )
  1323. 580 CONTINUE
  1324. *
  1325. ELSE IF( IPACK.EQ.3 .OR. IPACK.EQ.4 ) THEN
  1326. *
  1327. CALL CSSCAL( N*( N+1 ) / 2, ANORM / ONORM, A, 1 )
  1328. *
  1329. ELSE IF( IPACK.GE.5 ) THEN
  1330. *
  1331. DO 590 J = 1, N
  1332. CALL CSSCAL( KLL+KUU+1, ANORM / ONORM, A( 1, J ), 1 )
  1333. 590 CONTINUE
  1334. END IF
  1335. *
  1336. END IF
  1337. *
  1338. END IF
  1339. *
  1340. * End of CLATMR
  1341. *
  1342. END