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.

zerrac.f 3.9 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149
  1. *> \brief \b ZERRAC
  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 ZERRAC( NUNIT )
  12. *
  13. * .. Scalar Arguments ..
  14. * INTEGER NUNIT
  15. * ..
  16. *
  17. *
  18. *> \par Purpose:
  19. * =============
  20. *>
  21. *> \verbatim
  22. *>
  23. *> ZERRPX tests the error exits for ZCPOSV.
  24. *> \endverbatim
  25. *
  26. * Arguments:
  27. * ==========
  28. *
  29. *> \param[in] NUNIT
  30. *> \verbatim
  31. *> NUNIT is INTEGER
  32. *> The unit number for output.
  33. *> \endverbatim
  34. *
  35. * Authors:
  36. * ========
  37. *
  38. *> \author Univ. of Tennessee
  39. *> \author Univ. of California Berkeley
  40. *> \author Univ. of Colorado Denver
  41. *> \author NAG Ltd.
  42. *
  43. *> \date December 2016
  44. *
  45. *> \ingroup complex16_lin
  46. *
  47. * =====================================================================
  48. SUBROUTINE ZERRAC( NUNIT )
  49. *
  50. * -- LAPACK test routine (version 3.7.0) --
  51. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  52. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  53. * December 2016
  54. *
  55. * .. Scalar Arguments ..
  56. INTEGER NUNIT
  57. * ..
  58. *
  59. * =====================================================================
  60. *
  61. * .. Parameters ..
  62. INTEGER NMAX
  63. PARAMETER ( NMAX = 4 )
  64. * ..
  65. * .. Local Scalars ..
  66. INTEGER I, INFO, ITER, J
  67. * ..
  68. * .. Local Arrays ..
  69. COMPLEX*16 A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
  70. $ C( NMAX ), R( NMAX ), R1( NMAX ), R2( NMAX ),
  71. $ W( 2*NMAX ), X( NMAX )
  72. DOUBLE PRECISION RWORK( NMAX )
  73. COMPLEX*16 WORK(NMAX*NMAX)
  74. COMPLEX SWORK(NMAX*NMAX)
  75. * ..
  76. * .. External Subroutines ..
  77. EXTERNAL CHKXER, ZCPOSV
  78. * ..
  79. * .. Scalars in Common ..
  80. LOGICAL LERR, OK
  81. CHARACTER*32 SRNAMT
  82. INTEGER INFOT, NOUT
  83. * ..
  84. * .. Common blocks ..
  85. COMMON / INFOC / INFOT, NOUT, OK, LERR
  86. COMMON / SRNAMC / SRNAMT
  87. * ..
  88. * .. Intrinsic Functions ..
  89. INTRINSIC DBLE
  90. * ..
  91. * .. Executable Statements ..
  92. *
  93. NOUT = NUNIT
  94. WRITE( NOUT, FMT = * )
  95. *
  96. * Set the variables to innocuous values.
  97. *
  98. DO 20 J = 1, NMAX
  99. DO 10 I = 1, NMAX
  100. A( I, J ) = 1.D0 / DBLE( I+J )
  101. AF( I, J ) = 1.D0 / DBLE( I+J )
  102. 10 CONTINUE
  103. B( J ) = 0.D0
  104. R1( J ) = 0.D0
  105. R2( J ) = 0.D0
  106. W( J ) = 0.D0
  107. X( J ) = 0.D0
  108. C( J ) = 0.D0
  109. R( J ) = 0.D0
  110. 20 CONTINUE
  111. OK = .TRUE.
  112. *
  113. SRNAMT = 'ZCPOSV'
  114. INFOT = 1
  115. CALL ZCPOSV('/',0,0,A,1,B,1,X,1,WORK,SWORK,RWORK,ITER,INFO)
  116. CALL CHKXER( 'ZCPOSV', INFOT, NOUT, LERR, OK )
  117. INFOT = 2
  118. CALL ZCPOSV('U',-1,0,A,1,B,1,X,1,WORK,SWORK,RWORK,ITER,INFO)
  119. CALL CHKXER( 'ZCPOSV', INFOT, NOUT, LERR, OK )
  120. INFOT = 3
  121. CALL ZCPOSV('U',0,-1,A,1,B,1,X,1,WORK,SWORK,RWORK,ITER,INFO)
  122. CALL CHKXER( 'ZCPOSV', INFOT, NOUT, LERR, OK )
  123. INFOT = 5
  124. CALL ZCPOSV('U',2,1,A,1,B,2,X,2,WORK,SWORK,RWORK,ITER,INFO)
  125. CALL CHKXER( 'ZCPOSV', INFOT, NOUT, LERR, OK )
  126. INFOT = 7
  127. CALL ZCPOSV('U',2,1,A,2,B,1,X,2,WORK,SWORK,RWORK,ITER,INFO)
  128. CALL CHKXER( 'ZCPOSV', INFOT, NOUT, LERR, OK )
  129. INFOT = 9
  130. CALL ZCPOSV('U',2,1,A,2,B,2,X,1,WORK,SWORK,RWORK,ITER,INFO)
  131. CALL CHKXER( 'ZCPOSV', INFOT, NOUT, LERR, OK )
  132. *
  133. * Print a summary line.
  134. *
  135. IF( OK ) THEN
  136. WRITE( NOUT, FMT = 9999 )'ZCPOSV'
  137. ELSE
  138. WRITE( NOUT, FMT = 9998 )'ZCPOSV'
  139. END IF
  140. *
  141. 9999 FORMAT( 1X, A6, ' drivers passed the tests of the error exits' )
  142. 9998 FORMAT( ' *** ', A6, ' drivers failed the tests of the error ',
  143. $ 'exits ***' )
  144. *
  145. RETURN
  146. *
  147. * End of ZERRAC
  148. *
  149. END