ScaLAPACK 2.1  2.1 ScaLAPACK: Scalable Linear Algebra PACKage
Go to the documentation of this file.
1  SUBROUTINE dtzpadcpy( 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  DOUBLE PRECISION A( LDA, * ), B( LDB, * )
14 * ..
15 *
16 * Purpose
17 * =======
18 *
19 * DTZPADCPY 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
32 * = 'U' or 'u': Upper triangular part is copied; the
33 * strictly lower triangular part of B is
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) DOUBLE PRECISION 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) DOUBLE PRECISION 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  DOUBLE PRECISION ONE, ZERO
120  parameter( one = 1.0d+0, zero = 0.0d+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 *