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.

cchkgl.f 4.9 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189
  1. *> \brief \b CCHKGL
  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 CCHKGL( NIN, NOUT )
  12. *
  13. * .. Scalar Arguments ..
  14. * INTEGER NIN, NOUT
  15. * ..
  16. *
  17. *
  18. *> \par Purpose:
  19. * =============
  20. *>
  21. *> \verbatim
  22. *>
  23. *> CCHKGL tests CGGBAL, a routine for balancing a matrix pair (A, B).
  24. *> \endverbatim
  25. *
  26. * Arguments:
  27. * ==========
  28. *
  29. *> \param[in] NIN
  30. *> \verbatim
  31. *> NIN is INTEGER
  32. *> The logical unit number for input. NIN > 0.
  33. *> \endverbatim
  34. *>
  35. *> \param[in] NOUT
  36. *> \verbatim
  37. *> NOUT is INTEGER
  38. *> The logical unit number for output. NOUT > 0.
  39. *> \endverbatim
  40. *
  41. * Authors:
  42. * ========
  43. *
  44. *> \author Univ. of Tennessee
  45. *> \author Univ. of California Berkeley
  46. *> \author Univ. of Colorado Denver
  47. *> \author NAG Ltd.
  48. *
  49. *> \ingroup complex_eig
  50. *
  51. * =====================================================================
  52. SUBROUTINE CCHKGL( NIN, NOUT )
  53. *
  54. * -- LAPACK test routine --
  55. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  56. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  57. *
  58. * .. Scalar Arguments ..
  59. INTEGER NIN, NOUT
  60. * ..
  61. *
  62. * =====================================================================
  63. *
  64. * .. Parameters ..
  65. INTEGER LDA, LDB, LWORK
  66. PARAMETER ( LDA = 20, LDB = 20, LWORK = 6*LDA )
  67. REAL ZERO
  68. PARAMETER ( ZERO = 0.0E+0 )
  69. * ..
  70. * .. Local Scalars ..
  71. INTEGER I, IHI, IHIIN, ILO, ILOIN, INFO, J, KNT, N,
  72. $ NINFO
  73. REAL ANORM, BNORM, EPS, RMAX, VMAX
  74. * ..
  75. * .. Local Arrays ..
  76. INTEGER LMAX( 3 )
  77. REAL LSCALE( LDA ), LSCLIN( LDA ), RSCALE( LDA ),
  78. $ RSCLIN( LDA ), WORK( LWORK )
  79. COMPLEX A( LDA, LDA ), AIN( LDA, LDA ), B( LDB, LDB ),
  80. $ BIN( LDB, LDB )
  81. * ..
  82. * .. External Functions ..
  83. REAL CLANGE, SLAMCH
  84. EXTERNAL CLANGE, SLAMCH
  85. * ..
  86. * .. External Subroutines ..
  87. EXTERNAL CGGBAL
  88. * ..
  89. * .. Intrinsic Functions ..
  90. INTRINSIC ABS, MAX
  91. * ..
  92. * .. Executable Statements ..
  93. *
  94. LMAX( 1 ) = 0
  95. LMAX( 2 ) = 0
  96. LMAX( 3 ) = 0
  97. NINFO = 0
  98. KNT = 0
  99. RMAX = ZERO
  100. *
  101. EPS = SLAMCH( 'Precision' )
  102. *
  103. 10 CONTINUE
  104. *
  105. READ( NIN, FMT = * )N
  106. IF( N.EQ.0 )
  107. $ GO TO 90
  108. DO 20 I = 1, N
  109. READ( NIN, FMT = * )( A( I, J ), J = 1, N )
  110. 20 CONTINUE
  111. *
  112. DO 30 I = 1, N
  113. READ( NIN, FMT = * )( B( I, J ), J = 1, N )
  114. 30 CONTINUE
  115. *
  116. READ( NIN, FMT = * )ILOIN, IHIIN
  117. DO 40 I = 1, N
  118. READ( NIN, FMT = * )( AIN( I, J ), J = 1, N )
  119. 40 CONTINUE
  120. DO 50 I = 1, N
  121. READ( NIN, FMT = * )( BIN( I, J ), J = 1, N )
  122. 50 CONTINUE
  123. *
  124. READ( NIN, FMT = * )( LSCLIN( I ), I = 1, N )
  125. READ( NIN, FMT = * )( RSCLIN( I ), I = 1, N )
  126. *
  127. ANORM = CLANGE( 'M', N, N, A, LDA, WORK )
  128. BNORM = CLANGE( 'M', N, N, B, LDB, WORK )
  129. *
  130. KNT = KNT + 1
  131. *
  132. CALL CGGBAL( 'B', N, A, LDA, B, LDB, ILO, IHI, LSCALE, RSCALE,
  133. $ WORK, INFO )
  134. *
  135. IF( INFO.NE.0 ) THEN
  136. NINFO = NINFO + 1
  137. LMAX( 1 ) = KNT
  138. END IF
  139. *
  140. IF( ILO.NE.ILOIN .OR. IHI.NE.IHIIN ) THEN
  141. NINFO = NINFO + 1
  142. LMAX( 2 ) = KNT
  143. END IF
  144. *
  145. VMAX = ZERO
  146. DO 70 I = 1, N
  147. DO 60 J = 1, N
  148. VMAX = MAX( VMAX, ABS( A( I, J )-AIN( I, J ) ) )
  149. VMAX = MAX( VMAX, ABS( B( I, J )-BIN( I, J ) ) )
  150. 60 CONTINUE
  151. 70 CONTINUE
  152. *
  153. DO 80 I = 1, N
  154. VMAX = MAX( VMAX, ABS( LSCALE( I )-LSCLIN( I ) ) )
  155. VMAX = MAX( VMAX, ABS( RSCALE( I )-RSCLIN( I ) ) )
  156. 80 CONTINUE
  157. *
  158. VMAX = VMAX / ( EPS*MAX( ANORM, BNORM ) )
  159. *
  160. IF( VMAX.GT.RMAX ) THEN
  161. LMAX( 3 ) = KNT
  162. RMAX = VMAX
  163. END IF
  164. *
  165. GO TO 10
  166. *
  167. 90 CONTINUE
  168. *
  169. WRITE( NOUT, FMT = 9999 )
  170. 9999 FORMAT( ' .. test output of CGGBAL .. ' )
  171. *
  172. WRITE( NOUT, FMT = 9998 )RMAX
  173. 9998 FORMAT( ' ratio of largest test error = ', E12.3 )
  174. WRITE( NOUT, FMT = 9997 )LMAX( 1 )
  175. 9997 FORMAT( ' example number where info is not zero = ', I4 )
  176. WRITE( NOUT, FMT = 9996 )LMAX( 2 )
  177. 9996 FORMAT( ' example number where ILO or IHI is wrong = ', I4 )
  178. WRITE( NOUT, FMT = 9995 )LMAX( 3 )
  179. 9995 FORMAT( ' example number having largest error = ', I4 )
  180. WRITE( NOUT, FMT = 9994 )NINFO
  181. 9994 FORMAT( ' number of examples where info is not 0 = ', I4 )
  182. WRITE( NOUT, FMT = 9993 )KNT
  183. 9993 FORMAT( ' total number of examples tested = ', I4 )
  184. *
  185. RETURN
  186. *
  187. * End of CCHKGL
  188. *
  189. END