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.

clsets.f 5.5 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214
  1. *> \brief \b CLSETS
  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 CLSETS( M, P, N, A, AF, LDA, B, BF, LDB, C, CF,
  12. * D, DF, X, WORK, LWORK, RWORK, RESULT )
  13. *
  14. * .. Scalar Arguments ..
  15. * INTEGER LDA, LDB, LWORK, M, P, N
  16. * ..
  17. * .. Array Arguments ..
  18. * REAL RESULT( 2 ), RWORK( * )
  19. * COMPLEX A( LDA, * ), AF( LDA, * ), B( LDB, * ),
  20. * $ BF( LDB, * ), C( * ), D( * ), CF( * ),
  21. * $ DF( * ), WORK( LWORK ), X( * )
  22. *
  23. *
  24. *> \par Purpose:
  25. * =============
  26. *>
  27. *> \verbatim
  28. *>
  29. *> CLSETS tests CGGLSE - a subroutine for solving linear equality
  30. *> constrained least square problem (LSE).
  31. *> \endverbatim
  32. *
  33. * Arguments:
  34. * ==========
  35. *
  36. *> \param[in] M
  37. *> \verbatim
  38. *> M is INTEGER
  39. *> The number of rows of the matrix A. M >= 0.
  40. *> \endverbatim
  41. *>
  42. *> \param[in] P
  43. *> \verbatim
  44. *> P is INTEGER
  45. *> The number of rows of the matrix B. P >= 0.
  46. *> \endverbatim
  47. *>
  48. *> \param[in] N
  49. *> \verbatim
  50. *> N is INTEGER
  51. *> The number of columns of the matrices A and B. N >= 0.
  52. *> \endverbatim
  53. *>
  54. *> \param[in] A
  55. *> \verbatim
  56. *> A is COMPLEX array, dimension (LDA,N)
  57. *> The M-by-N matrix A.
  58. *> \endverbatim
  59. *>
  60. *> \param[out] AF
  61. *> \verbatim
  62. *> AF is COMPLEX array, dimension (LDA,N)
  63. *> \endverbatim
  64. *>
  65. *> \param[in] LDA
  66. *> \verbatim
  67. *> LDA is INTEGER
  68. *> The leading dimension of the arrays A, AF, Q and R.
  69. *> LDA >= max(M,N).
  70. *> \endverbatim
  71. *>
  72. *> \param[in] B
  73. *> \verbatim
  74. *> B is COMPLEX array, dimension (LDB,N)
  75. *> The P-by-N matrix A.
  76. *> \endverbatim
  77. *>
  78. *> \param[out] BF
  79. *> \verbatim
  80. *> BF is COMPLEX array, dimension (LDB,N)
  81. *> \endverbatim
  82. *>
  83. *> \param[in] LDB
  84. *> \verbatim
  85. *> LDB is INTEGER
  86. *> The leading dimension of the arrays B, BF, V and S.
  87. *> LDB >= max(P,N).
  88. *> \endverbatim
  89. *>
  90. *> \param[in] C
  91. *> \verbatim
  92. *> C is COMPLEX array, dimension( M )
  93. *> the vector C in the LSE problem.
  94. *> \endverbatim
  95. *>
  96. *> \param[out] CF
  97. *> \verbatim
  98. *> CF is COMPLEX array, dimension( M )
  99. *> \endverbatim
  100. *>
  101. *> \param[in] D
  102. *> \verbatim
  103. *> D is COMPLEX array, dimension( P )
  104. *> the vector D in the LSE problem.
  105. *> \endverbatim
  106. *>
  107. *> \param[out] DF
  108. *> \verbatim
  109. *> DF is COMPLEX array, dimension( P )
  110. *> \endverbatim
  111. *>
  112. *> \param[out] X
  113. *> \verbatim
  114. *> X is COMPLEX array, dimension( N )
  115. *> solution vector X in the LSE problem.
  116. *> \endverbatim
  117. *>
  118. *> \param[out] WORK
  119. *> \verbatim
  120. *> WORK is COMPLEX array, dimension (LWORK)
  121. *> \endverbatim
  122. *>
  123. *> \param[in] LWORK
  124. *> \verbatim
  125. *> LWORK is INTEGER
  126. *> The dimension of the array WORK.
  127. *> \endverbatim
  128. *>
  129. *> \param[out] RWORK
  130. *> \verbatim
  131. *> RWORK is REAL array, dimension (M)
  132. *> \endverbatim
  133. *>
  134. *> \param[out] RESULT
  135. *> \verbatim
  136. *> RESULT is REAL array, dimension (2)
  137. *> The test ratios:
  138. *> RESULT(1) = norm( A*x - c )/ norm(A)*norm(X)*EPS
  139. *> RESULT(2) = norm( B*x - d )/ norm(B)*norm(X)*EPS
  140. *> \endverbatim
  141. *
  142. * Authors:
  143. * ========
  144. *
  145. *> \author Univ. of Tennessee
  146. *> \author Univ. of California Berkeley
  147. *> \author Univ. of Colorado Denver
  148. *> \author NAG Ltd.
  149. *
  150. *> \date December 2016
  151. *
  152. *> \ingroup complex_eig
  153. *
  154. * =====================================================================
  155. SUBROUTINE CLSETS( M, P, N, A, AF, LDA, B, BF, LDB, C, CF,
  156. $ D, DF, X, WORK, LWORK, RWORK, RESULT )
  157. *
  158. * -- LAPACK test routine (version 3.7.0) --
  159. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  160. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  161. * December 2016
  162. *
  163. * .. Scalar Arguments ..
  164. INTEGER LDA, LDB, LWORK, M, P, N
  165. * ..
  166. * .. Array Arguments ..
  167. REAL RESULT( 2 ), RWORK( * )
  168. COMPLEX A( LDA, * ), AF( LDA, * ), B( LDB, * ),
  169. $ BF( LDB, * ), C( * ), D( * ), CF( * ),
  170. $ DF( * ), WORK( LWORK ), X( * )
  171. *
  172. * ====================================================================
  173. *
  174. * ..
  175. * .. Local Scalars ..
  176. INTEGER INFO
  177. * ..
  178. * .. External Subroutines ..
  179. EXTERNAL CGGLSE, CLACPY, CGET02
  180. * ..
  181. * .. Executable Statements ..
  182. *
  183. * Copy the matrices A and B to the arrays AF and BF,
  184. * and the vectors C and D to the arrays CF and DF,
  185. *
  186. CALL CLACPY( 'Full', M, N, A, LDA, AF, LDA )
  187. CALL CLACPY( 'Full', P, N, B, LDB, BF, LDB )
  188. CALL CCOPY( M, C, 1, CF, 1 )
  189. CALL CCOPY( P, D, 1, DF, 1 )
  190. *
  191. * Solve LSE problem
  192. *
  193. CALL CGGLSE( M, N, P, AF, LDA, BF, LDB, CF, DF, X,
  194. $ WORK, LWORK, INFO )
  195. *
  196. * Test the residual for the solution of LSE
  197. *
  198. * Compute RESULT(1) = norm( A*x - c ) / norm(A)*norm(X)*EPS
  199. *
  200. CALL CCOPY( M, C, 1, CF, 1 )
  201. CALL CCOPY( P, D, 1, DF, 1 )
  202. CALL CGET02( 'No transpose', M, N, 1, A, LDA, X, N, CF, M,
  203. $ RWORK, RESULT( 1 ) )
  204. *
  205. * Compute result(2) = norm( B*x - d ) / norm(B)*norm(X)*EPS
  206. *
  207. CALL CGET02( 'No transpose', P, N, 1, B, LDB, X, N, DF, P,
  208. $ RWORK, RESULT( 2 ) )
  209. *
  210. RETURN
  211. *
  212. * End of CLSETS
  213. *
  214. END