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.

dchklqt.f 5.4 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210
  1. *> \brief \b DCHKLQT
  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 DCHKLQT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB,
  12. * NBVAL, NOUT )
  13. *
  14. * .. Scalar Arguments ..
  15. * LOGICAL TSTERR
  16. * INTEGER NM, NN, NNB, NOUT
  17. * DOUBLE PRECISION THRESH
  18. * ..
  19. * .. Array Arguments ..
  20. * INTEGER MVAL( * ), NBVAL( * ), NVAL( * )
  21. *
  22. *> \par Purpose:
  23. * =============
  24. *>
  25. *> \verbatim
  26. *>
  27. *> DCHKLQT tests DGELQT and DGEMLQT.
  28. *> \endverbatim
  29. *
  30. * Arguments:
  31. * ==========
  32. *
  33. *> \param[in] THRESH
  34. *> \verbatim
  35. *> THRESH is DOUBLE PRECISION
  36. *> The threshold value for the test ratios. A result is
  37. *> included in the output file if RESULT >= THRESH. To have
  38. *> every test ratio printed, use THRESH = 0.
  39. *> \endverbatim
  40. *>
  41. *> \param[in] TSTERR
  42. *> \verbatim
  43. *> TSTERR is LOGICAL
  44. *> Flag that indicates whether error exits are to be tested.
  45. *> \endverbatim
  46. *>
  47. *> \param[in] NM
  48. *> \verbatim
  49. *> NM is INTEGER
  50. *> The number of values of M contained in the vector MVAL.
  51. *> \endverbatim
  52. *>
  53. *> \param[in] MVAL
  54. *> \verbatim
  55. *> MVAL is INTEGER array, dimension (NM)
  56. *> The values of the matrix row dimension M.
  57. *> \endverbatim
  58. *>
  59. *> \param[in] NN
  60. *> \verbatim
  61. *> NN is INTEGER
  62. *> The number of values of N contained in the vector NVAL.
  63. *> \endverbatim
  64. *>
  65. *> \param[in] NVAL
  66. *> \verbatim
  67. *> NVAL is INTEGER array, dimension (NN)
  68. *> The values of the matrix column dimension N.
  69. *> \endverbatim
  70. *>
  71. *> \param[in] NNB
  72. *> \verbatim
  73. *> NNB is INTEGER
  74. *> The number of values of NB contained in the vector NBVAL.
  75. *> \endverbatim
  76. *>
  77. *> \param[in] NBVAL
  78. *> \verbatim
  79. *> NBVAL is INTEGER array, dimension (NBVAL)
  80. *> The values of the blocksize NB.
  81. *> \endverbatim
  82. *>
  83. *> \param[in] NOUT
  84. *> \verbatim
  85. *> NOUT is INTEGER
  86. *> The unit number for output.
  87. *> \endverbatim
  88. *
  89. * Authors:
  90. * ========
  91. *
  92. *> \author Univ. of Tennessee
  93. *> \author Univ. of California Berkeley
  94. *> \author Univ. of Colorado Denver
  95. *> \author NAG Ltd.
  96. *
  97. *> \date December 2016
  98. *
  99. *> \ingroup double_lin
  100. *
  101. * =====================================================================
  102. SUBROUTINE DCHKLQT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB,
  103. $ NBVAL, NOUT )
  104. IMPLICIT NONE
  105. *
  106. * -- LAPACK test routine (version 3.7.0) --
  107. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  108. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  109. * December 2016
  110. *
  111. * .. Scalar Arguments ..
  112. LOGICAL TSTERR
  113. INTEGER NM, NN, NNB, NOUT
  114. DOUBLE PRECISION THRESH
  115. * ..
  116. * .. Array Arguments ..
  117. INTEGER MVAL( * ), NBVAL( * ), NVAL( * )
  118. * ..
  119. *
  120. * =====================================================================
  121. *
  122. * .. Parameters ..
  123. INTEGER NTESTS
  124. PARAMETER ( NTESTS = 6 )
  125. * ..
  126. * .. Local Scalars ..
  127. CHARACTER*3 PATH
  128. INTEGER I, J, K, T, M, N, NB, NFAIL, NERRS, NRUN,
  129. $ MINMN
  130. *
  131. * .. Local Arrays ..
  132. DOUBLE PRECISION RESULT( NTESTS )
  133. * ..
  134. * .. External Subroutines ..
  135. EXTERNAL ALAERH, ALAHD, ALASUM, DERRLQT, DLQT04
  136. * ..
  137. * .. Scalars in Common ..
  138. LOGICAL LERR, OK
  139. CHARACTER*32 SRNAMT
  140. INTEGER INFOT, NUNIT
  141. * ..
  142. * .. Common blocks ..
  143. COMMON / INFOC / INFOT, NUNIT, OK, LERR
  144. COMMON / SRNAMC / SRNAMT
  145. * ..
  146. * .. Executable Statements ..
  147. *
  148. * Initialize constants
  149. *
  150. PATH( 1: 1 ) = 'D'
  151. PATH( 2: 3 ) = 'TQ'
  152. NRUN = 0
  153. NFAIL = 0
  154. NERRS = 0
  155. *
  156. * Test the error exits
  157. *
  158. IF( TSTERR ) CALL DERRLQT( PATH, NOUT )
  159. INFOT = 0
  160. *
  161. * Do for each value of M in MVAL.
  162. *
  163. DO I = 1, NM
  164. M = MVAL( I )
  165. *
  166. * Do for each value of N in NVAL.
  167. *
  168. DO J = 1, NN
  169. N = NVAL( J )
  170. *
  171. * Do for each possible value of NB
  172. *
  173. MINMN = MIN( M, N )
  174. DO K = 1, NNB
  175. NB = NBVAL( K )
  176. *
  177. * Test DGELQT and DGEMLQT
  178. *
  179. IF( (NB.LE.MINMN).AND.(NB.GT.0) ) THEN
  180. CALL DLQT04( M, N, NB, RESULT )
  181. *
  182. * Print information about the tests that did not
  183. * pass the threshold.
  184. *
  185. DO T = 1, NTESTS
  186. IF( RESULT( T ).GE.THRESH ) THEN
  187. IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
  188. $ CALL ALAHD( NOUT, PATH )
  189. WRITE( NOUT, FMT = 9999 )M, N, NB,
  190. $ T, RESULT( T )
  191. NFAIL = NFAIL + 1
  192. END IF
  193. END DO
  194. NRUN = NRUN + NTESTS
  195. END IF
  196. END DO
  197. END DO
  198. END DO
  199. *
  200. * Print a summary of the results.
  201. *
  202. CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
  203. *
  204. 9999 FORMAT( ' M=', I5, ', N=', I5, ', NB=', I4,
  205. $ ' test(', I2, ')=', G12.5 )
  206. RETURN
  207. *
  208. * End of DCHKLQT
  209. *
  210. END