228 lines
		
	
	
		
			5.5 KiB
		
	
	
	
		
			Fortran
		
	
	
	
			
		
		
	
	
			228 lines
		
	
	
		
			5.5 KiB
		
	
	
	
		
			Fortran
		
	
	
	
*> \brief \b ZGERU
 | 
						|
*
 | 
						|
*  =========== DOCUMENTATION ===========
 | 
						|
*
 | 
						|
* Online html documentation available at
 | 
						|
*            http://www.netlib.org/lapack/explore-html/
 | 
						|
*
 | 
						|
*  Definition:
 | 
						|
*  ===========
 | 
						|
*
 | 
						|
*       SUBROUTINE ZGERU(M,N,ALPHA,X,INCX,Y,INCY,A,LDA)
 | 
						|
*
 | 
						|
*       .. Scalar Arguments ..
 | 
						|
*       COMPLEX*16 ALPHA
 | 
						|
*       INTEGER INCX,INCY,LDA,M,N
 | 
						|
*       ..
 | 
						|
*       .. Array Arguments ..
 | 
						|
*       COMPLEX*16 A(LDA,*),X(*),Y(*)
 | 
						|
*       ..
 | 
						|
*
 | 
						|
*
 | 
						|
*> \par Purpose:
 | 
						|
*  =============
 | 
						|
*>
 | 
						|
*> \verbatim
 | 
						|
*>
 | 
						|
*> ZGERU  performs the rank 1 operation
 | 
						|
*>
 | 
						|
*>    A := alpha*x*y**T + A,
 | 
						|
*>
 | 
						|
*> where alpha is a scalar, x is an m element vector, y is an n element
 | 
						|
*> vector and A is an m by n matrix.
 | 
						|
*> \endverbatim
 | 
						|
*
 | 
						|
*  Arguments:
 | 
						|
*  ==========
 | 
						|
*
 | 
						|
*> \param[in] M
 | 
						|
*> \verbatim
 | 
						|
*>          M is INTEGER
 | 
						|
*>           On entry, M specifies the number of rows of the matrix A.
 | 
						|
*>           M must be at least zero.
 | 
						|
*> \endverbatim
 | 
						|
*>
 | 
						|
*> \param[in] N
 | 
						|
*> \verbatim
 | 
						|
*>          N is INTEGER
 | 
						|
*>           On entry, N specifies the number of columns of the matrix A.
 | 
						|
*>           N must be at least zero.
 | 
						|
*> \endverbatim
 | 
						|
*>
 | 
						|
*> \param[in] ALPHA
 | 
						|
*> \verbatim
 | 
						|
*>          ALPHA is COMPLEX*16
 | 
						|
*>           On entry, ALPHA specifies the scalar alpha.
 | 
						|
*> \endverbatim
 | 
						|
*>
 | 
						|
*> \param[in] X
 | 
						|
*> \verbatim
 | 
						|
*>          X is COMPLEX*16 array, dimension at least
 | 
						|
*>           ( 1 + ( m - 1 )*abs( INCX ) ).
 | 
						|
*>           Before entry, the incremented array X must contain the m
 | 
						|
*>           element vector x.
 | 
						|
*> \endverbatim
 | 
						|
*>
 | 
						|
*> \param[in] INCX
 | 
						|
*> \verbatim
 | 
						|
*>          INCX is INTEGER
 | 
						|
*>           On entry, INCX specifies the increment for the elements of
 | 
						|
*>           X. INCX must not be zero.
 | 
						|
*> \endverbatim
 | 
						|
*>
 | 
						|
*> \param[in] Y
 | 
						|
*> \verbatim
 | 
						|
*>          Y is COMPLEX*16 array, dimension at least
 | 
						|
*>           ( 1 + ( n - 1 )*abs( INCY ) ).
 | 
						|
*>           Before entry, the incremented array Y must contain the n
 | 
						|
*>           element vector y.
 | 
						|
*> \endverbatim
 | 
						|
*>
 | 
						|
*> \param[in] INCY
 | 
						|
*> \verbatim
 | 
						|
*>          INCY is INTEGER
 | 
						|
*>           On entry, INCY specifies the increment for the elements of
 | 
						|
*>           Y. INCY must not be zero.
 | 
						|
*> \endverbatim
 | 
						|
*>
 | 
						|
*> \param[in,out] A
 | 
						|
*> \verbatim
 | 
						|
*>          A is COMPLEX*16 array, dimension ( LDA, N )
 | 
						|
*>           Before entry, the leading m by n part of the array A must
 | 
						|
*>           contain the matrix of coefficients. On exit, A is
 | 
						|
*>           overwritten by the updated matrix.
 | 
						|
*> \endverbatim
 | 
						|
*>
 | 
						|
*> \param[in] LDA
 | 
						|
*> \verbatim
 | 
						|
*>          LDA is INTEGER
 | 
						|
*>           On entry, LDA specifies the first dimension of A as declared
 | 
						|
*>           in the calling (sub) program. LDA must be at least
 | 
						|
*>           max( 1, m ).
 | 
						|
*> \endverbatim
 | 
						|
*
 | 
						|
*  Authors:
 | 
						|
*  ========
 | 
						|
*
 | 
						|
*> \author Univ. of Tennessee
 | 
						|
*> \author Univ. of California Berkeley
 | 
						|
*> \author Univ. of Colorado Denver
 | 
						|
*> \author NAG Ltd.
 | 
						|
*
 | 
						|
