ScaLAPACK 2.1  2.1 ScaLAPACK: Scalable Linear Algebra PACKage
zhescal.f
Go to the documentation of this file.
1  SUBROUTINE zhescal( 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  DOUBLE PRECISION ALPHA
12 * ..
13 * .. Array Arguments ..
14  COMPLEX*16 A( LDA, * )
15 * ..
16 *
17 * Purpose
18 * =======
19 *
20 * ZHESCAL scales a two-dimensional array A by the real scalar alpha.
21 * The diagonal entries specified by IOFFD of A are supposed to be real.
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 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) DOUBLE PRECISION
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 Hermitian
63 * matrix to be scaled as specified by IOFFD, and the strictly
64 * lower trapezoidal part of A is not referenced. When UPLO is
65 * 'L' or 'l', the leading m by n part of the array A must con-
66 * tain the lower trapezoidal part of the Hermitian matrix to be
67 * scaled as specified by IOFFD, and the strictly upper trape-
68 * zoidal part of A is not referenced. On exit, the entries of
69 * the trapezoid part of A determined by UPLO and IOFFD are sca-
70 * led.
71 *
72 * LDA (input) INTEGER
73 * On entry, LDA specifies the leading dimension of the array A.
74 * LDA must be at least max( 1, M ).
75 *
76 * Notes
77 * =====
78 * N N
79 * ---------------------------- -----------
80 * | d | | |
81 * M | d 'U' | | 'U' |
82 * | 'L' 'D' | |d |
83 * | d | M | d |
84 * ---------------------------- | 'D' |
85 * | d |
86 * IOFFD < 0 | 'L' d |
87 * | d|
88 * N | |
89 * ----------- -----------
90 * | d 'U'|
91 * | d | IOFFD > 0
92 * M | 'D' |
93 * | d| N
94 * | 'L' | ----------------------------
95 * | | | 'U' |
96 * | | |d |
97 * | | | 'D' |
98 * | | | d |
99 * | | |'L' d |
100 * ----------- ----------------------------
101 *
102 * -- Written on April 1, 1998 by
103 * Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
104 *
105 * =====================================================================
106 *
107 * .. Parameters ..
108  DOUBLE PRECISION RONE, RZERO
109  parameter( rone = 1.0d+0, rzero = 0.0d+0 )
110  COMPLEX*16 ZERO
111  parameter( zero = ( 0.0d+0, 0.0d+0 ) )
112 * ..
113 * .. Local Scalars ..
114  INTEGER J, JTMP, MN
115 * ..
116 * .. External Subroutines ..
118 * ..
119 * .. External Functions ..
120  LOGICAL LSAME
121  EXTERNAL lsame
122 * ..
123 * .. Intrinsic Functions ..
124  INTRINSIC dble, dcmplx, max, min
125 * ..
126 * .. Executable Statements ..
127 *
128 * Quick return if possible
129 *
130  IF( m.LE.0 .OR. n.LE.0 )
131  \$ RETURN
132 *
133 * Start the operations
134 *
135  IF( alpha.EQ.rone ) THEN
136 *
137 * Zeros the imaginary part of the diagonals
138 *
139  IF( lsame( uplo, 'L' ).OR.lsame( uplo, 'U' ).OR.
140  \$ lsame( uplo, 'D' ) ) THEN
141  DO 10 j = max( 0, -ioffd ) + 1, min( m - ioffd, n )
142  jtmp = j + ioffd
143  a( jtmp, j ) = dcmplx( dble( a( jtmp, j ) ), rzero )
144  10 CONTINUE
145  END IF
146  RETURN
147  ELSE IF( alpha.EQ.rzero ) THEN
148  CALL ztzpad( uplo, 'N', m, n, ioffd, zero, zero, a, lda )
149  RETURN
150  END IF
151 *
152  IF( lsame( uplo, 'L' ) ) THEN
153 *
154 * Scales the lower triangular part of the array by ALPHA.
155 *
156  mn = max( 0, -ioffd )
157  DO 20 j = 1, min( mn, n )
158  CALL zdscal( m, alpha, a( 1, j ), 1 )
159  20 CONTINUE
160  DO 30 j = mn + 1, min( m - ioffd, n )
161  jtmp = j + ioffd
162  a( jtmp, j ) = dcmplx( alpha * dble( a( jtmp, j ) ), rzero )
163  IF( m.GT.jtmp )
164  \$ CALL zdscal( m-jtmp, alpha, a( jtmp + 1, j ), 1 )
165  30 CONTINUE
166 *
167  ELSE IF( lsame( uplo, 'U' ) ) THEN
168 *
169 * Scales the upper triangular part of the array by ALPHA.
170 *
171  mn = min( m - ioffd, n )
172  DO 40 j = max( 0, -ioffd ) + 1, mn
173  jtmp = j + ioffd
174  CALL zdscal( jtmp - 1, alpha, a( 1, j ), 1 )
175  a( jtmp, j ) = dcmplx( alpha * dble( a( jtmp, j ) ), rzero )
176  40 CONTINUE
177  DO 50 j = max( 0, mn ) + 1, n
178  CALL zdscal( m, alpha, a( 1, j ), 1 )
179  50 CONTINUE
180 *
181  ELSE IF( lsame( uplo, 'D' ) ) THEN
182 *
183 * Scales the diagonal entries by ALPHA.
184 *
185  DO 60 j = max( 0, -ioffd ) + 1, min( m - ioffd, n )
186  jtmp = j + ioffd
187  a( jtmp, j ) = dcmplx( alpha * dble( a( jtmp, j ) ), rzero )
188  60 CONTINUE
189 *
190  ELSE
191 *
192 * Scales the entire array by ALPHA.
193 *
194  DO 70 j = 1, n
195  CALL zdscal( m, alpha, a( 1, j ), 1 )
196  70 CONTINUE
197 *
198  END IF
199 *
200  RETURN
201 *
202 * End of ZHESCAL
203 *
204  END
max
#define max(A, B)
Definition: pcgemr.c:180