Routine: PZLASE2()  File: SRC\pzlase2.f

 
 
# lines: 411
  # code: 411
  # comment: 0
  # blank:0
# Variables:53
# Callers:1
# Callings:0
# Words:182
# Keywords:104
 

 

 
..
     .. Array Arguments ..
     ..
  Purpose
  =======
  PZLASE2 initializes an M-by-N distributed matrix sub( A ) denoting
  A(IA:IA+M-1,JA:JA+N-1) to BETA on the diagonal and ALPHA on the
  offdiagonals.  PZLASE2 requires that only dimension of the matrix
  operand is distributed.
  Notes
  =====
  Each global data object is described by an associated description
  vector.  This vector stores the information required to establish
  the mapping between an object element and its corresponding process
  and memory location.
  Let A be a generic term for any 2D block cyclicly distributed array.
  Such a global array has an associated description vector DESCA.
  In the following comments, the character _ should be read as
  "of the global array".
  NOTATION        STORED IN      EXPLANATION
  --------------- -------------- --------------------------------------
  DTYPE_A(global) DESCA( DTYPE_ )The descriptor type.  In this case,
                                 DTYPE_A = 1.
  CTXT_A (global) DESCA( CTXT_ ) The BLACS context handle, indicating
                                 the BLACS process grid A is distribu-
                                 ted over. The context itself is glo-
                                 bal, but the handle (the integer
                                 value) may vary.
  M_A    (global) DESCA( M_ )    The number of rows in the global
                                 array A.
  N_A    (global) DESCA( N_ )    The number of columns in the global
                                 array A.
  MB_A   (global) DESCA( MB_ )   The blocking factor used to distribute
                                 the rows of the array.
  NB_A   (global) DESCA( NB_ )   The blocking factor used to distribute
                                 the columns of the array.
  RSRC_A (global) DESCA( RSRC_ ) The process row over which the first
                                 row of the array A is distributed.
  CSRC_A (global) DESCA( CSRC_ ) The process column over which the
                                 first column of the array A is
                                 distributed.
  LLD_A  (local)  DESCA( LLD_ )  The leading dimension of the local
                                 array.  LLD_A >= MAX(1,LOCr(M_A)).
  Let K be the number of rows or columns of a distributed matrix,
  and assume that its process grid has dimension p x q.
  LOCr( K ) denotes the number of elements of K that a process
  would receive if K were distributed over the p processes of its
  process column.
  Similarly, LOCc( K ) denotes the number of elements of K that a
  process would receive if K were distributed over the q processes of
  its process row.
  The values of LOCr() and LOCc() may be determined via a call to the
  ScaLAPACK tool function, NUMROC:
          LOCr( M ) = NUMROC( M, MB_A, MYROW, RSRC_A, NPROW ),
          LOCc( N ) = NUMROC( N, NB_A, MYCOL, CSRC_A, NPCOL ).
  An upper bound for these quantities may be computed by:
          LOCr( M ) <= ceil( ceil(M/MB_A)/NPROW )*MB_A
          LOCc( N ) <= ceil( ceil(N/NB_A)/NPCOL )*NB_A
  Arguments
  =========
  UPLO    (global input) CHARACTER
          Specifies the part of the distributed matrix sub( A ) to be
          set:
          = 'U':      Upper triangular part is set; the strictly lower
                      triangular part of sub( A ) is not changed;
          = 'L':      Lower triangular part is set; the strictly upper
                      triangular part of sub( A ) is not changed;
          Otherwise:  All of the matrix sub( A ) is set.
  M       (global input) INTEGER
          The number of rows to be operated on i.e the number of rows
          of the distributed submatrix sub( A ). M >= 0.
  N       (global input) INTEGER
          The number of columns to be operated on i.e the number of
          columns of the distributed submatrix sub( A ). N >= 0.
  ALPHA   (global input) COMPLEX*16
          The constant to which the offdiagonal elements are to be
          set.
  BETA    (global input) COMPLEX*16
          The constant to which the diagonal elements are to be set.
  A       (local output) COMPLEX*16 pointer into the local memory
          to an array of dimension (LLD_A,LOCc(JA+N-1)).  This array
          contains the local pieces of the distributed matrix sub( A )
          to be set.  On exit, the leading M-by-N submatrix sub( A )
          is set as follows:
          if UPLO = 'U', A(IA+i-1,JA+j-1) = ALPHA, 1<=i<=j-1, 1<=j<=N,
          if UPLO = 'L', A(IA+i-1,JA+j-1) = ALPHA, j+1<=i<=M, 1<=j<=N,
          otherwise,     A(IA+i-1,JA+j-1) = ALPHA, 1<=i<=M, 1<=j<=N,
                                                   IA+i.NE.JA+j,
          and, for all UPLO, A(IA+i-1,JA+i-1) = BETA, 1<=i<=min(M,N).
  IA      (global input) INTEGER
          The row index in the global array A indicating the first
          row of sub( A ).
  JA      (global input) INTEGER
          The column index in the global array A indicating the
          first column of sub( A ).
  DESCA   (global and local input) INTEGER array of dimension DLEN_.
          The array descriptor for the distributed matrix A.
  =====================================================================
     .. Parameters ..
 
