Routine: PDORMTR()  File: SRC\pdormtr.f

 
 
# lines: 437
  # code: 437
  # comment: 0
  # blank:0
# Variables:58
# Callers:3
# Callings:2
# Words:195
# Keywords:133
 

 

..
     .. Array Arguments ..
     ..
  Purpose
  =======
  PDORMTR overwrites the general real M-by-N distributed matrix
  sub( C ) = C(IC:IC+M-1,JC:JC+N-1) with
                       SIDE = 'L'           SIDE = 'R'
  TRANS = 'N':      Q * sub( C )          sub( C ) * Q
  TRANS = 'T':      Q**T * sub( C )       sub( C ) * Q**T
  where Q is a real orthogonal distributed matrix of order nq, with
  nq = m if SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the
  product of nq-1 elementary reflectors, as returned by PDSYTRD:
  if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1);
  if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1).
  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
  =========
  SIDE    (global input) CHARACTER
          = 'L': apply Q or Q**T from the Left;
          = 'R': apply Q or Q**T from the Right.
  UPLO    (global input) CHARACTER
          = 'U': Upper triangle of A(IA:*,JA:*) contains elementary
                 reflectors from PDSYTRD;
          = 'L': Lower triangle of A(IA:*,JA:*) contains elementary
                 reflectors from PDSYTRD.
  TRANS   (global input) CHARACTER
          = 'N':  No transpose, apply Q;
          = 'T':  Transpose, apply Q**T.
  M       (global input) INTEGER
          The number of rows to be operated on i.e the number of rows
          of the distributed submatrix sub( C ). 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( C ). N >= 0.
  A       (local input) DOUBLE PRECISION pointer into the local memory
          to an array of dimension (LLD_A,LOCc(JA+M-1)) if SIDE='L',
          or (LLD_A,LOCc(JA+N-1)) if SIDE = 'R'. The vectors which
          define the elementary reflectors, as returned by PDSYTRD.
          If SIDE = 'L', LLD_A >= max(1,LOCr(IA+M-1));
          if SIDE = 'R', LLD_A >= max(1,LOCr(IA+N-1)).
  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.
  TAU     (local input) DOUBLE PRECISION array, dimension LTAU, where
          if SIDE = 'L' and UPLO = 'U', LTAU = LOCc(M_A),
          if SIDE = 'L' and UPLO = 'L', LTAU = LOCc(JA+M-2),
          if SIDE = 'R' and UPLO = 'U', LTAU = LOCc(N_A),
          if SIDE = 'R' and UPLO = 'L', LTAU = LOCc(JA+N-2).
          TAU(i) must contain the scalar factor of the elementary
          reflector H(i), as returned by PDSYTRD. TAU is tied to the
          distributed matrix A.
  C       (local input/local output) DOUBLE PRECISION pointer into the
          local memory to an array of dimension (LLD_C,LOCc(JC+N-1)).
          On entry, the local pieces of the distributed matrix sub(C).
          On exit, sub( C ) is overwritten by Q*sub( C ) or Q'*sub( C )
          or sub( C )*Q' or sub( C )*Q.
  IC      (global input) INTEGER
          The row index in the global array C indicating the first
          row of sub( C ).
  JC      (global input) INTEGER
          The column index in the global array C indicating the
          first column of sub( C ).
  DESCC   (global and local input) INTEGER array of dimension DLEN_.
          The array descriptor for the distributed matrix C.
  WORK    (local workspace/local output) DOUBLE PRECISION array,
                                                     dimension (LWORK)
          On exit, WORK(1) returns the minimal and optimal LWORK.
  LWORK   (local or global input)  INTEGER
          The dimension of the array WORK.
          LWORK is local input and must be at least
          If UPLO = 'U',
            IAA = IA, JAA = JA+1, ICC = IC, JCC = JC;
          else UPLO = 'L',
            IAA = IA+1, JAA = JA;
            if SIDE = 'L',
              ICC = IC+1; JCC = JC;
            else
              ICC = IC; JCC = JC+1;
            end if
          end if
          If SIDE = 'L',
            MI = M-1; NI = N;
            LWORK >= MAX( (NB_A*(NB_A-1))/2, (NqC0 + MpC0)*NB_A ) +
                     NB_A * NB_A
          else if SIDE = 'R',
            MI = M; MI = N-1;
            LWORK >= MAX( (NB_A*(NB_A-1))/2, ( NqC0 + MAX( NpA0 +
                     NUMROC( NUMROC( NI+ICOFFC, NB_A, 0, 0, NPCOL ),
                             NB_A, 0, 0, LCMQ ), MpC0 ) )*NB_A ) +
                     NB_A * NB_A
          end if
          where LCMQ = LCM / NPCOL with LCM = ICLM( NPROW, NPCOL ),
          IROFFA = MOD( IAA-1, MB_A ), ICOFFA = MOD( JAA-1, NB_A ),
          IAROW = INDXG2P( IAA, MB_A, MYROW, RSRC_A, NPROW ),
          NpA0 = NUMROC( NI+IROFFA, MB_A, MYROW, IAROW, NPROW ),
          IROFFC = MOD( ICC-1, MB_C ), ICOFFC = MOD( JCC-1, NB_C ),
          ICROW = INDXG2P( ICC, MB_C, MYROW, RSRC_C, NPROW ),
          ICCOL = INDXG2P( JCC, NB_C, MYCOL, CSRC_C, NPCOL ),
          MpC0 = NUMROC( MI+IROFFC, MB_C, MYROW, ICROW, NPROW ),
          NqC0 = NUMROC( NI+ICOFFC, NB_C, MYCOL, ICCOL, NPCOL ),
          ILCM, INDXG2P and NUMROC are ScaLAPACK tool functions;
          MYROW, MYCOL, NPROW and NPCOL can be determined by calling
          the subroutine BLACS_GRIDINFO.
          If LWORK = -1, then LWORK is global input and a workspace
          query is assumed; the routine only calculates the minimum
          and optimal size for all work arrays. Each of these
          values is returned in the first entry of the corresponding
          work array, and no error message is issued by PXERBLA.
  INFO    (global output) INTEGER
          = 0:  successful exit
          < 0:  If the i-th argument is an array and the j-entry had
                an illegal value, then INFO = -(i*100+j), if the i-th
                argument is a scalar and had an illegal value, then
                INFO = -i.
  Alignment requirements
  ======================
  The distributed submatrices A(IA:*, JA:*) and C(IC:IC+M-1,JC:JC+N-1)
  must verify some alignment properties, namely the following
  expressions should be true:
  If SIDE = 'L',
    ( MB_A.EQ.MB_C .AND. IROFFA.EQ.IROFFC .AND. IAROW.EQ.ICROW )
  If SIDE = 'R',
    ( MB_A.EQ.NB_C .AND. IROFFA.EQ.ICOFFC )
  =====================================================================
     .. Parameters ..

 
