SCALAPACK 2.2.2
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
ztzcnjg.f
Go to the documentation of this file.
1 SUBROUTINE ztzcnjg( UPLO, M, N, IOFFD, ALPHA, A, LDA )
2*
3* -- PBLAS auxiliary routine (version 2.0) --
4* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
5* and University of California, Berkeley.
6* April 1, 1998
7*
8* .. Scalar Arguments ..
9 CHARACTER*1 UPLO
10 INTEGER IOFFD, LDA, M, N
11 COMPLEX*16 ALPHA
12* ..
13* .. Array Arguments ..
14 COMPLEX*16 A( LDA, * )
15* ..
16*
17* Purpose
18* =======
19*
20* ZTZCNJG conjugates a two-dimensional array A and then scales it by
21* the scalar alpha.
22*
23* Arguments
24* =========
25*
26* UPLO (input) CHARACTER*1
27* On entry, UPLO specifies which trapezoidal part of the ar-
28* ray A is to be conjugated and scaled as follows:
29* = 'L' or 'l': the lower trapezoid of A is scaled,
30* = 'U' or 'u': the upper trapezoid of A is scaled,
31* = 'D' or 'd': diagonal specified by IOFFD is scaled,
32* Otherwise: all of the array A is scaled.
33*
34* M (input) INTEGER
35* On entry, M specifies the number of rows of the array A. M
36* must be at least zero.
37*
38* N (input) INTEGER
39* On entry, N specifies the number of columns of the array A.
40* N must be at least zero.
41*
42* IOFFD (input) INTEGER
43* On entry, IOFFD specifies the position of the offdiagonal de-
44* limiting the upper and lower trapezoidal part of A as follows
45* (see the notes below):
46*
47* IOFFD = 0 specifies the main diagonal A( i, i ),
48* with i = 1 ... MIN( M, N ),
49* IOFFD > 0 specifies the subdiagonal A( i+IOFFD, i ),
50* with i = 1 ... MIN( M-IOFFD, N ),
51* IOFFD < 0 specifies the superdiagonal A( i, i-IOFFD ),
52* with i = 1 ... MIN( M, N+IOFFD ).
53*
54* ALPHA (input) COMPLEX*16
55* On entry, ALPHA specifies the scalar alpha, i.e., the value
56* by which the diagonal and offdiagonal entries of the array A
57* as specified by UPLO and IOFFD are scaled.
58*
59* A (input/output) COMPLEX*16 array
60* On entry, A is an array of dimension (LDA,N). Before entry
61* with UPLO = 'U' or 'u', the leading m by n part of the array
62* A must contain the upper trapezoidal part of the matrix as
63* specified by IOFFD to be scaled, and the strictly lower tra-
64* pezoidal part of A is not referenced; When UPLO = 'L' or 'l',
65* the leading m by n part of the array A must contain the lower
66* trapezoidal part of the matrix as specified by IOFFD to be
67* scaled, and the strictly upper trapezoidal part of A is not
68* referenced. On exit, the entries of the trapezoid part of A
69* determined by UPLO and IOFFD are conjugated and scaled.
70*
71* LDA (input) INTEGER
72* On entry, LDA specifies the leading dimension of the array A.
73* LDA must be at least max( 1, M ).
74*
75* Notes
76* =====
77* N N
78* ---------------------------- -----------
79* | d | | |
80* M | d 'U' | | 'U' |
81* | 'L' 'D' | |d |
82* | d | M | d |
83* ---------------------------- | 'D' |
84* | d |
85* IOFFD < 0 | 'L' d |
86* | d|
87* N | |
88* ----------- -----------
89* | d 'U'|
90* | d | IOFFD > 0
91* M | 'D' |
92* | d| N
93* | 'L' | ----------------------------
94* | | | 'U' |
95* | | |d |
96* | | | 'D' |
97* | | | d |
98* | | |'L' d |
99* ----------- ----------------------------
100*
101* -- Written on April 1, 1998 by
102* Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
103*
104* =====================================================================
105*
106* .. Parameters ..
107 COMPLEX*16 ONE, ZERO
108 parameter( one = ( 1.0d+0, 0.0d+0 ),
109 $ zero = ( 0.0d+0, 0.0d+0 ) )
110* ..
111* .. Local Scalars ..
112 INTEGER I, J, JTMP, MN
113* ..
114* .. External Subroutines ..
115 EXTERNAL ztzpad
116* ..
117* .. External Functions ..
118 LOGICAL LSAME
119 EXTERNAL lsame
120* ..
121* .. Intrinsic Functions ..
122 INTRINSIC dconjg, max, min
123* ..
124* .. Executable Statements ..
125*
126* Quick return if possible
127*
128 IF( ( m.LE.0 ).OR.( n.LE.0 ) )
129 $ RETURN
130*
131* Start the operations
132*
133 IF( alpha.EQ.zero ) THEN
134*
135 CALL ztzpad( uplo, 'N', m, n, ioffd, zero, zero, a, lda )
136*
137 ELSE IF( alpha.EQ.one ) THEN
138*
139 IF( lsame( uplo, 'L' ) ) THEN
140*
141 mn = max( 0, -ioffd )
142 DO 20 j = 1, min( mn, n )
143 DO 10 i = 1, m
144 a( i, j ) = dconjg( a( i, j ) )
145 10 CONTINUE
146 20 CONTINUE
147*
148 DO 40 j = mn + 1, min( m - ioffd, n )
149 DO 30 i = j + ioffd, m
150 a( i, j ) = dconjg( a( i, j ) )
151 30 CONTINUE
152 40 CONTINUE
153*
154 ELSE IF( lsame( uplo, 'U' ) ) THEN
155*
156* Scales the upper triangular part of the array by ALPHA.
157*
158 mn = min( m - ioffd, n )
159 DO 60 j = max( 0, -ioffd ) + 1, mn
160 DO 50 i = 1, j + ioffd
161 a( i, j ) = dconjg( a( i, j ) )
162 50 CONTINUE
163 60 CONTINUE
164*
165 DO 80 j = max( 0, mn ) + 1, n
166 DO 70 i = 1, m
167 a( i, j ) = dconjg( a( i, j ) )
168 70 CONTINUE
169 80 CONTINUE
170*
171 ELSE IF( lsame( uplo, 'D' ) ) THEN
172*
173* Scales the diagonal entries by ALPHA.
174*
175 DO 90 j = max( 0, -ioffd ) + 1, min( m - ioffd, n )
176 jtmp = j + ioffd
177 a( jtmp, j ) = dconjg( a( jtmp, j ) )
178 90 CONTINUE
179*
180 ELSE
181*
182* Scales the entire array by ALPHA.
183*
184 DO 110 j = 1, n
185 DO 100 i = 1, m
186 a( i, j ) = dconjg( a( i, j ) )
187 100 CONTINUE
188 110 CONTINUE
189*
190 END IF
191*
192 ELSE
193*
194 IF( lsame( uplo, 'L' ) ) THEN
195*
196* Scales the lower triangular part of the array by ALPHA.
197*
198 mn = max( 0, -ioffd )
199 DO 130 j = 1, min( mn, n )
200 DO 120 i = 1, m
201 a( i, j ) = alpha * dconjg( a( i, j ) )
202 120 CONTINUE
203 130 CONTINUE
204*
205 DO 150 j = mn + 1, min( m - ioffd, n )
206 DO 140 i = j + ioffd, m
207 a( i, j ) = alpha * dconjg( a( i, j ) )
208 140 CONTINUE
209 150 CONTINUE
210*
211 ELSE IF( lsame( uplo, 'U' ) ) THEN
212*
213* Scales the upper triangular part of the array by ALPHA.
214*
215 mn = min( m - ioffd, n )
216 DO 170 j = max( 0, -ioffd ) + 1, mn
217 DO 160 i = 1, j + ioffd
218 a( i, j ) = alpha * dconjg( a( i, j ) )
219 160 CONTINUE
220 170 CONTINUE
221*
222 DO 190 j = max( 0, mn ) + 1, n
223 DO 180 i = 1, m
224 a( i, j ) = alpha * dconjg( a( i, j ) )
225 180 CONTINUE
226 190 CONTINUE
227*
228 ELSE IF( lsame( uplo, 'D' ) ) THEN
229*
230* Scales the diagonal entries by ALPHA.
231*
232 DO 200 j = max( 0, -ioffd ) + 1, min( m - ioffd, n )
233 jtmp = j + ioffd
234 a( jtmp, j ) = alpha * dconjg( a( jtmp, j ) )
235 200 CONTINUE
236*
237 ELSE
238*
239* Scales the entire array by ALPHA.
240*
241 DO 220 j = 1, n
242 DO 210 i = 1, m
243 a( i, j ) = alpha * dconjg( a( i, j ) )
244 210 CONTINUE
245 220 CONTINUE
246*
247 END IF
248*
249 END IF
250*
251 RETURN
252*
253* End of ZTZCNJG
254*
255 END
#define max(A, B)
Definition pcgemr.c:180
#define min(A, B)
Definition pcgemr.c:181
subroutine ztzcnjg(uplo, m, n, ioffd, alpha, a, lda)
Definition ztzcnjg.f:2
subroutine ztzpad(uplo, herm, m, n, ioffd, alpha, beta, a, lda)
Definition ztzpad.f:2