Routine: PDORMBR()  File: SRC\pdormbr.f

 
 
# lines: 591
  # code: 591
  # comment: 0
  # blank:0
# Variables:64
# Callers:1
# Callings:2
# Words:325
# Keywords:227
 

 

 
..
     .. Array Arguments ..
     ..
  Purpose
  =======
  If VECT = 'Q', PDORMBR overwrites the general real distributed M-by-N
  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
  If VECT = 'P', PDORMBR overwrites sub( C ) with
                       SIDE = 'L'           SIDE = 'R'
  TRANS = 'N':      P * sub( C )          sub( C ) * P
  TRANS = 'T':      P**T * sub( C )       sub( C ) * P**T
  Here Q and P**T are the orthogonal distributed matrices determined by
  PDGEBRD when reducing a real distributed matrix A(IA:*,JA:*) to
  bidiagonal form: A(IA:*,JA:*) = Q * B * P**T. Q and P**T are defined
  as products of elementary reflectors H(i) and G(i) respectively.
  Let nq = m if SIDE = 'L' and nq = n if SIDE = 'R'. Thus nq is the
  order of the orthogonal matrix Q or P**T that is applied.
  If VECT = 'Q', A(IA:*,JA:*) is assumed to have been an NQ-by-K
  matrix:
  if nq >= k, Q = H(1) H(2) . . . H(k);
  if nq < k, Q = H(1) H(2) . . . H(nq-1).
  If VECT = 'P', A(IA:*,JA:*) is assumed to have been a K-by-NQ
  matrix:
  if k < nq, P = G(1) G(2) . . . G(k);
  if k >= nq, P = G(1) G(2) . . . G(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
  =========
  VECT    (global input) CHARACTER
          = 'Q': apply Q or Q**T;
          = 'P': apply P or P**T.
  SIDE    (global input) CHARACTER
          = 'L': apply Q, Q**T, P or P**T from the Left;
          = 'R': apply Q, Q**T, P or P**T from the Right.
  TRANS   (global input) CHARACTER
          = 'N':  No transpose, apply Q or P;
          = 'T':  Transpose, apply Q**T or P**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.
  K       (global input) INTEGER
          If VECT = 'Q', the number of columns in the original
          distributed matrix reduced by PDGEBRD.
          If VECT = 'P', the number of rows in the original
          distributed matrix reduced by PDGEBRD.
          K >= 0.
  A       (local input) DOUBLE PRECISION pointer into the local memory
          to an array of dimension (LLD_A,LOCc(JA+MIN(NQ,K)-1)) if
          VECT='Q', and (LLD_A,LOCc(JA+NQ-1)) if VECT = 'P'. NQ = M
          if SIDE = 'L', and NQ = N otherwise. The vectors which
          define the elementary reflectors H(i) and G(i), whose
          products determine the matrices Q and P, as returned by
          PDGEBRD.
          If VECT = 'Q', LLD_A >= max(1,LOCr(IA+NQ-1));
          if VECT = 'P', LLD_A >= max(1,LOCr(IA+MIN(NQ,K)-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
          LOCc(JA+MIN(NQ,K)-1) if VECT = 'Q', LOCr(IA+MIN(NQ,K)-1) if
          VECT = 'P', TAU(i) must contain the scalar factor of the
          elementary  reflector H(i) or G(i), which determines Q or P,
          as returned by PDGEBRD in its array argument TAUQ or TAUP.
          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, if VECT='Q', sub( C ) is overwritten by Q*sub( C )
          or Q'*sub( C ) or sub( C )*Q' or sub( C )*Q; if VECT='P,
          sub( C ) is overwritten by P*sub( C ) or P'*sub( C ) or
          sub( C )*P or sub( C )*P'.
  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 SIDE = 'L',
            NQ = M;
            if( (VECT = 'Q' and NQ >= K) or (VECT <> 'Q' and NQ > K) ),
               IAA=IA; JAA=JA; MI=M; NI=N; ICC=IC; JCC=JC;
            else
               IAA=IA+1; JAA=JA; MI=M-1; NI=N; ICC=IC+1; JCC=JC;
            end if
          else if SIDE = 'R',
            NQ = N;
            if( (VECT = 'Q' and NQ >= K) or (VECT <> 'Q' and NQ > K) ),
               IAA=IA; JAA=JA; MI=M; NI=N; ICC=IC; JCC=JC;
            else
               IAA=IA; JAA=JA+1; MI=M; NI=N-1; ICC=IC; JCC=JC+1;
            end if
          end if
          If VECT = 'Q',
            If SIDE = 'L',
              LWORK >= MAX( (NB_A*(NB_A-1))/2, (NqC0 + MpC0)*NB_A ) +
                       NB_A * NB_A
            else if SIDE = 'R',
              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
          else if VECT <> 'Q',
            if SIDE = 'L',
              LWORK >= MAX( (MB_A*(MB_A-1))/2, ( MpC0 + MAX( MqA0 +
                       NUMROC( NUMROC( MI+IROFFC, MB_A, 0, 0, NPROW ),
                               MB_A, 0, 0, LCMP ), NqC0 ) )*MB_A ) +
                       MB_A * MB_A
            else if SIDE = 'R',
              LWORK >= MAX( (MB_A*(MB_A-1))/2, (MpC0 + NqC0)*MB_A ) +
                       MB_A * MB_A
            end if
          end if
          where LCMP = LCM / NPROW, 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 ),
          IACOL = INDXG2P( JAA, NB_A, MYCOL, CSRC_A, NPCOL ),
          MqA0 = NUMROC( MI+ICOFFA, NB_A, MYCOL, IACOL, NPCOL ),
          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 ),
          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 VECT = 'Q',
    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 )
  else
     If SIDE = 'L',
       ( MB_A.EQ.MB_C .AND. ICOFFA.EQ.IROFFC )
     If SIDE = 'R',
       ( NB_A.EQ.NB_C .AND. ICOFFA.EQ.ICOFFC .AND. IACOL.EQ.ICCOL )
  end if
  =====================================================================
     .. Parameters ..
 
