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.

dchkorhr_col.f 6.5 kB

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