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.

derrlqt.f 5.6 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197
  1. *> \brief \b DERLQT
  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 DERRLQT( 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. *> DERRLQT tests the error exits for the DOUBLE PRECISION routines
  25. *> that use the LQT decomposition of a general matrix.
  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 double_lin
  54. *
  55. * =====================================================================
  56. SUBROUTINE DERRLQT( PATH, NUNIT )
  57. IMPLICIT NONE
  58. *
  59. * -- LAPACK test routine (version 3.7.0) --
  60. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  61. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  62. * December 2016
  63. *
  64. * .. Scalar Arguments ..
  65. CHARACTER*3 PATH
  66. INTEGER NUNIT
  67. * ..
  68. *
  69. * =====================================================================
  70. *
  71. * .. Parameters ..
  72. INTEGER NMAX
  73. PARAMETER ( NMAX = 2 )
  74. * ..
  75. * .. Local Scalars ..
  76. INTEGER I, INFO, J
  77. * ..
  78. * .. Local Arrays ..
  79. DOUBLE PRECISION A( NMAX, NMAX ), T( NMAX, NMAX ), W( NMAX ),
  80. $ C( NMAX, NMAX )
  81. * ..
  82. * .. External Subroutines ..
  83. EXTERNAL ALAESM, CHKXER, DGELQT3, DGELQT,
  84. $ DGEMLQT
  85. * ..
  86. * .. Scalars in Common ..
  87. LOGICAL LERR, OK
  88. CHARACTER*32 SRNAMT
  89. INTEGER INFOT, NOUT
  90. * ..
  91. * .. Common blocks ..
  92. COMMON / INFOC / INFOT, NOUT, OK, LERR
  93. COMMON / SRNAMC / SRNAMT
  94. * ..
  95. * .. Intrinsic Functions ..
  96. INTRINSIC DBLE
  97. * ..
  98. * .. Executable Statements ..
  99. *
  100. NOUT = NUNIT
  101. WRITE( NOUT, FMT = * )
  102. *
  103. * Set the variables to innocuous values.
  104. *
  105. DO J = 1, NMAX
  106. DO I = 1, NMAX
  107. A( I, J ) = 1.D0 / DBLE( I+J )
  108. C( I, J ) = 1.D0 / DBLE( I+J )
  109. T( I, J ) = 1.D0 / DBLE( I+J )
  110. END DO
  111. W( J ) = 0.D0
  112. END DO
  113. OK = .TRUE.
  114. *
  115. * Error exits for LQT factorization
  116. *
  117. * DGELQT
  118. *
  119. SRNAMT = 'DGELQT'
  120. INFOT = 1
  121. CALL DGELQT( -1, 0, 1, A, 1, T, 1, W, INFO )
  122. CALL CHKXER( 'DGELQT', INFOT, NOUT, LERR, OK )
  123. INFOT = 2
  124. CALL DGELQT( 0, -1, 1, A, 1, T, 1, W, INFO )
  125. CALL CHKXER( 'DGELQT', INFOT, NOUT, LERR, OK )
  126. INFOT = 3
  127. CALL DGELQT( 0, 0, 0, A, 1, T, 1, W, INFO )
  128. CALL CHKXER( 'DGELQT', INFOT, NOUT, LERR, OK )
  129. INFOT = 5
  130. CALL DGELQT( 2, 1, 1, A, 1, T, 1, W, INFO )
  131. CALL CHKXER( 'DGELQT', INFOT, NOUT, LERR, OK )
  132. INFOT = 7
  133. CALL DGELQT( 2, 2, 2, A, 2, T, 1, W, INFO )
  134. CALL CHKXER( 'DGELQT', INFOT, NOUT, LERR, OK )
  135. *
  136. * DGELQT3
  137. *
  138. SRNAMT = 'DGELQT3'
  139. INFOT = 1
  140. CALL DGELQT3( -1, 0, A, 1, T, 1, INFO )
  141. CALL CHKXER( 'DGELQT3', INFOT, NOUT, LERR, OK )
  142. INFOT = 2
  143. CALL DGELQT3( 0, -1, A, 1, T, 1, INFO )
  144. CALL CHKXER( 'DGELQT3', INFOT, NOUT, LERR, OK )
  145. INFOT = 4
  146. CALL DGELQT3( 2, 2, A, 1, T, 1, INFO )
  147. CALL CHKXER( 'DGELQT3', INFOT, NOUT, LERR, OK )
  148. INFOT = 6
  149. CALL DGELQT3( 2, 2, A, 2, T, 1, INFO )
  150. CALL CHKXER( 'DGELQT3', INFOT, NOUT, LERR, OK )
  151. *
  152. * DGEMLQT
  153. *
  154. SRNAMT = 'DGEMLQT'
  155. INFOT = 1
  156. CALL DGEMLQT( '/', 'N', 0, 0, 0, 1, A, 1, T, 1, C, 1, W, INFO )
  157. CALL CHKXER( 'DGEMLQT', INFOT, NOUT, LERR, OK )
  158. INFOT = 2
  159. CALL DGEMLQT( 'L', '/', 0, 0, 0, 1, A, 1, T, 1, C, 1, W, INFO )
  160. CALL CHKXER( 'DGEMLQT', INFOT, NOUT, LERR, OK )
  161. INFOT = 3
  162. CALL DGEMLQT( 'L', 'N', -1, 0, 0, 1, A, 1, T, 1, C, 1, W, INFO )
  163. CALL CHKXER( 'DGEMLQT', INFOT, NOUT, LERR, OK )
  164. INFOT = 4
  165. CALL DGEMLQT( 'L', 'N', 0, -1, 0, 1, A, 1, T, 1, C, 1, W, INFO )
  166. CALL CHKXER( 'DGEMLQT', INFOT, NOUT, LERR, OK )
  167. INFOT = 5
  168. CALL DGEMLQT( 'L', 'N', 0, 0, -1, 1, A, 1, T, 1, C, 1, W, INFO )
  169. CALL CHKXER( 'DGEMLQT', INFOT, NOUT, LERR, OK )
  170. INFOT = 5
  171. CALL DGEMLQT( 'R', 'N', 0, 0, -1, 1, A, 1, T, 1, C, 1, W, INFO )
  172. CALL CHKXER( 'DGEMLQT', INFOT, NOUT, LERR, OK )
  173. INFOT = 6
  174. CALL DGEMLQT( 'L', 'N', 0, 0, 0, 0, A, 1, T, 1, C, 1, W, INFO )
  175. CALL CHKXER( 'DGEMLQT', INFOT, NOUT, LERR, OK )
  176. INFOT = 8
  177. CALL DGEMLQT( 'R', 'N', 2, 2, 2, 1, A, 1, T, 1, C, 1, W, INFO )
  178. CALL CHKXER( 'DGEMLQT', INFOT, NOUT, LERR, OK )
  179. INFOT = 8
  180. CALL DGEMLQT( 'L', 'N', 2, 2, 2, 1, A, 1, T, 1, C, 1, W, INFO )
  181. CALL CHKXER( 'DGEMLQT', INFOT, NOUT, LERR, OK )
  182. INFOT = 10
  183. CALL DGEMLQT( 'R', 'N', 1, 1, 1, 1, A, 1, T, 0, C, 1, W, INFO )
  184. CALL CHKXER( 'DGEMLQT', INFOT, NOUT, LERR, OK )
  185. INFOT = 12
  186. CALL DGEMLQT( 'L', 'N', 1, 1, 1, 1, A, 1, T, 1, C, 0, W, INFO )
  187. CALL CHKXER( 'DGEMLQT', INFOT, NOUT, LERR, OK )
  188. *
  189. * Print a summary line.
  190. *
  191. CALL ALAESM( PATH, OK, NOUT )
  192. *
  193. RETURN
  194. *
  195. * End of DERRLQT
  196. *
  197. END