ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
pslaset.f
Go to the documentation of this file.
1  SUBROUTINE pslaset( UPLO, M, N, ALPHA, BETA, A, IA, JA, DESCA )
2 *
3 * -- ScaLAPACK auxiliary routine (version 1.7) --
4 * University of Tennessee, Knoxville, Oak Ridge National Laboratory,
5 * and University of California, Berkeley.
6 * May 1, 1997
7 *
8 * .. Scalar Arguments ..
9  CHARACTER UPLO
10  INTEGER IA, JA, M, N
11  REAL ALPHA, BETA
12 * ..
13 * .. Array Arguments ..
14  INTEGER DESCA( * )
15  REAL A( * )
16 * ..
17 *
18 * Purpose
19 * =======
20 *
21 * PSLASET initializes an M-by-N distributed matrix sub( A ) denoting
22 * A(IA:IA+M-1,JA:JA+N-1) to BETA on the diagonal and ALPHA on the
23 * offdiagonals.
24 *
25 * Notes
26 * =====
27 *
28 * Each global data object is described by an associated description
29 * vector. This vector stores the information required to establish
30 * the mapping between an object element and its corresponding process
31 * and memory location.
32 *
33 * Let A be a generic term for any 2D block cyclicly distributed array.
34 * Such a global array has an associated description vector DESCA.
35 * In the following comments, the character _ should be read as
36 * "of the global array".
37 *
38 * NOTATION STORED IN EXPLANATION
39 * --------------- -------------- --------------------------------------
40 * DTYPE_A(global) DESCA( DTYPE_ )The descriptor type. In this case,
41 * DTYPE_A = 1.
42 * CTXT_A (global) DESCA( CTXT_ ) The BLACS context handle, indicating
43 * the BLACS process grid A is distribu-
44 * ted over. The context itself is glo-
45 * bal, but the handle (the integer
46 * value) may vary.
47 * M_A (global) DESCA( M_ ) The number of rows in the global
48 * array A.
49 * N_A (global) DESCA( N_ ) The number of columns in the global
50 * array A.
51 * MB_A (global) DESCA( MB_ ) The blocking factor used to distribute
52 * the rows of the array.
53 * NB_A (global) DESCA( NB_ ) The blocking factor used to distribute
54 * the columns of the array.
55 * RSRC_A (global) DESCA( RSRC_ ) The process row over which the first
56 * row of the array A is distributed.
57 * CSRC_A (global) DESCA( CSRC_ ) The process column over which the
58 * first column of the array A is
59 * distributed.
60 * LLD_A (local) DESCA( LLD_ ) The leading dimension of the local
61 * array. LLD_A >= MAX(1,LOCr(M_A)).
62 *
63 * Let K be the number of rows or columns of a distributed matrix,
64 * and assume that its process grid has dimension p x q.
65 * LOCr( K ) denotes the number of elements of K that a process
66 * would receive if K were distributed over the p processes of its
67 * process column.
68 * Similarly, LOCc( K ) denotes the number of elements of K that a
69 * process would receive if K were distributed over the q processes of
70 * its process row.
71 * The values of LOCr() and LOCc() may be determined via a call to the
72 * ScaLAPACK tool function, NUMROC:
73 * LOCr( M ) = NUMROC( M, MB_A, MYROW, RSRC_A, NPROW ),
74 * LOCc( N ) = NUMROC( N, NB_A, MYCOL, CSRC_A, NPCOL ).
75 * An upper bound for these quantities may be computed by:
76 * LOCr( M ) <= ceil( ceil(M/MB_A)/NPROW )*MB_A
77 * LOCc( N ) <= ceil( ceil(N/NB_A)/NPCOL )*NB_A
78 *
79 * Arguments
80 * =========
81 *
82 * UPLO (global input) CHARACTER
83 * Specifies the part of the distributed matrix sub( A ) to be
84 * set:
85 * = 'U': Upper triangular part is set; the strictly lower
86 * triangular part of sub( A ) is not changed;
87 * = 'L': Lower triangular part is set; the strictly upper
88 * triangular part of sub( A ) is not changed;
89 * Otherwise: All of the matrix sub( A ) is set.
90 *
91 * M (global input) INTEGER
92 * The number of rows to be operated on i.e the number of rows
93 * of the distributed submatrix sub( A ). M >= 0.
94 *
95 * N (global input) INTEGER
96 * The number of columns to be operated on i.e the number of
97 * columns of the distributed submatrix sub( A ). N >= 0.
98 *
99 * ALPHA (global input) REAL
100 * The constant to which the offdiagonal elements are to be
101 * set.
102 *
103 * BETA (global input) REAL
104 * The constant to which the diagonal elements are to be set.
105 *
106 * A (local output) REAL pointer into the local memory
107 * to an array of dimension (LLD_A,LOCc(JA+N-1)). This array
108 * contains the local pieces of the distributed matrix sub( A )
109 * to be set. On exit, the leading M-by-N submatrix sub( A )
110 * is set as follows:
111 *
112 * if UPLO = 'U', A(IA+i-1,JA+j-1) = ALPHA, 1<=i<=j-1, 1<=j<=N,
113 * if UPLO = 'L', A(IA+i-1,JA+j-1) = ALPHA, j+1<=i<=M, 1<=j<=N,
114 * otherwise, A(IA+i-1,JA+j-1) = ALPHA, 1<=i<=M, 1<=j<=N,
115 * IA+i.NE.JA+j,
116 * and, for all UPLO, A(IA+i-1,JA+i-1) = BETA, 1<=i<=min(M,N).
117 *
118 * IA (global input) INTEGER
119 * The row index in the global array A indicating the first
120 * row of sub( A ).
121 *
122 * JA (global input) INTEGER
123 * The column index in the global array A indicating the
124 * first column of sub( A ).
125 *
126 * DESCA (global and local input) INTEGER array of dimension DLEN_.
127 * The array descriptor for the distributed matrix A.
128 *
129 * =====================================================================
130 *
131 * .. Parameters ..
132  INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_,
133  $ LLD_, MB_, M_, NB_, N_, RSRC_
134  parameter( block_cyclic_2d = 1, dlen_ = 9, dtype_ = 1,
135  $ ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
136  $ rsrc_ = 7, csrc_ = 8, lld_ = 9 )
137 * ..
138 * .. Local Scalars ..
139  INTEGER I, IAA, IBLK, IN, ITMP, J, JAA, JBLK, JN, JTMP
140 * ..
141 * .. External Subroutines ..
142  EXTERNAL pslase2
143 * ..
144 * .. External Functions ..
145  LOGICAL LSAME
146  INTEGER ICEIL
147  EXTERNAL iceil, lsame
148 * ..
149 * .. Intrinsic Functions ..
150  INTRINSIC min, mod
151 * ..
152 * .. Executable Statements ..
153 *
154  IF( m.EQ.0 .OR. n.EQ.0 )
155  $ RETURN
156 *
157  IF( m.LE.( desca( mb_ ) - mod( ia-1, desca( mb_ ) ) ) .OR.
158  $ n.LE.( desca( nb_ ) - mod( ja-1, desca( nb_ ) ) ) ) THEN
159  CALL pslase2( uplo, m, n, alpha, beta, a, ia, ja, desca )
160  ELSE
161 *
162  IF( lsame( uplo, 'U' ) ) THEN
163  in = min( iceil( ia, desca( mb_ ) ) * desca( mb_ ), ia+m-1 )
164  CALL pslase2( uplo, in-ia+1, n, alpha, beta, a, ia, ja,
165  $ desca )
166  DO 10 i = in+1, ia+m-1, desca( mb_ )
167  itmp = i-ia
168  iblk = min( desca( mb_ ), m-itmp )
169  jaa = ja + itmp
170  CALL pslase2( uplo, iblk, n-itmp, alpha, beta,
171  $ a, i, jaa, desca )
172  10 CONTINUE
173  ELSE IF( lsame( uplo, 'L' ) ) THEN
174  jn = min( iceil( ja, desca( nb_ ) ) * desca( nb_ ), ja+n-1 )
175  CALL pslase2( uplo, m, jn-ja+1, alpha, beta, a, ia, ja,
176  $ desca )
177  DO 20 j = jn+1, ja+n-1, desca( nb_ )
178  jtmp = j-ja
179  jblk = min( desca( nb_ ), n-jtmp )
180  iaa = ia + jtmp
181  CALL pslase2( uplo, m-jtmp, jblk, alpha, beta, a, iaa,
182  $ j, desca )
183  20 CONTINUE
184  ELSE
185  IF( m.LE.n ) THEN
186  in = min( iceil( ia, desca( mb_ ) ) * desca( mb_ ),
187  $ ia+m-1 )
188  CALL pslase2( uplo, in-ia+1, n, alpha, beta, a, ia,
189  $ ja, desca )
190  DO 30 i = in+1, ia+m-1, desca( mb_ )
191  itmp = i-ia
192  iblk = min( desca( mb_ ), m-itmp )
193  CALL pslase2( uplo, iblk, i-ia, alpha, alpha, a, i,
194  $ ja, desca )
195  CALL pslase2( uplo, iblk, n-i+ia, alpha, beta, a, i,
196  $ ja+i-ia, desca )
197  30 CONTINUE
198  ELSE
199  jn = min( iceil( ja, desca( nb_ ) ) * desca( nb_ ),
200  $ ja+n-1 )
201  CALL pslase2( uplo, m, jn-ja+1, alpha, beta, a, ia,
202  $ ja, desca )
203  DO 40 j = jn+1, ja+n-1, desca( nb_ )
204  jtmp = j-ja
205  jblk = min( desca( nb_ ), n-jtmp )
206  CALL pslase2( uplo, j-ja, jblk, alpha, alpha, a, ia,
207  $ j, desca )
208  CALL pslase2( uplo, m-j+ja, jblk, alpha, beta, a,
209  $ ia+j-ja, j, desca )
210  40 CONTINUE
211  END IF
212  END IF
213 *
214  END IF
215 *
216  RETURN
217 *
218 * End of PSLASET
219 *
220  END
pslase2
subroutine pslase2(UPLO, M, N, ALPHA, BETA, A, IA, JA, DESCA)
Definition: pslase2.f:2
pslaset
subroutine pslaset(UPLO, M, N, ALPHA, BETA, A, IA, JA, DESCA)
Definition: psblastst.f:6863
min
#define min(A, B)
Definition: pcgemr.c:181