Mercurial > hg > octave-nkf

annotate libcruft/blas/zsyrk.f @ 9581:3d0d2bda3a0f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
fix previous change, avoid duplicate loads of methods in descendant classes
author Jaroslav Hajek <highegg@gmail.com>
date Thu, 27 Aug 2009 16:08:23 +0200
parents 15c23c1c3c18
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
8408
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
1 SUBROUTINE ZSYRK(UPLO,TRANS,N,K,ALPHA,A,LDA,BETA,C,LDC)
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
2 * .. Scalar Arguments ..
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
3 DOUBLE COMPLEX ALPHA,BETA
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
4 INTEGER K,LDA,LDC,N
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
5 CHARACTER TRANS,UPLO
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
6 * ..
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
7 * .. Array Arguments ..
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
8 DOUBLE COMPLEX A(LDA,*),C(LDC,*)
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
9 * ..
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
10 *
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
11 * Purpose
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
12 * =======
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
13 *
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
14 * ZSYRK performs one of the symmetric rank k operations
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
15 *
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
16 * C := alpha*A*A' + beta*C,
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
17 *
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
18 * or
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
19 *
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
20 * C := alpha*A'*A + beta*C,
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
21 *
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
22 * where alpha and beta are scalars, C is an n by n symmetric matrix
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
23 * and A is an n by k matrix in the first case and a k by n matrix
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
24 * in the second case.
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
25 *
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
26 * Arguments
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
27 * ==========
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
28 *
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
29 * UPLO - CHARACTER*1.
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
30 * On entry, UPLO specifies whether the upper or lower
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
31 * triangular part of the array C is to be referenced as
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
32 * follows:
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
33 *
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
34 * UPLO = 'U' or 'u' Only the upper triangular part of C
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
35 * is to be referenced.
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
36 *
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
37 * UPLO = 'L' or 'l' Only the lower triangular part of C
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
38 * is to be referenced.
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
39 *
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
40 * Unchanged on exit.
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
41 *
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
42 * TRANS - CHARACTER*1.
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
43 * On entry, TRANS specifies the operation to be performed as
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
44 * follows:
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
45 *
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
46 * TRANS = 'N' or 'n' C := alpha*A*A' + beta*C.
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
47 *
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
48 * TRANS = 'T' or 't' C := alpha*A'*A + beta*C.
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
49 *
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
50 * Unchanged on exit.
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
51 *
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
52 * N - INTEGER.
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
53 * On entry, N specifies the order of the matrix C. N must be
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
54 * at least zero.
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
55 * Unchanged on exit.
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
56 *
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
57 * K - INTEGER.
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
58 * On entry with TRANS = 'N' or 'n', K specifies the number
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
59 * of columns of the matrix A, and on entry with
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
60 * TRANS = 'T' or 't', K specifies the number of rows of the
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
61 * matrix A. K must be at least zero.
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
62 * Unchanged on exit.
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
63 *
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
64 * ALPHA - COMPLEX*16 .
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
65 * On entry, ALPHA specifies the scalar alpha.
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
66 * Unchanged on exit.
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
67 *
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
68 * A - COMPLEX*16 array of DIMENSION ( LDA, ka ), where ka is
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
69 * k when TRANS = 'N' or 'n', and is n otherwise.
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
70 * Before entry with TRANS = 'N' or 'n', the leading n by k
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
71 * part of the array A must contain the matrix A, otherwise
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
72 * the leading k by n part of the array A must contain the
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
73 * matrix A.
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
74 * Unchanged on exit.
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
75 *
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
76 * LDA - INTEGER.
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
77 * On entry, LDA specifies the first dimension of A as declared
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
78 * in the calling (sub) program. When TRANS = 'N' or 'n'
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
79 * then LDA must be at least max( 1, n ), otherwise LDA must
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
80 * be at least max( 1, k ).
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
81 * Unchanged on exit.
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
82 *
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
83 * BETA - COMPLEX*16 .
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
84 * On entry, BETA specifies the scalar beta.
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
85 * Unchanged on exit.
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
86 *
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
87 * C - COMPLEX*16 array of DIMENSION ( LDC, n ).
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
88 * Before entry with UPLO = 'U' or 'u', the leading n by n
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
89 * upper triangular part of the array C must contain the upper
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
90 * triangular part of the symmetric matrix and the strictly
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
91 * lower triangular part of C is not referenced. On exit, the
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
92 * upper triangular part of the array C is overwritten by the
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
93 * upper triangular part of the updated matrix.
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
94 * Before entry with UPLO = 'L' or 'l', the leading n by n
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
95 * lower triangular part of the array C must contain the lower
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
96 * triangular part of the symmetric matrix and the strictly
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
97 * upper triangular part of C is not referenced. On exit, the
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
98 * lower triangular part of the array C is overwritten by the
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
99 * lower triangular part of the updated matrix.
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
100 *
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
101 * LDC - INTEGER.
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
102 * On entry, LDC specifies the first dimension of C as declared
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
103 * in the calling (sub) program. LDC must be at least
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
104 * max( 1, n ).
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
105 * Unchanged on exit.
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
106 *
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
107 *
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
108 * Level 3 Blas routine.
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
109 *
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
110 * -- Written on 8-February-1989.
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
111 * Jack Dongarra, Argonne National Laboratory.
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
112 * Iain Duff, AERE Harwell.
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
113 * Jeremy Du Croz, Numerical Algorithms Group Ltd.
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
114 * Sven Hammarling, Numerical Algorithms Group Ltd.
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
115 *
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
116 *
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
117 * .. External Functions ..
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
118 LOGICAL LSAME
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
119 EXTERNAL LSAME
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
120 * ..
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
121 * .. External Subroutines ..
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
122 EXTERNAL XERBLA
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
123 * ..
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
124 * .. Intrinsic Functions ..
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
125 INTRINSIC MAX
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
126 * ..
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
127 * .. Local Scalars ..
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
128 DOUBLE COMPLEX TEMP
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
129 INTEGER I,INFO,J,L,NROWA
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
130 LOGICAL UPPER
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
131 * ..
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
132 * .. Parameters ..
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
133 DOUBLE COMPLEX ONE
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
134 PARAMETER (ONE= (1.0D+0,0.0D+0))
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
135 DOUBLE COMPLEX ZERO
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
136 PARAMETER (ZERO= (0.0D+0,0.0D+0))
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
137 * ..
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
138 *
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
139 * Test the input parameters.
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
140 *
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
141 IF (LSAME(TRANS,'N')) THEN
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
142 NROWA = N
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
143 ELSE
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
144 NROWA = K
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
145 END IF
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
146 UPPER = LSAME(UPLO,'U')
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
147 *
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
148 INFO = 0
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
149 IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
150 INFO = 1
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
151 ELSE IF ((.NOT.LSAME(TRANS,'N')) .AND.
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
152 + (.NOT.LSAME(TRANS,'T'))) THEN
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
153 INFO = 2
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
154 ELSE IF (N.LT.0) THEN
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
155 INFO = 3
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
156 ELSE IF (K.LT.0) THEN
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
157 INFO = 4
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
158 ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
159 INFO = 7
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
160 ELSE IF (LDC.LT.MAX(1,N)) THEN
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
161 INFO = 10
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
162 END IF
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
163 IF (INFO.NE.0) THEN
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
164 CALL XERBLA('ZSYRK ',INFO)
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
165 RETURN
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
166 END IF
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
167 *
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
168 * Quick return if possible.
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
169 *
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
170 IF ((N.EQ.0) .OR. (((ALPHA.EQ.ZERO).OR.
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
171 + (K.EQ.0)).AND. (BETA.EQ.ONE))) RETURN
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
172 *
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
173 * And when alpha.eq.zero.
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
174 *
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
175 IF (ALPHA.EQ.ZERO) THEN
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
176 IF (UPPER) THEN
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
177 IF (BETA.EQ.ZERO) THEN
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
178 DO 20 J = 1,N
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
179 DO 10 I = 1,J
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
180 C(I,J) = ZERO
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
181 10 CONTINUE
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
182 20 CONTINUE
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
183 ELSE
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
184 DO 40 J = 1,N
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
185 DO 30 I = 1,J
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
186 C(I,J) = BETA*C(I,J)
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
187 30 CONTINUE
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
188 40 CONTINUE
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
189 END IF
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
190 ELSE
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
191 IF (BETA.EQ.ZERO) THEN
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
192 DO 60 J = 1,N
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
193 DO 50 I = J,N
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
194 C(I,J) = ZERO
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
195 50 CONTINUE
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
196 60 CONTINUE
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
197 ELSE
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
198 DO 80 J = 1,N
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
199 DO 70 I = J,N
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
200 C(I,J) = BETA*C(I,J)
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
201 70 CONTINUE
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
202 80 CONTINUE
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
203 END IF
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
204 END IF
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
205 RETURN
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
206 END IF
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
207 *
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
208 * Start the operations.
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
209 *
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
210 IF (LSAME(TRANS,'N')) THEN
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
211 *
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
212 * Form C := alpha*A*A' + beta*C.
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
213 *
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
214 IF (UPPER) THEN
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
215 DO 130 J = 1,N
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
216 IF (BETA.EQ.ZERO) THEN
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
217 DO 90 I = 1,J
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
218 C(I,J) = ZERO
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
219 90 CONTINUE
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
220 ELSE IF (BETA.NE.ONE) THEN
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
221 DO 100 I = 1,J
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
222 C(I,J) = BETA*C(I,J)
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
223 100 CONTINUE
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
224 END IF
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
225 DO 120 L = 1,K
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
226 IF (A(J,L).NE.ZERO) THEN
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
227 TEMP = ALPHA*A(J,L)
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
228 DO 110 I = 1,J
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
229 C(I,J) = C(I,J) + TEMP*A(I,L)
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
230 110 CONTINUE
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
231 END IF
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
232 120 CONTINUE
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
233 130 CONTINUE
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
234 ELSE
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
235 DO 180 J = 1,N
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
236 IF (BETA.EQ.ZERO) THEN
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
237 DO 140 I = J,N
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
238 C(I,J) = ZERO
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
239 140 CONTINUE
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
240 ELSE IF (BETA.NE.ONE) THEN
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
241 DO 150 I = J,N
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
242 C(I,J) = BETA*C(I,J)
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
243 150 CONTINUE
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
244 END IF
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
245 DO 170 L = 1,K
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
246 IF (A(J,L).NE.ZERO) THEN
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
247 TEMP = ALPHA*A(J,L)
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
248 DO 160 I = J,N
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
249 C(I,J) = C(I,J) + TEMP*A(I,L)
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
250 160 CONTINUE
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
251 END IF
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
252 170 CONTINUE
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
253 180 CONTINUE
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
254 END IF
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
255 ELSE
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
256 *
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
257 * Form C := alpha*A'*A + beta*C.
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
258 *
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
259 IF (UPPER) THEN
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
260 DO 210 J = 1,N
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
261 DO 200 I = 1,J
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
262 TEMP = ZERO
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
263 DO 190 L = 1,K
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
264 TEMP = TEMP + A(L,I)*A(L,J)
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
265 190 CONTINUE
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
266 IF (BETA.EQ.ZERO) THEN
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
267 C(I,J) = ALPHA*TEMP
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
268 ELSE
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
269 C(I,J) = ALPHA*TEMP + BETA*C(I,J)
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
270 END IF
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
271 200 CONTINUE
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
272 210 CONTINUE
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
273 ELSE
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
274 DO 240 J = 1,N
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
275 DO 230 I = J,N
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
276 TEMP = ZERO
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
277 DO 220 L = 1,K
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
278 TEMP = TEMP + A(L,I)*A(L,J)
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
279 220 CONTINUE
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
280 IF (BETA.EQ.ZERO) THEN
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
281 C(I,J) = ALPHA*TEMP
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
282 ELSE
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
283 C(I,J) = ALPHA*TEMP + BETA*C(I,J)
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
284 END IF
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
285 230 CONTINUE
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
286 240 CONTINUE
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
287 END IF
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
288 END IF
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
289 *
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
290 RETURN
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
291 *
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
292 * End of ZSYRK .
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
293 *
15c23c1c3c18 add missing blas & lapack sources
Jaroslav Hajek <highegg@gmail.com>
parents:
diff changeset
294 END