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.

zerrls.f 7.0 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226
  1. *> \brief \b ZERRLS
  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 ZERRLS( PATH, NUNIT )
  12. *
  13. * .. Scalar Arguments ..
  14. * CHARACTER*3 PATH
  15. * INTEGER NUNIT
  16. * ..
  17. *
  18. *
  19. *> \par Purpose:
  20. * =============
  21. *>
  22. *> \verbatim
  23. *>
  24. *> ZERRLS tests the error exits for the COMPLEX*16 least squares
  25. *> driver routines (ZGELS, CGELSS, CGELSY, CGELSD).
  26. *> \endverbatim
  27. *
  28. * Arguments:
  29. * ==========
  30. *
  31. *> \param[in] PATH
  32. *> \verbatim
  33. *> PATH is CHARACTER*3
  34. *> The LAPACK path name for the routines to be tested.
  35. *> \endverbatim
  36. *>
  37. *> \param[in] NUNIT
  38. *> \verbatim
  39. *> NUNIT is INTEGER
  40. *> The unit number for output.
  41. *> \endverbatim
  42. *
  43. * Authors:
  44. * ========
  45. *
  46. *> \author Univ. of Tennessee
  47. *> \author Univ. of California Berkeley
  48. *> \author Univ. of Colorado Denver
  49. *> \author NAG Ltd.
  50. *
  51. *> \ingroup complex16_lin
  52. *
  53. * =====================================================================
  54. SUBROUTINE ZERRLS( PATH, NUNIT )
  55. *
  56. * -- LAPACK test routine --
  57. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  58. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  59. *
  60. * .. Scalar Arguments ..
  61. CHARACTER*3 PATH
  62. INTEGER NUNIT
  63. * ..
  64. *
  65. * =====================================================================
  66. *
  67. * .. Parameters ..
  68. INTEGER NMAX
  69. PARAMETER ( NMAX = 2 )
  70. * ..
  71. * .. Local Scalars ..
  72. CHARACTER*2 C2
  73. INTEGER INFO, IRNK
  74. DOUBLE PRECISION RCOND
  75. * ..
  76. * .. Local Arrays ..
  77. INTEGER IP( NMAX )
  78. DOUBLE PRECISION RW( NMAX ), S( NMAX )
  79. COMPLEX*16 A( NMAX, NMAX ), B( NMAX, NMAX ), W( NMAX )
  80. * ..
  81. * .. External Functions ..
  82. LOGICAL LSAMEN
  83. EXTERNAL LSAMEN
  84. * ..
  85. * .. External Subroutines ..
  86. EXTERNAL ALAESM, CHKXER, ZGELS, ZGELSD, ZGELSS, ZGELSY
  87. * ..
  88. * .. Scalars in Common ..
  89. LOGICAL LERR, OK
  90. CHARACTER*32 SRNAMT
  91. INTEGER INFOT, NOUT
  92. * ..
  93. * .. Common blocks ..
  94. COMMON / INFOC / INFOT, NOUT, OK, LERR
  95. COMMON / SRNAMC / SRNAMT
  96. * ..
  97. * .. Executable Statements ..
  98. *
  99. NOUT = NUNIT
  100. C2 = PATH( 2: 3 )
  101. A( 1, 1 ) = ( 1.0D+0, 0.0D+0 )
  102. A( 1, 2 ) = ( 2.0D+0, 0.0D+0 )
  103. A( 2, 2 ) = ( 3.0D+0, 0.0D+0 )
  104. A( 2, 1 ) = ( 4.0D+0, 0.0D+0 )
  105. OK = .TRUE.
  106. WRITE( NOUT, FMT = * )
  107. *
  108. * Test error exits for the least squares driver routines.
  109. *
  110. IF( LSAMEN( 2, C2, 'LS' ) ) THEN
  111. *
  112. * ZGELS
  113. *
  114. SRNAMT = 'ZGELS '
  115. INFOT = 1
  116. CALL ZGELS( '/', 0, 0, 0, A, 1, B, 1, W, 1, INFO )
  117. CALL CHKXER( 'ZGELS ', INFOT, NOUT, LERR, OK )
  118. INFOT = 2
  119. CALL ZGELS( 'N', -1, 0, 0, A, 1, B, 1, W, 1, INFO )
  120. CALL CHKXER( 'ZGELS ', INFOT, NOUT, LERR, OK )
  121. INFOT = 3
  122. CALL ZGELS( 'N', 0, -1, 0, A, 1, B, 1, W, 1, INFO )
  123. CALL CHKXER( 'ZGELS ', INFOT, NOUT, LERR, OK )
  124. INFOT = 4
  125. CALL ZGELS( 'N', 0, 0, -1, A, 1, B, 1, W, 1, INFO )
  126. CALL CHKXER( 'ZGELS ', INFOT, NOUT, LERR, OK )
  127. INFOT = 6
  128. CALL ZGELS( 'N', 2, 0, 0, A, 1, B, 2, W, 2, INFO )
  129. CALL CHKXER( 'ZGELS ', INFOT, NOUT, LERR, OK )
  130. INFOT = 8
  131. CALL ZGELS( 'N', 2, 0, 0, A, 2, B, 1, W, 2, INFO )
  132. CALL CHKXER( 'ZGELS ', INFOT, NOUT, LERR, OK )
  133. INFOT = 10
  134. CALL ZGELS( 'N', 1, 1, 0, A, 1, B, 1, W, 1, INFO )
  135. CALL CHKXER( 'ZGELS ', INFOT, NOUT, LERR, OK )
  136. *
  137. * ZGELSS
  138. *
  139. SRNAMT = 'ZGELSS'
  140. INFOT = 1
  141. CALL ZGELSS( -1, 0, 0, A, 1, B, 1, S, RCOND, IRNK, W, 1, RW,
  142. $ INFO )
  143. CALL CHKXER( 'ZGELSS', INFOT, NOUT, LERR, OK )
  144. INFOT = 2
  145. CALL ZGELSS( 0, -1, 0, A, 1, B, 1, S, RCOND, IRNK, W, 1, RW,
  146. $ INFO )
  147. CALL CHKXER( 'ZGELSS', INFOT, NOUT, LERR, OK )
  148. INFOT = 3
  149. CALL ZGELSS( 0, 0, -1, A, 1, B, 1, S, RCOND, IRNK, W, 1, RW,
  150. $ INFO )
  151. CALL CHKXER( 'ZGELSS', INFOT, NOUT, LERR, OK )
  152. INFOT = 5
  153. CALL ZGELSS( 2, 0, 0, A, 1, B, 2, S, RCOND, IRNK, W, 2, RW,
  154. $ INFO )
  155. CALL CHKXER( 'ZGELSS', INFOT, NOUT, LERR, OK )
  156. INFOT = 7
  157. CALL ZGELSS( 2, 0, 0, A, 2, B, 1, S, RCOND, IRNK, W, 2, RW,
  158. $ INFO )
  159. CALL CHKXER( 'ZGELSS', INFOT, NOUT, LERR, OK )
  160. *
  161. * ZGELSY
  162. *
  163. SRNAMT = 'ZGELSY'
  164. INFOT = 1
  165. CALL ZGELSY( -1, 0, 0, A, 1, B, 1, IP, RCOND, IRNK, W, 10, RW,
  166. $ INFO )
  167. CALL CHKXER( 'ZGELSY', INFOT, NOUT, LERR, OK )
  168. INFOT = 2
  169. CALL ZGELSY( 0, -1, 0, A, 1, B, 1, IP, RCOND, IRNK, W, 10, RW,
  170. $ INFO )
  171. CALL CHKXER( 'ZGELSY', INFOT, NOUT, LERR, OK )
  172. INFOT = 3
  173. CALL ZGELSY( 0, 0, -1, A, 1, B, 1, IP, RCOND, IRNK, W, 10, RW,
  174. $ INFO )
  175. CALL CHKXER( 'ZGELSY', INFOT, NOUT, LERR, OK )
  176. INFOT = 5
  177. CALL ZGELSY( 2, 0, 0, A, 1, B, 2, IP, RCOND, IRNK, W, 10, RW,
  178. $ INFO )
  179. CALL CHKXER( 'ZGELSY', INFOT, NOUT, LERR, OK )
  180. INFOT = 7
  181. CALL ZGELSY( 2, 0, 0, A, 2, B, 1, IP, RCOND, IRNK, W, 10, RW,
  182. $ INFO )
  183. CALL CHKXER( 'ZGELSY', INFOT, NOUT, LERR, OK )
  184. INFOT = 12
  185. CALL ZGELSY( 0, 3, 0, A, 1, B, 3, IP, RCOND, IRNK, W, 1, RW,
  186. $ INFO )
  187. CALL CHKXER( 'ZGELSY', INFOT, NOUT, LERR, OK )
  188. *
  189. * ZGELSD
  190. *
  191. SRNAMT = 'ZGELSD'
  192. INFOT = 1
  193. CALL ZGELSD( -1, 0, 0, A, 1, B, 1, S, RCOND, IRNK, W, 10, RW,
  194. $ IP, INFO )
  195. CALL CHKXER( 'ZGELSD', INFOT, NOUT, LERR, OK )
  196. INFOT = 2
  197. CALL ZGELSD( 0, -1, 0, A, 1, B, 1, S, RCOND, IRNK, W, 10, RW,
  198. $ IP, INFO )
  199. CALL CHKXER( 'ZGELSD', INFOT, NOUT, LERR, OK )
  200. INFOT = 3
  201. CALL ZGELSD( 0, 0, -1, A, 1, B, 1, S, RCOND, IRNK, W, 10, RW,
  202. $ IP, INFO )
  203. CALL CHKXER( 'ZGELSD', INFOT, NOUT, LERR, OK )
  204. INFOT = 5
  205. CALL ZGELSD( 2, 0, 0, A, 1, B, 2, S, RCOND, IRNK, W, 10, RW,
  206. $ IP, INFO )
  207. CALL CHKXER( 'ZGELSD', INFOT, NOUT, LERR, OK )
  208. INFOT = 7
  209. CALL ZGELSD( 2, 0, 0, A, 2, B, 1, S, RCOND, IRNK, W, 10, RW,
  210. $ IP, INFO )
  211. CALL CHKXER( 'ZGELSD', INFOT, NOUT, LERR, OK )
  212. INFOT = 12
  213. CALL ZGELSD( 2, 2, 1, A, 2, B, 2, S, RCOND, IRNK, W, 1, RW, IP,
  214. $ INFO )
  215. CALL CHKXER( 'ZGELSD', INFOT, NOUT, LERR, OK )
  216. END IF
  217. *
  218. * Print a summary line.
  219. *
  220. CALL ALAESM( PATH, OK, NOUT )
  221. *
  222. RETURN
  223. *
  224. * End of ZERRLS
  225. *
  226. END