1 SUBROUTINE pclaset( UPLO, M, N, ALPHA, BETA, A, IA, JA, DESCA )
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 )
139 INTEGER I, IAA, IBLK, IN, ITMP, J, JAA, JBLK, JN, JTMP
147 EXTERNAL iceil, lsame
154 IF( m.EQ.0 .OR. n.EQ.0 )
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 pclase2( uplo, m, n, alpha, beta, a, ia, ja, desca )
162 IF( lsame( uplo,
'U' ) )
THEN
163 in =
min( iceil( ia, desca( mb_ ) ) * desca( mb_ ), ia+m-1 )
164 CALL pclase2( uplo, in-ia+1, n, alpha, beta, a, ia, ja,
166 DO 10 i = in+1, ia+m-1, desca( mb_ )
168 iblk =
min( desca( mb_ ), m-itmp )
170 CALL pclase2( uplo, iblk, n-itmp, alpha, beta,
173 ELSE IF( lsame( uplo,
'L' ) )
THEN
174 jn =
min( iceil( ja, desca( nb_ ) ) * desca( nb_ ), ja+n-1 )
175 CALL pclase2( uplo, m, jn-ja+1, alpha, beta, a, ia, ja,
177 DO 20 j = jn+1, ja+n-1, desca( nb_ )
179 jblk =
min( desca( nb_ ), n-jtmp )
181 CALL pclase2( uplo, m-jtmp, jblk, alpha, beta, a, iaa,
186 in =
min( iceil( ia, desca( mb_ ) ) * desca( mb_ ),
188 CALL pclase2( uplo, in-ia+1, n, alpha, beta, a, ia,
190 DO 30 i = in+1, ia+m-1, desca( mb_ )
192 iblk =
min( desca( mb_ ), m-itmp )
193 CALL pclase2( uplo, iblk, i-ia, alpha, alpha, a, i,
195 CALL pclase2( uplo, iblk, n-i+ia, alpha, beta, a, i,
199 jn =
min( iceil( ja, desca( nb_ ) ) * desca( nb_ ),
201 CALL pclase2( uplo, m, jn-ja+1, alpha, beta, a, ia,
203 DO 40 j = jn+1, ja+n-1, desca( nb_ )
205 jblk =
min( desca( nb_ ), n-jtmp )
206 CALL pclase2( uplo, j-ja, jblk, alpha, alpha, a, ia,
208 CALL pclase2( uplo, m-j+ja, jblk, alpha, beta, a,
209 $ ia+j-ja, j, desca )