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.1 kB

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