SCALAPACK 2.2.2
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
stzpadcpy.f
Go to the documentation of this file.
1 SUBROUTINE stzpadcpy( UPLO, DIAG, M, N, IOFFD, A, LDA, B, LDB )
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 DIAG, UPLO
10 INTEGER IOFFD, LDA, LDB, M, N
11* ..
12* .. Array Arguments ..
13 REAL A( LDA, * ), B( LDB, * )
14* ..
15*
16* Purpose
17* =======
18*
19* STZPADCPY copies an array A into an array B. The unchanged part of B
20* is padded with zeros. The diagonal of B specified by IOFFD may be set
21* to ones.
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 copied as follows:
29* = 'L' or 'l': Lower triangular part is copied; the
30* strictly upper triangular part of B is
31* padded with zeros,
32* = 'U' or 'u': Upper triangular part is copied; the
33* strictly lower triangular part of B is
34* padded with zeros.
35*
36* DIAG (input) CHARACTER*1
37* On entry, DIAG specifies whether or not the diagonal of B is
38* to be set to ones or not as follows:
39*
40* DIAG = 'N' or 'n': the diagonals of A are copied into the
41* diagonals of B, otherwise the diagonals of B are set to ones.
42*
43* M (input) INTEGER
44* On entry, M specifies the number of rows of the array A. M
45* must be at least zero.
46*
47* N (input) INTEGER
48* On entry, N specifies the number of columns of the array A.
49* N must be at least zero.
50*
51* IOFFD (input) INTEGER
52* On entry, IOFFD specifies the position of the offdiagonal de-
53* limiting the upper and lower trapezoidal part of A as follows
54* (see the notes below):
55*
56* IOFFD = 0 specifies the main diagonal A( i, i ),
57* with i = 1 ... MIN( M, N ),
58* IOFFD > 0 specifies the subdiagonal A( i+IOFFD, i ),
59* with i = 1 ... MIN( M-IOFFD, N ),
60* IOFFD < 0 specifies the superdiagonal A( i, i-IOFFD ),
61* with i = 1 ... MIN( M, N+IOFFD ).
62*
63* A (input) REAL array
64* On entry, A is an array of dimension (LDA,N). Before entry
65* with UPLO = 'U', the leading m by n part of the array A must
66* contain the upper trapezoidal part of the matrix to be copied
67* as specified by IOFFD, UPLO and DIAG, and the strictly lower
68* trapezoidal part of A is not referenced; When UPLO = 'L',the
69* leading m by n part of the array A must contain the lower
70* trapezoidal part of the matrix to be copied as specified by
71* IOFFD, UPLO and DIAG and the strictly upper trapezoidal part
72* of A is not referenced.
73*
74* LDA (input) INTEGER
75* On entry, LDA specifies the leading dimension of the array A.
76* LDA must be at least max( 1, M ).
77*
78* B (output) REAL array
79* On entry, B is an array of dimension (LDB,N). On exit, this
80* array contains the padded copy of A as specified by IOFFD,
81* UPLO and DIAG.
82*
83* LDB (input) INTEGER
84* On entry, LDB specifies the leading dimension of the array B.
85* LDB must be at least max( 1, M ).
86*
87* Notes
88* =====
89* N N
90* ---------------------------- -----------
91* | d | | |
92* M | d 'U' | | 'U' |
93* | 'L' 'D' | |d |
94* | d | M | d |
95* ---------------------------- | 'D' |
96* | d |
97* IOFFD < 0 | 'L' d |
98* | d|
99* N | |
100* ----------- -----------
101* | d 'U'|
102* | d | IOFFD > 0
103* M | 'D' |
104* | d| N
105* | 'L' | ----------------------------
106* | | | 'U' |
107* | | |d |
108* | | | 'D' |
109* | | | d |
110* | | |'L' d |
111* ----------- ----------------------------
112*
113* -- Written on April 1, 1998 by
114* Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
115*
116* =====================================================================
117*
118* .. Parameters ..
119 REAL ONE, ZERO
120 parameter( one = 1.0e+0, zero = 0.0e+0 )
121* ..
122* .. Local Scalars ..
123 INTEGER I, ITMP, J, JTMP, MN
124* ..
125* .. External Functions ..
126 LOGICAL LSAME
127 EXTERNAL lsame
128* ..
129* .. Intrinsic Functions ..
130 INTRINSIC max, min
131* .. Executable Statements ..
132*
133* Quick return if possible
134*
135 IF( m.LE.0 .OR. n.LE.0 )
136 $ RETURN
137*
138* Start the operations
139*
140 IF( lsame( uplo, 'L' ) ) THEN
141*
142 mn = max( 0, -ioffd )
143 DO 20 j = 1, min( mn, n )
144 DO 10 i = 1, m
145 b( i, j ) = a( i, j )
146 10 CONTINUE
147 20 CONTINUE
148*
149 jtmp = min( m - ioffd, n )
150*
151 IF( lsame( diag, 'N' ) ) THEN
152 DO 50 j = mn + 1, jtmp
153 itmp = j + ioffd
154 DO 30 i = 1, itmp - 1
155 b( i, j ) = zero
156 30 CONTINUE
157 DO 40 i = itmp, m
158 b( i, j ) = a( i, j )
159 40 CONTINUE
160 50 CONTINUE
161 ELSE
162 DO 80 j = mn + 1, jtmp
163 itmp = j + ioffd
164 DO 60 i = 1, itmp - 1
165 b( i, j ) = zero
166 60 CONTINUE
167 b( itmp, j ) = one
168 DO 70 i = itmp + 1, m
169 b( i, j ) = a( i, j )
170 70 CONTINUE
171 80 CONTINUE
172 END IF
173*
174 DO 100 j = jtmp + 1, n
175 DO 90 i = 1, m
176 b( i, j ) = zero
177 90 CONTINUE
178 100 CONTINUE
179*
180 ELSE IF( lsame( uplo, 'U' ) ) THEN
181*
182 jtmp = max( 0, -ioffd )
183*
184 DO 120 j = 1, jtmp
185 DO 110 i = 1, m
186 b( i, j ) = zero
187 110 CONTINUE
188 120 CONTINUE
189*
190 mn = min( m - ioffd, n )
191*
192 IF( lsame( diag, 'N' ) ) THEN
193 DO 150 j = jtmp + 1, mn
194 itmp = j + ioffd
195 DO 130 i = 1, itmp
196 b( i, j ) = a( i, j )
197 130 CONTINUE
198 DO 140 i = itmp + 1, m
199 b( i, j ) = zero
200 140 CONTINUE
201 150 CONTINUE
202 ELSE
203 DO 180 j = jtmp + 1, mn
204 itmp = j + ioffd
205 DO 160 i = 1, itmp - 1
206 b( i, j ) = a( i, j )
207 160 CONTINUE
208 b( itmp, j ) = one
209 DO 170 i = itmp + 1, m
210 b( i, j ) = zero
211 170 CONTINUE
212 180 CONTINUE
213 END IF
214*
215 DO 200 j = max( 0, mn ) + 1, n
216 DO 190 i = 1, m
217 b( i, j ) = a( i, j )
218 190 CONTINUE
219 200 CONTINUE
220*
221 ELSE
222*
223 DO 220 j = 1, n
224 DO 210 i = 1, m
225 b( i, j ) = a( i, j )
226 210 CONTINUE
227 220 CONTINUE
228*
229 END IF
230*
231 RETURN
232*
233* End of STZPADCPY
234*
235 END
#define max(A, B)
Definition pcgemr.c:180
#define min(A, B)
Definition pcgemr.c:181
subroutine stzpadcpy(uplo, diag, m, n, ioffd, a, lda, b, ldb)
Definition stzpadcpy.f:2