LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ cherk()

subroutine cherk ( character  uplo,
character  trans,
integer  n,
integer  k,
real  alpha,
complex, dimension(lda,*)  a,
integer  lda,
real  beta,
complex, dimension(ldc,*)  c,
integer  ldc 
)

CHERK

Purpose:
 CHERK  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 REAL
           On entry, ALPHA specifies the scalar alpha.
[in]A
          A is COMPLEX 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 REAL
           On entry, BETA specifies the scalar beta.
[in,out]C
          C is COMPLEX 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 REAL( C(J,J) ) when BETA = 1.
     Ed Anderson, Cray Research Inc.

Definition at line 172 of file cherk.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 REAL ALPHA,BETA
180 INTEGER K,LDA,LDC,N
181 CHARACTER TRANS,UPLO
182* ..
183* .. Array Arguments ..
184 COMPLEX 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 cmplx,conjg,max,real
198* ..
199* .. Local Scalars ..
200 COMPLEX TEMP
201 REAL RTEMP
202 INTEGER I,INFO,J,L,NROWA
203 LOGICAL UPPER
204* ..
205* .. Parameters ..
206 REAL ONE,ZERO
207 parameter(one=1.0e+0,zero=0.0e+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('CHERK ',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*real(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*real(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*real(c(j,j))
298 ELSE
299 c(j,j) = real(c(j,j))
300 END IF
301 DO 120 l = 1,k
302 IF (a(j,l).NE.cmplx(zero)) THEN
303 temp = alpha*conjg(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) = real(c(j,j)) + real(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*real(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) = real(c(j,j))
324 END IF
325 DO 170 l = 1,k
326 IF (a(j,l).NE.cmplx(zero)) THEN
327 temp = alpha*conjg(a(j,l))
328 c(j,j) = real(c(j,j)) + real(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 + conjg(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 + real(conjg(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*real(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 + real(conjg(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*real(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 + conjg(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 CHERK
392*
xerbla
subroutine xerbla(srname, info)
Definition cblat2.f:3285
lsame
logical function lsame(ca, cb)
LSAME
Definition lsame.f:48
Here is the call graph for this function:
Here is the caller graph for this function: