LAPACK  3.6.0
LAPACK: Linear Algebra PACKage
Collaboration diagram for complex16:

Functions

subroutine zgemm (TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
 ZGEMM More...
 
subroutine zhemm (SIDE, UPLO, M, N, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
 ZHEMM More...
 
subroutine zher2k (UPLO, TRANS, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
 ZHER2K More...
 
subroutine zherk (UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC)
 ZHERK More...
 
subroutine zsymm (SIDE, UPLO, M, N, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
 ZSYMM More...
 
subroutine zsyr2k (UPLO, TRANS, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
 ZSYR2K More...
 
subroutine zsyrk (UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC)
 ZSYRK More...
 
subroutine ztrmm (SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
 ZTRMM More...
 
subroutine ztrsm (SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
 ZTRSM More...
 

Detailed Description

This is the group of complex16 LEVEL 3 BLAS routines.

Function Documentation

subroutine zgemm ( character  TRANSA,
character  TRANSB,
integer  M,
integer  N,
integer  K,
complex*16  ALPHA,
complex*16, dimension(lda,*)  A,
integer  LDA,
complex*16, dimension(ldb,*)  B,
integer  LDB,
complex*16  BETA,
complex*16, dimension(ldc,*)  C,
integer  LDC 
)

ZGEMM

Purpose:
 ZGEMM  performs one of the matrix-matrix operations

    C := alpha*op( A )*op( B ) + beta*C,

 where  op( X ) is one of

    op( X ) = X   or   op( X ) = X**T   or   op( X ) = X**H,

 alpha and beta are scalars, and A, B and C are matrices, with op( A )
 an m by k matrix,  op( B )  a  k by n matrix and  C an m by n matrix.
Parameters
[in]TRANSA
          TRANSA is CHARACTER*1
           On entry, TRANSA specifies the form of op( A ) to be used in
           the matrix multiplication as follows:

              TRANSA = 'N' or 'n',  op( A ) = A.

              TRANSA = 'T' or 't',  op( A ) = A**T.

              TRANSA = 'C' or 'c',  op( A ) = A**H.
[in]TRANSB
          TRANSB is CHARACTER*1
           On entry, TRANSB specifies the form of op( B ) to be used in
           the matrix multiplication as follows:

              TRANSB = 'N' or 'n',  op( B ) = B.

              TRANSB = 'T' or 't',  op( B ) = B**T.

              TRANSB = 'C' or 'c',  op( B ) = B**H.
[in]M
          M is INTEGER
           On entry,  M  specifies  the number  of rows  of the  matrix
           op( A )  and of the  matrix  C.  M  must  be at least  zero.
[in]N
          N is INTEGER
           On entry,  N  specifies the number  of columns of the matrix
           op( B ) and the number of columns of the matrix C. N must be
           at least zero.
[in]K
          K is INTEGER
           On entry,  K  specifies  the number of columns of the matrix
           op( A ) and the number of rows of the matrix op( B ). K must
           be at least  zero.
[in]ALPHA
          ALPHA is COMPLEX*16
           On entry, ALPHA specifies the scalar alpha.
[in]A
          A is COMPLEX*16 array of DIMENSION ( LDA, ka ), where ka is
           k  when  TRANSA = 'N' or 'n',  and is  m  otherwise.
           Before entry with  TRANSA = 'N' or 'n',  the leading  m by k
           part of the array  A  must contain the matrix  A,  otherwise
           the leading  k by m  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  TRANSA = 'N' or 'n' then
           LDA must be at least  max( 1, m ), otherwise  LDA must be at
           least  max( 1, k ).
[in]B
          B is COMPLEX*16 array of DIMENSION ( LDB, kb ), where kb is
           n  when  TRANSB = 'N' or 'n',  and is  k  otherwise.
           Before entry with  TRANSB = 'N' or 'n',  the leading  k by n
           part of the array  B  must contain the matrix  B,  otherwise
           the leading  n by k  part of the array  B  must contain  the
           matrix B.
[in]LDB
          LDB is INTEGER
           On entry, LDB specifies the first dimension of B as declared
           in the calling (sub) program. When  TRANSB = 'N' or 'n' then
           LDB must be at least  max( 1, k ), otherwise  LDB must be at
           least  max( 1, n ).
[in]BETA
          BETA is COMPLEX*16
           On entry,  BETA  specifies the scalar  beta.  When  BETA  is
           supplied as zero then C need not be set on input.
[in,out]C
          C is COMPLEX*16 array of DIMENSION ( LDC, n ).
           Before entry, the leading  m by n  part of the array  C must
           contain the matrix  C,  except when  beta  is zero, in which
           case C need not be set on entry.
           On exit, the array  C  is overwritten by the  m by n  matrix
           ( alpha*op( A )*op( B ) + beta*C ).
[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, m ).
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2015
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.

Definition at line 189 of file zgemm.f.

189 *
190 * -- Reference BLAS level3 routine (version 3.6.0) --
191 * -- Reference BLAS is a software package provided by Univ. of Tennessee, --
192 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
193 * November 2015
194 *
195 * .. Scalar Arguments ..
196  COMPLEX*16 alpha,beta
197  INTEGER k,lda,ldb,ldc,m,n
198  CHARACTER transa,transb
199 * ..
200 * .. Array Arguments ..
201  COMPLEX*16 a(lda,*),b(ldb,*),c(ldc,*)
202 * ..
203 *
204 * =====================================================================
205 *
206 * .. External Functions ..
207  LOGICAL lsame
208  EXTERNAL lsame
209 * ..
210 * .. External Subroutines ..
211  EXTERNAL xerbla
212 * ..
213 * .. Intrinsic Functions ..
214  INTRINSIC dconjg,max
215 * ..
216 * .. Local Scalars ..
217  COMPLEX*16 temp
218  INTEGER i,info,j,l,ncola,nrowa,nrowb
219  LOGICAL conja,conjb,nota,notb
220 * ..
221 * .. Parameters ..
222  COMPLEX*16 one
223  parameter(one= (1.0d+0,0.0d+0))
224  COMPLEX*16 zero
225  parameter(zero= (0.0d+0,0.0d+0))
226 * ..
227 *
228 * Set NOTA and NOTB as true if A and B respectively are not
229 * conjugated or transposed, set CONJA and CONJB as true if A and
230 * B respectively are to be transposed but not conjugated and set
231 * NROWA, NCOLA and NROWB as the number of rows and columns of A
232 * and the number of rows of B respectively.
233 *
234  nota = lsame(transa,'N')
235  notb = lsame(transb,'N')
236  conja = lsame(transa,'C')
237  conjb = lsame(transb,'C')
238  IF (nota) THEN
239  nrowa = m
240  ncola = k
241  ELSE
242  nrowa = k
243  ncola = m
244  END IF
245  IF (notb) THEN
246  nrowb = k
247  ELSE
248  nrowb = n
249  END IF
250 *
251 * Test the input parameters.
252 *
253  info = 0
254  IF ((.NOT.nota) .AND. (.NOT.conja) .AND.
255  + (.NOT.lsame(transa,'T'))) THEN
256  info = 1
257  ELSE IF ((.NOT.notb) .AND. (.NOT.conjb) .AND.
258  + (.NOT.lsame(transb,'T'))) THEN
259  info = 2
260  ELSE IF (m.LT.0) THEN
261  info = 3
262  ELSE IF (n.LT.0) THEN
263  info = 4
264  ELSE IF (k.LT.0) THEN
265  info = 5
266  ELSE IF (lda.LT.max(1,nrowa)) THEN
267  info = 8
268  ELSE IF (ldb.LT.max(1,nrowb)) THEN
269  info = 10
270  ELSE IF (ldc.LT.max(1,m)) THEN
271  info = 13
272  END IF
273  IF (info.NE.0) THEN
274  CALL xerbla('ZGEMM ',info)
275  RETURN
276  END IF
277 *
278 * Quick return if possible.
279 *
280  IF ((m.EQ.0) .OR. (n.EQ.0) .OR.
281  + (((alpha.EQ.zero).OR. (k.EQ.0)).AND. (beta.EQ.one))) RETURN
282 *
283 * And when alpha.eq.zero.
284 *
285  IF (alpha.EQ.zero) THEN
286  IF (beta.EQ.zero) THEN
287  DO 20 j = 1,n
288  DO 10 i = 1,m
289  c(i,j) = zero
290  10 CONTINUE
291  20 CONTINUE
292  ELSE
293  DO 40 j = 1,n
294  DO 30 i = 1,m
295  c(i,j) = beta*c(i,j)
296  30 CONTINUE
297  40 CONTINUE
298  END IF
299  RETURN
300  END IF
301 *
302 * Start the operations.
303 *
304  IF (notb) THEN
305  IF (nota) THEN
306 *
307 * Form C := alpha*A*B + beta*C.
308 *
309  DO 90 j = 1,n
310  IF (beta.EQ.zero) THEN
311  DO 50 i = 1,m
312  c(i,j) = zero
313  50 CONTINUE
314  ELSE IF (beta.NE.one) THEN
315  DO 60 i = 1,m
316  c(i,j) = beta*c(i,j)
317  60 CONTINUE
318  END IF
319  DO 80 l = 1,k
320  temp = alpha*b(l,j)
321  DO 70 i = 1,m
322  c(i,j) = c(i,j) + temp*a(i,l)
323  70 CONTINUE
324  80 CONTINUE
325  90 CONTINUE
326  ELSE IF (conja) THEN
327 *
328 * Form C := alpha*A**H*B + beta*C.
329 *
330  DO 120 j = 1,n
331  DO 110 i = 1,m
332  temp = zero
333  DO 100 l = 1,k
334  temp = temp + dconjg(a(l,i))*b(l,j)
335  100 CONTINUE
336  IF (beta.EQ.zero) THEN
337  c(i,j) = alpha*temp
338  ELSE
339  c(i,j) = alpha*temp + beta*c(i,j)
340  END IF
341  110 CONTINUE
342  120 CONTINUE
343  ELSE
344 *
345 * Form C := alpha*A**T*B + beta*C
346 *
347  DO 150 j = 1,n
348  DO 140 i = 1,m
349  temp = zero
350  DO 130 l = 1,k
351  temp = temp + a(l,i)*b(l,j)
352  130 CONTINUE
353  IF (beta.EQ.zero) THEN
354  c(i,j) = alpha*temp
355  ELSE
356  c(i,j) = alpha*temp + beta*c(i,j)
357  END IF
358  140 CONTINUE
359  150 CONTINUE
360  END IF
361  ELSE IF (nota) THEN
362  IF (conjb) THEN
363 *
364 * Form C := alpha*A*B**H + beta*C.
365 *
366  DO 200 j = 1,n
367  IF (beta.EQ.zero) THEN
368  DO 160 i = 1,m
369  c(i,j) = zero
370  160 CONTINUE
371  ELSE IF (beta.NE.one) THEN
372  DO 170 i = 1,m
373  c(i,j) = beta*c(i,j)
374  170 CONTINUE
375  END IF
376  DO 190 l = 1,k
377  temp = alpha*dconjg(b(j,l))
378  DO 180 i = 1,m
379  c(i,j) = c(i,j) + temp*a(i,l)
380  180 CONTINUE
381  190 CONTINUE
382  200 CONTINUE
383  ELSE
384 *
385 * Form C := alpha*A*B**T + beta*C
386 *
387  DO 250 j = 1,n
388  IF (beta.EQ.zero) THEN
389  DO 210 i = 1,m
390  c(i,j) = zero
391  210 CONTINUE
392  ELSE IF (beta.NE.one) THEN
393  DO 220 i = 1,m
394  c(i,j) = beta*c(i,j)
395  220 CONTINUE
396  END IF
397  DO 240 l = 1,k
398  temp = alpha*b(j,l)
399  DO 230 i = 1,m
400  c(i,j) = c(i,j) + temp*a(i,l)
401  230 CONTINUE
402  240 CONTINUE
403  250 CONTINUE
404  END IF
405  ELSE IF (conja) THEN
406  IF (conjb) THEN
407 *
408 * Form C := alpha*A**H*B**H + beta*C.
409 *
410  DO 280 j = 1,n
411  DO 270 i = 1,m
412  temp = zero
413  DO 260 l = 1,k
414  temp = temp + dconjg(a(l,i))*dconjg(b(j,l))
415  260 CONTINUE
416  IF (beta.EQ.zero) THEN
417  c(i,j) = alpha*temp
418  ELSE
419  c(i,j) = alpha*temp + beta*c(i,j)
420  END IF
421  270 CONTINUE
422  280 CONTINUE
423  ELSE
424 *
425 * Form C := alpha*A**H*B**T + beta*C
426 *
427  DO 310 j = 1,n
428  DO 300 i = 1,m
429  temp = zero
430  DO 290 l = 1,k
431  temp = temp + dconjg(a(l,i))*b(j,l)
432  290 CONTINUE
433  IF (beta.EQ.zero) THEN
434  c(i,j) = alpha*temp
435  ELSE
436  c(i,j) = alpha*temp + beta*c(i,j)
437  END IF
438  300 CONTINUE
439  310 CONTINUE
440  END IF
441  ELSE
442  IF (conjb) THEN
443 *
444 * Form C := alpha*A**T*B**H + beta*C
445 *
446  DO 340 j = 1,n
447  DO 330 i = 1,m
448  temp = zero
449  DO 320 l = 1,k
450  temp = temp + a(l,i)*dconjg(b(j,l))
451  320 CONTINUE
452  IF (beta.EQ.zero) THEN
453  c(i,j) = alpha*temp
454  ELSE
455  c(i,j) = alpha*temp + beta*c(i,j)
456  END IF
457  330 CONTINUE
458  340 CONTINUE
459  ELSE
460 *
461 * Form C := alpha*A**T*B**T + beta*C
462 *
463  DO 370 j = 1,n
464  DO 360 i = 1,m
465  temp = zero
466  DO 350 l = 1,k
467  temp = temp + a(l,i)*b(j,l)
468  350 CONTINUE
469  IF (beta.EQ.zero) THEN
470  c(i,j) = alpha*temp
471  ELSE
472  c(i,j) = alpha*temp + beta*c(i,j)
473  END IF
474  360 CONTINUE
475  370 CONTINUE
476  END IF
477  END IF
478 *
479  RETURN
480 *
481 * End of ZGEMM .
482 *
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55

Here is the call graph for this function:

subroutine zhemm ( character  SIDE,
character  UPLO,
integer  M,
integer  N,
complex*16  ALPHA,
complex*16, dimension(lda,*)  A,
integer  LDA,
complex*16, dimension(ldb,*)  B,
integer  LDB,
complex*16  BETA,
complex*16, dimension(ldc,*)  C,
integer  LDC 
)

ZHEMM

Purpose:
 ZHEMM  performs one of the matrix-matrix operations

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

 or

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

 where alpha and beta are scalars, A is an hermitian matrix and  B and
 C are m by n matrices.
Parameters
[in]SIDE
          SIDE is CHARACTER*1
           On entry,  SIDE  specifies whether  the  hermitian matrix  A
           appears on the  left or right  in the  operation as follows:

              SIDE = 'L' or 'l'   C := alpha*A*B + beta*C,

              SIDE = 'R' or 'r'   C := alpha*B*A + beta*C,
[in]UPLO
          UPLO is CHARACTER*1
           On  entry,   UPLO  specifies  whether  the  upper  or  lower
           triangular  part  of  the  hermitian  matrix   A  is  to  be
           referenced as follows:

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

              UPLO = 'L' or 'l'   Only the lower triangular part of the
                                  hermitian matrix is to be referenced.
[in]M
          M is INTEGER
           On entry,  M  specifies the number of rows of the matrix  C.
           M  must be at least zero.
[in]N
          N is INTEGER
           On entry, N specifies the number of columns of the matrix C.
           N  must be at least zero.
[in]ALPHA
          ALPHA is COMPLEX*16
           On entry, ALPHA specifies the scalar alpha.
[in]A
          A is COMPLEX*16 array of DIMENSION ( LDA, ka ), where ka is
           m  when  SIDE = 'L' or 'l'  and is n  otherwise.
           Before entry  with  SIDE = 'L' or 'l',  the  m by m  part of
           the array  A  must contain the  hermitian matrix,  such that
           when  UPLO = 'U' or 'u', the leading m by m upper triangular
           part of the array  A  must contain the upper triangular part
           of the  hermitian matrix and the  strictly  lower triangular
           part of  A  is not referenced,  and when  UPLO = 'L' or 'l',
           the leading  m by m  lower triangular part  of the  array  A
           must  contain  the  lower triangular part  of the  hermitian
           matrix and the  strictly upper triangular part of  A  is not
           referenced.
           Before entry  with  SIDE = 'R' or 'r',  the  n by n  part of
           the array  A  must contain the  hermitian matrix,  such that
           when  UPLO = 'U' or 'u', the leading n by n upper triangular
           part of the array  A  must contain the upper triangular part
           of the  hermitian matrix and the  strictly  lower triangular
           part of  A  is not referenced,  and when  UPLO = 'L' or 'l',
           the leading  n by n  lower triangular part  of the  array  A
           must  contain  the  lower triangular part  of the  hermitian
           matrix and the  strictly upper triangular part of  A  is not
           referenced.
           Note that the imaginary parts  of the diagonal elements need
           not be set, they are assumed to be zero.
[in]LDA
          LDA is INTEGER
           On entry, LDA specifies the first dimension of A as declared
           in the  calling (sub) program. When  SIDE = 'L' or 'l'  then
           LDA must be at least  max( 1, m ), otherwise  LDA must be at
           least max( 1, n ).
[in]B
          B is COMPLEX*16 array of DIMENSION ( LDB, n ).
           Before entry, the leading  m by n part of the array  B  must
           contain the matrix B.
[in]LDB
          LDB is INTEGER
           On entry, LDB specifies the first dimension of B as declared
           in  the  calling  (sub)  program.   LDB  must  be  at  least
           max( 1, m ).
[in]BETA
          BETA is COMPLEX*16
           On entry,  BETA  specifies the scalar  beta.  When  BETA  is
           supplied as zero then C need not be set on input.
[in,out]C
          C is COMPLEX*16 array of DIMENSION ( LDC, n ).
           Before entry, the leading  m by n  part of the array  C must
           contain the matrix  C,  except when  beta  is zero, in which
           case C need not be set on entry.
           On exit, the array  C  is overwritten by the  m by n updated
           matrix.
[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, m ).
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011
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.

Definition at line 193 of file zhemm.f.

193 *
194 * -- Reference BLAS level3 routine (version 3.4.0) --
195 * -- Reference BLAS is a software package provided by Univ. of Tennessee, --
196 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
197 * November 2011
198 *
199 * .. Scalar Arguments ..
200  COMPLEX*16 alpha,beta
201  INTEGER lda,ldb,ldc,m,n
202  CHARACTER side,uplo
203 * ..
204 * .. Array Arguments ..
205  COMPLEX*16 a(lda,*),b(ldb,*),c(ldc,*)
206 * ..
207 *
208 * =====================================================================
209 *
210 * .. External Functions ..
211  LOGICAL lsame
212  EXTERNAL lsame
213 * ..
214 * .. External Subroutines ..
215  EXTERNAL xerbla
216 * ..
217 * .. Intrinsic Functions ..
218  INTRINSIC dble,dconjg,max
219 * ..
220 * .. Local Scalars ..
221  COMPLEX*16 temp1,temp2
222  INTEGER i,info,j,k,nrowa
223  LOGICAL upper
224 * ..
225 * .. Parameters ..
226  COMPLEX*16 one
227  parameter(one= (1.0d+0,0.0d+0))
228  COMPLEX*16 zero
229  parameter(zero= (0.0d+0,0.0d+0))
230 * ..
231 *
232 * Set NROWA as the number of rows of A.
233 *
234  IF (lsame(side,'L')) THEN
235  nrowa = m
236  ELSE
237  nrowa = n
238  END IF
239  upper = lsame(uplo,'U')
240 *
241 * Test the input parameters.
242 *
243  info = 0
244  IF ((.NOT.lsame(side,'L')) .AND. (.NOT.lsame(side,'R'))) THEN
245  info = 1
246  ELSE IF ((.NOT.upper) .AND. (.NOT.lsame(uplo,'L'))) THEN
247  info = 2
248  ELSE IF (m.LT.0) THEN
249  info = 3
250  ELSE IF (n.LT.0) THEN
251  info = 4
252  ELSE IF (lda.LT.max(1,nrowa)) THEN
253  info = 7
254  ELSE IF (ldb.LT.max(1,m)) THEN
255  info = 9
256  ELSE IF (ldc.LT.max(1,m)) THEN
257  info = 12
258  END IF
259  IF (info.NE.0) THEN
260  CALL xerbla('ZHEMM ',info)
261  RETURN
262  END IF
263 *
264 * Quick return if possible.
265 *
266  IF ((m.EQ.0) .OR. (n.EQ.0) .OR.
267  + ((alpha.EQ.zero).AND. (beta.EQ.one))) RETURN
268 *
269 * And when alpha.eq.zero.
270 *
271  IF (alpha.EQ.zero) THEN
272  IF (beta.EQ.zero) THEN
273  DO 20 j = 1,n
274  DO 10 i = 1,m
275  c(i,j) = zero
276  10 CONTINUE
277  20 CONTINUE
278  ELSE
279  DO 40 j = 1,n
280  DO 30 i = 1,m
281  c(i,j) = beta*c(i,j)
282  30 CONTINUE
283  40 CONTINUE
284  END IF
285  RETURN
286  END IF
287 *
288 * Start the operations.
289 *
290  IF (lsame(side,'L')) THEN
291 *
292 * Form C := alpha*A*B + beta*C.
293 *
294  IF (upper) THEN
295  DO 70 j = 1,n
296  DO 60 i = 1,m
297  temp1 = alpha*b(i,j)
298  temp2 = zero
299  DO 50 k = 1,i - 1
300  c(k,j) = c(k,j) + temp1*a(k,i)
301  temp2 = temp2 + b(k,j)*dconjg(a(k,i))
302  50 CONTINUE
303  IF (beta.EQ.zero) THEN
304  c(i,j) = temp1*dble(a(i,i)) + alpha*temp2
305  ELSE
306  c(i,j) = beta*c(i,j) + temp1*dble(a(i,i)) +
307  + alpha*temp2
308  END IF
309  60 CONTINUE
310  70 CONTINUE
311  ELSE
312  DO 100 j = 1,n
313  DO 90 i = m,1,-1
314  temp1 = alpha*b(i,j)
315  temp2 = zero
316  DO 80 k = i + 1,m
317  c(k,j) = c(k,j) + temp1*a(k,i)
318  temp2 = temp2 + b(k,j)*dconjg(a(k,i))
319  80 CONTINUE
320  IF (beta.EQ.zero) THEN
321  c(i,j) = temp1*dble(a(i,i)) + alpha*temp2
322  ELSE
323  c(i,j) = beta*c(i,j) + temp1*dble(a(i,i)) +
324  + alpha*temp2
325  END IF
326  90 CONTINUE
327  100 CONTINUE
328  END IF
329  ELSE
330 *
331 * Form C := alpha*B*A + beta*C.
332 *
333  DO 170 j = 1,n
334  temp1 = alpha*dble(a(j,j))
335  IF (beta.EQ.zero) THEN
336  DO 110 i = 1,m
337  c(i,j) = temp1*b(i,j)
338  110 CONTINUE
339  ELSE
340  DO 120 i = 1,m
341  c(i,j) = beta*c(i,j) + temp1*b(i,j)
342  120 CONTINUE
343  END IF
344  DO 140 k = 1,j - 1
345  IF (upper) THEN
346  temp1 = alpha*a(k,j)
347  ELSE
348  temp1 = alpha*dconjg(a(j,k))
349  END IF
350  DO 130 i = 1,m
351  c(i,j) = c(i,j) + temp1*b(i,k)
352  130 CONTINUE
353  140 CONTINUE
354  DO 160 k = j + 1,n
355  IF (upper) THEN
356  temp1 = alpha*dconjg(a(j,k))
357  ELSE
358  temp1 = alpha*a(k,j)
359  END IF
360  DO 150 i = 1,m
361  c(i,j) = c(i,j) + temp1*b(i,k)
362  150 CONTINUE
363  160 CONTINUE
364  170 CONTINUE
365  END IF
366 *
367  RETURN
368 *
369 * End of ZHEMM .
370 *
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55

Here is the call graph for this function:

Here is the caller graph for this function:

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

ZHER2K

Purpose:
 ZHER2K  performs one of the hermitian rank 2k operations

    C := alpha*A*B**H + conjg( alpha )*B*A**H + beta*C,

 or

    C := alpha*A**H*B + conjg( alpha )*B**H*A + beta*C,

 where  alpha and beta  are scalars with  beta  real,  C is an  n by n
 hermitian matrix and  A and B  are  n by k matrices in the first case
 and  k by n  matrices 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*B**H          +
                                         conjg( alpha )*B*A**H +
                                         beta*C.

              TRANS = 'C' or 'c'    C := alpha*A**H*B          +
                                         conjg( alpha )*B**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  matrices  A and B,  and on  entry  with
           TRANS = 'C' or 'c',  K  specifies  the number of rows of the
           matrices  A and B.  K must be at least zero.
[in]ALPHA
          ALPHA is COMPLEX*16 .
           On entry, ALPHA specifies the scalar alpha.
[in]A
          A is COMPLEX*16 array of 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]B
          B is COMPLEX*16 array of DIMENSION ( LDB, kb ), where kb 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  B  must contain the matrix  B,  otherwise
           the leading  k by n  part of the array  B  must contain  the
           matrix B.
[in]LDB
          LDB is INTEGER
           On entry, LDB specifies the first dimension of B as declared
           in  the  calling  (sub)  program.   When  TRANS = 'N' or 'n'
           then  LDB must be at least  max( 1, n ), otherwise  LDB must
           be at least  max( 1, k ).
           Unchanged on exit.
[in]BETA
          BETA is DOUBLE PRECISION .
           On entry, BETA specifies the scalar beta.
[in,out]C
          C is COMPLEX*16 array of 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.
Date
November 2011
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 200 of file zher2k.f.

200 *
201 * -- Reference BLAS level3 routine (version 3.4.0) --
202 * -- Reference BLAS is a software package provided by Univ. of Tennessee, --
203 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
204 * November 2011
205 *
206 * .. Scalar Arguments ..
207  COMPLEX*16 alpha
208  DOUBLE PRECISION beta
209  INTEGER k,lda,ldb,ldc,n
210  CHARACTER trans,uplo
211 * ..
212 * .. Array Arguments ..
213  COMPLEX*16 a(lda,*),b(ldb,*),c(ldc,*)
214 * ..
215 *
216 * =====================================================================
217 *
218 * .. External Functions ..
219  LOGICAL lsame
220  EXTERNAL lsame
221 * ..
222 * .. External Subroutines ..
223  EXTERNAL xerbla
224 * ..
225 * .. Intrinsic Functions ..
226  INTRINSIC dble,dconjg,max
227 * ..
228 * .. Local Scalars ..
229  COMPLEX*16 temp1,temp2
230  INTEGER i,info,j,l,nrowa
231  LOGICAL upper
232 * ..
233 * .. Parameters ..
234  DOUBLE PRECISION one
235  parameter(one=1.0d+0)
236  COMPLEX*16 zero
237  parameter(zero= (0.0d+0,0.0d+0))
238 * ..
239 *
240 * Test the input parameters.
241 *
242  IF (lsame(trans,'N')) THEN
243  nrowa = n
244  ELSE
245  nrowa = k
246  END IF
247  upper = lsame(uplo,'U')
248 *
249  info = 0
250  IF ((.NOT.upper) .AND. (.NOT.lsame(uplo,'L'))) THEN
251  info = 1
252  ELSE IF ((.NOT.lsame(trans,'N')) .AND.
253  + (.NOT.lsame(trans,'C'))) THEN
254  info = 2
255  ELSE IF (n.LT.0) THEN
256  info = 3
257  ELSE IF (k.LT.0) THEN
258  info = 4
259  ELSE IF (lda.LT.max(1,nrowa)) THEN
260  info = 7
261  ELSE IF (ldb.LT.max(1,nrowa)) THEN
262  info = 9
263  ELSE IF (ldc.LT.max(1,n)) THEN
264  info = 12
265  END IF
266  IF (info.NE.0) THEN
267  CALL xerbla('ZHER2K',info)
268  RETURN
269  END IF
270 *
271 * Quick return if possible.
272 *
273  IF ((n.EQ.0) .OR. (((alpha.EQ.zero).OR.
274  + (k.EQ.0)).AND. (beta.EQ.one))) RETURN
275 *
276 * And when alpha.eq.zero.
277 *
278  IF (alpha.EQ.zero) THEN
279  IF (upper) THEN
280  IF (beta.EQ.dble(zero)) THEN
281  DO 20 j = 1,n
282  DO 10 i = 1,j
283  c(i,j) = zero
284  10 CONTINUE
285  20 CONTINUE
286  ELSE
287  DO 40 j = 1,n
288  DO 30 i = 1,j - 1
289  c(i,j) = beta*c(i,j)
290  30 CONTINUE
291  c(j,j) = beta*dble(c(j,j))
292  40 CONTINUE
293  END IF
294  ELSE
295  IF (beta.EQ.dble(zero)) THEN
296  DO 60 j = 1,n
297  DO 50 i = j,n
298  c(i,j) = zero
299  50 CONTINUE
300  60 CONTINUE
301  ELSE
302  DO 80 j = 1,n
303  c(j,j) = beta*dble(c(j,j))
304  DO 70 i = j + 1,n
305  c(i,j) = beta*c(i,j)
306  70 CONTINUE
307  80 CONTINUE
308  END IF
309  END IF
310  RETURN
311  END IF
312 *
313 * Start the operations.
314 *
315  IF (lsame(trans,'N')) THEN
316 *
317 * Form C := alpha*A*B**H + conjg( alpha )*B*A**H +
318 * C.
319 *
320  IF (upper) THEN
321  DO 130 j = 1,n
322  IF (beta.EQ.dble(zero)) THEN
323  DO 90 i = 1,j
324  c(i,j) = zero
325  90 CONTINUE
326  ELSE IF (beta.NE.one) THEN
327  DO 100 i = 1,j - 1
328  c(i,j) = beta*c(i,j)
329  100 CONTINUE
330  c(j,j) = beta*dble(c(j,j))
331  ELSE
332  c(j,j) = dble(c(j,j))
333  END IF
334  DO 120 l = 1,k
335  IF ((a(j,l).NE.zero) .OR. (b(j,l).NE.zero)) THEN
336  temp1 = alpha*dconjg(b(j,l))
337  temp2 = dconjg(alpha*a(j,l))
338  DO 110 i = 1,j - 1
339  c(i,j) = c(i,j) + a(i,l)*temp1 +
340  + b(i,l)*temp2
341  110 CONTINUE
342  c(j,j) = dble(c(j,j)) +
343  + dble(a(j,l)*temp1+b(j,l)*temp2)
344  END IF
345  120 CONTINUE
346  130 CONTINUE
347  ELSE
348  DO 180 j = 1,n
349  IF (beta.EQ.dble(zero)) THEN
350  DO 140 i = j,n
351  c(i,j) = zero
352  140 CONTINUE
353  ELSE IF (beta.NE.one) THEN
354  DO 150 i = j + 1,n
355  c(i,j) = beta*c(i,j)
356  150 CONTINUE
357  c(j,j) = beta*dble(c(j,j))
358  ELSE
359  c(j,j) = dble(c(j,j))
360  END IF
361  DO 170 l = 1,k
362  IF ((a(j,l).NE.zero) .OR. (b(j,l).NE.zero)) THEN
363  temp1 = alpha*dconjg(b(j,l))
364  temp2 = dconjg(alpha*a(j,l))
365  DO 160 i = j + 1,n
366  c(i,j) = c(i,j) + a(i,l)*temp1 +
367  + b(i,l)*temp2
368  160 CONTINUE
369  c(j,j) = dble(c(j,j)) +
370  + dble(a(j,l)*temp1+b(j,l)*temp2)
371  END IF
372  170 CONTINUE
373  180 CONTINUE
374  END IF
375  ELSE
376 *
377 * Form C := alpha*A**H*B + conjg( alpha )*B**H*A +
378 * C.
379 *
380  IF (upper) THEN
381  DO 210 j = 1,n
382  DO 200 i = 1,j
383  temp1 = zero
384  temp2 = zero
385  DO 190 l = 1,k
386  temp1 = temp1 + dconjg(a(l,i))*b(l,j)
387  temp2 = temp2 + dconjg(b(l,i))*a(l,j)
388  190 CONTINUE
389  IF (i.EQ.j) THEN
390  IF (beta.EQ.dble(zero)) THEN
391  c(j,j) = dble(alpha*temp1+
392  + dconjg(alpha)*temp2)
393  ELSE
394  c(j,j) = beta*dble(c(j,j)) +
395  + dble(alpha*temp1+
396  + dconjg(alpha)*temp2)
397  END IF
398  ELSE
399  IF (beta.EQ.dble(zero)) THEN
400  c(i,j) = alpha*temp1 + dconjg(alpha)*temp2
401  ELSE
402  c(i,j) = beta*c(i,j) + alpha*temp1 +
403  + dconjg(alpha)*temp2
404  END IF
405  END IF
406  200 CONTINUE
407  210 CONTINUE
408  ELSE
409  DO 240 j = 1,n
410  DO 230 i = j,n
411  temp1 = zero
412  temp2 = zero
413  DO 220 l = 1,k
414  temp1 = temp1 + dconjg(a(l,i))*b(l,j)
415  temp2 = temp2 + dconjg(b(l,i))*a(l,j)
416  220 CONTINUE
417  IF (i.EQ.j) THEN
418  IF (beta.EQ.dble(zero)) THEN
419  c(j,j) = dble(alpha*temp1+
420  + dconjg(alpha)*temp2)
421  ELSE
422  c(j,j) = beta*dble(c(j,j)) +
423  + dble(alpha*temp1+
424  + dconjg(alpha)*temp2)
425  END IF
426  ELSE
427  IF (beta.EQ.dble(zero)) THEN
428  c(i,j) = alpha*temp1 + dconjg(alpha)*temp2
429  ELSE
430  c(i,j) = beta*c(i,j) + alpha*temp1 +
431  + dconjg(alpha)*temp2
432  END IF
433  END IF
434  230 CONTINUE
435  240 CONTINUE
436  END IF
437  END IF
438 *
439  RETURN
440 *
441 * End of ZHER2K.
442 *
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55

Here is the call graph for this function:

Here is the caller graph for this function:

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 of 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 of 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.
Date
November 2011
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 175 of file zherk.f.

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 *
181 * .. Scalar Arguments ..
182  DOUBLE PRECISION alpha,beta
183  INTEGER k,lda,ldc,n
184  CHARACTER trans,uplo
185 * ..
186 * .. Array Arguments ..
187  COMPLEX*16 a(lda,*),c(ldc,*)
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 ..
203  COMPLEX*16 temp
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 *
288 * Form C := alpha*A*A**H + beta*C.
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 *
341 * Form C := alpha*A**H*A + beta*C.
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 *
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55

Here is the call graph for this function:

Here is the caller graph for this function:

subroutine zsymm ( character  SIDE,
character  UPLO,
integer  M,
integer  N,
complex*16  ALPHA,
complex*16, dimension(lda,*)  A,
integer  LDA,
complex*16, dimension(ldb,*)  B,
integer  LDB,
complex*16  BETA,
complex*16, dimension(ldc,*)  C,
integer  LDC 
)

ZSYMM

Purpose:
 ZSYMM  performs one of the matrix-matrix operations

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

 or

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

 where  alpha and beta are scalars, A is a symmetric matrix and  B and
 C are m by n matrices.
Parameters
[in]SIDE
          SIDE is CHARACTER*1
           On entry,  SIDE  specifies whether  the  symmetric matrix  A
           appears on the  left or right  in the  operation as follows:

              SIDE = 'L' or 'l'   C := alpha*A*B + beta*C,

              SIDE = 'R' or 'r'   C := alpha*B*A + beta*C,
[in]UPLO
          UPLO is CHARACTER*1
           On  entry,   UPLO  specifies  whether  the  upper  or  lower
           triangular  part  of  the  symmetric  matrix   A  is  to  be
           referenced as follows:

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

              UPLO = 'L' or 'l'   Only the lower triangular part of the
                                  symmetric matrix is to be referenced.
[in]M
          M is INTEGER
           On entry,  M  specifies the number of rows of the matrix  C.
           M  must be at least zero.
[in]N
          N is INTEGER
           On entry, N specifies the number of columns of the matrix C.
           N  must be at least zero.
[in]ALPHA
          ALPHA is COMPLEX*16
           On entry, ALPHA specifies the scalar alpha.
[in]A
          A is COMPLEX*16 array of DIMENSION ( LDA, ka ), where ka is
           m  when  SIDE = 'L' or 'l'  and is n  otherwise.
           Before entry  with  SIDE = 'L' or 'l',  the  m by m  part of
           the array  A  must contain the  symmetric matrix,  such that
           when  UPLO = 'U' or 'u', the leading m by m upper triangular
           part of the array  A  must contain the upper triangular part
           of the  symmetric matrix and the  strictly  lower triangular
           part of  A  is not referenced,  and when  UPLO = 'L' or 'l',
           the leading  m by m  lower triangular part  of the  array  A
           must  contain  the  lower triangular part  of the  symmetric
           matrix and the  strictly upper triangular part of  A  is not
           referenced.
           Before entry  with  SIDE = 'R' or 'r',  the  n by n  part of
           the array  A  must contain the  symmetric matrix,  such that
           when  UPLO = 'U' or 'u', the leading n by n upper triangular
           part of the array  A  must contain the upper triangular part
           of the  symmetric matrix and the  strictly  lower triangular
           part of  A  is not referenced,  and when  UPLO = 'L' or 'l',
           the leading  n by n  lower triangular part  of the  array  A
           must  contain  the  lower triangular part  of the  symmetric
           matrix and the  strictly upper triangular part of  A  is not
           referenced.
[in]LDA
          LDA is INTEGER
           On entry, LDA specifies the first dimension of A as declared
           in the  calling (sub) program. When  SIDE = 'L' or 'l'  then
           LDA must be at least  max( 1, m ), otherwise  LDA must be at
           least max( 1, n ).
[in]B
          B is COMPLEX*16 array of DIMENSION ( LDB, n ).
           Before entry, the leading  m by n part of the array  B  must
           contain the matrix B.
[in]LDB
          LDB is INTEGER
           On entry, LDB specifies the first dimension of B as declared
           in  the  calling  (sub)  program.   LDB  must  be  at  least
           max( 1, m ).
[in]BETA
          BETA is COMPLEX*16
           On entry,  BETA  specifies the scalar  beta.  When  BETA  is
           supplied as zero then C need not be set on input.
[in,out]C
          C is COMPLEX*16 array of DIMENSION ( LDC, n ).
           Before entry, the leading  m by n  part of the array  C must
           contain the matrix  C,  except when  beta  is zero, in which
           case C need not be set on entry.
           On exit, the array  C  is overwritten by the  m by n updated
           matrix.
[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, m ).
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011
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.

Definition at line 191 of file zsymm.f.

191 *
192 * -- Reference BLAS level3 routine (version 3.4.0) --
193 * -- Reference BLAS is a software package provided by Univ. of Tennessee, --
194 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
195 * November 2011
196 *
197 * .. Scalar Arguments ..
198  COMPLEX*16 alpha,beta
199  INTEGER lda,ldb,ldc,m,n
200  CHARACTER side,uplo
201 * ..
202 * .. Array Arguments ..
203  COMPLEX*16 a(lda,*),b(ldb,*),c(ldc,*)
204 * ..
205 *
206 * =====================================================================
207 *
208 * .. External Functions ..
209  LOGICAL lsame
210  EXTERNAL lsame
211 * ..
212 * .. External Subroutines ..
213  EXTERNAL xerbla
214 * ..
215 * .. Intrinsic Functions ..
216  INTRINSIC max
217 * ..
218 * .. Local Scalars ..
219  COMPLEX*16 temp1,temp2
220  INTEGER i,info,j,k,nrowa
221  LOGICAL upper
222 * ..
223 * .. Parameters ..
224  COMPLEX*16 one
225  parameter(one= (1.0d+0,0.0d+0))
226  COMPLEX*16 zero
227  parameter(zero= (0.0d+0,0.0d+0))
228 * ..
229 *
230 * Set NROWA as the number of rows of A.
231 *
232  IF (lsame(side,'L')) THEN
233  nrowa = m
234  ELSE
235  nrowa = n
236  END IF
237  upper = lsame(uplo,'U')
238 *
239 * Test the input parameters.
240 *
241  info = 0
242  IF ((.NOT.lsame(side,'L')) .AND. (.NOT.lsame(side,'R'))) THEN
243  info = 1
244  ELSE IF ((.NOT.upper) .AND. (.NOT.lsame(uplo,'L'))) THEN
245  info = 2
246  ELSE IF (m.LT.0) THEN
247  info = 3
248  ELSE IF (n.LT.0) THEN
249  info = 4
250  ELSE IF (lda.LT.max(1,nrowa)) THEN
251  info = 7
252  ELSE IF (ldb.LT.max(1,m)) THEN
253  info = 9
254  ELSE IF (ldc.LT.max(1,m)) THEN
255  info = 12
256  END IF
257  IF (info.NE.0) THEN
258  CALL xerbla('ZSYMM ',info)
259  RETURN
260  END IF
261 *
262 * Quick return if possible.
263 *
264  IF ((m.EQ.0) .OR. (n.EQ.0) .OR.
265  + ((alpha.EQ.zero).AND. (beta.EQ.one))) RETURN
266 *
267 * And when alpha.eq.zero.
268 *
269  IF (alpha.EQ.zero) THEN
270  IF (beta.EQ.zero) THEN
271  DO 20 j = 1,n
272  DO 10 i = 1,m
273  c(i,j) = zero
274  10 CONTINUE
275  20 CONTINUE
276  ELSE
277  DO 40 j = 1,n
278  DO 30 i = 1,m
279  c(i,j) = beta*c(i,j)
280  30 CONTINUE
281  40 CONTINUE
282  END IF
283  RETURN
284  END IF
285 *
286 * Start the operations.
287 *
288  IF (lsame(side,'L')) THEN
289 *
290 * Form C := alpha*A*B + beta*C.
291 *
292  IF (upper) THEN
293  DO 70 j = 1,n
294  DO 60 i = 1,m
295  temp1 = alpha*b(i,j)
296  temp2 = zero
297  DO 50 k = 1,i - 1
298  c(k,j) = c(k,j) + temp1*a(k,i)
299  temp2 = temp2 + b(k,j)*a(k,i)
300  50 CONTINUE
301  IF (beta.EQ.zero) THEN
302  c(i,j) = temp1*a(i,i) + alpha*temp2
303  ELSE
304  c(i,j) = beta*c(i,j) + temp1*a(i,i) +
305  + alpha*temp2
306  END IF
307  60 CONTINUE
308  70 CONTINUE
309  ELSE
310  DO 100 j = 1,n
311  DO 90 i = m,1,-1
312  temp1 = alpha*b(i,j)
313  temp2 = zero
314  DO 80 k = i + 1,m
315  c(k,j) = c(k,j) + temp1*a(k,i)
316  temp2 = temp2 + b(k,j)*a(k,i)
317  80 CONTINUE
318  IF (beta.EQ.zero) THEN
319  c(i,j) = temp1*a(i,i) + alpha*temp2
320  ELSE
321  c(i,j) = beta*c(i,j) + temp1*a(i,i) +
322  + alpha*temp2
323  END IF
324  90 CONTINUE
325  100 CONTINUE
326  END IF
327  ELSE
328 *
329 * Form C := alpha*B*A + beta*C.
330 *
331  DO 170 j = 1,n
332  temp1 = alpha*a(j,j)
333  IF (beta.EQ.zero) THEN
334  DO 110 i = 1,m
335  c(i,j) = temp1*b(i,j)
336  110 CONTINUE
337  ELSE
338  DO 120 i = 1,m
339  c(i,j) = beta*c(i,j) + temp1*b(i,j)
340  120 CONTINUE
341  END IF
342  DO 140 k = 1,j - 1
343  IF (upper) THEN
344  temp1 = alpha*a(k,j)
345  ELSE
346  temp1 = alpha*a(j,k)
347  END IF
348  DO 130 i = 1,m
349  c(i,j) = c(i,j) + temp1*b(i,k)
350  130 CONTINUE
351  140 CONTINUE
352  DO 160 k = j + 1,n
353  IF (upper) THEN
354  temp1 = alpha*a(j,k)
355  ELSE
356  temp1 = alpha*a(k,j)
357  END IF
358  DO 150 i = 1,m
359  c(i,j) = c(i,j) + temp1*b(i,k)
360  150 CONTINUE
361  160 CONTINUE
362  170 CONTINUE
363  END IF
364 *
365  RETURN
366 *
367 * End of ZSYMM .
368 *
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55

Here is the call graph for this function:

Here is the caller graph for this function:

subroutine zsyr2k ( character  UPLO,
character  TRANS,
integer  N,
integer  K,
complex*16  ALPHA,
complex*16, dimension(lda,*)  A,
integer  LDA,
complex*16, dimension(ldb,*)  B,
integer  LDB,
complex*16  BETA,
complex*16, dimension(ldc,*)  C,
integer  LDC 
)

ZSYR2K

Purpose:
 ZSYR2K  performs one of the symmetric rank 2k operations

    C := alpha*A*B**T + alpha*B*A**T + beta*C,

 or

    C := alpha*A**T*B + alpha*B**T*A + beta*C,

 where  alpha and beta  are scalars,  C is an  n by n symmetric matrix
 and  A and B  are  n by k  matrices  in the  first  case  and  k by n
 matrices 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*B**T + alpha*B*A**T +
                                         beta*C.

              TRANS = 'T' or 't'    C := alpha*A**T*B + alpha*B**T*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  matrices  A and B,  and on  entry  with
           TRANS = 'T' or 't',  K  specifies  the number of rows of the
           matrices  A and B.  K must be at least zero.
[in]ALPHA
          ALPHA is COMPLEX*16
           On entry, ALPHA specifies the scalar alpha.
[in]A
          A is COMPLEX*16 array of 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]B
          B is COMPLEX*16 array of DIMENSION ( LDB, kb ), where kb 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  B  must contain the matrix  B,  otherwise
           the leading  k by n  part of the array  B  must contain  the
           matrix B.
[in]LDB
          LDB is INTEGER
           On entry, LDB specifies the first dimension of B as declared
           in  the  calling  (sub)  program.   When  TRANS = 'N' or 'n'
           then  LDB must be at least  max( 1, n ), otherwise  LDB must
           be at least  max( 1, k ).
[in]BETA
          BETA is COMPLEX*16
           On entry, BETA specifies the scalar beta.
[in,out]C
          C is COMPLEX*16 array of 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  symmetric 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  symmetric 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.
[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.
Date
November 2011
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.

Definition at line 190 of file zsyr2k.f.

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

Here is the call graph for this function:

Here is the caller graph for this function:

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

ZSYRK

Purpose:
 ZSYRK  performs one of the symmetric rank k operations

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

 or

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

 where  alpha and beta  are scalars,  C is an  n by n symmetric 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**T + beta*C.

              TRANS = 'T' or 't'   C := alpha*A**T*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 = 'T' or 't',  K  specifies  the number of rows of the
           matrix A.  K must be at least zero.
[in]ALPHA
          ALPHA is COMPLEX*16
           On entry, ALPHA specifies the scalar alpha.
[in]A
          A is COMPLEX*16 array of 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 COMPLEX*16
           On entry, BETA specifies the scalar beta.
[in,out]C
          C is COMPLEX*16 array of 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  symmetric 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  symmetric 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.
[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.
Date
November 2011
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.

Definition at line 169 of file zsyrk.f.

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

Here is the call graph for this function:

Here is the caller graph for this function:

subroutine ztrmm ( character  SIDE,
character  UPLO,
character  TRANSA,
character  DIAG,
integer  M,
integer  N,
complex*16  ALPHA,
complex*16, dimension(lda,*)  A,
integer  LDA,
complex*16, dimension(ldb,*)  B,
integer  LDB 
)

ZTRMM

Purpose:
 ZTRMM  performs one of the matrix-matrix operations

    B := alpha*op( A )*B,   or   B := alpha*B*op( A )

 where  alpha  is a scalar,  B  is an m by n matrix,  A  is a unit, or
 non-unit,  upper or lower triangular matrix  and  op( A )  is one  of

    op( A ) = A   or   op( A ) = A**T   or   op( A ) = A**H.
Parameters
[in]SIDE
          SIDE is CHARACTER*1
           On entry,  SIDE specifies whether  op( A ) multiplies B from
           the left or right as follows:

              SIDE = 'L' or 'l'   B := alpha*op( A )*B.

              SIDE = 'R' or 'r'   B := alpha*B*op( A ).
[in]UPLO
          UPLO is CHARACTER*1
           On entry, UPLO specifies whether the matrix A is an upper or
           lower triangular matrix as follows:

              UPLO = 'U' or 'u'   A is an upper triangular matrix.

              UPLO = 'L' or 'l'   A is a lower triangular matrix.
[in]TRANSA
          TRANSA is CHARACTER*1
           On entry, TRANSA specifies the form of op( A ) to be used in
           the matrix multiplication as follows:

              TRANSA = 'N' or 'n'   op( A ) = A.

              TRANSA = 'T' or 't'   op( A ) = A**T.

              TRANSA = 'C' or 'c'   op( A ) = A**H.
[in]DIAG
          DIAG is CHARACTER*1
           On entry, DIAG specifies whether or not A is unit triangular
           as follows:

              DIAG = 'U' or 'u'   A is assumed to be unit triangular.

              DIAG = 'N' or 'n'   A is not assumed to be unit
                                  triangular.
[in]M
          M is INTEGER
           On entry, M specifies the number of rows of B. M must be at
           least zero.
[in]N
          N is INTEGER
           On entry, N specifies the number of columns of B.  N must be
           at least zero.
[in]ALPHA
          ALPHA is COMPLEX*16
           On entry,  ALPHA specifies the scalar  alpha. When  alpha is
           zero then  A is not referenced and  B need not be set before
           entry.
[in]A
          A is COMPLEX*16 array of DIMENSION ( LDA, k ), where k is m
           when  SIDE = 'L' or 'l'  and is  n  when  SIDE = 'R' or 'r'.
           Before entry  with  UPLO = 'U' or 'u',  the  leading  k by k
           upper triangular part of the array  A must contain the upper
           triangular matrix  and the strictly lower triangular part of
           A is not referenced.
           Before entry  with  UPLO = 'L' or 'l',  the  leading  k by k
           lower triangular part of the array  A must contain the lower
           triangular matrix  and the strictly upper triangular part of
           A is not referenced.
           Note that when  DIAG = 'U' or 'u',  the diagonal elements of
           A  are not referenced either,  but are assumed to be  unity.
[in]LDA
          LDA is INTEGER
           On entry, LDA specifies the first dimension of A as declared
           in the calling (sub) program.  When  SIDE = 'L' or 'l'  then
           LDA  must be at least  max( 1, m ),  when  SIDE = 'R' or 'r'
           then LDA must be at least max( 1, n ).
[in]B
          B is (input/output) COMPLEX*16 array of DIMENSION ( LDB, n ).
           Before entry,  the leading  m by n part of the array  B must
           contain the matrix  B,  and  on exit  is overwritten  by the
           transformed matrix.
[in]LDB
          LDB is INTEGER
           On entry, LDB specifies the first dimension of B as declared
           in  the  calling  (sub)  program.   LDB  must  be  at  least
           max( 1, m ).
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011
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.

Definition at line 179 of file ztrmm.f.

179 *
180 * -- Reference BLAS level3 routine (version 3.4.0) --
181 * -- Reference BLAS is a software package provided by Univ. of Tennessee, --
182 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
183 * November 2011
184 *
185 * .. Scalar Arguments ..
186  COMPLEX*16 alpha
187  INTEGER lda,ldb,m,n
188  CHARACTER diag,side,transa,uplo
189 * ..
190 * .. Array Arguments ..
191  COMPLEX*16 a(lda,*),b(ldb,*)
192 * ..
193 *
194 * =====================================================================
195 *
196 * .. External Functions ..
197  LOGICAL lsame
198  EXTERNAL lsame
199 * ..
200 * .. External Subroutines ..
201  EXTERNAL xerbla
202 * ..
203 * .. Intrinsic Functions ..
204  INTRINSIC dconjg,max
205 * ..
206 * .. Local Scalars ..
207  COMPLEX*16 temp
208  INTEGER i,info,j,k,nrowa
209  LOGICAL lside,noconj,nounit,upper
210 * ..
211 * .. Parameters ..
212  COMPLEX*16 one
213  parameter(one= (1.0d+0,0.0d+0))
214  COMPLEX*16 zero
215  parameter(zero= (0.0d+0,0.0d+0))
216 * ..
217 *
218 * Test the input parameters.
219 *
220  lside = lsame(side,'L')
221  IF (lside) THEN
222  nrowa = m
223  ELSE
224  nrowa = n
225  END IF
226  noconj = lsame(transa,'T')
227  nounit = lsame(diag,'N')
228  upper = lsame(uplo,'U')
229 *
230  info = 0
231  IF ((.NOT.lside) .AND. (.NOT.lsame(side,'R'))) THEN
232  info = 1
233  ELSE IF ((.NOT.upper) .AND. (.NOT.lsame(uplo,'L'))) THEN
234  info = 2
235  ELSE IF ((.NOT.lsame(transa,'N')) .AND.
236  + (.NOT.lsame(transa,'T')) .AND.
237  + (.NOT.lsame(transa,'C'))) THEN
238  info = 3
239  ELSE IF ((.NOT.lsame(diag,'U')) .AND. (.NOT.lsame(diag,'N'))) THEN
240  info = 4
241  ELSE IF (m.LT.0) THEN
242  info = 5
243  ELSE IF (n.LT.0) THEN
244  info = 6
245  ELSE IF (lda.LT.max(1,nrowa)) THEN
246  info = 9
247  ELSE IF (ldb.LT.max(1,m)) THEN
248  info = 11
249  END IF
250  IF (info.NE.0) THEN
251  CALL xerbla('ZTRMM ',info)
252  RETURN
253  END IF
254 *
255 * Quick return if possible.
256 *
257  IF (m.EQ.0 .OR. n.EQ.0) RETURN
258 *
259 * And when alpha.eq.zero.
260 *
261  IF (alpha.EQ.zero) THEN
262  DO 20 j = 1,n
263  DO 10 i = 1,m
264  b(i,j) = zero
265  10 CONTINUE
266  20 CONTINUE
267  RETURN
268  END IF
269 *
270 * Start the operations.
271 *
272  IF (lside) THEN
273  IF (lsame(transa,'N')) THEN
274 *
275 * Form B := alpha*A*B.
276 *
277  IF (upper) THEN
278  DO 50 j = 1,n
279  DO 40 k = 1,m
280  IF (b(k,j).NE.zero) THEN
281  temp = alpha*b(k,j)
282  DO 30 i = 1,k - 1
283  b(i,j) = b(i,j) + temp*a(i,k)
284  30 CONTINUE
285  IF (nounit) temp = temp*a(k,k)
286  b(k,j) = temp
287  END IF
288  40 CONTINUE
289  50 CONTINUE
290  ELSE
291  DO 80 j = 1,n
292  DO 70 k = m,1,-1
293  IF (b(k,j).NE.zero) THEN
294  temp = alpha*b(k,j)
295  b(k,j) = temp
296  IF (nounit) b(k,j) = b(k,j)*a(k,k)
297  DO 60 i = k + 1,m
298  b(i,j) = b(i,j) + temp*a(i,k)
299  60 CONTINUE
300  END IF
301  70 CONTINUE
302  80 CONTINUE
303  END IF
304  ELSE
305 *
306 * Form B := alpha*A**T*B or B := alpha*A**H*B.
307 *
308  IF (upper) THEN
309  DO 120 j = 1,n
310  DO 110 i = m,1,-1
311  temp = b(i,j)
312  IF (noconj) THEN
313  IF (nounit) temp = temp*a(i,i)
314  DO 90 k = 1,i - 1
315  temp = temp + a(k,i)*b(k,j)
316  90 CONTINUE
317  ELSE
318  IF (nounit) temp = temp*dconjg(a(i,i))
319  DO 100 k = 1,i - 1
320  temp = temp + dconjg(a(k,i))*b(k,j)
321  100 CONTINUE
322  END IF
323  b(i,j) = alpha*temp
324  110 CONTINUE
325  120 CONTINUE
326  ELSE
327  DO 160 j = 1,n
328  DO 150 i = 1,m
329  temp = b(i,j)
330  IF (noconj) THEN
331  IF (nounit) temp = temp*a(i,i)
332  DO 130 k = i + 1,m
333  temp = temp + a(k,i)*b(k,j)
334  130 CONTINUE
335  ELSE
336  IF (nounit) temp = temp*dconjg(a(i,i))
337  DO 140 k = i + 1,m
338  temp = temp + dconjg(a(k,i))*b(k,j)
339  140 CONTINUE
340  END IF
341  b(i,j) = alpha*temp
342  150 CONTINUE
343  160 CONTINUE
344  END IF
345  END IF
346  ELSE
347  IF (lsame(transa,'N')) THEN
348 *
349 * Form B := alpha*B*A.
350 *
351  IF (upper) THEN
352  DO 200 j = n,1,-1
353  temp = alpha
354  IF (nounit) temp = temp*a(j,j)
355  DO 170 i = 1,m
356  b(i,j) = temp*b(i,j)
357  170 CONTINUE
358  DO 190 k = 1,j - 1
359  IF (a(k,j).NE.zero) THEN
360  temp = alpha*a(k,j)
361  DO 180 i = 1,m
362  b(i,j) = b(i,j) + temp*b(i,k)
363  180 CONTINUE
364  END IF
365  190 CONTINUE
366  200 CONTINUE
367  ELSE
368  DO 240 j = 1,n
369  temp = alpha
370  IF (nounit) temp = temp*a(j,j)
371  DO 210 i = 1,m
372  b(i,j) = temp*b(i,j)
373  210 CONTINUE
374  DO 230 k = j + 1,n
375  IF (a(k,j).NE.zero) THEN
376  temp = alpha*a(k,j)
377  DO 220 i = 1,m
378  b(i,j) = b(i,j) + temp*b(i,k)
379  220 CONTINUE
380  END IF
381  230 CONTINUE
382  240 CONTINUE
383  END IF
384  ELSE
385 *
386 * Form B := alpha*B*A**T or B := alpha*B*A**H.
387 *
388  IF (upper) THEN
389  DO 280 k = 1,n
390  DO 260 j = 1,k - 1
391  IF (a(j,k).NE.zero) THEN
392  IF (noconj) THEN
393  temp = alpha*a(j,k)
394  ELSE
395  temp = alpha*dconjg(a(j,k))
396  END IF
397  DO 250 i = 1,m
398  b(i,j) = b(i,j) + temp*b(i,k)
399  250 CONTINUE
400  END IF
401  260 CONTINUE
402  temp = alpha
403  IF (nounit) THEN
404  IF (noconj) THEN
405  temp = temp*a(k,k)
406  ELSE
407  temp = temp*dconjg(a(k,k))
408  END IF
409  END IF
410  IF (temp.NE.one) THEN
411  DO 270 i = 1,m
412  b(i,k) = temp*b(i,k)
413  270 CONTINUE
414  END IF
415  280 CONTINUE
416  ELSE
417  DO 320 k = n,1,-1
418  DO 300 j = k + 1,n
419  IF (a(j,k).NE.zero) THEN
420  IF (noconj) THEN
421  temp = alpha*a(j,k)
422  ELSE
423  temp = alpha*dconjg(a(j,k))
424  END IF
425  DO 290 i = 1,m
426  b(i,j) = b(i,j) + temp*b(i,k)
427  290 CONTINUE
428  END IF
429  300 CONTINUE
430  temp = alpha
431  IF (nounit) THEN
432  IF (noconj) THEN
433  temp = temp*a(k,k)
434  ELSE
435  temp = temp*dconjg(a(k,k))
436  END IF
437  END IF
438  IF (temp.NE.one) THEN
439  DO 310 i = 1,m
440  b(i,k) = temp*b(i,k)
441  310 CONTINUE
442  END IF
443  320 CONTINUE
444  END IF
445  END IF
446  END IF
447 *
448  RETURN
449 *
450 * End of ZTRMM .
451 *
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55

Here is the call graph for this function:

Here is the caller graph for this function:

subroutine ztrsm ( character  SIDE,
character  UPLO,
character  TRANSA,
character  DIAG,
integer  M,
integer  N,
complex*16  ALPHA,
complex*16, dimension(lda,*)  A,
integer  LDA,
complex*16, dimension(ldb,*)  B,
integer  LDB 
)

ZTRSM

Purpose:
 ZTRSM  solves one of the matrix equations

    op( A )*X = alpha*B,   or   X*op( A ) = alpha*B,

 where alpha is a scalar, X and B are m by n matrices, A is a unit, or
 non-unit,  upper or lower triangular matrix  and  op( A )  is one  of

    op( A ) = A   or   op( A ) = A**T   or   op( A ) = A**H.

 The matrix X is overwritten on B.
Parameters
[in]SIDE
          SIDE is CHARACTER*1
           On entry, SIDE specifies whether op( A ) appears on the left
           or right of X as follows:

              SIDE = 'L' or 'l'   op( A )*X = alpha*B.

              SIDE = 'R' or 'r'   X*op( A ) = alpha*B.
[in]UPLO
          UPLO is CHARACTER*1
           On entry, UPLO specifies whether the matrix A is an upper or
           lower triangular matrix as follows:

              UPLO = 'U' or 'u'   A is an upper triangular matrix.

              UPLO = 'L' or 'l'   A is a lower triangular matrix.
[in]TRANSA
          TRANSA is CHARACTER*1
           On entry, TRANSA specifies the form of op( A ) to be used in
           the matrix multiplication as follows:

              TRANSA = 'N' or 'n'   op( A ) = A.

              TRANSA = 'T' or 't'   op( A ) = A**T.

              TRANSA = 'C' or 'c'   op( A ) = A**H.
[in]DIAG
          DIAG is CHARACTER*1
           On entry, DIAG specifies whether or not A is unit triangular
           as follows:

              DIAG = 'U' or 'u'   A is assumed to be unit triangular.

              DIAG = 'N' or 'n'   A is not assumed to be unit
                                  triangular.
[in]M
          M is INTEGER
           On entry, M specifies the number of rows of B. M must be at
           least zero.
[in]N
          N is INTEGER
           On entry, N specifies the number of columns of B.  N must be
           at least zero.
[in]ALPHA
          ALPHA is COMPLEX*16
           On entry,  ALPHA specifies the scalar  alpha. When  alpha is
           zero then  A is not referenced and  B need not be set before
           entry.
[in]A
          A is COMPLEX*16 array of DIMENSION ( LDA, k ),
           where k is m when SIDE = 'L' or 'l'  
             and k is n when SIDE = 'R' or 'r'.
           Before entry  with  UPLO = 'U' or 'u',  the  leading  k by k
           upper triangular part of the array  A must contain the upper
           triangular matrix  and the strictly lower triangular part of
           A is not referenced.
           Before entry  with  UPLO = 'L' or 'l',  the  leading  k by k
           lower triangular part of the array  A must contain the lower
           triangular matrix  and the strictly upper triangular part of
           A is not referenced.
           Note that when  DIAG = 'U' or 'u',  the diagonal elements of
           A  are not referenced either,  but are assumed to be  unity.
[in]LDA
          LDA is INTEGER
           On entry, LDA specifies the first dimension of A as declared
           in the calling (sub) program.  When  SIDE = 'L' or 'l'  then
           LDA  must be at least  max( 1, m ),  when  SIDE = 'R' or 'r'
           then LDA must be at least max( 1, n ).
[in,out]B
          B is COMPLEX*16 array of DIMENSION ( LDB, n ).
           Before entry,  the leading  m by n part of the array  B must
           contain  the  right-hand  side  matrix  B,  and  on exit  is
           overwritten by the solution matrix  X.
[in]LDB
          LDB is INTEGER
           On entry, LDB specifies the first dimension of B as declared
           in  the  calling  (sub)  program.   LDB  must  be  at  least
           max( 1, m ).
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011
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.

Definition at line 182 of file ztrsm.f.

182 *
183 * -- Reference BLAS level3 routine (version 3.4.0) --
184 * -- Reference BLAS is a software package provided by Univ. of Tennessee, --
185 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
186 * November 2011
187 *
188 * .. Scalar Arguments ..
189  COMPLEX*16 alpha
190  INTEGER lda,ldb,m,n
191  CHARACTER diag,side,transa,uplo
192 * ..
193 * .. Array Arguments ..
194  COMPLEX*16 a(lda,*),b(ldb,*)
195 * ..
196 *
197 * =====================================================================
198 *
199 * .. External Functions ..
200  LOGICAL lsame
201  EXTERNAL lsame
202 * ..
203 * .. External Subroutines ..
204  EXTERNAL xerbla
205 * ..
206 * .. Intrinsic Functions ..
207  INTRINSIC dconjg,max
208 * ..
209 * .. Local Scalars ..
210  COMPLEX*16 temp
211  INTEGER i,info,j,k,nrowa
212  LOGICAL lside,noconj,nounit,upper
213 * ..
214 * .. Parameters ..
215  COMPLEX*16 one
216  parameter(one= (1.0d+0,0.0d+0))
217  COMPLEX*16 zero
218  parameter(zero= (0.0d+0,0.0d+0))
219 * ..
220 *
221 * Test the input parameters.
222 *
223  lside = lsame(side,'L')
224  IF (lside) THEN
225  nrowa = m
226  ELSE
227  nrowa = n
228  END IF
229  noconj = lsame(transa,'T')
230  nounit = lsame(diag,'N')
231  upper = lsame(uplo,'U')
232 *
233  info = 0
234  IF ((.NOT.lside) .AND. (.NOT.lsame(side,'R'))) THEN
235  info = 1
236  ELSE IF ((.NOT.upper) .AND. (.NOT.lsame(uplo,'L'))) THEN
237  info = 2
238  ELSE IF ((.NOT.lsame(transa,'N')) .AND.
239  + (.NOT.lsame(transa,'T')) .AND.
240  + (.NOT.lsame(transa,'C'))) THEN
241  info = 3
242  ELSE IF ((.NOT.lsame(diag,'U')) .AND. (.NOT.lsame(diag,'N'))) THEN
243  info = 4
244  ELSE IF (m.LT.0) THEN
245  info = 5
246  ELSE IF (n.LT.0) THEN
247  info = 6
248  ELSE IF (lda.LT.max(1,nrowa)) THEN
249  info = 9
250  ELSE IF (ldb.LT.max(1,m)) THEN
251  info = 11
252  END IF
253  IF (info.NE.0) THEN
254  CALL xerbla('ZTRSM ',info)
255  RETURN
256  END IF
257 *
258 * Quick return if possible.
259 *
260  IF (m.EQ.0 .OR. n.EQ.0) RETURN
261 *
262 * And when alpha.eq.zero.
263 *
264  IF (alpha.EQ.zero) THEN
265  DO 20 j = 1,n
266  DO 10 i = 1,m
267  b(i,j) = zero
268  10 CONTINUE
269  20 CONTINUE
270  RETURN
271  END IF
272 *
273 * Start the operations.
274 *
275  IF (lside) THEN
276  IF (lsame(transa,'N')) THEN
277 *
278 * Form B := alpha*inv( A )*B.
279 *
280  IF (upper) THEN
281  DO 60 j = 1,n
282  IF (alpha.NE.one) THEN
283  DO 30 i = 1,m
284  b(i,j) = alpha*b(i,j)
285  30 CONTINUE
286  END IF
287  DO 50 k = m,1,-1
288  IF (b(k,j).NE.zero) THEN
289  IF (nounit) b(k,j) = b(k,j)/a(k,k)
290  DO 40 i = 1,k - 1
291  b(i,j) = b(i,j) - b(k,j)*a(i,k)
292  40 CONTINUE
293  END IF
294  50 CONTINUE
295  60 CONTINUE
296  ELSE
297  DO 100 j = 1,n
298  IF (alpha.NE.one) THEN
299  DO 70 i = 1,m
300  b(i,j) = alpha*b(i,j)
301  70 CONTINUE
302  END IF
303  DO 90 k = 1,m
304  IF (b(k,j).NE.zero) THEN
305  IF (nounit) b(k,j) = b(k,j)/a(k,k)
306  DO 80 i = k + 1,m
307  b(i,j) = b(i,j) - b(k,j)*a(i,k)
308  80 CONTINUE
309  END IF
310  90 CONTINUE
311  100 CONTINUE
312  END IF
313  ELSE
314 *
315 * Form B := alpha*inv( A**T )*B
316 * or B := alpha*inv( A**H )*B.
317 *
318  IF (upper) THEN
319  DO 140 j = 1,n
320  DO 130 i = 1,m
321  temp = alpha*b(i,j)
322  IF (noconj) THEN
323  DO 110 k = 1,i - 1
324  temp = temp - a(k,i)*b(k,j)
325  110 CONTINUE
326  IF (nounit) temp = temp/a(i,i)
327  ELSE
328  DO 120 k = 1,i - 1
329  temp = temp - dconjg(a(k,i))*b(k,j)
330  120 CONTINUE
331  IF (nounit) temp = temp/dconjg(a(i,i))
332  END IF
333  b(i,j) = temp
334  130 CONTINUE
335  140 CONTINUE
336  ELSE
337  DO 180 j = 1,n
338  DO 170 i = m,1,-1
339  temp = alpha*b(i,j)
340  IF (noconj) THEN
341  DO 150 k = i + 1,m
342  temp = temp - a(k,i)*b(k,j)
343  150 CONTINUE
344  IF (nounit) temp = temp/a(i,i)
345  ELSE
346  DO 160 k = i + 1,m
347  temp = temp - dconjg(a(k,i))*b(k,j)
348  160 CONTINUE
349  IF (nounit) temp = temp/dconjg(a(i,i))
350  END IF
351  b(i,j) = temp
352  170 CONTINUE
353  180 CONTINUE
354  END IF
355  END IF
356  ELSE
357  IF (lsame(transa,'N')) THEN
358 *
359 * Form B := alpha*B*inv( A ).
360 *
361  IF (upper) THEN
362  DO 230 j = 1,n
363  IF (alpha.NE.one) THEN
364  DO 190 i = 1,m
365  b(i,j) = alpha*b(i,j)
366  190 CONTINUE
367  END IF
368  DO 210 k = 1,j - 1
369  IF (a(k,j).NE.zero) THEN
370  DO 200 i = 1,m
371  b(i,j) = b(i,j) - a(k,j)*b(i,k)
372  200 CONTINUE
373  END IF
374  210 CONTINUE
375  IF (nounit) THEN
376  temp = one/a(j,j)
377  DO 220 i = 1,m
378  b(i,j) = temp*b(i,j)
379  220 CONTINUE
380  END IF
381  230 CONTINUE
382  ELSE
383  DO 280 j = n,1,-1
384  IF (alpha.NE.one) THEN
385  DO 240 i = 1,m
386  b(i,j) = alpha*b(i,j)
387  240 CONTINUE
388  END IF
389  DO 260 k = j + 1,n
390  IF (a(k,j).NE.zero) THEN
391  DO 250 i = 1,m
392  b(i,j) = b(i,j) - a(k,j)*b(i,k)
393  250 CONTINUE
394  END IF
395  260 CONTINUE
396  IF (nounit) THEN
397  temp = one/a(j,j)
398  DO 270 i = 1,m
399  b(i,j) = temp*b(i,j)
400  270 CONTINUE
401  END IF
402  280 CONTINUE
403  END IF
404  ELSE
405 *
406 * Form B := alpha*B*inv( A**T )
407 * or B := alpha*B*inv( A**H ).
408 *
409  IF (upper) THEN
410  DO 330 k = n,1,-1
411  IF (nounit) THEN
412  IF (noconj) THEN
413  temp = one/a(k,k)
414  ELSE
415  temp = one/dconjg(a(k,k))
416  END IF
417  DO 290 i = 1,m
418  b(i,k) = temp*b(i,k)
419  290 CONTINUE
420  END IF
421  DO 310 j = 1,k - 1
422  IF (a(j,k).NE.zero) THEN
423  IF (noconj) THEN
424  temp = a(j,k)
425  ELSE
426  temp = dconjg(a(j,k))
427  END IF
428  DO 300 i = 1,m
429  b(i,j) = b(i,j) - temp*b(i,k)
430  300 CONTINUE
431  END IF
432  310 CONTINUE
433  IF (alpha.NE.one) THEN
434  DO 320 i = 1,m
435  b(i,k) = alpha*b(i,k)
436  320 CONTINUE
437  END IF
438  330 CONTINUE
439  ELSE
440  DO 380 k = 1,n
441  IF (nounit) THEN
442  IF (noconj) THEN
443  temp = one/a(k,k)
444  ELSE
445  temp = one/dconjg(a(k,k))
446  END IF
447  DO 340 i = 1,m
448  b(i,k) = temp*b(i,k)
449  340 CONTINUE
450  END IF
451  DO 360 j = k + 1,n
452  IF (a(j,k).NE.zero) THEN
453  IF (noconj) THEN
454  temp = a(j,k)
455  ELSE
456  temp = dconjg(a(j,k))
457  END IF
458  DO 350 i = 1,m
459  b(i,j) = b(i,j) - temp*b(i,k)
460  350 CONTINUE
461  END IF
462  360 CONTINUE
463  IF (alpha.NE.one) THEN
464  DO 370 i = 1,m
465  b(i,k) = alpha*b(i,k)
466  370 CONTINUE
467  END IF
468  380 CONTINUE
469  END IF
470  END IF
471  END IF
472 *
473  RETURN
474 *
475 * End of ZTRSM .
476 *
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55

Here is the call graph for this function:

Here is the caller graph for this function: