Routine: PCDBTRS()  File: SRC\pcdbtrs.f

 
 
# lines: 764
  # code: 764
  # comment: 0
  # blank:0
# Variables:56
# Callers:1
# Callings:1
# Words:238
# Keywords:139
 

 

..
     .. Array Arguments ..
     ..
  Purpose
  =======
  PCDBTRS solves a system of linear equations
            A(1:N, JA:JA+N-1) * X = B(IB:IB+N-1, 1:NRHS)
                                    or
            A(1:N, JA:JA+N-1)' * X = B(IB:IB+N-1, 1:NRHS)
  where A(1:N, JA:JA+N-1) is the matrix used to produce the factors
  stored in A(1:N,JA:JA+N-1) and AF by PCDBTRF.
  A(1:N, JA:JA+N-1) is an N-by-N complex
  banded diagonally dominant-like distributed
  matrix with bandwidth BWL, BWU.
  Routine PCDBTRF MUST be called first.
  =====================================================================
  Arguments
  =========
  TRANS   (global input) CHARACTER
          = 'N':  Solve with A(1:N, JA:JA+N-1);
          = 'C':  Solve with conjugate_transpose( A(1:N, JA:JA+N-1) );
  N       (global input) INTEGER
          The number of rows and columns to be operated on, i.e. the
          order of the distributed submatrix A(1:N, JA:JA+N-1). N >= 0.
  BWL     (global input) INTEGER
          Number of subdiagonals. 0 <= BWL <= N-1
  BWU     (global input) INTEGER
          Number of superdiagonals. 0 <= BWU <= N-1
  NRHS    (global input) INTEGER
          The number of right hand sides, i.e., the number of columns
          of the distributed submatrix B(IB:IB+N-1, 1:NRHS).
          NRHS >= 0.
  A       (local input/local output) COMPLEX pointer into
          local memory to an array with first dimension
          LLD_A >=(bwl+bwu+1) (stored in DESCA).
          On entry, this array contains the local pieces of the
          N-by-N unsymmetric banded distributed Cholesky factor L or
          L^T A(1:N, JA:JA+N-1).
          This local portion is stored in the packed banded format
            used in LAPACK. Please see the Notes below and the
            ScaLAPACK manual for more detail on the format of
            distributed matrices.
  JA      (global input) INTEGER
          The index in the global array A that points to the start of
          the matrix to be operated on (which may be either all of A
          or a submatrix of A).
  DESCA   (global and local input) INTEGER array of dimension DLEN.
          if 1D type (DTYPE_A=501), DLEN >= 7;
          if 2D type (DTYPE_A=1), DLEN >= 9 .
          The array descriptor for the distributed matrix A.
          Contains information of mapping of A to memory. Please
          see NOTES below for full description and options.
  B       (local input/local output) COMPLEX pointer into
          local memory to an array of local lead dimension lld_b>=NB.
          On entry, this array contains the
          the local pieces of the right hand sides
          B(IB:IB+N-1, 1:NRHS).
          On exit, this contains the local piece of the solutions
          distributed matrix X.
  IB      (global input) INTEGER
          The row index in the global array B that points to the first
          row of the matrix to be operated on (which may be either
          all of B or a submatrix of B).
  DESCB   (global and local input) INTEGER array of dimension DLEN.
          if 1D type (DTYPE_B=502), DLEN >=7;
          if 2D type (DTYPE_B=1), DLEN >= 9.
          The array descriptor for the distributed matrix B.
          Contains information of mapping of B to memory. Please
          see NOTES below for full description and options.
  AF      (local output) COMPLEX array, dimension LAF.
          Auxiliary Fillin Space.
          Fillin is created during the factorization routine
          PCDBTRF and this is stored in AF. If a linear system
          is to be solved using PCDBTRS after the factorization
          routine, AF *must not be altered* after the factorization.
  LAF     (local input) INTEGER
          Size of user-input Auxiliary Fillin space AF. Must be >=
          NB*(bwl+bwu)+6*max(bwl,bwu)*max(bwl,bwu)
          If LAF is not large enough, an error code will be returned
          and the minimum acceptable size will be returned in AF( 1 )
  WORK    (local workspace/local output)
          COMPLEX temporary workspace. This space may
          be overwritten in between calls to routines. WORK must be
          the size given in LWORK.
          On exit, WORK( 1 ) contains the minimal LWORK.
  LWORK   (local input or global input) INTEGER
          Size of user-input workspace WORK.
          If LWORK is too small, the minimal acceptable size will be
          returned in WORK(1) and an error code is returned. LWORK>=
          (max(bwl,bwu)*NRHS)
  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.
  =====================================================================
  Restrictions
  ============
  The following are restrictions on the input parameters. Some of these
    are temporary and will be removed in future releases, while others
    may reflect fundamental technical limitations.
    Non-cyclic restriction: VERY IMPORTANT!
      P*NB>= mod(JA-1,NB)+N.
      The mapping for matrices must be blocked, reflecting the nature
      of the divide and conquer algorithm as a task-parallel algorithm.
      This formula in words is: no processor may have more than one
      chunk of the matrix.
    Blocksize cannot be too small:
      If the matrix spans more than one processor, the following
      restriction on NB, the size of each block on each processor,
      must hold:
      NB >= 2*MAX(BWL,BWU)
      The bulk of parallel computation is done on the matrix of size
      O(NB) on each processor. If this is too small, divide and conquer
      is a poor choice of algorithm.
    Submatrix reference:
      JA = IB
      Alignment restriction that prevents unnecessary communication.
  =====================================================================
  Notes
  =====
  If the factorization routine and the solve routine are to be called
    separately (to solve various sets of righthand sides using the same
    coefficient matrix), the auxiliary space AF *must not be altered*
    between calls to the factorization routine and the solve routine.
  The best algorithm for solving banded and tridiagonal linear systems
    depends on a variety of parameters, especially the bandwidth.
    Currently, only algorithms designed for the case N/P >> bw are
    implemented. These go by many names, including Divide and Conquer,
    Partitioning, domain decomposition-type, etc.
  Algorithm description: Divide and Conquer
    The Divide and Conqer algorithm assumes the matrix is narrowly
      banded compared with the number of equations. In this situation,
      it is best to distribute the input matrix A one-dimensionally,
      with columns atomic and rows divided amongst the processes.
      The basic algorithm divides the banded matrix up into
      P pieces with one stored on each processor,
      and then proceeds in 2 phases for the factorization or 3 for the
      solution of a linear system.
      1) Local Phase:
         The individual pieces are factored independently and in
         parallel. These factors are applied to the matrix creating
         fillin, which is stored in a non-inspectable way in auxiliary
         space AF. Mathematically, this is equivalent to reordering
         the matrix A as P A P^T and then factoring the principal
         leading submatrix of size equal to the sum of the sizes of
         the matrices factored on each processor. The factors of
         these submatrices overwrite the corresponding parts of A
         in memory.
      2) Reduced System Phase:
         A small (max(bwl,bwu)* (P-1)) system is formed representing
         interaction of the larger blocks, and is stored (as are its
         factors) in the space AF. A parallel Block Cyclic Reduction
         algorithm is used. For a linear system, a parallel front solve
         followed by an analagous backsolve, both using the structure
         of the factored matrix, are performed.
      3) Backsubsitution Phase:
         For a linear system, a local backsubstitution is performed on
         each processor in parallel.
  Descriptors
  ===========
  Descriptors now have *types* and differ from ScaLAPACK 1.0.
  Note: banded codes can use either the old two dimensional
    or new one-dimensional descriptors, though the processor grid in
    both cases *must be one-dimensional*. We describe both types below.
  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
  One-dimensional descriptors:
  One-dimensional descriptors are a new addition to ScaLAPACK since
    version 1.0. They simplify and shorten the descriptor for 1D
    arrays.
  Since ScaLAPACK supports two-dimensional arrays as the fundamental
    object, we allow 1D arrays to be distributed either over the
    first dimension of the array (as if the grid were P-by-1) or the
    2nd dimension (as if the grid were 1-by-P). This choice is
    indicated by the descriptor type (501 or 502)
    as described below.
    IMPORTANT NOTE: the actual BLACS grid represented by the
    CTXT entry in the descriptor may be *either*  P-by-1 or 1-by-P
    irrespective of which one-dimensional descriptor type
    (501 or 502) is input.
    This routine will interpret the grid properly either way.
    ScaLAPACK routines *do not support intercontext operations* so that
    the grid passed to a single ScaLAPACK routine *must be the same*
    for all array descriptors passed to that routine.
    NOTE: In all cases where 1D descriptors are used, 2D descriptors
    may also be used, since a one-dimensional array is a special case
    of a two-dimensional array with one dimension of size unity.
    The two-dimensional array used in this case *must* be of the
    proper orientation:
      If the appropriate one-dimensional descriptor is DTYPEA=501
      (1 by P type), then the two dimensional descriptor must
      have a CTXT value that refers to a 1 by P BLACS grid;
      If the appropriate one-dimensional descriptor is DTYPEA=502
      (P by 1 type), then the two dimensional descriptor must
      have a CTXT value that refers to a P by 1 BLACS grid.
  Summary of allowed descriptors, types, and BLACS grids:
  DTYPE           501         502         1         1
  BLACS grid      1xP or Px1  1xP or Px1  1xP       Px1
  -----------------------------------------------------
  A               OK          NO          OK        NO
  B               NO          OK          NO        OK
  Note that a consequence of this chart is that it is not possible
    for *both* DTYPE_A and DTYPE_B to be 2D_type(1), as these lead
    to opposite requirements for the orientation of the BLACS grid,
    and as noted before, the *same* BLACS context must be used in
    all descriptors in a single ScaLAPACK subroutine call.
  Let A be a generic term for any 1D 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( 1 ) The descriptor type. For 1D grids,
                                TYPE_A = 501: 1-by-P grid.
                                TYPE_A = 502: P-by-1 grid.
  CTXT_A (global) DESCA( 2 ) 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.
  N_A    (global) DESCA( 3 ) The size of the array dimension being
                                distributed.
  NB_A   (global) DESCA( 4 ) The blocking factor used to distribute
                                the distributed dimension of the array.
  SRC_A  (global) DESCA( 5 ) The process row or column over which the
                                first row or column of the array
                                is distributed.
  LLD_A  (local)  DESCA( 6 ) The leading dimension of the local array
                                storing the local blocks of the distri-
                                buted array A. Minimum value of LLD_A
                                depends on TYPE_A.
                                TYPE_A = 501: LLD_A >=
                                   size of undistributed dimension, 1.
                                TYPE_A = 502: LLD_A >=NB_A, 1.
  Reserved        DESCA( 7 ) Reserved for future use.
  =====================================================================
  Code Developer: Andrew J. Cleary, University of Tennessee.
    Current address: Lawrence Livermore National Labs.
  This version released: August, 2001.
  =====================================================================
     ..
     .. Parameters ..

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

 
001        SUBROUTINE PCDBTRS( TRANS , N , BWL , BWU , NRHS , A , JA , DESCA , B , IB ,
002       $DESCB , AF , LAF , 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  *     August 7 , 2001
008  
009  *     .. Scalar Arguments ..
010        CHARACTER TRANS
011        INTEGER BWL , BWU , IB , INFO , JA , LAF , LWORK , N , NRHS
012        REAL ONE , ZERO
013        PARAMETER( ONE = 1.0E + 0 )
014        PARAMETER( ZERO = 0.0E + 0 )
015        COMPLEX CONE , CZERO
016        PARAMETER( CONE =( 1.0E + 0 , 0.0E + 0 ) )
017        PARAMETER( CZERO =( 0.0E + 0 , 0.0E + 0 ) )
018        INTEGER INT_ONE
019        PARAMETER( INT_ONE = 1 )
020        INTEGER DESCMULT , BIGNUM
021        PARAMETER(DESCMULT = 100 , BIGNUM = DESCMULT * DESCMULT)
022        INTEGER BLOCK_CYCLIC_2D , CSRC_ , CTXT_ , DLEN_ , DTYPE_ ,
023       $LLD_ , MB_ , M_ , NB_ , N_ , RSRC_
024        PARAMETER( BLOCK_CYCLIC_2D = 1 , DLEN_ = 9 , DTYPE_ = 1 ,
025       $CTXT_ = 2 , M_ = 3 , N_ = 4 , MB_ = 5 , NB_ = 6 ,
026       $RSRC_ = 7 , CSRC_ = 8 , LLD_ = 9 )
027  *     ..
028  *     .. Local Scalars ..
029        INTEGER CSRC , FIRST_PROC , ICTXT , ICTXT_NEW , ICTXT_SAVE ,
030       $IDUM2 , IDUM3 , JA_NEW , LLDA , LLDB , MYCOL , MYROW ,
031       $NB , NP , NPCOL , NPROW , NP_SAVE , PART_OFFSET ,
032       $RETURN_CODE , STORE_M_B , STORE_N_A ,
033       $WORK_SIZE_MIN
034  *     ..
035  *     .. Local Arrays ..
036        INTEGER DESCA_1XP( 7 ) , DESCB_PX1( 7 ) ,
037       $PARAM_CHECK( 17 , 3 )
038  *     ..
039  *     .. External Subroutines ..
040        EXTERNAL BLACS_GRIDINFO , DESC_CONVERT , GLOBCHK ,
041       $PCDBTRSV , PXERBLA , RESHAPE
042  *     ..
043  *     .. External Functions ..
044        LOGICAL LSAME
045        INTEGER NUMROC
046        EXTERNAL LSAME , NUMROC
047  *     ..
048  *     .. Intrinsic Functions ..
049        INTRINSIC ICHAR , MIN , MOD
050  *     ..
051  *     .. Executable Statements ..
052  
053  *     Test the input parameters
054  
055        INFO = 0
056  
057  *     Convert descriptor into standard form for easy access to
058  *     parameters , check that grid is of right shape.
059  
060        DESCA_1XP( 1 ) = 501
061        DESCB_PX1( 1 ) = 502
062  
063        CALL DESC_CONVERT( DESCA , DESCA_1XP , RETURN_CODE )
064  
065        IF( RETURN_CODE .NE. 0) THEN
066            INFO = - ( 8*100 + 2 )
067        ENDIF
068  
069        CALL DESC_CONVERT( DESCB , DESCB_PX1 , RETURN_CODE )
070  
071        IF( RETURN_CODE .NE. 0) THEN
072            INFO = - ( 11*100 + 2 )
073        ENDIF
074  
075  *     Consistency checks for DESCA and DESCB.
076  
077  *     Context must be the same
078        IF( DESCA_1XP( 2 ) .NE. DESCB_PX1( 2 ) ) THEN
079            INFO = - ( 11*100 + 2 )
080        ENDIF
081  
082  *     These are alignment restrictions that may or may not be removed
083  *     in future releases. - Andy Cleary , April 14 , 1996.
084  
085  *     Block sizes must be the same
086        IF( DESCA_1XP( 4 ) .NE. DESCB_PX1( 4 ) ) THEN
087            INFO = - ( 11*100 + 4 )
088        ENDIF
089  
090  *     Source processor must be the same
091  
092        IF( DESCA_1XP( 5 ) .NE. DESCB_PX1( 5 ) ) THEN
093            INFO = - ( 11*100 + 5 )
094        ENDIF
095  
096  *     Get values out of descriptor for use in code.
097  
098        ICTXT = DESCA_1XP( 2 )
099        CSRC = DESCA_1XP( 5 )
100        NB = DESCA_1XP( 4 )
101        LLDA = DESCA_1XP( 6 )
102        STORE_N_A = DESCA_1XP( 3 )
103        LLDB = DESCB_PX1( 6 )
104        STORE_M_B = DESCB_PX1( 3 )
105  
106  *     Get grid parameters
107  
108        CALL BLACS_GRIDINFO( ICTXT , NPROW , NPCOL , MYROW , MYCOL )
109        NP = NPROW * NPCOL
110  
111        IF( LSAME( TRANS , 'N' ) ) THEN
112            IDUM2 = ICHAR( 'N' )
113        ELSE IF( LSAME( TRANS , 'C' ) ) THEN
114            IDUM2 = ICHAR( 'C' )
115        ELSE
116            INFO = - 1
117        END IF
118  
119        IF( LWORK .LT. - 1) THEN
120            INFO = - 15
121        ELSE IF( LWORK .EQ. - 1 ) THEN
122            IDUM3 = - 1
123        ELSE
124            IDUM3 = 1
125        ENDIF
126  
127        IF( N .LT. 0 ) THEN
128            INFO = - 2
129        ENDIF
130  
131        IF( N + JA - 1 .GT. STORE_N_A ) THEN
132            INFO = - ( 8*100 + 6 )
133        ENDIF
134  
135        IF(( BWL .GT. N - 1 ) .OR.
136       $( BWL .LT. 0 ) ) THEN
137        INFO = - 3
138        ENDIF
139  
140        IF(( BWU .GT. N - 1 ) .OR.
141       $( BWU .LT. 0 ) ) THEN
142        INFO = - 4
143        ENDIF
144  
145        IF( LLDA .LT.(BWL + BWU + 1) ) THEN
146            INFO = - ( 8*100 + 6 )
147        ENDIF
148  
149        IF( NB .LE. 0 ) THEN
150            INFO = - ( 8*100 + 4 )
151        ENDIF
152  
153        IF( N + IB - 1 .GT. STORE_M_B ) THEN
154            INFO = - ( 11*100 + 3 )
155        ENDIF
156  
157        IF( LLDB .LT. NB ) THEN
158            INFO = - ( 11*100 + 6 )
159        ENDIF
160  
161        IF( NRHS .LT. 0 ) THEN
162            INFO = - 5
163        ENDIF
164  
165  *     Current alignment restriction
166  
167        IF( JA .NE. IB) THEN
168            INFO = - 7
169        ENDIF
170  
171  *     Argument checking that is specific to Divide & Conquer routine
172  
173        IF( NPROW .NE. 1 ) THEN
174            INFO = - ( 8*100 + 2 )
175        ENDIF
176  
177        IF( N .GT. NP*NB - MOD( JA - 1 , NB )) THEN
178            INFO = - ( 2 )
179            CALL PXERBLA( ICTXT ,
180       $    'PCDBTRS , D&C alg. : only 1 block per proc' ,
181       $    - INFO )
182            RETURN
183        ENDIF
184  
185        IF((JA + N - 1.GT.NB) .AND.( NB.LT.2*MAX(BWL , BWU) )) THEN
186            INFO = - ( 8*100 + 4 )
187            CALL PXERBLA( ICTXT ,
188       $    'PCDBTRS , D&C alg. : NB too small' ,
189       $    - INFO )
190            RETURN
191        ENDIF
192  
193        WORK_SIZE_MIN =
194       $(MAX(BWL , BWU)*NRHS)
195  
196        WORK( 1 ) = WORK_SIZE_MIN
197  
198        IF( LWORK .LT. WORK_SIZE_MIN ) THEN
199            IF( LWORK .NE. - 1 ) THEN
200                INFO = - 15
201                CALL PXERBLA( ICTXT ,
202       $        'PCDBTRS : worksize error' ,
203       $        - INFO )
204            ENDIF
205            RETURN
206        ENDIF
207  
208  *     Pack params and positions into arrays for global consistency check
209  
210        PARAM_CHECK( 17 , 1 ) = DESCB(5)
211        PARAM_CHECK( 16 , 1 ) = DESCB(4)
212        PARAM_CHECK( 15 , 1 ) = DESCB(3)
213        PARAM_CHECK( 14 , 1 ) = DESCB(2)
214        PARAM_CHECK( 13 , 1 ) = DESCB(1)
215        PARAM_CHECK( 12 , 1 ) = IB
216        PARAM_CHECK( 11 , 1 ) = DESCA(5)
217        PARAM_CHECK( 10 , 1 ) = DESCA(4)
218        PARAM_CHECK( 9 , 1 ) = DESCA(3)
219        PARAM_CHECK( 8 , 1 ) = DESCA(1)
220        PARAM_CHECK( 7 , 1 ) = JA
221        PARAM_CHECK( 6 , 1 ) = NRHS
222        PARAM_CHECK( 5 , 1 ) = BWU
223        PARAM_CHECK( 4 , 1 ) = BWL
224        PARAM_CHECK( 3 , 1 ) = N
225        PARAM_CHECK( 2 , 1 ) = IDUM3
226        PARAM_CHECK( 1 , 1 ) = IDUM2
227  
228        PARAM_CHECK( 17 , 2 ) = 1105
229        PARAM_CHECK( 16 , 2 ) = 1104
230        PARAM_CHECK( 15 , 2 ) = 1103
231        PARAM_CHECK( 14 , 2 ) = 1102
232        PARAM_CHECK( 13 , 2 ) = 1101
233        PARAM_CHECK( 12 , 2 ) = 10
234        PARAM_CHECK( 11 , 2 ) = 805
235        PARAM_CHECK( 10 , 2 ) = 804
236        PARAM_CHECK( 9 , 2 ) = 803
237        PARAM_CHECK( 8 , 2 ) = 801
238        PARAM_CHECK( 7 , 2 ) = 7
239        PARAM_CHECK( 6 , 2 ) = 5
240        PARAM_CHECK( 5 , 2 ) = 4
241        PARAM_CHECK( 4 , 2 ) = 3
242        PARAM_CHECK( 3 , 2 ) = 2
243        PARAM_CHECK( 2 , 2 ) = 15
244        PARAM_CHECK( 1 , 2 ) = 1
245  
246  *     Want to find errors with MIN( ) , so if no error , set it to a big
247  *     number. If there already is an error , multiply by the the
248  *     descriptor multiplier.
249  
250        IF( INFO.GE.0 ) THEN
251            INFO = BIGNUM
252        ELSE IF( INFO.LT. - DESCMULT ) THEN
253            INFO = - INFO
254        ELSE
255            INFO = - INFO * DESCMULT
256        END IF
257  
258  *     Check consistency across processors
259  
260        CALL GLOBCHK( ICTXT , 17 , PARAM_CHECK , 17 ,
261       $PARAM_CHECK( 1 , 3 ) , INFO )
262  
263  *     Prepare output : set info = 0 if no error , and divide by DESCMULT
264  *     if error is not in a descriptor entry.
265  
266        IF( INFO.EQ.BIGNUM ) THEN
267            INFO = 0
268        ELSE IF( MOD( INFO , DESCMULT ) .EQ. 0 ) THEN
269            INFO = - INFO / DESCMULT
270        ELSE
271            INFO = - INFO
272        END IF
273  
274        IF( INFO.LT.0 ) THEN
275            CALL PXERBLA( ICTXT , 'PCDBTRS' , - INFO )
276            RETURN
277        END IF
278  
279  *     Quick return if possible
280  
281        IF( N.EQ.0 )
282       $    RETURN
283  
284            IF( NRHS.EQ.0 )
285       $        RETURN
286  
287  *             Adjust addressing into matrix space to properly get into
288  *             the beginning part of the relevant data
289  
290                PART_OFFSET = NB*((JA - 1) / (NPCOL*NB) )
291  
292                IF((MYCOL - CSRC) .LT.(JA - PART_OFFSET - 1) / NB ) THEN
293                PART_OFFSET = PART_OFFSET + NB
294            ENDIF
295  
296            IF( MYCOL .LT. CSRC ) THEN
297                PART_OFFSET = PART_OFFSET - NB
298            ENDIF
299  
300  *         Form a new BLACS grid(the "standard form" grid) with only procs
301  *         holding part of the matrix , of size 1xNP where NP is adjusted ,
302  *         starting at csrc = 0 , with JA modified to reflect dropped procs.
303  
304  *         First processor to hold part of the matrix :
305  
306            FIRST_PROC = MOD(( JA - 1 ) / NB + CSRC , NPCOL )
307  
308  *         Calculate new JA one while dropping off unused processors.
309  
310            JA_NEW = MOD( JA - 1 , NB ) + 1
311  
312  *         Save and compute new value of NP
313  
314            NP_SAVE = NP
315            NP =( JA_NEW + N - 2 ) / NB + 1
316  
317  *         Call utility routine that forms "standard-form" grid
318  
319            CALL RESHAPE( ICTXT , INT_ONE , ICTXT_NEW , INT_ONE ,
320       $    FIRST_PROC , INT_ONE , NP )
321  
322  *         Use new context from standard grid as context.
323  
324            ICTXT_SAVE = ICTXT
325            ICTXT = ICTXT_NEW
326            DESCA_1XP( 2 ) = ICTXT_NEW
327            DESCB_PX1( 2 ) = ICTXT_NEW
328  
329  *         Get information about new grid.
330  
331            CALL BLACS_GRIDINFO( ICTXT , NPROW , NPCOL , MYROW , MYCOL )
332  
333  *         Drop out processors that do not have part of the matrix.
334  
335            IF( MYROW .LT. 0 ) THEN
336                GOTO 1234
337            ENDIF
338  
339  *         Begin main code
340  
341            INFO = 0
342  
343  *         Call frontsolve routine
344  
345            IF( LSAME( TRANS , 'N' ) ) THEN
346  
347                CALL PCDBTRSV ( 'L' , 'N' , N , BWL , BWU , NRHS , A( PART_OFFSET + 1 ) ,
348       $        JA_NEW , DESCA_1XP , B , IB , DESCB_PX1 , AF , LAF ,
349       $        WORK , LWORK , INFO )
350  
351            ELSE
352  
353                CALL PCDBTRSV ( 'U' , 'C' , N , BWL , BWU , NRHS , A( PART_OFFSET + 1 ) ,
354       $        JA_NEW , DESCA_1XP , B , IB , DESCB_PX1 , AF , LAF ,
355       $        WORK , LWORK , INFO )
356  
357            ENDIF
358  
359  *         Call backsolve routine
360  
361            IF( LSAME( TRANS , 'C' ) ) THEN
362  
363                CALL PCDBTRSV ( 'L' , 'C' , N , BWL , BWU , NRHS , A( PART_OFFSET + 1 ) ,
364       $        JA_NEW , DESCA_1XP , B , IB , DESCB_PX1 , AF , LAF ,
365       $        WORK , LWORK , INFO )
366  
367            ELSE
368  
369                CALL PCDBTRSV ( 'U' , 'N' , N , BWL , BWU , NRHS , A( PART_OFFSET + 1 ) ,
370       $        JA_NEW , DESCA_1XP , B , IB , DESCB_PX1 , AF , LAF ,
371       $        WORK , LWORK , INFO )
372  
373            ENDIF
374   1000 CONTINUE
375  
376  *     Free BLACS space used to hold standard - form grid.
377  
378        IF( ICTXT_SAVE .NE. ICTXT_NEW ) THEN
379            CALL BLACS_GRIDEXIT( ICTXT_NEW )
380        ENDIF
381  
382   1234 CONTINUE
383  
384  *     Restore saved input parameters
385  
386        ICTXT = ICTXT_SAVE
387        NP = NP_SAVE
388  
389  *     Output minimum worksize
390  
391        WORK( 1 ) = WORK_SIZE_MIN
392  
393        RETURN
394  
395  *     End of PCDBTRS
396  
397        END