Display dynamic version Find AutoScroll Reload FontSize: - + Hide Comments Hide Blanks Frame FullScreen MailPrint

  
001        SUBROUTINE PZLASE2( UPLO , M , N , ALPHA , BETA , A , IA , JA , DESCA )
002  
003  *     -- ScaLAPACK auxiliary routine(version 1.7) --
004  *     University of Tennessee , Knoxville , Oak Ridge National Laboratory ,
005  *     and University of California , Berkeley.
006  *     May 1 , 1997
007  
008  *     .. Scalar Arguments ..
009        CHARACTER UPLO
010        INTEGER IA , JA , M , N
011        COMPLEX*16 ALPHA , BETA
012        INTEGER BLOCK_CYCLIC_2D , CSRC_ , CTXT_ , DLEN_ , DTYPE_ ,
013       $LLD_ , MB_ , M_ , NB_ , N_ , RSRC_
014        PARAMETER( BLOCK_CYCLIC_2D = 1 , DLEN_ = 9 , DTYPE_ = 1 ,
015       $CTXT_ = 2 , M_ = 3 , N_ = 4 , MB_ = 5 , NB_ = 6 ,
016       $RSRC_ = 7 , CSRC_ = 8 , LLD_ = 9 )
017  *     ..
018  *     .. Local Scalars ..
019        INTEGER HEIGHT , IACOL , IAROW , IBASE , ICOFFA , II , IIA ,
020       $IIBEG , IIEND , IINXT , ILEFT , IRIGHT , IROFFA ,
021       $ITOP , JJ , JJA , JJBEG , JJEND , JJNXT , LDA , MBA ,
022       $MP , MPA , MYCOL , MYDIST , MYROW , NBA , NPCOL ,
023       $NPROW , NQ , NQA , WIDE
024  *     ..
025  *     .. External Subroutines ..
026        EXTERNAL BLACS_GRIDINFO , INFOG2L , ZLASET
027  *     ..
028  *     .. External Functions ..
029        LOGICAL LSAME
030        INTEGER ICEIL , NUMROC
031        EXTERNAL ICEIL , LSAME , NUMROC
032  *     ..
033  *     .. Intrinsic Functions ..
034        INTRINSIC MAX , MIN , MOD
035  *     ..
036  *     .. Executable Statements ..
037  
038        IF( M.EQ.0 .OR. N.EQ.0 )
039       $    RETURN
040  
041  *         Get grid parameters
042  
043            CALL BLACS_GRIDINFO( DESCA( CTXT_ ) , NPROW , NPCOL , MYROW , MYCOL )
044  
045            CALL INFOG2L( IA , JA , DESCA , NPROW , NPCOL , MYROW , MYCOL , IIA , JJA ,
046       $    IAROW , IACOL )
047            MBA = DESCA( MB_ )
048            NBA = DESCA( NB_ )
049            LDA = DESCA( LLD_ )
050            IROFFA = MOD( IA - 1 , MBA )
051            ICOFFA = MOD( JA - 1 , NBA )
052  
053            IF( N.LE.( NBA - ICOFFA ) ) THEN
054  
055  *             It is assumed that the local columns JJA : JJA + N - 1 of the matrix
056  *             A are in the same process column(IACOL).
057  
058  *             N
059  *             JJA JJA + N - 1
060  *             / --------------------- \
061  *             IROFFA| | | |
062  *             \ |...................| |( IAROW )
063  *             IIA |x | | MB_A
064  *             | x | |
065  *             | -- x ---------------- | /
066  *             | x |
067  *             | x | ITOP
068  *             | x | |
069  *             | x | /------- \
070  *             | ------- x ----------- | | ------- x ----------- |
071  *             | x | | x |
072  *             | x | | x |
073  *             | x | | x |
074  *             | x | | x |
075  *             | ------------ x ------ | | ------------ x ------ |
076  *             | x | \____________ /
077  *             | x | |
078  *             | x | IBASE
079  *             | x |
080  *             | ----------------- x - | Local picture
081  *             | x|
082  *             | |
083  *             | |
084  *             | |
085  *             | ------------------- |
086  *             | |
087  *             . .
088  *             . .
089  *             .(IACOL) .
090  
091                IF( MYCOL.EQ.IACOL ) THEN
092  
093                    MPA = NUMROC( M + IROFFA , MBA , MYROW , IAROW , NPROW )
094                    IF( MPA.LE.0 )
095       $                RETURN
096                        IF( MYROW.EQ.IAROW )
097       $                    MPA = MPA - IROFFA
098                            MYDIST = MOD( MYROW - IAROW + NPROW , NPROW )
099                            ITOP = MYDIST * MBA - IROFFA
100  
101                            IF( LSAME( UPLO , 'U' ) ) THEN
102  
103                                ITOP = MAX( 0 , ITOP )
104                                IIBEG = IIA
105                                IIEND = IIA + MPA - 1
106                                IINXT = MIN( ICEIL( IIBEG , MBA ) * MBA , IIEND )
107  
108     10 CONTINUE
109        IF(( N - ITOP ).GT.0 ) THEN
110            CALL ZLASET( UPLO , IINXT - IIBEG + 1 , N - ITOP , ALPHA , BETA ,
111       $    A( IIBEG + (JJA + ITOP - 1)*LDA ) , LDA )
112            MYDIST = MYDIST + NPROW
113            ITOP = MYDIST * MBA - IROFFA
114            IIBEG = IINXT + 1
115            IINXT = MIN( IINXT + MBA , IIEND )
116            GO TO 10
117        END IF
118  
119        ELSE IF( LSAME( UPLO , 'L' ) ) THEN
120  
121            II = IIA
122            JJ = JJA
123            MP = MPA
124            IBASE = MIN( ITOP + MBA , N )
125            ITOP = MIN( MAX( 0 , ITOP ) , N )
126  
127     20 CONTINUE
128        IF( JJ.LE.( JJA + N - 1 ) ) THEN
129            HEIGHT = IBASE - ITOP
130            CALL ZLASET( 'All' , MP , ITOP - JJ + JJA , ALPHA , ALPHA ,
131       $    A( II + (JJ - 1)*LDA ) , LDA )
132            CALL ZLASET( UPLO , MP , HEIGHT , ALPHA , BETA ,
133       $    A( II + (JJA + ITOP - 1)*LDA ) , LDA )
134            MP = MAX( 0 , MP - HEIGHT )
135            II = II + HEIGHT
136            JJ = JJA + IBASE
137            MYDIST = MYDIST + NPROW
138            ITOP = MYDIST * MBA - IROFFA
139            IBASE = MIN( ITOP + MBA , N )
140            ITOP = MIN( ITOP , N )
141            GO TO 20
142        END IF
143  
144        ELSE
145  
146            II = IIA
147            JJ = JJA
148            MP = MPA
149            IBASE = MIN( ITOP + MBA , N )
150            ITOP = MIN( MAX( 0 , ITOP ) , N )
151  
152     30 CONTINUE
153        IF( JJ.LE.( JJA + N - 1 ) ) THEN
154            HEIGHT = IBASE - ITOP
155            CALL ZLASET( 'All' , MPA , ITOP - JJ + JJA , ALPHA , ALPHA ,
156       $    A( IIA + (JJ - 1)*LDA ) , LDA )
157            CALL ZLASET( 'All' , MPA - MP , HEIGHT , ALPHA , ALPHA ,
158       $    A( IIA + (JJA + ITOP - 1)*LDA ) , LDA )
159            CALL ZLASET( 'All' , MP , HEIGHT , ALPHA , BETA ,
160       $    A( II + (JJA + ITOP - 1)*LDA ) , LDA )
161            MP = MAX( 0 , MP - HEIGHT )
162            II = II + HEIGHT
163            JJ = JJA + IBASE
164            MYDIST = MYDIST + NPROW
165            ITOP = MYDIST * MBA - IROFFA
166            IBASE = MIN( ITOP + MBA , N )
167            ITOP = MIN( ITOP , N )
168            GO TO 30
169        END IF
170  
171        END IF
172  
173        END IF
174  
175        ELSE IF( M.LE.( MBA - IROFFA ) ) THEN
176  
177  *         It is assumed that the local rows IIA : IIA + M - 1 of the matrix A
178  *         are in the same process row(IAROW).
179  
180  *         ICOFFA
181  *         / \JJA
182  *         IIA ------------------ .... --------
183  *         | .x | | | / | | \
184  *         | . x | | | ILEFT| | | |
185  *         | . x | | | | | |
186  *         | . x | | \ x | |
187  *         | . |x | | |x | | IRIGHT
188  *         | . | x | | | x | |
189  *         (IAROW) | . | x | | | x | |
190  *         | . | x| | | x| |
191  *         | . | x | | x /
192  *         | . | |x | | |
193  *         | . | | x | | |
194  *         | . | | x | | |
195  *         | . | | x| | |
196  *         IIA + M - 1 ------------------ .... -------
197  *         NB_A
198  *         (IACOL) Local picture
199  
200            IF( MYROW.EQ.IAROW ) THEN
201  
202                NQA = NUMROC( N + ICOFFA , NBA , MYCOL , IACOL , NPCOL )
203                IF( NQA.LE.0 )
204       $            RETURN
205                    IF( MYCOL.EQ.IACOL )
206       $                NQA = NQA - ICOFFA
207                        MYDIST = MOD( MYCOL - IACOL + NPCOL , NPCOL )
208                        ILEFT = MYDIST * NBA - ICOFFA
209  
210                        IF( LSAME( UPLO , 'L' ) ) THEN
211  
212                            ILEFT = MAX( 0 , ILEFT )
213                            JJBEG = JJA
214                            JJEND = JJA + NQA - 1
215                            JJNXT = MIN( ICEIL( JJBEG , NBA ) * NBA , JJEND )
216  
217     40 CONTINUE
218        IF(( M - ILEFT ).GT.0 ) THEN
219            CALL ZLASET( UPLO , M - ILEFT , JJNXT - JJBEG + 1 , ALPHA ,
220       $    BETA , A( IIA + ILEFT + (JJBEG - 1)*LDA ) , LDA )
221            MYDIST = MYDIST + NPCOL
222            ILEFT = MYDIST * NBA - ICOFFA
223            JJBEG = JJNXT + 1
224            JJNXT = MIN( JJNXT + NBA , JJEND )
225            GO TO 40
226        END IF
227  
228        ELSE IF( LSAME( UPLO , 'U' ) ) THEN
229  
230            II = IIA
231            JJ = JJA
232            NQ = NQA
233            IRIGHT = MIN( ILEFT + NBA , M )
234            ILEFT = MIN( MAX( 0 , ILEFT ) , M )
235  
236     50 CONTINUE
237        IF( II.LE.( IIA + M - 1 ) ) THEN
238            WIDE = IRIGHT - ILEFT
239            CALL ZLASET( 'All' , ILEFT - II + IIA , NQ , ALPHA , ALPHA ,
240       $    A( II + (JJ - 1)*LDA ) , LDA )
241            CALL ZLASET( UPLO , WIDE , NQ , ALPHA , BETA ,
242       $    A( IIA + ILEFT + (JJ - 1)*LDA ) , LDA )
243            NQ = MAX( 0 , NQ - WIDE )
244            II = IIA + IRIGHT
245            JJ = JJ + WIDE
246            MYDIST = MYDIST + NPCOL
247            ILEFT = MYDIST * NBA - ICOFFA
248            IRIGHT = MIN( ILEFT + NBA , M )
249            ILEFT = MIN( ILEFT , M )
250            GO TO 50
251        END IF
252  
253        ELSE
254  
255            II = IIA
256            JJ = JJA
257            NQ = NQA
258            IRIGHT = MIN( ILEFT + NBA , M )
259            ILEFT = MIN( MAX( 0 , ILEFT ) , M )
260  
261     60 CONTINUE
262        IF( II.LE.( IIA + M - 1 ) ) THEN
263            WIDE = IRIGHT - ILEFT
264            CALL ZLASET( 'All' , ILEFT - II + IIA , NQA , ALPHA , ALPHA ,
265       $    A( II + (JJA - 1)*LDA ) , LDA )
266            CALL ZLASET( 'All' , WIDE , NQA - NQ , ALPHA , ALPHA ,
267       $    A( IIA + ILEFT + (JJA - 1)*LDA ) , LDA )
268            CALL ZLASET( 'All' , WIDE , NQ , ALPHA , BETA ,
269       $    A( IIA + ILEFT + (JJ - 1)*LDA ) , LDA )
270            NQ = MAX( 0 , NQ - WIDE )
271            II = IIA + IRIGHT
272            JJ = JJ + WIDE
273            MYDIST = MYDIST + NPCOL
274            ILEFT = MYDIST * NBA - ICOFFA
275            IRIGHT = MIN( ILEFT + NBA , M )
276            ILEFT = MIN( ILEFT , M )
277            GO TO 60
278        END IF
279  
280        END IF
281  
282        END IF
283  
284        END IF
285  
286        RETURN
287  
288  *     End of PZLASE2
289  
290        END