*> \date December 2016
 | 
						|
*
 | 
						|
*> \ingroup complex16_blas_level2
 | 
						|
*
 | 
						|
*> \par Further Details:
 | 
						|
*  =====================
 | 
						|
*>
 | 
						|
*> \verbatim
 | 
						|
*>
 | 
						|
*>  Level 2 Blas routine.
 | 
						|
*>
 | 
						|
*>  -- Written on 22-October-1986.
 | 
						|
*>     Jack Dongarra, Argonne National Lab.
 | 
						|
*>     Jeremy Du Croz, Nag Central Office.
 | 
						|
*>     Sven Hammarling, Nag Central Office.
 | 
						|
*>     Richard Hanson, Sandia National Labs.
 | 
						|
*> \endverbatim
 | 
						|
*>
 | 
						|
*  =====================================================================
 | 
						|
      SUBROUTINE ZGERU(M,N,ALPHA,X,INCX,Y,INCY,A,LDA)
 | 
						|
*
 | 
						|
*  -- Reference BLAS level2 routine (version 3.7.0) --
 | 
						|
*  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 | 
						|
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 | 
						|
*     December 2016
 | 
						|
*
 | 
						|
*     .. Scalar Arguments ..
 | 
						|
      COMPLEX*16 ALPHA
 | 
						|
      INTEGER INCX,INCY,LDA,M,N
 | 
						|
*     ..
 | 
						|
*     .. Array Arguments ..
 | 
						|
      COMPLEX*16 A(LDA,*),X(*),Y(*)
 | 
						|
*     ..
 | 
						|
*
 | 
						|
*  =====================================================================
 | 
						|
*
 | 
						|
*     .. Parameters ..
 | 
						|
      COMPLEX*16 ZERO
 | 
						|
      PARAMETER (ZERO= (0.0D+0,0.0D+0))
 | 
						|
*     ..
 | 
						|
*     .. Local Scalars ..
 | 
						|
      COMPLEX*16 TEMP
 | 
						|
      INTEGER I,INFO,IX,J,JY,KX
 | 
						|
*     ..
 | 
						|
*     .. External Subroutines ..
 | 
						|
      EXTERNAL XERBLA
 | 
						|
*     ..
 | 
						|
*     .. Intrinsic Functions ..
 | 
						|
      INTRINSIC MAX
 | 
						|
*     ..
 | 
						|
*
 | 
						|
*     Test the input parameters.
 | 
						|
*
 | 
						|
      INFO = 0
 | 
						|
      IF (M.LT.0) THEN
 | 
						|
          INFO = 1
 | 
						|
      ELSE IF (N.LT.0) THEN
 | 
						|
          INFO = 2
 | 
						|
      ELSE IF (INCX.EQ.0) THEN
 | 
						|
          INFO = 5
 | 
						|
      ELSE IF (INCY.EQ.0) THEN
 | 
						|
          INFO = 7
 | 
						|
      ELSE IF (LDA.LT.MAX(1,M)) THEN
 | 
						|
          INFO = 9
 | 
						|
      END IF
 | 
						|
      IF (INFO.NE.0) THEN
 | 
						|
          CALL XERBLA('ZGERU ',INFO)
 | 
						|
          RETURN
 | 
						|
      END IF
 | 
						|
*
 | 
						|
*     Quick return if possible.
 | 
						|
*
 | 
						|
      IF ((M.EQ.0) .OR. (N.EQ.0) .OR. (ALPHA.EQ.ZERO)) RETURN
 | 
						|
*
 | 
						|
*     Start the operations. In this version the elements of A are
 | 
						|
*     accessed sequentially with one pass through A.
 | 
						|
*
 | 
						|
      IF (INCY.GT.0) THEN
 | 
						|
          JY = 1
 | 
						|
      ELSE
 | 
						|
          JY = 1 - (N-1)*INCY
 | 
						|
      END IF
 | 
						|
      IF (INCX.EQ.1) THEN
 | 
						|
          DO 20 J = 1,N
 | 
						|
              IF (Y(JY).NE.ZERO) THEN
 | 
						|
                  TEMP = ALPHA*Y(JY)
 | 
						|
                  DO 10 I = 1,M
 | 
						|
                      A(I,J) = A(I,J) + X(I)*TEMP
 | 
						|
   10             CONTINUE
 | 
						|
              END IF
 | 
						|
              JY = JY + INCY
 | 
						|
   20     CONTINUE
 | 
						|
      ELSE
 | 
						|
          IF (INCX.GT.0) THEN
 | 
						|
              KX = 1
 | 
						|
          ELSE
 | 
						|
              KX = 1 - (M-1)*INCX
 | 
						|
          END IF
 | 
						|
          DO 40 J = 1,N
 | 
						|
              IF (Y(JY).NE.ZERO) THEN
 | 
						|
                  TEMP = ALPHA*Y(JY)
 | 
						|
                  IX = KX
 | 
						|
                  DO 30 I = 1,M
 | 
						|
                      A(I,J) = A(I,J) + X(IX)*TEMP
 | 
						|
                      IX = IX + INCX
 | 
						|
   30             CONTINUE
 | 
						|
              END IF
 | 
						|
              JY = JY + INCY
 | 
						|
   40     CONTINUE
 | 
						|
      END IF
 | 
						|
*
 | 
						|
      RETURN
 | 
						|
*
 | 
						|
*     End of ZGERU .
 | 
						|
*
 | 
						|
      END
 |