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.

cgeruf.f 4.4 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157
  1. SUBROUTINE CGERUF ( M, N, ALPHA, X, INCX, Y, INCY, A, LDA )
  2. * .. Scalar Arguments ..
  3. COMPLEX ALPHA
  4. INTEGER INCX, INCY, LDA, M, N
  5. * .. Array Arguments ..
  6. COMPLEX A( LDA, * ), X( * ), Y( * )
  7. * ..
  8. *
  9. * Purpose
  10. * =======
  11. *
  12. * CGERU performs the rank 1 operation
  13. *
  14. * A := alpha*x*y' + A,
  15. *
  16. * where alpha is a scalar, x is an m element vector, y is an n element
  17. * vector and A is an m by n matrix.
  18. *
  19. * Parameters
  20. * ==========
  21. *
  22. * M - INTEGER.
  23. * On entry, M specifies the number of rows of the matrix A.
  24. * M must be at least zero.
  25. * Unchanged on exit.
  26. *
  27. * N - INTEGER.
  28. * On entry, N specifies the number of columns of the matrix A.
  29. * N must be at least zero.
  30. * Unchanged on exit.
  31. *
  32. * ALPHA - COMPLEX .
  33. * On entry, ALPHA specifies the scalar alpha.
  34. * Unchanged on exit.
  35. *
  36. * X - COMPLEX array of dimension at least
  37. * ( 1 + ( m - 1 )*abs( INCX ) ).
  38. * Before entry, the incremented array X must contain the m
  39. * element vector x.
  40. * Unchanged on exit.
  41. *
  42. * INCX - INTEGER.
  43. * On entry, INCX specifies the increment for the elements of
  44. * X. INCX must not be zero.
  45. * Unchanged on exit.
  46. *
  47. * Y - COMPLEX array of dimension at least
  48. * ( 1 + ( n - 1 )*abs( INCY ) ).
  49. * Before entry, the incremented array Y must contain the n
  50. * element vector y.
  51. * Unchanged on exit.
  52. *
  53. * INCY - INTEGER.
  54. * On entry, INCY specifies the increment for the elements of
  55. * Y. INCY must not be zero.
  56. * Unchanged on exit.
  57. *
  58. * A - COMPLEX array of DIMENSION ( LDA, n ).
  59. * Before entry, the leading m by n part of the array A must
  60. * contain the matrix of coefficients. On exit, A is
  61. * overwritten by the updated matrix.
  62. *
  63. * LDA - INTEGER.
  64. * On entry, LDA specifies the first dimension of A as declared
  65. * in the calling (sub) program. LDA must be at least
  66. * max( 1, m ).
  67. * Unchanged on exit.
  68. *
  69. *
  70. * Level 2 Blas routine.
  71. *
  72. * -- Written on 22-October-1986.
  73. * Jack Dongarra, Argonne National Lab.
  74. * Jeremy Du Croz, Nag Central Office.
  75. * Sven Hammarling, Nag Central Office.
  76. * Richard Hanson, Sandia National Labs.
  77. *
  78. *
  79. * .. Parameters ..
  80. COMPLEX ZERO
  81. PARAMETER ( ZERO = ( 0.0E+0, 0.0E+0 ) )
  82. * .. Local Scalars ..
  83. COMPLEX TEMP
  84. INTEGER I, INFO, IX, J, JY, KX
  85. * .. External Subroutines ..
  86. EXTERNAL XERBLA
  87. * .. Intrinsic Functions ..
  88. INTRINSIC MAX
  89. * ..
  90. * .. Executable Statements ..
  91. *
  92. * Test the input parameters.
  93. *
  94. INFO = 0
  95. IF ( M.LT.0 )THEN
  96. INFO = 1
  97. ELSE IF( N.LT.0 )THEN
  98. INFO = 2
  99. ELSE IF( INCX.EQ.0 )THEN
  100. INFO = 5
  101. ELSE IF( INCY.EQ.0 )THEN
  102. INFO = 7
  103. ELSE IF( LDA.LT.MAX( 1, M ) )THEN
  104. INFO = 9
  105. END IF
  106. IF( INFO.NE.0 )THEN
  107. CALL XERBLA( 'CGERU ', INFO )
  108. RETURN
  109. END IF
  110. *
  111. * Quick return if possible.
  112. *
  113. IF( ( M.EQ.0 ).OR.( N.EQ.0 ).OR.( ALPHA.EQ.ZERO ) )
  114. $ RETURN
  115. *
  116. * Start the operations. In this version the elements of A are
  117. * accessed sequentially with one pass through A.
  118. *
  119. IF( INCY.GT.0 )THEN
  120. JY = 1
  121. ELSE
  122. JY = 1 - ( N - 1 )*INCY
  123. END IF
  124. IF( INCX.EQ.1 )THEN
  125. DO 20, J = 1, N
  126. IF( Y( JY ).NE.ZERO )THEN
  127. TEMP = ALPHA*Y( JY )
  128. DO 10, I = 1, M
  129. A( I, J ) = A( I, J ) + X( I )*TEMP
  130. 10 CONTINUE
  131. END IF
  132. JY = JY + INCY
  133. 20 CONTINUE
  134. ELSE
  135. IF( INCX.GT.0 )THEN
  136. KX = 1
  137. ELSE
  138. KX = 1 - ( M - 1 )*INCX
  139. END IF
  140. DO 40, J = 1, N
  141. IF( Y( JY ).NE.ZERO )THEN
  142. TEMP = ALPHA*Y( JY )
  143. IX = KX
  144. DO 30, I = 1, M
  145. A( I, J ) = A( I, J ) + X( IX )*TEMP
  146. IX = IX + INCX
  147. 30 CONTINUE
  148. END IF
  149. JY = JY + INCY
  150. 40 CONTINUE
  151. END IF
  152. *
  153. RETURN
  154. *
  155. * End of CGERU .
  156. *
  157. END