Display dynamic version Find AutoScroll Reload FontSize: - + Hide Comments Hide Blanks Frame FullScreen MailPrint

 
001        SUBROUTINE PDORMTR( SIDE , UPLO , TRANS , M , N , A , IA , JA , DESCA ,
002       $TAU , C , IC , JC , DESCC , WORK , LWORK , INFO )
003  
004  *     -- ScaLAPACK routine(version 1.7) --
005  *     University of Tennessee , Knoxville , Oak Ridge National Laboratory ,
006  *     and University of California , Berkeley.
007  *     May 1 , 1997
008  
009  *     .. Scalar Arguments ..
010        CHARACTER SIDE , TRANS , UPLO
011        INTEGER IA , IC , INFO , JA , JC , LWORK , M , N
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        LOGICAL LEFT , LQUERY , NOTRAN , UPPER
020        INTEGER IAA , IAROW , ICC , ICCOL , ICOFFC , ICROW , ICTXT ,
021       $IINFO , IROFFA , IROFFC , JAA , JCC , LCM , LCMQ ,
022       $LWMIN , MI , MPC0 , MYCOL , MYROW , NI , NPA0 , NPCOL ,
023       $NPROW , NQ , NQC0
024  *     ..
025  *     .. Local Arrays ..
026        INTEGER IDUM1( 4 ) , IDUM2( 4 )
027  *     ..
028  *     .. External Subroutines ..
029        EXTERNAL BLACS_GRIDINFO , CHK1MAT , PCHK2MAT , PDORMQL ,
030       $PDORMQR , PXERBLA
031  *     ..
032  *     .. External Functions ..
033        LOGICAL LSAME
034        INTEGER ILCM , INDXG2P , NUMROC
035        EXTERNAL ILCM , INDXG2P , LSAME , NUMROC
036  *     ..
037  *     .. Intrinsic Functions ..
038        INTRINSIC DBLE , ICHAR , MAX , MOD
039  *     ..
040  *     .. Executable Statements ..
041  
042  *     Get grid parameters
043  
044        ICTXT = DESCA( CTXT_ )
045        CALL BLACS_GRIDINFO( ICTXT , NPROW , NPCOL , MYROW , MYCOL )
046  
047  *     Test the input parameters
048  
049        INFO = 0
050        IF( NPROW.EQ. - 1 ) THEN
051            INFO = - (900 + CTXT_)
052        ELSE
053            LEFT = LSAME( SIDE , 'L' )
054            NOTRAN = LSAME( TRANS , 'N' )
055            UPPER = LSAME( UPLO , 'U' )
056  
057            IF( UPPER ) THEN
058                IAA = IA
059                JAA = JA + 1
060                ICC = IC
061                JCC = JC
062            ELSE
063                IAA = IA + 1
064                JAA = JA
065                IF( LEFT ) THEN
066                    ICC = IC + 1
067                    JCC = JC
068                ELSE
069                    ICC = IC
070                    JCC = JC + 1
071                END IF
072            END IF
073  
074  *         NQ is the order of Q
075  
076            IF( LEFT ) THEN
077                NQ = M
078                MI = M - 1
079                NI = N
080                CALL CHK1MAT( MI , 4 , NQ - 1 , 4 , IAA , JAA , DESCA , 9 , INFO )
081            ELSE
082                NQ = N
083                MI = M
084                NI = N - 1
085                CALL CHK1MAT( NI , 5 , NQ - 1 , 5 , IAA , JAA , DESCA , 9 , INFO )
086            END IF
087            CALL CHK1MAT( MI , 4 , NI , 5 , ICC , JCC , DESCC , 14 , INFO )
088            IF( INFO.EQ.0 ) THEN
089                IROFFA = MOD( IAA - 1 , DESCA( MB_ ) )
090                IROFFC = MOD( ICC - 1 , DESCC( MB_ ) )
091                ICOFFC = MOD( JCC - 1 , DESCC( NB_ ) )
092                IAROW = INDXG2P( IAA , DESCA( MB_ ) , MYROW , DESCA( RSRC_ ) ,
093       $        NPROW )
094                ICROW = INDXG2P( ICC , DESCC( MB_ ) , MYROW , DESCC( RSRC_ ) ,
095       $        NPROW )
096                ICCOL = INDXG2P( JCC , DESCC( NB_ ) , MYCOL , DESCC( CSRC_ ) ,
097       $        NPCOL )
098                MPC0 = NUMROC( MI + IROFFC , DESCC( MB_ ) , MYROW , ICROW ,
099       $        NPROW )
100                NQC0 = NUMROC( NI + ICOFFC , DESCC( NB_ ) , MYCOL , ICCOL ,
101       $        NPCOL )
102  
103                IF( LEFT ) THEN
104                    LWMIN = MAX(( DESCA( NB_ ) * ( DESCA( NB_ ) - 1 ) ) / 2 ,
105       $( MPC0 + NQC0 ) * DESCA( NB_ ) ) +
106       $            DESCA( NB_ ) * DESCA( NB_ )
107                ELSE
108                    NPA0 = NUMROC( NI + IROFFA , DESCA( MB_ ) , MYROW , IAROW ,
109       $            NPROW )
110                    LCM = ILCM( NPROW , NPCOL )
111                    LCMQ = LCM / NPCOL
112                    LWMIN = MAX(( DESCA( NB_ ) * ( DESCA( NB_ ) - 1 ) )
113       $            / 2 ,( NQC0 + MAX( NPA0 + NUMROC( NUMROC(
114       $            NI + ICOFFC , DESCA( NB_ ) , 0 , 0 , NPCOL ) ,
115       $            DESCA( NB_ ) , 0 , 0 , LCMQ ) , MPC0 ) ) *
116       $            DESCA( NB_ ) ) + DESCA( NB_ ) * DESCA( NB_ )
117                END IF
118  
119                WORK( 1 ) = DBLE( LWMIN )
120                LQUERY =( LWORK.EQ. - 1 )
121                IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE , 'R' ) ) THEN
122                    INFO = - 1
123                ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO , 'L' ) ) THEN
124                    INFO = - 2
125                ELSE IF( .NOT.LSAME( TRANS , 'N' ) .AND.
126       $            .NOT.LSAME( TRANS , 'T' ) ) THEN
127                    INFO = - 3
128                ELSE IF( .NOT.LEFT .AND. DESCA( MB_ ).NE.DESCC( NB_ ) ) THEN
129                    INFO = - (900 + NB_)
130                ELSE IF( LEFT .AND. IROFFA.NE.IROFFC ) THEN
131                    INFO = - 12
132                ELSE IF( LEFT .AND. IAROW.NE.ICROW ) THEN
133                    INFO = - 12
134                ELSE IF( .NOT.LEFT .AND. IROFFA.NE.ICOFFC ) THEN
135                    INFO = - 13
136                ELSE IF( LEFT .AND. DESCA( MB_ ).NE.DESCC( MB_ ) ) THEN
137                    INFO = - (1400 + MB_)
138                ELSE IF( ICTXT.NE.DESCC( CTXT_ ) ) THEN
139                    INFO = - (1400 + CTXT_)
140                ELSE IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
141                    INFO = - 16
142                END IF
143            END IF
144  
145            IF( LEFT ) THEN
146                IDUM1( 1 ) = ICHAR( 'L' )
147            ELSE
148                IDUM1( 1 ) = ICHAR( 'R' )
149            END IF
150            IDUM2( 1 ) = 1
151            IF( UPPER ) THEN
152                IDUM1( 2 ) = ICHAR( 'U' )
153            ELSE
154                IDUM1( 2 ) = ICHAR( 'L' )
155            END IF
156            IDUM2( 2 ) = 2
157            IF( NOTRAN ) THEN
158                IDUM1( 3 ) = ICHAR( 'N' )
159            ELSE
160                IDUM1( 3 ) = ICHAR( 'T' )
161            END IF
162            IDUM2( 3 ) = 3
163            IF( LWORK.EQ. - 1 ) THEN
164                IDUM1( 4 ) = - 1
165            ELSE
166                IDUM1( 4 ) = 1
167            END IF
168            IDUM2( 4 ) = 16
169            IF( LEFT ) THEN
170                CALL PCHK2MAT( MI , 4 , NQ - 1 , 4 , IAA , JAA , DESCA , 9 , MI , 4 ,
171       $        NI , 5 , ICC , JCC , DESCC , 14 , 4 , IDUM1 , IDUM2 ,
172       $        INFO )
173            ELSE
174                CALL PCHK2MAT( NI , 5 , NQ - 1 , 5 , IAA , JAA , DESCA , 9 , MI , 4 ,
175       $        NI , 5 , ICC , JCC , DESCC , 14 , 4 , IDUM1 , IDUM2 ,
176       $        INFO )
177            END IF
178        END IF
179  
180        IF( INFO.NE.0 ) THEN
181            CALL PXERBLA( ICTXT , 'PDORMTR' , - INFO )
182            RETURN
183        ELSE IF( LQUERY ) THEN
184            RETURN
185        END IF
186  
187  *     Quick return if possible
188  
189        IF( M.EQ.0 .OR. N.EQ.0 .OR. NQ.EQ.1 )
190       $    RETURN
191  
192            IF( UPPER ) THEN
193  
194  *             Q was determined by a call to PDSYTRD with UPLO = 'U'
195  
196                CALL PDORMQL ( SIDE , TRANS , MI , NI , NQ - 1 , A , IAA , JAA , DESCA ,
197       $        TAU , C , ICC , JCC , DESCC , WORK , LWORK , IINFO )
198  
199            ELSE
200  
201  *             Q was determined by a call to PDSYTRD with UPLO = 'L'
202  
203                CALL PDORMQR ( SIDE , TRANS , MI , NI , NQ - 1 , A , IAA , JAA , DESCA ,
204       $        TAU , C , ICC , JCC , DESCC , WORK , LWORK , IINFO )
205  
206            END IF
207  
208            WORK( 1 ) = DBLE( LWMIN )
209  
210            RETURN
211  
212  *         End of PDORMTR
213  
214        END