174 SUBROUTINE cherk(UPLO,TRANS,N,K,ALPHA,A,LDA,BETA,C,LDC)
187 COMPLEX A(lda,*),C(ldc,*)
200 INTRINSIC cmplx,conjg,max,real
205 INTEGER I,INFO,J,L,NROWA
210 parameter(one=1.0e+0,zero=0.0e+0)
215 IF (lsame(trans,
'N'))
THEN
220 upper = lsame(uplo,
'U')
223 IF ((.NOT.upper) .AND. (.NOT.lsame(uplo,
'L')))
THEN
225 ELSE IF ((.NOT.lsame(trans,
'N')) .AND.
226 + (.NOT.lsame(trans,
'C')))
THEN
228 ELSE IF (n.LT.0)
THEN
230 ELSE IF (k.LT.0)
THEN
232 ELSE IF (lda.LT.max(1,nrowa))
THEN
234 ELSE IF (ldc.LT.max(1,n))
THEN
238 CALL xerbla(
'CHERK ',info)
244 IF ((n.EQ.0) .OR. (((alpha.EQ.zero).OR.
245 + (k.EQ.0)).AND. (beta.EQ.one)))
RETURN
249 IF (alpha.EQ.zero)
THEN
251 IF (beta.EQ.zero)
THEN
262 c(j,j) = beta*
REAL(c(j,j))
266 IF (beta.EQ.zero)
THEN
274 c(j,j) = beta*
REAL(c(j,j))
286 IF (lsame(trans,
'N'))
THEN
292 IF (beta.EQ.zero)
THEN
296 ELSE IF (beta.NE.one)
THEN
300 c(j,j) = beta*
REAL(c(j,j))
302 c(j,j) =
REAL(c(j,j))
305 IF (a(j,l).NE.cmplx(zero))
THEN
306 temp = alpha*conjg(a(j,l))
308 c(i,j) = c(i,j) + temp*a(i,l)
310 c(j,j) =
REAL(C(J,J)) +
REAL(temp*a(i,l))
316 IF (beta.EQ.zero)
THEN
320 ELSE IF (beta.NE.one)
THEN
321 c(j,j) = beta*
REAL(c(j,j))
326 c(j,j) =
REAL(c(j,j))
329 IF (a(j,l).NE.cmplx(zero))
THEN
330 temp = alpha*conjg(a(j,l))
331 c(j,j) =
REAL(C(J,J)) +
REAL(temp*a(j,l))
333 c(i,j) = c(i,j) + temp*a(i,l)
348 temp = temp + conjg(a(l,i))*a(l,j)
350 IF (beta.EQ.zero)
THEN
353 c(i,j) = alpha*temp + beta*c(i,j)
358 rtemp = rtemp + conjg(a(l,j))*a(l,j)
360 IF (beta.EQ.zero)
THEN
363 c(j,j) = alpha*rtemp + beta*
REAL(c(j,j))
370 rtemp = rtemp + conjg(a(l,j))*a(l,j)
372 IF (beta.EQ.zero)
THEN
375 c(j,j) = alpha*rtemp + beta*
REAL(c(j,j))
380 temp = temp + conjg(a(l,i))*a(l,j)
382 IF (beta.EQ.zero)
THEN
385 c(i,j) = alpha*temp + beta*c(i,j)
subroutine cherk(UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC)
CHERK
subroutine xerbla(SRNAME, INFO)
XERBLA