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.

zsysvxx.f 27 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695
  1. *> \brief <b> ZSYSVXX computes the solution to system of linear equations A * X = B for SY matrices</b>
  2. *
  3. * =========== DOCUMENTATION ===========
  4. *
  5. * Online html documentation available at
  6. * http://www.netlib.org/lapack/explore-html/
  7. *
  8. *> \htmlonly
  9. *> Download ZSYSVXX + dependencies
  10. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zsysvxx.f">
  11. *> [TGZ]</a>
  12. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zsysvxx.f">
  13. *> [ZIP]</a>
  14. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zsysvxx.f">
  15. *> [TXT]</a>
  16. *> \endhtmlonly
  17. *
  18. * Definition:
  19. * ===========
  20. *
  21. * SUBROUTINE ZSYSVXX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV,
  22. * EQUED, S, B, LDB, X, LDX, RCOND, RPVGRW, BERR,
  23. * N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP,
  24. * NPARAMS, PARAMS, WORK, RWORK, INFO )
  25. *
  26. * .. Scalar Arguments ..
  27. * CHARACTER EQUED, FACT, UPLO
  28. * INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS, NPARAMS,
  29. * $ N_ERR_BNDS
  30. * DOUBLE PRECISION RCOND, RPVGRW
  31. * ..
  32. * .. Array Arguments ..
  33. * INTEGER IPIV( * )
  34. * COMPLEX*16 A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
  35. * $ X( LDX, * ), WORK( * )
  36. * DOUBLE PRECISION S( * ), PARAMS( * ), BERR( * ),
  37. * $ ERR_BNDS_NORM( NRHS, * ),
  38. * $ ERR_BNDS_COMP( NRHS, * ), RWORK( * )
  39. * ..
  40. *
  41. *
  42. *> \par Purpose:
  43. * =============
  44. *>
  45. *> \verbatim
  46. *>
  47. *> ZSYSVXX uses the diagonal pivoting factorization to compute the
  48. *> solution to a complex*16 system of linear equations A * X = B, where
  49. *> A is an N-by-N symmetric matrix and X and B are N-by-NRHS
  50. *> matrices.
  51. *>
  52. *> If requested, both normwise and maximum componentwise error bounds
  53. *> are returned. ZSYSVXX will return a solution with a tiny
  54. *> guaranteed error (O(eps) where eps is the working machine
  55. *> precision) unless the matrix is very ill-conditioned, in which
  56. *> case a warning is returned. Relevant condition numbers also are
  57. *> calculated and returned.
  58. *>
  59. *> ZSYSVXX accepts user-provided factorizations and equilibration
  60. *> factors; see the definitions of the FACT and EQUED options.
  61. *> Solving with refinement and using a factorization from a previous
  62. *> ZSYSVXX call will also produce a solution with either O(eps)
  63. *> errors or warnings, but we cannot make that claim for general
  64. *> user-provided factorizations and equilibration factors if they
  65. *> differ from what ZSYSVXX would itself produce.
  66. *> \endverbatim
  67. *
  68. *> \par Description:
  69. * =================
  70. *>
  71. *> \verbatim
  72. *>
  73. *> The following steps are performed:
  74. *>
  75. *> 1. If FACT = 'E', double precision scaling factors are computed to equilibrate
  76. *> the system:
  77. *>
  78. *> diag(S)*A*diag(S) *inv(diag(S))*X = diag(S)*B
  79. *>
  80. *> Whether or not the system will be equilibrated depends on the
  81. *> scaling of the matrix A, but if equilibration is used, A is
  82. *> overwritten by diag(S)*A*diag(S) and B by diag(S)*B.
  83. *>
  84. *> 2. If FACT = 'N' or 'E', the LU decomposition is used to factor
  85. *> the matrix A (after equilibration if FACT = 'E') as
  86. *>
  87. *> A = U * D * U**T, if UPLO = 'U', or
  88. *> A = L * D * L**T, if UPLO = 'L',
  89. *>
  90. *> where U (or L) is a product of permutation and unit upper (lower)
  91. *> triangular matrices, and D is symmetric and block diagonal with
  92. *> 1-by-1 and 2-by-2 diagonal blocks.
  93. *>
  94. *> 3. If some D(i,i)=0, so that D is exactly singular, then the
  95. *> routine returns with INFO = i. Otherwise, the factored form of A
  96. *> is used to estimate the condition number of the matrix A (see
  97. *> argument RCOND). If the reciprocal of the condition number is
  98. *> less than machine precision, the routine still goes on to solve
  99. *> for X and compute error bounds as described below.
  100. *>
  101. *> 4. The system of equations is solved for X using the factored form
  102. *> of A.
  103. *>
  104. *> 5. By default (unless PARAMS(LA_LINRX_ITREF_I) is set to zero),
  105. *> the routine will use iterative refinement to try to get a small
  106. *> error and error bounds. Refinement calculates the residual to at
  107. *> least twice the working precision.
  108. *>
  109. *> 6. If equilibration was used, the matrix X is premultiplied by
  110. *> diag(R) so that it solves the original system before
  111. *> equilibration.
  112. *> \endverbatim
  113. *
  114. * Arguments:
  115. * ==========
  116. *
  117. *> \verbatim
  118. *> Some optional parameters are bundled in the PARAMS array. These
  119. *> settings determine how refinement is performed, but often the
  120. *> defaults are acceptable. If the defaults are acceptable, users
  121. *> can pass NPARAMS = 0 which prevents the source code from accessing
  122. *> the PARAMS argument.
  123. *> \endverbatim
  124. *>
  125. *> \param[in] FACT
  126. *> \verbatim
  127. *> FACT is CHARACTER*1
  128. *> Specifies whether or not the factored form of the matrix A is
  129. *> supplied on entry, and if not, whether the matrix A should be
  130. *> equilibrated before it is factored.
  131. *> = 'F': On entry, AF and IPIV contain the factored form of A.
  132. *> If EQUED is not 'N', the matrix A has been
  133. *> equilibrated with scaling factors given by S.
  134. *> A, AF, and IPIV are not modified.
  135. *> = 'N': The matrix A will be copied to AF and factored.
  136. *> = 'E': The matrix A will be equilibrated if necessary, then
  137. *> copied to AF and factored.
  138. *> \endverbatim
  139. *>
  140. *> \param[in] UPLO
  141. *> \verbatim
  142. *> UPLO is CHARACTER*1
  143. *> = 'U': Upper triangle of A is stored;
  144. *> = 'L': Lower triangle of A is stored.
  145. *> \endverbatim
  146. *>
  147. *> \param[in] N
  148. *> \verbatim
  149. *> N is INTEGER
  150. *> The number of linear equations, i.e., the order of the
  151. *> matrix A. N >= 0.
  152. *> \endverbatim
  153. *>
  154. *> \param[in] NRHS
  155. *> \verbatim
  156. *> NRHS is INTEGER
  157. *> The number of right hand sides, i.e., the number of columns
  158. *> of the matrices B and X. NRHS >= 0.
  159. *> \endverbatim
  160. *>
  161. *> \param[in,out] A
  162. *> \verbatim
  163. *> A is COMPLEX*16 array, dimension (LDA,N)
  164. *> The symmetric matrix A. If UPLO = 'U', the leading N-by-N
  165. *> upper triangular part of A contains the upper triangular
  166. *> part of the matrix A, and the strictly lower triangular
  167. *> part of A is not referenced. If UPLO = 'L', the leading
  168. *> N-by-N lower triangular part of A contains the lower
  169. *> triangular part of the matrix A, and the strictly upper
  170. *> triangular part of A is not referenced.
  171. *>
  172. *> On exit, if FACT = 'E' and EQUED = 'Y', A is overwritten by
  173. *> diag(S)*A*diag(S).
  174. *> \endverbatim
  175. *>
  176. *> \param[in] LDA
  177. *> \verbatim
  178. *> LDA is INTEGER
  179. *> The leading dimension of the array A. LDA >= max(1,N).
  180. *> \endverbatim
  181. *>
  182. *> \param[in,out] AF
  183. *> \verbatim
  184. *> AF is COMPLEX*16 array, dimension (LDAF,N)
  185. *> If FACT = 'F', then AF is an input argument and on entry
  186. *> contains the block diagonal matrix D and the multipliers
  187. *> used to obtain the factor U or L from the factorization A =
  188. *> U*D*U**T or A = L*D*L**T as computed by ZSYTRF.
  189. *>
  190. *> If FACT = 'N', then AF is an output argument and on exit
  191. *> returns the block diagonal matrix D and the multipliers
  192. *> used to obtain the factor U or L from the factorization A =
  193. *> U*D*U**T or A = L*D*L**T.
  194. *> \endverbatim
  195. *>
  196. *> \param[in] LDAF
  197. *> \verbatim
  198. *> LDAF is INTEGER
  199. *> The leading dimension of the array AF. LDAF >= max(1,N).
  200. *> \endverbatim
  201. *>
  202. *> \param[in,out] IPIV
  203. *> \verbatim
  204. *> IPIV is INTEGER array, dimension (N)
  205. *> If FACT = 'F', then IPIV is an input argument and on entry
  206. *> contains details of the interchanges and the block
  207. *> structure of D, as determined by ZSYTRF. If IPIV(k) > 0,
  208. *> then rows and columns k and IPIV(k) were interchanged and
  209. *> D(k,k) is a 1-by-1 diagonal block. If UPLO = 'U' and
  210. *> IPIV(k) = IPIV(k-1) < 0, then rows and columns k-1 and
  211. *> -IPIV(k) were interchanged and D(k-1:k,k-1:k) is a 2-by-2
  212. *> diagonal block. If UPLO = 'L' and IPIV(k) = IPIV(k+1) < 0,
  213. *> then rows and columns k+1 and -IPIV(k) were interchanged
  214. *> and D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
  215. *>
  216. *> If FACT = 'N', then IPIV is an output argument and on exit
  217. *> contains details of the interchanges and the block
  218. *> structure of D, as determined by ZSYTRF.
  219. *> \endverbatim
  220. *>
  221. *> \param[in,out] EQUED
  222. *> \verbatim
  223. *> EQUED is CHARACTER*1
  224. *> Specifies the form of equilibration that was done.
  225. *> = 'N': No equilibration (always true if FACT = 'N').
  226. *> = 'Y': Both row and column equilibration, i.e., A has been
  227. *> replaced by diag(S) * A * diag(S).
  228. *> EQUED is an input argument if FACT = 'F'; otherwise, it is an
  229. *> output argument.
  230. *> \endverbatim
  231. *>
  232. *> \param[in,out] S
  233. *> \verbatim
  234. *> S is DOUBLE PRECISION array, dimension (N)
  235. *> The scale factors for A. If EQUED = 'Y', A is multiplied on
  236. *> the left and right by diag(S). S is an input argument if FACT =
  237. *> 'F'; otherwise, S is an output argument. If FACT = 'F' and EQUED
  238. *> = 'Y', each element of S must be positive. If S is output, each
  239. *> element of S is a power of the radix. If S is input, each element
  240. *> of S should be a power of the radix to ensure a reliable solution
  241. *> and error estimates. Scaling by powers of the radix does not cause
  242. *> rounding errors unless the result underflows or overflows.
  243. *> Rounding errors during scaling lead to refining with a matrix that
  244. *> is not equivalent to the input matrix, producing error estimates
  245. *> that may not be reliable.
  246. *> \endverbatim
  247. *>
  248. *> \param[in,out] B
  249. *> \verbatim
  250. *> B is COMPLEX*16 array, dimension (LDB,NRHS)
  251. *> On entry, the N-by-NRHS right hand side matrix B.
  252. *> On exit,
  253. *> if EQUED = 'N', B is not modified;
  254. *> if EQUED = 'Y', B is overwritten by diag(S)*B;
  255. *> \endverbatim
  256. *>
  257. *> \param[in] LDB
  258. *> \verbatim
  259. *> LDB is INTEGER
  260. *> The leading dimension of the array B. LDB >= max(1,N).
  261. *> \endverbatim
  262. *>
  263. *> \param[out] X
  264. *> \verbatim
  265. *> X is COMPLEX*16 array, dimension (LDX,NRHS)
  266. *> If INFO = 0, the N-by-NRHS solution matrix X to the original
  267. *> system of equations. Note that A and B are modified on exit if
  268. *> EQUED .ne. 'N', and the solution to the equilibrated system is
  269. *> inv(diag(S))*X.
  270. *> \endverbatim
  271. *>
  272. *> \param[in] LDX
  273. *> \verbatim
  274. *> LDX is INTEGER
  275. *> The leading dimension of the array X. LDX >= max(1,N).
  276. *> \endverbatim
  277. *>
  278. *> \param[out] RCOND
  279. *> \verbatim
  280. *> RCOND is DOUBLE PRECISION
  281. *> Reciprocal scaled condition number. This is an estimate of the
  282. *> reciprocal Skeel condition number of the matrix A after
  283. *> equilibration (if done). If this is less than the machine
  284. *> precision (in particular, if it is zero), the matrix is singular
  285. *> to working precision. Note that the error may still be small even
  286. *> if this number is very small and the matrix appears ill-
  287. *> conditioned.
  288. *> \endverbatim
  289. *>
  290. *> \param[out] RPVGRW
  291. *> \verbatim
  292. *> RPVGRW is DOUBLE PRECISION
  293. *> Reciprocal pivot growth. On exit, this contains the reciprocal
  294. *> pivot growth factor norm(A)/norm(U). The "max absolute element"
  295. *> norm is used. If this is much less than 1, then the stability of
  296. *> the LU factorization of the (equilibrated) matrix A could be poor.
  297. *> This also means that the solution X, estimated condition numbers,
  298. *> and error bounds could be unreliable. If factorization fails with
  299. *> 0<INFO<=N, then this contains the reciprocal pivot growth factor
  300. *> for the leading INFO columns of A.
  301. *> \endverbatim
  302. *>
  303. *> \param[out] BERR
  304. *> \verbatim
  305. *> BERR is DOUBLE PRECISION array, dimension (NRHS)
  306. *> Componentwise relative backward error. This is the
  307. *> componentwise relative backward error of each solution vector X(j)
  308. *> (i.e., the smallest relative change in any element of A or B that
  309. *> makes X(j) an exact solution).
  310. *> \endverbatim
  311. *>
  312. *> \param[in] N_ERR_BNDS
  313. *> \verbatim
  314. *> N_ERR_BNDS is INTEGER
  315. *> Number of error bounds to return for each right hand side
  316. *> and each type (normwise or componentwise). See ERR_BNDS_NORM and
  317. *> ERR_BNDS_COMP below.
  318. *> \endverbatim
  319. *>
  320. *> \param[out] ERR_BNDS_NORM
  321. *> \verbatim
  322. *> ERR_BNDS_NORM is DOUBLE PRECISION array, dimension (NRHS, N_ERR_BNDS)
  323. *> For each right-hand side, this array contains information about
  324. *> various error bounds and condition numbers corresponding to the
  325. *> normwise relative error, which is defined as follows:
  326. *>
  327. *> Normwise relative error in the ith solution vector:
  328. *> max_j (abs(XTRUE(j,i) - X(j,i)))
  329. *> ------------------------------
  330. *> max_j abs(X(j,i))
  331. *>
  332. *> The array is indexed by the type of error information as described
  333. *> below. There currently are up to three pieces of information
  334. *> returned.
  335. *>
  336. *> The first index in ERR_BNDS_NORM(i,:) corresponds to the ith
  337. *> right-hand side.
  338. *>
  339. *> The second index in ERR_BNDS_NORM(:,err) contains the following
  340. *> three fields:
  341. *> err = 1 "Trust/don't trust" boolean. Trust the answer if the
  342. *> reciprocal condition number is less than the threshold
  343. *> sqrt(n) * dlamch('Epsilon').
  344. *>
  345. *> err = 2 "Guaranteed" error bound: The estimated forward error,
  346. *> almost certainly within a factor of 10 of the true error
  347. *> so long as the next entry is greater than the threshold
  348. *> sqrt(n) * dlamch('Epsilon'). This error bound should only
  349. *> be trusted if the previous boolean is true.
  350. *>
  351. *> err = 3 Reciprocal condition number: Estimated normwise
  352. *> reciprocal condition number. Compared with the threshold
  353. *> sqrt(n) * dlamch('Epsilon') to determine if the error
  354. *> estimate is "guaranteed". These reciprocal condition
  355. *> numbers are 1 / (norm(Z^{-1},inf) * norm(Z,inf)) for some
  356. *> appropriately scaled matrix Z.
  357. *> Let Z = S*A, where S scales each row by a power of the
  358. *> radix so all absolute row sums of Z are approximately 1.
  359. *>
  360. *> See Lapack Working Note 165 for further details and extra
  361. *> cautions.
  362. *> \endverbatim
  363. *>
  364. *> \param[out] ERR_BNDS_COMP
  365. *> \verbatim
  366. *> ERR_BNDS_COMP is DOUBLE PRECISION array, dimension (NRHS, N_ERR_BNDS)
  367. *> For each right-hand side, this array contains information about
  368. *> various error bounds and condition numbers corresponding to the
  369. *> componentwise relative error, which is defined as follows:
  370. *>
  371. *> Componentwise relative error in the ith solution vector:
  372. *> abs(XTRUE(j,i) - X(j,i))
  373. *> max_j ----------------------
  374. *> abs(X(j,i))
  375. *>
  376. *> The array is indexed by the right-hand side i (on which the
  377. *> componentwise relative error depends), and the type of error
  378. *> information as described below. There currently are up to three
  379. *> pieces of information returned for each right-hand side. If
  380. *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then
  381. *> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most
  382. *> the first (:,N_ERR_BNDS) entries are returned.
  383. *>
  384. *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith
  385. *> right-hand side.
  386. *>
  387. *> The second index in ERR_BNDS_COMP(:,err) contains the following
  388. *> three fields:
  389. *> err = 1 "Trust/don't trust" boolean. Trust the answer if the
  390. *> reciprocal condition number is less than the threshold
  391. *> sqrt(n) * dlamch('Epsilon').
  392. *>
  393. *> err = 2 "Guaranteed" error bound: The estimated forward error,
  394. *> almost certainly within a factor of 10 of the true error
  395. *> so long as the next entry is greater than the threshold
  396. *> sqrt(n) * dlamch('Epsilon'). This error bound should only
  397. *> be trusted if the previous boolean is true.
  398. *>
  399. *> err = 3 Reciprocal condition number: Estimated componentwise
  400. *> reciprocal condition number. Compared with the threshold
  401. *> sqrt(n) * dlamch('Epsilon') to determine if the error
  402. *> estimate is "guaranteed". These reciprocal condition
  403. *> numbers are 1 / (norm(Z^{-1},inf) * norm(Z,inf)) for some
  404. *> appropriately scaled matrix Z.
  405. *> Let Z = S*(A*diag(x)), where x is the solution for the
  406. *> current right-hand side and S scales each row of
  407. *> A*diag(x) by a power of the radix so all absolute row
  408. *> sums of Z are approximately 1.
  409. *>
  410. *> See Lapack Working Note 165 for further details and extra
  411. *> cautions.
  412. *> \endverbatim
  413. *>
  414. *> \param[in] NPARAMS
  415. *> \verbatim
  416. *> NPARAMS is INTEGER
  417. *> Specifies the number of parameters set in PARAMS. If <= 0, the
  418. *> PARAMS array is never referenced and default values are used.
  419. *> \endverbatim
  420. *>
  421. *> \param[in,out] PARAMS
  422. *> \verbatim
  423. *> PARAMS is DOUBLE PRECISION array, dimension NPARAMS
  424. *> Specifies algorithm parameters. If an entry is < 0.0, then
  425. *> that entry will be filled with default value used for that
  426. *> parameter. Only positions up to NPARAMS are accessed; defaults
  427. *> are used for higher-numbered parameters.
  428. *>
  429. *> PARAMS(LA_LINRX_ITREF_I = 1) : Whether to perform iterative
  430. *> refinement or not.
  431. *> Default: 1.0D+0
  432. *> = 0.0: No refinement is performed, and no error bounds are
  433. *> computed.
  434. *> = 1.0: Use the extra-precise refinement algorithm.
  435. *> (other values are reserved for future use)
  436. *>
  437. *> PARAMS(LA_LINRX_ITHRESH_I = 2) : Maximum number of residual
  438. *> computations allowed for refinement.
  439. *> Default: 10
  440. *> Aggressive: Set to 100 to permit convergence using approximate
  441. *> factorizations or factorizations other than LU. If
  442. *> the factorization uses a technique other than
  443. *> Gaussian elimination, the guarantees in
  444. *> err_bnds_norm and err_bnds_comp may no longer be
  445. *> trustworthy.
  446. *>
  447. *> PARAMS(LA_LINRX_CWISE_I = 3) : Flag determining if the code
  448. *> will attempt to find a solution with small componentwise
  449. *> relative error in the double-precision algorithm. Positive
  450. *> is true, 0.0 is false.
  451. *> Default: 1.0 (attempt componentwise convergence)
  452. *> \endverbatim
  453. *>
  454. *> \param[out] WORK
  455. *> \verbatim
  456. *> WORK is COMPLEX*16 array, dimension (2*N)
  457. *> \endverbatim
  458. *>
  459. *> \param[out] RWORK
  460. *> \verbatim
  461. *> RWORK is DOUBLE PRECISION array, dimension (2*N)
  462. *> \endverbatim
  463. *>
  464. *> \param[out] INFO
  465. *> \verbatim
  466. *> INFO is INTEGER
  467. *> = 0: Successful exit. The solution to every right-hand side is
  468. *> guaranteed.
  469. *> < 0: If INFO = -i, the i-th argument had an illegal value
  470. *> > 0 and <= N: U(INFO,INFO) is exactly zero. The factorization
  471. *> has been completed, but the factor U is exactly singular, so
  472. *> the solution and error bounds could not be computed. RCOND = 0
  473. *> is returned.
  474. *> = N+J: The solution corresponding to the Jth right-hand side is
  475. *> not guaranteed. The solutions corresponding to other right-
  476. *> hand sides K with K > J may not be guaranteed as well, but
  477. *> only the first such right-hand side is reported. If a small
  478. *> componentwise error is not requested (PARAMS(3) = 0.0) then
  479. *> the Jth right-hand side is the first with a normwise error
  480. *> bound that is not guaranteed (the smallest J such
  481. *> that ERR_BNDS_NORM(J,1) = 0.0). By default (PARAMS(3) = 1.0)
  482. *> the Jth right-hand side is the first with either a normwise or
  483. *> componentwise error bound that is not guaranteed (the smallest
  484. *> J such that either ERR_BNDS_NORM(J,1) = 0.0 or
  485. *> ERR_BNDS_COMP(J,1) = 0.0). See the definition of
  486. *> ERR_BNDS_NORM(:,1) and ERR_BNDS_COMP(:,1). To get information
  487. *> about all of the right-hand sides check ERR_BNDS_NORM or
  488. *> ERR_BNDS_COMP.
  489. *> \endverbatim
  490. *
  491. * Authors:
  492. * ========
  493. *
  494. *> \author Univ. of Tennessee
  495. *> \author Univ. of California Berkeley
  496. *> \author Univ. of Colorado Denver
  497. *> \author NAG Ltd.
  498. *
  499. *> \ingroup complex16SYsolve
  500. *
  501. * =====================================================================
  502. SUBROUTINE ZSYSVXX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV,
  503. $ EQUED, S, B, LDB, X, LDX, RCOND, RPVGRW, BERR,
  504. $ N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP,
  505. $ NPARAMS, PARAMS, WORK, RWORK, INFO )
  506. *
  507. * -- LAPACK driver routine --
  508. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  509. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  510. *
  511. * .. Scalar Arguments ..
  512. CHARACTER EQUED, FACT, UPLO
  513. INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS, NPARAMS,
  514. $ N_ERR_BNDS
  515. DOUBLE PRECISION RCOND, RPVGRW
  516. * ..
  517. * .. Array Arguments ..
  518. INTEGER IPIV( * )
  519. COMPLEX*16 A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
  520. $ X( LDX, * ), WORK( * )
  521. DOUBLE PRECISION S( * ), PARAMS( * ), BERR( * ),
  522. $ ERR_BNDS_NORM( NRHS, * ),
  523. $ ERR_BNDS_COMP( NRHS, * ), RWORK( * )
  524. * ..
  525. *
  526. * ==================================================================
  527. *
  528. * .. Parameters ..
  529. DOUBLE PRECISION ZERO, ONE
  530. PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
  531. INTEGER FINAL_NRM_ERR_I, FINAL_CMP_ERR_I, BERR_I
  532. INTEGER RCOND_I, NRM_RCOND_I, NRM_ERR_I, CMP_RCOND_I
  533. INTEGER CMP_ERR_I, PIV_GROWTH_I
  534. PARAMETER ( FINAL_NRM_ERR_I = 1, FINAL_CMP_ERR_I = 2,
  535. $ BERR_I = 3 )
  536. PARAMETER ( RCOND_I = 4, NRM_RCOND_I = 5, NRM_ERR_I = 6 )
  537. PARAMETER ( CMP_RCOND_I = 7, CMP_ERR_I = 8,
  538. $ PIV_GROWTH_I = 9 )
  539. * ..
  540. * .. Local Scalars ..
  541. LOGICAL EQUIL, NOFACT, RCEQU
  542. INTEGER INFEQU, J
  543. DOUBLE PRECISION AMAX, BIGNUM, SMIN, SMAX, SCOND, SMLNUM
  544. * ..
  545. * .. External Functions ..
  546. EXTERNAL LSAME, DLAMCH, ZLA_SYRPVGRW
  547. LOGICAL LSAME
  548. DOUBLE PRECISION DLAMCH, ZLA_SYRPVGRW
  549. * ..
  550. * .. External Subroutines ..
  551. EXTERNAL ZSYEQUB, ZSYTRF, ZSYTRS, ZLACPY,
  552. $ ZLAQSY, XERBLA, ZLASCL2, ZSYRFSX
  553. * ..
  554. * .. Intrinsic Functions ..
  555. INTRINSIC MAX, MIN
  556. * ..
  557. * .. Executable Statements ..
  558. *
  559. INFO = 0
  560. NOFACT = LSAME( FACT, 'N' )
  561. EQUIL = LSAME( FACT, 'E' )
  562. SMLNUM = DLAMCH( 'Safe minimum' )
  563. BIGNUM = ONE / SMLNUM
  564. IF( NOFACT .OR. EQUIL ) THEN
  565. EQUED = 'N'
  566. RCEQU = .FALSE.
  567. ELSE
  568. RCEQU = LSAME( EQUED, 'Y' )
  569. ENDIF
  570. *
  571. * Default is failure. If an input parameter is wrong or
  572. * factorization fails, make everything look horrible. Only the
  573. * pivot growth is set here, the rest is initialized in ZSYRFSX.
  574. *
  575. RPVGRW = ZERO
  576. *
  577. * Test the input parameters. PARAMS is not tested until ZSYRFSX.
  578. *
  579. IF( .NOT.NOFACT .AND. .NOT.EQUIL .AND. .NOT.
  580. $ LSAME( FACT, 'F' ) ) THEN
  581. INFO = -1
  582. ELSE IF( .NOT.LSAME(UPLO, 'U') .AND.
  583. $ .NOT.LSAME(UPLO, 'L') ) THEN
  584. INFO = -2
  585. ELSE IF( N.LT.0 ) THEN
  586. INFO = -3
  587. ELSE IF( NRHS.LT.0 ) THEN
  588. INFO = -4
  589. ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
  590. INFO = -6
  591. ELSE IF( LDAF.LT.MAX( 1, N ) ) THEN
  592. INFO = -8
  593. ELSE IF( LSAME( FACT, 'F' ) .AND. .NOT.
  594. $ ( RCEQU .OR. LSAME( EQUED, 'N' ) ) ) THEN
  595. INFO = -10
  596. ELSE
  597. IF ( RCEQU ) THEN
  598. SMIN = BIGNUM
  599. SMAX = ZERO
  600. DO 10 J = 1, N
  601. SMIN = MIN( SMIN, S( J ) )
  602. SMAX = MAX( SMAX, S( J ) )
  603. 10 CONTINUE
  604. IF( SMIN.LE.ZERO ) THEN
  605. INFO = -11
  606. ELSE IF( N.GT.0 ) THEN
  607. SCOND = MAX( SMIN, SMLNUM ) / MIN( SMAX, BIGNUM )
  608. ELSE
  609. SCOND = ONE
  610. END IF
  611. END IF
  612. IF( INFO.EQ.0 ) THEN
  613. IF( LDB.LT.MAX( 1, N ) ) THEN
  614. INFO = -13
  615. ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
  616. INFO = -15
  617. END IF
  618. END IF
  619. END IF
  620. *
  621. IF( INFO.NE.0 ) THEN
  622. CALL XERBLA( 'ZSYSVXX', -INFO )
  623. RETURN
  624. END IF
  625. *
  626. IF( EQUIL ) THEN
  627. *
  628. * Compute row and column scalings to equilibrate the matrix A.
  629. *
  630. CALL ZSYEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, INFEQU )
  631. IF( INFEQU.EQ.0 ) THEN
  632. *
  633. * Equilibrate the matrix.
  634. *
  635. CALL ZLAQSY( UPLO, N, A, LDA, S, SCOND, AMAX, EQUED )
  636. RCEQU = LSAME( EQUED, 'Y' )
  637. END IF
  638. END IF
  639. *
  640. * Scale the right hand-side.
  641. *
  642. IF( RCEQU ) CALL ZLASCL2( N, NRHS, S, B, LDB )
  643. *
  644. IF( NOFACT .OR. EQUIL ) THEN
  645. *
  646. * Compute the LDL^T or UDU^T factorization of A.
  647. *
  648. CALL ZLACPY( UPLO, N, N, A, LDA, AF, LDAF )
  649. CALL ZSYTRF( UPLO, N, AF, LDAF, IPIV, WORK, 5*MAX(1,N), INFO )
  650. *
  651. * Return if INFO is non-zero.
  652. *
  653. IF( INFO.GT.0 ) THEN
  654. *
  655. * Pivot in column INFO is exactly 0
  656. * Compute the reciprocal pivot growth factor of the
  657. * leading rank-deficient INFO columns of A.
  658. *
  659. IF ( N.GT.0 )
  660. $ RPVGRW = ZLA_SYRPVGRW( UPLO, N, INFO, A, LDA, AF,
  661. $ LDAF, IPIV, RWORK )
  662. RETURN
  663. END IF
  664. END IF
  665. *
  666. * Compute the reciprocal pivot growth factor RPVGRW.
  667. *
  668. IF ( N.GT.0 )
  669. $ RPVGRW = ZLA_SYRPVGRW( UPLO, N, INFO, A, LDA, AF, LDAF,
  670. $ IPIV, RWORK )
  671. *
  672. * Compute the solution matrix X.
  673. *
  674. CALL ZLACPY( 'Full', N, NRHS, B, LDB, X, LDX )
  675. CALL ZSYTRS( UPLO, N, NRHS, AF, LDAF, IPIV, X, LDX, INFO )
  676. *
  677. * Use iterative refinement to improve the computed solution and
  678. * compute error bounds and backward error estimates for it.
  679. *
  680. CALL ZSYRFSX( UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF, IPIV,
  681. $ S, B, LDB, X, LDX, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_NORM,
  682. $ ERR_BNDS_COMP, NPARAMS, PARAMS, WORK, RWORK, INFO )
  683. *
  684. * Scale solutions.
  685. *
  686. IF ( RCEQU ) THEN
  687. CALL ZLASCL2 (N, NRHS, S, X, LDX )
  688. END IF
  689. *
  690. RETURN
  691. *
  692. * End of ZSYSVXX
  693. *
  694. END