1c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath SUBROUTINE ZHBMV(UPLO,N,K,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) 2c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* .. Scalar Arguments .. 3c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath DOUBLE COMPLEX ALPHA,BETA 4c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath INTEGER INCX,INCY,K,LDA,N 5c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath CHARACTER UPLO 6c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* .. 7c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* .. Array Arguments .. 8c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath DOUBLE COMPLEX A(LDA,*),X(*),Y(*) 9c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* .. 10c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* 11c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* Purpose 12c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* ======= 13c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* 14c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* ZHBMV performs the matrix-vector operation 15c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* 16c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* y := alpha*A*x + beta*y, 17c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* 18c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* where alpha and beta are scalars, x and y are n element vectors and 19c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* A is an n by n hermitian band matrix, with k super-diagonals. 20c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* 21c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* Arguments 22c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* ========== 23c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* 24c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* UPLO - CHARACTER*1. 25c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* On entry, UPLO specifies whether the upper or lower 26c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* triangular part of the band matrix A is being supplied as 27c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* follows: 28c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* 29c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* UPLO = 'U' or 'u' The upper triangular part of A is 30c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* being supplied. 31c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* 32c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* UPLO = 'L' or 'l' The lower triangular part of A is 33c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* being supplied. 34c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* 35c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* Unchanged on exit. 36c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* 37c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* N - INTEGER. 38c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* On entry, N specifies the order of the matrix A. 39c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* N must be at least zero. 40c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* Unchanged on exit. 41c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* 42c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* K - INTEGER. 43c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* On entry, K specifies the number of super-diagonals of the 44c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* matrix A. K must satisfy 0 .le. K. 45c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* Unchanged on exit. 46c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* 47c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* ALPHA - COMPLEX*16 . 48c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* On entry, ALPHA specifies the scalar alpha. 49c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* Unchanged on exit. 50c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* 51c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* A - COMPLEX*16 array of DIMENSION ( LDA, n ). 52c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* Before entry with UPLO = 'U' or 'u', the leading ( k + 1 ) 53c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* by n part of the array A must contain the upper triangular 54c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* band part of the hermitian matrix, supplied column by 55c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* column, with the leading diagonal of the matrix in row 56c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* ( k + 1 ) of the array, the first super-diagonal starting at 57c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* position 2 in row k, and so on. The top left k by k triangle 58c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* of the array A is not referenced. 59c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* The following program segment will transfer the upper 60c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* triangular part of a hermitian band matrix from conventional 61c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* full matrix storage to band storage: 62c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* 63c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* DO 20, J = 1, N 64c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* M = K + 1 - J 65c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* DO 10, I = MAX( 1, J - K ), J 66c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* A( M + I, J ) = matrix( I, J ) 67c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* 10 CONTINUE 68c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* 20 CONTINUE 69c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* 70c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* Before entry with UPLO = 'L' or 'l', the leading ( k + 1 ) 71c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* by n part of the array A must contain the lower triangular 72c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* band part of the hermitian matrix, supplied column by 73c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* column, with the leading diagonal of the matrix in row 1 of 74c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* the array, the first sub-diagonal starting at position 1 in 75c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* row 2, and so on. The bottom right k by k triangle of the 76c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* array A is not referenced. 77c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* The following program segment will transfer the lower 78c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* triangular part of a hermitian band matrix from conventional 79c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* full matrix storage to band storage: 80c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* 81c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* DO 20, J = 1, N 82c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* M = 1 - J 83c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* DO 10, I = J, MIN( N, J + K ) 84c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* A( M + I, J ) = matrix( I, J ) 85c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* 10 CONTINUE 86c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* 20 CONTINUE 87c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* 88c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* Note that the imaginary parts of the diagonal elements need 89c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* not be set and are assumed to be zero. 90c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* Unchanged on exit. 91c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* 92c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* LDA - INTEGER. 93c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* On entry, LDA specifies the first dimension of A as declared 94c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* in the calling (sub) program. LDA must be at least 95c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* ( k + 1 ). 96c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* Unchanged on exit. 97c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* 98c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* X - COMPLEX*16 array of DIMENSION at least 99c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* ( 1 + ( n - 1 )*abs( INCX ) ). 100c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* Before entry, the incremented array X must contain the 101c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* vector x. 102c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* Unchanged on exit. 103c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* 104c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* INCX - INTEGER. 105c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* On entry, INCX specifies the increment for the elements of 106c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* X. INCX must not be zero. 107c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* Unchanged on exit. 108c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* 109c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* BETA - COMPLEX*16 . 110c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* On entry, BETA specifies the scalar beta. 111c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* Unchanged on exit. 112c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* 113c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* Y - COMPLEX*16 array of DIMENSION at least 114c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* ( 1 + ( n - 1 )*abs( INCY ) ). 115c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* Before entry, the incremented array Y must contain the 116c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* vector y. On exit, Y is overwritten by the updated vector y. 117c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* 118c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* INCY - INTEGER. 119c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* On entry, INCY specifies the increment for the elements of 120c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* Y. INCY must not be zero. 121c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* Unchanged on exit. 122c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* 123c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* Further Details 124c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* =============== 125c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* 126c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* Level 2 Blas routine. 127c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* 128c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* -- Written on 22-October-1986. 129c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* Jack Dongarra, Argonne National Lab. 130c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* Jeremy Du Croz, Nag Central Office. 131c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* Sven Hammarling, Nag Central Office. 132c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* Richard Hanson, Sandia National Labs. 133c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* 134c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* ===================================================================== 135c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* 136c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* .. Parameters .. 137c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath DOUBLE COMPLEX ONE 138c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath PARAMETER (ONE= (1.0D+0,0.0D+0)) 139c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath DOUBLE COMPLEX ZERO 140c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath PARAMETER (ZERO= (0.0D+0,0.0D+0)) 141c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* .. 142c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* .. Local Scalars .. 143c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath DOUBLE COMPLEX TEMP1,TEMP2 144c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath INTEGER I,INFO,IX,IY,J,JX,JY,KPLUS1,KX,KY,L 145c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* .. 146c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* .. External Functions .. 147c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath LOGICAL LSAME 148c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath EXTERNAL LSAME 149c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* .. 150c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* .. External Subroutines .. 151c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath EXTERNAL XERBLA 152c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* .. 153c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* .. Intrinsic Functions .. 154c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath INTRINSIC DBLE,DCONJG,MAX,MIN 155c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* .. 156c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* 157c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* Test the input parameters. 158c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* 159c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath INFO = 0 160c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN 161c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath INFO = 1 162c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath ELSE IF (N.LT.0) THEN 163c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath INFO = 2 164c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath ELSE IF (K.LT.0) THEN 165c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath INFO = 3 166c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath ELSE IF (LDA.LT. (K+1)) THEN 167c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath INFO = 6 168c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath ELSE IF (INCX.EQ.0) THEN 169c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath INFO = 8 170c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath ELSE IF (INCY.EQ.0) THEN 171c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath INFO = 11 172c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath END IF 173c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath IF (INFO.NE.0) THEN 174c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath CALL XERBLA('ZHBMV ',INFO) 175c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath RETURN 176c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath END IF 177c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* 178c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* Quick return if possible. 179c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* 180c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath IF ((N.EQ.0) .OR. ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN 181c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* 182c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* Set up the start points in X and Y. 183c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* 184c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath IF (INCX.GT.0) THEN 185c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath KX = 1 186c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath ELSE 187c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath KX = 1 - (N-1)*INCX 188c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath END IF 189c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath IF (INCY.GT.0) THEN 190c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath KY = 1 191c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath ELSE 192c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath KY = 1 - (N-1)*INCY 193c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath END IF 194c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* 195c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* Start the operations. In this version the elements of the array A 196c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* are accessed sequentially with one pass through A. 197c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* 198c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* First form y := beta*y. 199c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* 200c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath IF (BETA.NE.ONE) THEN 201c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath IF (INCY.EQ.1) THEN 202c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath IF (BETA.EQ.ZERO) THEN 203c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath DO 10 I = 1,N 204c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath Y(I) = ZERO 205c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath 10 CONTINUE 206c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath ELSE 207c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath DO 20 I = 1,N 208c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath Y(I) = BETA*Y(I) 209c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath 20 CONTINUE 210c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath END IF 211c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath ELSE 212c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath IY = KY 213c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath IF (BETA.EQ.ZERO) THEN 214c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath DO 30 I = 1,N 215c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath Y(IY) = ZERO 216c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath IY = IY + INCY 217c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath 30 CONTINUE 218c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath ELSE 219c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath DO 40 I = 1,N 220c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath Y(IY) = BETA*Y(IY) 221c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath IY = IY + INCY 222c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath 40 CONTINUE 223c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath END IF 224c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath END IF 225c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath END IF 226c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath IF (ALPHA.EQ.ZERO) RETURN 227c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath IF (LSAME(UPLO,'U')) THEN 228c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* 229c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* Form y when upper triangle of A is stored. 230c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* 231c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath KPLUS1 = K + 1 232c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN 233c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath DO 60 J = 1,N 234c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath TEMP1 = ALPHA*X(J) 235c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath TEMP2 = ZERO 236c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath L = KPLUS1 - J 237c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath DO 50 I = MAX(1,J-K),J - 1 238c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath Y(I) = Y(I) + TEMP1*A(L+I,J) 239c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath TEMP2 = TEMP2 + DCONJG(A(L+I,J))*X(I) 240c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath 50 CONTINUE 241c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath Y(J) = Y(J) + TEMP1*DBLE(A(KPLUS1,J)) + ALPHA*TEMP2 242c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath 60 CONTINUE 243c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath ELSE 244c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath JX = KX 245c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath JY = KY 246c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath DO 80 J = 1,N 247c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath TEMP1 = ALPHA*X(JX) 248c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath TEMP2 = ZERO 249c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath IX = KX 250c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath IY = KY 251c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath L = KPLUS1 - J 252c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath DO 70 I = MAX(1,J-K),J - 1 253c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath Y(IY) = Y(IY) + TEMP1*A(L+I,J) 254c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath TEMP2 = TEMP2 + DCONJG(A(L+I,J))*X(IX) 255c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath IX = IX + INCX 256c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath IY = IY + INCY 257c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath 70 CONTINUE 258c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath Y(JY) = Y(JY) + TEMP1*DBLE(A(KPLUS1,J)) + ALPHA*TEMP2 259c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath JX = JX + INCX 260c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath JY = JY + INCY 261c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath IF (J.GT.K) THEN 262c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath KX = KX + INCX 263c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath KY = KY + INCY 264c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath END IF 265c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath 80 CONTINUE 266c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath END IF 267c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath ELSE 268c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* 269c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* Form y when lower triangle of A is stored. 270c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* 271c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN 272c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath DO 100 J = 1,N 273c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath TEMP1 = ALPHA*X(J) 274c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath TEMP2 = ZERO 275c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath Y(J) = Y(J) + TEMP1*DBLE(A(1,J)) 276c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath L = 1 - J 277c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath DO 90 I = J + 1,MIN(N,J+K) 278c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath Y(I) = Y(I) + TEMP1*A(L+I,J) 279c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath TEMP2 = TEMP2 + DCONJG(A(L+I,J))*X(I) 280c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath 90 CONTINUE 281c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath Y(J) = Y(J) + ALPHA*TEMP2 282c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath 100 CONTINUE 283c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath ELSE 284c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath JX = KX 285c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath JY = KY 286c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath DO 120 J = 1,N 287c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath TEMP1 = ALPHA*X(JX) 288c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath TEMP2 = ZERO 289c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath Y(JY) = Y(JY) + TEMP1*DBLE(A(1,J)) 290c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath L = 1 - J 291c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath IX = JX 292c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath IY = JY 293c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath DO 110 I = J + 1,MIN(N,J+K) 294c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath IX = IX + INCX 295c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath IY = IY + INCY 296c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath Y(IY) = Y(IY) + TEMP1*A(L+I,J) 297c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath TEMP2 = TEMP2 + DCONJG(A(L+I,J))*X(IX) 298c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath 110 CONTINUE 299c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath Y(JY) = Y(JY) + ALPHA*TEMP2 300c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath JX = JX + INCX 301c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath JY = JY + INCY 302c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath 120 CONTINUE 303c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath END IF 304c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath END IF 305c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* 306c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath RETURN 307c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* 308c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* End of ZHBMV . 309c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath* 310c981c48f5bc9aefeffc0bcb0cc3934c2fae179ddNarayan Kamath END 311