Routine: PSLAMR1D()  File: SRC\pslamr1d.f

 
 
# lines: 144
  # code: 144
  # comment: 0
  # blank:0
# Variables:26
# Callers:2
# Callings:0
# Words:40
# Keywords:24
 

 

 
..
     .. Array Arguments ..
     ..
  Bugs
  ====
  I am not sure that this works correctly when IB and JB are not equal
  to 1.  Indeed, I suspect that IB should always be set to 1 or ignored
  with 1 used in its place.
  PSLAMR1D has not been tested except withint the contect of
  PSSYPTRD, the prototype reduction to tridiagonal form code.
  Purpose
  =======
  PSLAMR1D redistributes a one-dimensional row vector from one data
  decomposition to another.
  This is an auxiliary routine called by PSSYTRD to redistribute D, E
  and TAU.
  Notes
  =====
  Although all processes call PSGEMR2D, only the processes that own
  the first column of A send data and only processes that own the
  first column of B receive data.  The calls to SGEBS2D/SGEBR2D
  spread the data down.
  Arguments
  =========
  N       (global input) INTEGER
          The size of the matrix to be transposed.
  A       (local output) COMPLEX*16 pointer into the
          local memory to an array of dimension (LOCc(JA+N-1)).
          On output, A is replicated across all processes in
          this processor column.
  IA      (global input) INTEGER
          A's global row index, which points to the beginning of
          the submatrix which is to be operated on.
  JA      (global input) INTEGER
          A's global column index, which points to the beginning of
          the submatrix which is to be operated on.
  DESCA   (global and local input) INTEGER array of dimension DLEN_.
          The array descriptor for the distributed matrix A.
  B       (local input/local output) COMPLEX*16 pointer into the
          local memory to an array of dimension (LOCc(JB+N-1)).
  IB      (global input) INTEGER
          B's global row index,  NOT USED
  JB      (global input) INTEGER
          B's global column index, which points to the beginning of
          the submatrix which is to be operated on.
  DESCB   (global and local input) INTEGER array of dimension DLEN_.
          The array descriptor for the distributed matrix B.
  WORK    (local workspace) COMPLEX*16 array, dimension ( LWORK )
  LWORK   (local input) INTEGER
          The dimension of the array WORK.
          LWORK is local input and must be at least
          LWORK >= NB * NUMROC( N, 1, 0, 0, NPROW )
  =====================================================================
     .. Parameters ..
 
Display dynamic version Find AutoScroll Reload FontSize: - + Hide Comments Hide Blanks Frame FullScreen MailPrint

  
01        SUBROUTINE PSLAMR1D( N , A , IA , JA , DESCA , B , IB , JB , DESCB )
02  
03  *     -- ScaLAPACK routine(version 1.7) --
04  *     University of Tennessee , Knoxville , Oak Ridge National Laboratory ,
05  *     and University of California , Berkeley.
06  *     October 15 , 1999
07  
08  *     .. Scalar Arguments ..
09        INTEGER IA , IB , JA , JB , N
10        INTEGER BLOCK_CYCLIC_2D , DLEN_ , DTYPE_ , CTXT_ , M_ , N_ ,
11       $MB_ , NB_ , RSRC_ , CSRC_ , LLD_
12        PARAMETER( BLOCK_CYCLIC_2D = 1 , DLEN_ = 9 , DTYPE_ = 1 ,
13       $CTXT_ = 2 , M_ = 3 , N_ = 4 , MB_ = 5 , NB_ = 6 ,
14       $RSRC_ = 7 , CSRC_ = 8 , LLD_ = 9 )
15  *     ..
16  *     .. Local Scalars ..
17        INTEGER I , ICTXT , MYCOL , MYROW , NPCOL , NPROW , NQ
18  *     ..
19  *     .. Local Arrays ..
20        INTEGER DESCAA( DLEN_ ) , DESCBB( DLEN_ )
21  *     ..
22  *     .. External Subroutines ..
23        EXTERNAL BLACS_GRIDINFO , PSGEMR2D , SGEBR2D , SGEBS2D
24  *     ..
25  *     .. External Functions ..
26        INTEGER NUMROC
27        EXTERNAL NUMROC
28  *     ..
29  *     .. Executable Statements ..
30  *     This is just to keep ftnchek and toolpack / 1 happy
31        IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_*
32       $    RSRC_.LT.0 )RETURN
33  
34  *         Quick return if possible
35  
36            IF( N.LE.0 )
37       $        RETURN
38  
39                DO 10 I = 1 , DLEN_
40                    DESCAA( I ) = DESCA( I )
41                    DESCBB( I ) = DESCB( I )
42     10         CONTINUE
43  
44                DESCAA( M_ ) = 1
45                DESCBB( M_ ) = 1
46                DESCAA( LLD_ ) = 1
47                DESCBB( LLD_ ) = 1
48  
49                ICTXT = DESCB( CTXT_ )
50                CALL PSGEMR2D( 1 , N , A , IA , JA , DESCAA , B , IB , JB , DESCBB , ICTXT )
51  
52                CALL BLACS_GRIDINFO( ICTXT , NPROW , NPCOL , MYROW , MYCOL )
53                NQ = NUMROC( N , DESCB( NB_ ) , MYCOL , 0 , NPCOL )
54  
55                IF( MYROW.EQ.0 ) THEN
56                    CALL SGEBS2D( ICTXT , 'C' , ' ' , NQ , 1 , B , NQ )
57                ELSE
58                    CALL SGEBR2D( ICTXT , 'C' , ' ' , NQ , 1 , B , NQ , 0 , MYCOL )
59                END IF
60  
61                RETURN
62  
63  *             End of PSLAMR1D
64  
65            END