Display dynamic version Find AutoScroll Reload FontSize: - + Hide Comments Hide Blanks Frame FullScreen MailPrint

  
001        SUBROUTINE PDORMBR( VECT , SIDE , TRANS , M , N , K , 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 , VECT
011        INTEGER IA , IC , INFO , JA , JC , K , 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 APPLYQ , LEFT , LQUERY , NOTRAN
020        CHARACTER TRANST
021        INTEGER IAA , IACOL , IAROW , ICC , ICCOL , ICOFFA , ICOFFC ,
022       $ICROW , ICTXT , IINFO , IROFFA , IROFFC , JAA , JCC ,
023       $LCM , LCMP , LCMQ , LWMIN , MI , MPC0 , MQA0 , MYCOL ,
024       $MYROW , NI , NPA0 , NPCOL , NPROW , NQ , NQC0
025  *     ..
026  *     .. Local Arrays ..
027        INTEGER IDUM1( 5 ) , IDUM2( 5 )
028  *     ..
029  *     .. External Subroutines ..
030        EXTERNAL BLACS_GRIDINFO , CHK1MAT , PCHK2MAT , PDORMLQ ,
031       $PDORMQR , PXERBLA
032  *     ..
033  *     .. External Functions ..
034        LOGICAL LSAME
035        INTEGER ILCM , INDXG2P , NUMROC
036        EXTERNAL ILCM , INDXG2P , LSAME , NUMROC
037  *     ..
038  *     .. Intrinsic Functions ..
039        INTRINSIC DBLE , ICHAR , MAX , MOD
040  *     ..
041  *     .. Executable Statements ..
042  
043  *     Get grid parameters
044  
045        ICTXT = DESCA( CTXT_ )
046        CALL BLACS_GRIDINFO( ICTXT , NPROW , NPCOL , MYROW , MYCOL )
047  
048  *     Test the input parameters
049  
050        INFO = 0
051        IF( NPROW.EQ. - 1 ) THEN
052            INFO = - (1000 + CTXT_)
053        ELSE
054            APPLYQ = LSAME( VECT , 'Q' )
055            LEFT = LSAME( SIDE , 'L' )
056            NOTRAN = LSAME( TRANS , 'N' )
057  
058  *         NQ is the order of Q or P
059  
060            IF( LEFT ) THEN
061                NQ = M
062                IF(( APPLYQ .AND. NQ.GE.K ) .OR.
063       $( .NOT.APPLYQ .AND. NQ.GT.K ) ) THEN
064                IAA = IA
065                JAA = JA
066                MI = M
067                NI = N
068                ICC = IC
069                JCC = JC
070            ELSE
071                IAA = IA + 1
072                JAA = JA
073                MI = M - 1
074                NI = N
075                ICC = IC + 1
076                JCC = JC
077            END IF
078  
079            IF( APPLYQ ) THEN
080                CALL CHK1MAT( M , 4 , K , 6 , IA , JA , DESCA , 10 , INFO )
081            ELSE
082                CALL CHK1MAT( K , 6 , M , 4 , IA , JA , DESCA , 10 , INFO )
083            END IF
084        ELSE
085            NQ = N
086            IF(( APPLYQ .AND. NQ.GE.K ) .OR.
087       $( .NOT.APPLYQ .AND. NQ.GT.K ) ) THEN
088            IAA = IA
089            JAA = JA
090            MI = M
091            NI = N
092            ICC = IC
093            JCC = JC
094        ELSE
095            IAA = IA
096            JAA = JA + 1
097            MI = M
098            NI = N - 1
099            ICC = IC
100            JCC = JC + 1
101        END IF
102  
103        IF( APPLYQ ) THEN
104            CALL CHK1MAT( N , 5 , K , 6 , IA , JA , DESCA , 10 , INFO )
105        ELSE
106            CALL CHK1MAT( K , 6 , N , 5 , IA , JA , DESCA , 10 , INFO )
107        END IF
108        END IF
109        CALL CHK1MAT( M , 4 , N , 5 , IC , JC , DESCC , 15 , INFO )
110  
111        IF( INFO.EQ.0 ) THEN
112            IROFFA = MOD( IAA - 1 , DESCA( MB_ ) )
113            ICOFFA = MOD( JAA - 1 , DESCA( NB_ ) )
114            IROFFC = MOD( ICC - 1 , DESCC( MB_ ) )
115            ICOFFC = MOD( JCC - 1 , DESCC( NB_ ) )
116            IACOL = INDXG2P( JAA , DESCA( NB_ ) , MYCOL , DESCA( CSRC_ ) ,
117       $    NPCOL )
118            IAROW = INDXG2P( IAA , DESCA( MB_ ) , MYROW , DESCA( RSRC_ ) ,
119       $    NPROW )
120            ICROW = INDXG2P( ICC , DESCC( MB_ ) , MYROW , DESCC( RSRC_ ) ,
121       $    NPROW )
122            ICCOL = INDXG2P( JCC , DESCC( NB_ ) , MYCOL , DESCC( CSRC_ ) ,
123       $    NPCOL )
124            MPC0 = NUMROC( MI + IROFFC , DESCC( MB_ ) , MYROW , ICROW ,
125       $    NPROW )
126            NQC0 = NUMROC( NI + ICOFFC , DESCC( NB_ ) , MYCOL , ICCOL ,
127       $    NPCOL )
128  
129            IF( APPLYQ ) THEN
130                IF( LEFT ) THEN
131                    LWMIN = MAX(( DESCA( NB_ ) * ( DESCA( NB_ ) - 1 ) )
132       $            / 2 ,( MPC0 + NQC0 ) * DESCA( NB_ ) ) +
133       $            DESCA( NB_ ) * DESCA( NB_ )
134                ELSE
135                    NPA0 = NUMROC( NI + IROFFA , DESCA( MB_ ) , MYROW , IAROW ,
136       $            NPROW )
137                    LCM = ILCM( NPROW , NPCOL )
138                    LCMQ = LCM / NPCOL
139                    LWMIN = MAX(( DESCA( NB_ ) * ( DESCA( NB_ ) - 1 ) )
140       $            / 2 ,( NQC0 + MAX( NPA0 + NUMROC( NUMROC(
141       $            NI + ICOFFC , DESCA( NB_ ) , 0 , 0 , NPCOL ) ,
142       $            DESCA( NB_ ) , 0 , 0 , LCMQ ) , MPC0 ) ) *
143       $            DESCA( NB_ ) ) + DESCA( NB_ ) * DESCA( NB_ )
144                END IF
145            ELSE
146  
147                IF( LEFT ) THEN
148                    MQA0 = NUMROC( MI + ICOFFA , DESCA( NB_ ) , MYCOL , IACOL ,
149       $            NPCOL )
150                    LCM = ILCM( NPROW , NPCOL )
151                    LCMP = LCM / NPROW
152                    LWMIN = MAX(( DESCA( MB_ ) * ( DESCA( MB_ ) - 1 ) )
153       $            / 2 ,( MPC0 + MAX( MQA0 + NUMROC( NUMROC(
154       $            MI + IROFFC , DESCA( MB_ ) , 0 , 0 , NPROW ) ,
155       $            DESCA( MB_ ) , 0 , 0 , LCMP ) , NQC0 ) ) *
156       $            DESCA( MB_ ) ) + DESCA( MB_ ) * DESCA( MB_ )
157                ELSE
158                    LWMIN = MAX(( DESCA( MB_ ) * ( DESCA( MB_ ) - 1 ) )
159       $            / 2 ,( MPC0 + NQC0 ) * DESCA( MB_ ) ) +
160       $            DESCA( MB_ ) * DESCA( MB_ )
161                END IF
162  
163            END IF
164  
165            WORK( 1 ) = DBLE( LWMIN )
166            LQUERY =( LWORK.EQ. - 1 )
167            IF( .NOT.APPLYQ .AND. .NOT.LSAME( VECT , 'P' ) ) THEN
168                INFO = - 1
169            ELSE IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE , 'R' ) ) THEN
170                INFO = - 2
171            ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS , 'T' ) ) THEN
172                INFO = - 3
173            ELSE IF( K.LT.0 ) THEN
174                INFO = - 6
175            ELSE IF( APPLYQ .AND. .NOT.LEFT .AND.
176       $        DESCA( MB_ ).NE.DESCC( NB_ ) ) THEN
177                INFO = - (1000 + NB_)
178            ELSE IF( APPLYQ .AND. LEFT .AND. IROFFA.NE.IROFFC ) THEN
179                INFO = - 13
180            ELSE IF( APPLYQ .AND. LEFT .AND. IAROW.NE.ICROW ) THEN
181                INFO = - 13
182            ELSE IF( .NOT.APPLYQ .AND. LEFT .AND.
183       $        ICOFFA.NE.IROFFC ) THEN
184                INFO = - 13
185            ELSE IF( .NOT.APPLYQ .AND. .NOT.LEFT .AND.
186       $        IACOL.NE.ICCOL ) THEN
187                INFO = - 14
188            ELSE IF( APPLYQ .AND. .NOT.LEFT .AND.
189       $        IROFFA.NE.ICOFFC ) THEN
190                INFO = - 14
191            ELSE IF( .NOT.APPLYQ .AND. .NOT.LEFT .AND.
192       $        ICOFFA.NE.ICOFFC ) THEN
193                INFO = - 14
194            ELSE IF( APPLYQ .AND. LEFT .AND.
195       $        DESCA( MB_ ).NE.DESCC( MB_ ) ) THEN
196                INFO = - (1500 + MB_)
197            ELSE IF( .NOT.APPLYQ .AND. LEFT .AND.
198       $        DESCA( MB_ ).NE.DESCC( MB_ ) ) THEN
199                INFO = - (1500 + MB_)
200            ELSE IF( APPLYQ .AND. .NOT.LEFT .AND.
201       $        DESCA( MB_ ).NE.DESCC( NB_ ) ) THEN
202                INFO = - (1500 + NB_)
203            ELSE IF( .NOT.APPLYQ .AND. .NOT.LEFT .AND.
204       $        DESCA( NB_ ).NE.DESCC( NB_ ) ) THEN
205                INFO = - (1500 + NB_)
206            ELSE IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
207                INFO = - 17
208            END IF
209        END IF
210  
211        IF( APPLYQ ) THEN
212            IDUM1( 1 ) = ICHAR( 'Q' )
213        ELSE
214            IDUM1( 1 ) = ICHAR( 'P' )
215        END IF
216        IDUM2( 1 ) = 1
217        IF( LEFT ) THEN
218            IDUM1( 2 ) = ICHAR( 'L' )
219        ELSE
220            IDUM1( 2 ) = ICHAR( 'R' )
221        END IF
222        IDUM2( 2 ) = 2
223        IF( NOTRAN ) THEN
224            IDUM1( 3 ) = ICHAR( 'N' )
225        ELSE
226            IDUM1( 3 ) = ICHAR( 'T' )
227        END IF
228        IDUM2( 3 ) = 3
229        IDUM1( 4 ) = K
230        IDUM2( 4 ) = 6
231        IF( LWORK.EQ. - 1 ) THEN
232            IDUM1( 5 ) = - 1
233        ELSE
234            IDUM1( 5 ) = 1
235        END IF
236        IDUM2( 5 ) = 17
237        IF( APPLYQ ) THEN
238            IF( LEFT ) THEN
239                CALL PCHK2MAT( M , 4 , K , 6 , IA , JA , DESCA , 10 , M , 4 , N ,
240       $        5 , IC , JC , DESCC , 15 , 5 , IDUM1 , IDUM2 ,
241       $        INFO )
242            ELSE
243                CALL PCHK2MAT( N , 5 , K , 6 , IA , JA , DESCA , 10 , M , 4 , N ,
244       $        5 , IC , JC , DESCC , 15 , 5 , IDUM1 , IDUM2 ,
245       $        INFO )
246            END IF
247        ELSE
248            IF( LEFT ) THEN
249                CALL PCHK2MAT( K , 6 , M , 4 , IA , JA , DESCA , 10 , M , 4 , N ,
250       $        5 , IC , JC , DESCC , 15 , 5 , IDUM1 , IDUM2 ,
251       $        INFO )
252            ELSE
253                CALL PCHK2MAT( K , 6 , N , 5 , IA , JA , DESCA , 10 , M , 4 , N ,
254       $        5 , IC , JC , DESCC , 15 , 5 , IDUM1 , IDUM2 ,
255       $        INFO )
256            END IF
257        END IF
258        END IF
259  
260        IF( INFO.NE.0 ) THEN
261            CALL PXERBLA( ICTXT , 'PDORMBR' , - INFO )
262            RETURN
263        ELSE IF( LQUERY ) THEN
264            RETURN
265        END IF
266  
267  *     Quick return if possible
268  
269        IF( M.EQ.0 .OR. N.EQ.0 )
270       $    RETURN
271  
272            IF( APPLYQ ) THEN
273  
274  *             Apply Q
275  
276                IF( NQ.GE.K ) THEN
277  
278  *                 Q was determined by a call to PDGEBRD with nq >= k
279  
280                    CALL PDORMQR ( SIDE , TRANS , M , N , K , A , IA , JA , DESCA , TAU ,
281       $            C , IC , JC , DESCC , WORK , LWORK , IINFO )
282                ELSE IF( NQ.GT.1 ) THEN
283  
284  *                 Q was determined by a call to PDGEBRD with nq < k
285  
286                    CALL PDORMQR ( SIDE , TRANS , MI , NI , NQ - 1 , A , IA + 1 , JA , DESCA ,
287       $            TAU , C , ICC , JCC , DESCC , WORK , LWORK , IINFO )
288                END IF
289            ELSE
290  
291  *             Apply P
292  
293                IF( NOTRAN ) THEN
294                    TRANST = 'T'
295                ELSE
296                    TRANST = 'N'
297                END IF
298                IF( NQ.GT.K ) THEN
299  
300  *                 P was determined by a call to PDGEBRD with nq > k
301  
302                    CALL PDORMLQ ( SIDE , TRANST , M , N , K , A , IA , JA , DESCA , TAU ,
303       $            C , IC , JC , DESCC , WORK , LWORK , IINFO )
304                ELSE IF( NQ.GT.1 ) THEN
305  
306  *                 P was determined by a call to PDGEBRD with nq <= k
307  
308                    CALL PDORMLQ ( SIDE , TRANST , MI , NI , NQ - 1 , A , IA , JA + 1 ,
309       $            DESCA , TAU , C , ICC , JCC , DESCC , WORK , LWORK ,
310       $            IINFO )
311                END IF
312            END IF
313  
314            WORK( 1 ) = DBLE( LWMIN )
315  
316            RETURN
317  
318  *         End of PDORMBR
319  
320        END