Annotation of rpl/lapack/blas/zherk.f, revision 1.8
1.8 ! bertrand 1: *> \brief \b ZHERK
! 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 ZHERK(UPLO,TRANS,N,K,ALPHA,A,LDA,BETA,C,LDC)
! 12: *
! 13: * .. Scalar Arguments ..
! 14: * DOUBLE PRECISION ALPHA,BETA
! 15: * INTEGER K,LDA,LDC,N
! 16: * CHARACTER TRANS,UPLO
! 17: * ..
! 18: * .. Array Arguments ..
! 19: * COMPLEX*16 A(LDA,*),C(LDC,*)
! 20: * ..
! 21: *
! 22: *
! 23: *> \par Purpose:
! 24: * =============
! 25: *>
! 26: *> \verbatim
! 27: *>
! 28: *> ZHERK performs one of the hermitian rank k operations
! 29: *>
! 30: *> C := alpha*A*A**H + beta*C,
! 31: *>
! 32: *> or
! 33: *>
! 34: *> C := alpha*A**H*A + beta*C,
! 35: *>
! 36: *> where alpha and beta are real scalars, C is an n by n hermitian
! 37: *> matrix and A is an n by k matrix in the first case and a k by n
! 38: *> matrix in the second case.
! 39: *> \endverbatim
! 40: *
! 41: * Arguments:
! 42: * ==========
! 43: *
! 44: *> \param[in] UPLO
! 45: *> \verbatim
! 46: *> UPLO is CHARACTER*1
! 47: *> On entry, UPLO specifies whether the upper or lower
! 48: *> triangular part of the array C is to be referenced as
! 49: *> follows:
! 50: *>
! 51: *> UPLO = 'U' or 'u' Only the upper triangular part of C
! 52: *> is to be referenced.
! 53: *>
! 54: *> UPLO = 'L' or 'l' Only the lower triangular part of C
! 55: *> is to be referenced.
! 56: *> \endverbatim
! 57: *>
! 58: *> \param[in] TRANS
! 59: *> \verbatim
! 60: *> TRANS is CHARACTER*1
! 61: *> On entry, TRANS specifies the operation to be performed as
! 62: *> follows:
! 63: *>
! 64: *> TRANS = 'N' or 'n' C := alpha*A*A**H + beta*C.
! 65: *>
! 66: *> TRANS = 'C' or 'c' C := alpha*A**H*A + beta*C.
! 67: *> \endverbatim
! 68: *>
! 69: *> \param[in] N
! 70: *> \verbatim
! 71: *> N is INTEGER
! 72: *> On entry, N specifies the order of the matrix C. N must be
! 73: *> at least zero.
! 74: *> \endverbatim
! 75: *>
! 76: *> \param[in] K
! 77: *> \verbatim
! 78: *> K is INTEGER
! 79: *> On entry with TRANS = 'N' or 'n', K specifies the number
! 80: *> of columns of the matrix A, and on entry with
! 81: *> TRANS = 'C' or 'c', K specifies the number of rows of the
! 82: *> matrix A. K must be at least zero.
! 83: *> \endverbatim
! 84: *>
! 85: *> \param[in] ALPHA
! 86: *> \verbatim
! 87: *> ALPHA is DOUBLE PRECISION .
! 88: *> On entry, ALPHA specifies the scalar alpha.
! 89: *> \endverbatim
! 90: *>
! 91: *> \param[in] A
! 92: *> \verbatim
! 93: *> A is COMPLEX*16 array of DIMENSION ( LDA, ka ), where ka is
! 94: *> k when TRANS = 'N' or 'n', and is n otherwise.
! 95: *> Before entry with TRANS = 'N' or 'n', the leading n by k
! 96: *> part of the array A must contain the matrix A, otherwise
! 97: *> the leading k by n part of the array A must contain the
! 98: *> matrix A.
! 99: *> \endverbatim
! 100: *>
! 101: *> \param[in] LDA
! 102: *> \verbatim
! 103: *> LDA is INTEGER
! 104: *> On entry, LDA specifies the first dimension of A as declared
! 105: *> in the calling (sub) program. When TRANS = 'N' or 'n'
! 106: *> then LDA must be at least max( 1, n ), otherwise LDA must
! 107: *> be at least max( 1, k ).
! 108: *> \endverbatim
! 109: *>
! 110: *> \param[in] BETA
! 111: *> \verbatim
! 112: *> BETA is DOUBLE PRECISION.
! 113: *> On entry, BETA specifies the scalar beta.
! 114: *> \endverbatim
! 115: *>
! 116: *> \param[in,out] C
! 117: *> \verbatim
! 118: *> C is COMPLEX*16 array of DIMENSION ( LDC, n ).
! 119: *> Before entry with UPLO = 'U' or 'u', the leading n by n
! 120: *> upper triangular part of the array C must contain the upper
! 121: *> triangular part of the hermitian matrix and the strictly
! 122: *> lower triangular part of C is not referenced. On exit, the
! 123: *> upper triangular part of the array C is overwritten by the
! 124: *> upper triangular part of the updated matrix.
! 125: *> Before entry with UPLO = 'L' or 'l', the leading n by n
! 126: *> lower triangular part of the array C must contain the lower
! 127: *> triangular part of the hermitian matrix and the strictly
! 128: *> upper triangular part of C is not referenced. On exit, the
! 129: *> lower triangular part of the array C is overwritten by the
! 130: *> lower triangular part of the updated matrix.
! 131: *> Note that the imaginary parts of the diagonal elements need
! 132: *> not be set, they are assumed to be zero, and on exit they
! 133: *> are set to zero.
! 134: *> \endverbatim
! 135: *>
! 136: *> \param[in] LDC
! 137: *> \verbatim
! 138: *> LDC is INTEGER
! 139: *> On entry, LDC specifies the first dimension of C as declared
! 140: *> in the calling (sub) program. LDC must be at least
! 141: *> max( 1, n ).
! 142: *> \endverbatim
! 143: *
! 144: * Authors:
! 145: * ========
! 146: *
! 147: *> \author Univ. of Tennessee
! 148: *> \author Univ. of California Berkeley
! 149: *> \author Univ. of Colorado Denver
! 150: *> \author NAG Ltd.
! 151: *
! 152: *> \date November 2011
! 153: *
! 154: *> \ingroup complex16_blas_level3
! 155: *
! 156: *> \par Further Details:
! 157: * =====================
! 158: *>
! 159: *> \verbatim
! 160: *>
! 161: *> Level 3 Blas routine.
! 162: *>
! 163: *> -- Written on 8-February-1989.
! 164: *> Jack Dongarra, Argonne National Laboratory.
! 165: *> Iain Duff, AERE Harwell.
! 166: *> Jeremy Du Croz, Numerical Algorithms Group Ltd.
! 167: *> Sven Hammarling, Numerical Algorithms Group Ltd.
! 168: *>
! 169: *> -- Modified 8-Nov-93 to set C(J,J) to DBLE( C(J,J) ) when BETA = 1.
! 170: *> Ed Anderson, Cray Research Inc.
! 171: *> \endverbatim
! 172: *>
! 173: * =====================================================================
1.1 bertrand 174: SUBROUTINE ZHERK(UPLO,TRANS,N,K,ALPHA,A,LDA,BETA,C,LDC)
1.8 ! bertrand 175: *
! 176: * -- Reference BLAS level3 routine (version 3.4.0) --
! 177: * -- Reference BLAS is a software package provided by Univ. of Tennessee, --
! 178: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
! 179: * November 2011
! 180: *
1.1 bertrand 181: * .. Scalar Arguments ..
182: DOUBLE PRECISION ALPHA,BETA
183: INTEGER K,LDA,LDC,N
184: CHARACTER TRANS,UPLO
185: * ..
186: * .. Array Arguments ..
1.8 ! bertrand 187: COMPLEX*16 A(LDA,*),C(LDC,*)
1.1 bertrand 188: * ..
189: *
190: * =====================================================================
191: *
192: * .. External Functions ..
193: LOGICAL LSAME
194: EXTERNAL LSAME
195: * ..
196: * .. External Subroutines ..
197: EXTERNAL XERBLA
198: * ..
199: * .. Intrinsic Functions ..
200: INTRINSIC DBLE,DCMPLX,DCONJG,MAX
201: * ..
202: * .. Local Scalars ..
1.8 ! bertrand 203: COMPLEX*16 TEMP
1.1 bertrand 204: DOUBLE PRECISION RTEMP
205: INTEGER I,INFO,J,L,NROWA
206: LOGICAL UPPER
207: * ..
208: * .. Parameters ..
209: DOUBLE PRECISION ONE,ZERO
210: PARAMETER (ONE=1.0D+0,ZERO=0.0D+0)
211: * ..
212: *
213: * Test the input parameters.
214: *
215: IF (LSAME(TRANS,'N')) THEN
216: NROWA = N
217: ELSE
218: NROWA = K
219: END IF
220: UPPER = LSAME(UPLO,'U')
221: *
222: INFO = 0
223: IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN
224: INFO = 1
225: ELSE IF ((.NOT.LSAME(TRANS,'N')) .AND.
226: + (.NOT.LSAME(TRANS,'C'))) THEN
227: INFO = 2
228: ELSE IF (N.LT.0) THEN
229: INFO = 3
230: ELSE IF (K.LT.0) THEN
231: INFO = 4
232: ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
233: INFO = 7
234: ELSE IF (LDC.LT.MAX(1,N)) THEN
235: INFO = 10
236: END IF
237: IF (INFO.NE.0) THEN
238: CALL XERBLA('ZHERK ',INFO)
239: RETURN
240: END IF
241: *
242: * Quick return if possible.
243: *
244: IF ((N.EQ.0) .OR. (((ALPHA.EQ.ZERO).OR.
245: + (K.EQ.0)).AND. (BETA.EQ.ONE))) RETURN
246: *
247: * And when alpha.eq.zero.
248: *
249: IF (ALPHA.EQ.ZERO) THEN
250: IF (UPPER) THEN
251: IF (BETA.EQ.ZERO) THEN
252: DO 20 J = 1,N
253: DO 10 I = 1,J
254: C(I,J) = ZERO
255: 10 CONTINUE
256: 20 CONTINUE
257: ELSE
258: DO 40 J = 1,N
259: DO 30 I = 1,J - 1
260: C(I,J) = BETA*C(I,J)
261: 30 CONTINUE
262: C(J,J) = BETA*DBLE(C(J,J))
263: 40 CONTINUE
264: END IF
265: ELSE
266: IF (BETA.EQ.ZERO) THEN
267: DO 60 J = 1,N
268: DO 50 I = J,N
269: C(I,J) = ZERO
270: 50 CONTINUE
271: 60 CONTINUE
272: ELSE
273: DO 80 J = 1,N
274: C(J,J) = BETA*DBLE(C(J,J))
275: DO 70 I = J + 1,N
276: C(I,J) = BETA*C(I,J)
277: 70 CONTINUE
278: 80 CONTINUE
279: END IF
280: END IF
281: RETURN
282: END IF
283: *
284: * Start the operations.
285: *
286: IF (LSAME(TRANS,'N')) THEN
287: *
1.7 bertrand 288: * Form C := alpha*A*A**H + beta*C.
1.1 bertrand 289: *
290: IF (UPPER) THEN
291: DO 130 J = 1,N
292: IF (BETA.EQ.ZERO) THEN
293: DO 90 I = 1,J
294: C(I,J) = ZERO
295: 90 CONTINUE
296: ELSE IF (BETA.NE.ONE) THEN
297: DO 100 I = 1,J - 1
298: C(I,J) = BETA*C(I,J)
299: 100 CONTINUE
300: C(J,J) = BETA*DBLE(C(J,J))
301: ELSE
302: C(J,J) = DBLE(C(J,J))
303: END IF
304: DO 120 L = 1,K
305: IF (A(J,L).NE.DCMPLX(ZERO)) THEN
306: TEMP = ALPHA*DCONJG(A(J,L))
307: DO 110 I = 1,J - 1
308: C(I,J) = C(I,J) + TEMP*A(I,L)
309: 110 CONTINUE
310: C(J,J) = DBLE(C(J,J)) + DBLE(TEMP*A(I,L))
311: END IF
312: 120 CONTINUE
313: 130 CONTINUE
314: ELSE
315: DO 180 J = 1,N
316: IF (BETA.EQ.ZERO) THEN
317: DO 140 I = J,N
318: C(I,J) = ZERO
319: 140 CONTINUE
320: ELSE IF (BETA.NE.ONE) THEN
321: C(J,J) = BETA*DBLE(C(J,J))
322: DO 150 I = J + 1,N
323: C(I,J) = BETA*C(I,J)
324: 150 CONTINUE
325: ELSE
326: C(J,J) = DBLE(C(J,J))
327: END IF
328: DO 170 L = 1,K
329: IF (A(J,L).NE.DCMPLX(ZERO)) THEN
330: TEMP = ALPHA*DCONJG(A(J,L))
331: C(J,J) = DBLE(C(J,J)) + DBLE(TEMP*A(J,L))
332: DO 160 I = J + 1,N
333: C(I,J) = C(I,J) + TEMP*A(I,L)
334: 160 CONTINUE
335: END IF
336: 170 CONTINUE
337: 180 CONTINUE
338: END IF
339: ELSE
340: *
1.7 bertrand 341: * Form C := alpha*A**H*A + beta*C.
1.1 bertrand 342: *
343: IF (UPPER) THEN
344: DO 220 J = 1,N
345: DO 200 I = 1,J - 1
346: TEMP = ZERO
347: DO 190 L = 1,K
348: TEMP = TEMP + DCONJG(A(L,I))*A(L,J)
349: 190 CONTINUE
350: IF (BETA.EQ.ZERO) THEN
351: C(I,J) = ALPHA*TEMP
352: ELSE
353: C(I,J) = ALPHA*TEMP + BETA*C(I,J)
354: END IF
355: 200 CONTINUE
356: RTEMP = ZERO
357: DO 210 L = 1,K
358: RTEMP = RTEMP + DCONJG(A(L,J))*A(L,J)
359: 210 CONTINUE
360: IF (BETA.EQ.ZERO) THEN
361: C(J,J) = ALPHA*RTEMP
362: ELSE
363: C(J,J) = ALPHA*RTEMP + BETA*DBLE(C(J,J))
364: END IF
365: 220 CONTINUE
366: ELSE
367: DO 260 J = 1,N
368: RTEMP = ZERO
369: DO 230 L = 1,K
370: RTEMP = RTEMP + DCONJG(A(L,J))*A(L,J)
371: 230 CONTINUE
372: IF (BETA.EQ.ZERO) THEN
373: C(J,J) = ALPHA*RTEMP
374: ELSE
375: C(J,J) = ALPHA*RTEMP + BETA*DBLE(C(J,J))
376: END IF
377: DO 250 I = J + 1,N
378: TEMP = ZERO
379: DO 240 L = 1,K
380: TEMP = TEMP + DCONJG(A(L,I))*A(L,J)
381: 240 CONTINUE
382: IF (BETA.EQ.ZERO) THEN
383: C(I,J) = ALPHA*TEMP
384: ELSE
385: C(I,J) = ALPHA*TEMP + BETA*C(I,J)
386: END IF
387: 250 CONTINUE
388: 260 CONTINUE
389: END IF
390: END IF
391: *
392: RETURN
393: *
394: * End of ZHERK .
395: *
396: END
CVSweb interface <joel.bertrand@systella.fr>