LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ zherk()

subroutine zherk ( character  UPLO,
character  TRANS,
integer  N,
integer  K,
double precision  ALPHA,
complex*16, dimension(lda,*)  A,
integer  LDA,
double precision  BETA,
complex*16, dimension(ldc,*)  C,
integer  LDC 
)

ZHERK

Purpose:
 ZHERK  performs one of the hermitian rank k operations

    C := alpha*A*A**H + beta*C,

 or

    C := alpha*A**H*A + beta*C,

 where  alpha and beta  are  real scalars,  C is an  n by n  hermitian
 matrix and  A  is an  n by k  matrix in the  first case and a  k by n
 matrix in the second case.
Parameters
[in]UPLO
          UPLO is CHARACTER*1
           On  entry,   UPLO  specifies  whether  the  upper  or  lower
           triangular  part  of the  array  C  is to be  referenced  as
           follows:

              UPLO = 'U' or 'u'   Only the  upper triangular part of  C
                                  is to be referenced.

              UPLO = 'L' or 'l'   Only the  lower triangular part of  C
                                  is to be referenced.
[in]TRANS
          TRANS is CHARACTER*1
           On entry,  TRANS  specifies the operation to be performed as
           follows:

              TRANS = 'N' or 'n'   C := alpha*A*A**H + beta*C.

              TRANS = 'C' or 'c'   C := alpha*A**H*A + beta*C.
[in]N
          N is INTEGER
           On entry,  N specifies the order of the matrix C.  N must be
           at least zero.
[in]K
          K is INTEGER
           On entry with  TRANS = 'N' or 'n',  K  specifies  the number
           of  columns   of  the   matrix   A,   and  on   entry   with
           TRANS = 'C' or 'c',  K  specifies  the number of rows of the
           matrix A.  K must be at least zero.
[in]ALPHA
          ALPHA is DOUBLE PRECISION .
           On entry, ALPHA specifies the scalar alpha.
[in]A
          A is COMPLEX*16 array, dimension ( LDA, ka ), where ka is
           k  when  TRANS = 'N' or 'n',  and is  n  otherwise.
           Before entry with  TRANS = 'N' or 'n',  the  leading  n by k
           part of the array  A  must contain the matrix  A,  otherwise
           the leading  k by n  part of the array  A  must contain  the
           matrix A.
[in]LDA
          LDA is INTEGER
           On entry, LDA specifies the first dimension of A as declared
           in  the  calling  (sub)  program.   When  TRANS = 'N' or 'n'
           then  LDA must be at least  max( 1, n ), otherwise  LDA must
           be at least  max( 1, k ).
[in]BETA
          BETA is DOUBLE PRECISION.
           On entry, BETA specifies the scalar beta.
[in,out]C
          C is COMPLEX*16 array, dimension ( LDC, N )
           Before entry  with  UPLO = 'U' or 'u',  the leading  n by n
           upper triangular part of the array C must contain the upper
           triangular part  of the  hermitian matrix  and the strictly
           lower triangular part of C is not referenced.  On exit, the
           upper triangular part of the array  C is overwritten by the
           upper triangular part of the updated matrix.
           Before entry  with  UPLO = 'L' or 'l',  the leading  n by n
           lower triangular part of the array C must contain the lower
           triangular part  of the  hermitian matrix  and the strictly
           upper triangular part of C is not referenced.  On exit, the
           lower triangular part of the array  C is overwritten by the
           lower triangular part of the updated matrix.
           Note that the imaginary parts of the diagonal elements need
           not be set,  they are assumed to be zero,  and on exit they
           are set to zero.
[in]LDC
          LDC is INTEGER
           On entry, LDC specifies the first dimension of C as declared
           in  the  calling  (sub)  program.   LDC  must  be  at  least
           max( 1, n ).
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Further Details:
  Level 3 Blas routine.

  -- Written on 8-February-1989.
     Jack Dongarra, Argonne National Laboratory.
     Iain Duff, AERE Harwell.
     Jeremy Du Croz, Numerical Algorithms Group Ltd.
     Sven Hammarling, Numerical Algorithms Group Ltd.

  -- Modified 8-Nov-93 to set C(J,J) to DBLE( C(J,J) ) when BETA = 1.
     Ed Anderson, Cray Research Inc.

Definition at line 172 of file zherk.f.

173 *
174 * -- Reference BLAS level3 routine --
175 * -- Reference BLAS is a software package provided by Univ. of Tennessee, --
176 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
177 *
178 * .. Scalar Arguments ..
179  DOUBLE PRECISION ALPHA,BETA
180  INTEGER K,LDA,LDC,N
181  CHARACTER TRANS,UPLO
182 * ..
183 * .. Array Arguments ..
184  COMPLEX*16 A(LDA,*),C(LDC,*)
185 * ..
186 *
187 * =====================================================================
188 *
189 * .. External Functions ..
190  LOGICAL LSAME
191  EXTERNAL lsame
192 * ..
193 * .. External Subroutines ..
194  EXTERNAL xerbla
195 * ..
196 * .. Intrinsic Functions ..
197  INTRINSIC dble,dcmplx,dconjg,max
198 * ..
199 * .. Local Scalars ..
200  COMPLEX*16 TEMP
201  DOUBLE PRECISION RTEMP
202  INTEGER I,INFO,J,L,NROWA
203  LOGICAL UPPER
204 * ..
205 * .. Parameters ..
206  DOUBLE PRECISION ONE,ZERO
207  parameter(one=1.0d+0,zero=0.0d+0)
208 * ..
209 *
210 * Test the input parameters.
211 *
212  IF (lsame(trans,'N')) THEN
213  nrowa = n
214  ELSE
215  nrowa = k
216  END IF
217  upper = lsame(uplo,'U')
218 *
219  info = 0
220  IF ((.NOT.upper) .AND. (.NOT.lsame(uplo,'L'))) THEN
221  info = 1
222  ELSE IF ((.NOT.lsame(trans,'N')) .AND.
223  + (.NOT.lsame(trans,'C'))) THEN
224  info = 2
225  ELSE IF (n.LT.0) THEN
226  info = 3
227  ELSE IF (k.LT.0) THEN
228  info = 4
229  ELSE IF (lda.LT.max(1,nrowa)) THEN
230  info = 7
231  ELSE IF (ldc.LT.max(1,n)) THEN
232  info = 10
233  END IF
234  IF (info.NE.0) THEN
235  CALL xerbla('ZHERK ',info)
236  RETURN
237  END IF
238 *
239 * Quick return if possible.
240 *
241  IF ((n.EQ.0) .OR. (((alpha.EQ.zero).OR.
242  + (k.EQ.0)).AND. (beta.EQ.one))) RETURN
243 *
244 * And when alpha.eq.zero.
245 *
246  IF (alpha.EQ.zero) THEN
247  IF (upper) THEN
248  IF (beta.EQ.zero) THEN
249  DO 20 j = 1,n
250  DO 10 i = 1,j
251  c(i,j) = zero
252  10 CONTINUE
253  20 CONTINUE
254  ELSE
255  DO 40 j = 1,n
256  DO 30 i = 1,j - 1
257  c(i,j) = beta*c(i,j)
258  30 CONTINUE
259  c(j,j) = beta*dble(c(j,j))
260  40 CONTINUE
261  END IF
262  ELSE
263  IF (beta.EQ.zero) THEN
264  DO 60 j = 1,n
265  DO 50 i = j,n
266  c(i,j) = zero
267  50 CONTINUE
268  60 CONTINUE
269  ELSE
270  DO 80 j = 1,n
271  c(j,j) = beta*dble(c(j,j))
272  DO 70 i = j + 1,n
273  c(i,j) = beta*c(i,j)
274  70 CONTINUE
275  80 CONTINUE
276  END IF
277  END IF
278  RETURN
279  END IF
280 *
281 * Start the operations.
282 *
283  IF (lsame(trans,'N')) THEN
284 *
285 * Form C := alpha*A*A**H + beta*C.
286 *
287  IF (upper) THEN
288  DO 130 j = 1,n
289  IF (beta.EQ.zero) THEN
290  DO 90 i = 1,j
291  c(i,j) = zero
292  90 CONTINUE
293  ELSE IF (beta.NE.one) THEN
294  DO 100 i = 1,j - 1
295  c(i,j) = beta*c(i,j)
296  100 CONTINUE
297  c(j,j) = beta*dble(c(j,j))
298  ELSE
299  c(j,j) = dble(c(j,j))
300  END IF
301  DO 120 l = 1,k
302  IF (a(j,l).NE.dcmplx(zero)) THEN
303  temp = alpha*dconjg(a(j,l))
304  DO 110 i = 1,j - 1
305  c(i,j) = c(i,j) + temp*a(i,l)
306  110 CONTINUE
307  c(j,j) = dble(c(j,j)) + dble(temp*a(i,l))
308  END IF
309  120 CONTINUE
310  130 CONTINUE
311  ELSE
312  DO 180 j = 1,n
313  IF (beta.EQ.zero) THEN
314  DO 140 i = j,n
315  c(i,j) = zero
316  140 CONTINUE
317  ELSE IF (beta.NE.one) THEN
318  c(j,j) = beta*dble(c(j,j))
319  DO 150 i = j + 1,n
320  c(i,j) = beta*c(i,j)
321  150 CONTINUE
322  ELSE
323  c(j,j) = dble(c(j,j))
324  END IF
325  DO 170 l = 1,k
326  IF (a(j,l).NE.dcmplx(zero)) THEN
327  temp = alpha*dconjg(a(j,l))
328  c(j,j) = dble(c(j,j)) + dble(temp*a(j,l))
329  DO 160 i = j + 1,n
330  c(i,j) = c(i,j) + temp*a(i,l)
331  160 CONTINUE
332  END IF
333  170 CONTINUE
334  180 CONTINUE
335  END IF
336  ELSE
337 *
338 * Form C := alpha*A**H*A + beta*C.
339 *
340  IF (upper) THEN
341  DO 220 j = 1,n
342  DO 200 i = 1,j - 1
343  temp = zero
344  DO 190 l = 1,k
345  temp = temp + dconjg(a(l,i))*a(l,j)
346  190 CONTINUE
347  IF (beta.EQ.zero) THEN
348  c(i,j) = alpha*temp
349  ELSE
350  c(i,j) = alpha*temp + beta*c(i,j)
351  END IF
352  200 CONTINUE
353  rtemp = zero
354  DO 210 l = 1,k
355  rtemp = rtemp + dconjg(a(l,j))*a(l,j)
356  210 CONTINUE
357  IF (beta.EQ.zero) THEN
358  c(j,j) = alpha*rtemp
359  ELSE
360  c(j,j) = alpha*rtemp + beta*dble(c(j,j))
361  END IF
362  220 CONTINUE
363  ELSE
364  DO 260 j = 1,n
365  rtemp = zero
366  DO 230 l = 1,k
367  rtemp = rtemp + dconjg(a(l,j))*a(l,j)
368  230 CONTINUE
369  IF (beta.EQ.zero) THEN
370  c(j,j) = alpha*rtemp
371  ELSE
372  c(j,j) = alpha*rtemp + beta*dble(c(j,j))
373  END IF
374  DO 250 i = j + 1,n
375  temp = zero
376  DO 240 l = 1,k
377  temp = temp + dconjg(a(l,i))*a(l,j)
378  240 CONTINUE
379  IF (beta.EQ.zero) THEN
380  c(i,j) = alpha*temp
381  ELSE
382  c(i,j) = alpha*temp + beta*c(i,j)
383  END IF
384  250 CONTINUE
385  260 CONTINUE
386  END IF
387  END IF
388 *
389  RETURN
390 *
391 * End of ZHERK
392 *
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:53
Here is the call graph for this function:
Here is the caller graph for this function: