      PROGRAM sample_psgbsv_call
*
*  -- ScaLAPACK example code --
*
*     Written by Xiaoye S. Li, 6-4-97 (xiaoye@nersc.gov)
*
*     This program shows how to set the matrix descriptors and call
*     the general band linear equation solver PSGBSV.
*
*     To run the program, type the following command:
*        mpprun -n 2 sample_psgbsv_call
*     ..
*     .. Data layout ..
* 
*     8 x 8 matrix A is partitioned into 1 x 2 blocks, each of size 8 x 4.
*     The 2 processes are arranged as 1 x 2 process grid.
*     The 1-dimensional block-column distribution gives the following mapping 
*     between process grid and the global matrix.
*
*                P0    |   P1
*            ---------------------
*            [4 1  1   |         ]    bwl = 1  lower bandwidth
*            [1 4  1 1 |         ]    BWU = 2  upper bandwidth
*            [  1  4 1 |1        ]
*            [     1 4 |1 1      ]
*            [       1 |4 1  1   ]
*            [         |1 4  1 1 ]
*            [         |  1  4 1 ]
*            [         |     1 4 ]
*            ---------------------
*     
*     Mapping of the local arrays (in compact storage) is given below.
*     "F" is a position for potential fill-in due to partial pivoting.
*
*                P0    |   P1
*            ---------------------
*            [F F  F F |F F  F F ]
*            [F F  F F |F F  F F ]    Number of rows = 2*(bwl+bwu)+1
*            [F F  F F |F F  F F ]
*            [* *  1 1 |1 1  1 1 ]
*            [* 1  1 1 |1 1  1 1 ]
*            [4 4  4 4 |4 4  4 4 ]
*            [1 1  1 1 |1 1  1 * ]
*            ---------------------
*
*     For a complete description of the compact storage schemes for band
*     matrices, refer to ScaLAPACK Users' Guide Section 4.4 "In-Core Narrow
*     Band and Tridiagonal Matrices".
*
*     The RHS B is a vector of all 1's. The correct solution vector is 
*
*            0.18092206366630079
*            0.13145993413830953
*            0.14485181119648735
*            0.14838638858397366
*            0.14074643249176727
*            0.12085620197585072
*            0.16777167947310648
*            0.20805708013172339
*
*
      implicit none
*     ..
*     .. Parameters ..
* Entries associated with the distributed array descriptors
      INTEGER            BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_,
     $                   LLD_, MB_, M_, NB_, N_, RSRC_
      PARAMETER          ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1,
     $                     CTXT_ = 2, M_ = 3, N_ = 4, MB_ = 5, NB_ = 6,
     $                     RSRC_ = 7, CSRC_ = 8, LLD_ = 9 )
*
      real   ONE, ZERO
      PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
      integer LWORK
      PARAMETER          ( LWORK = 2000 )
*     ..
*     .. Local Scalars ..
      INTEGER            IAM, ICTXT, INFO, MYCOL, MYROW, M, N, NB, NRHS,
     $                   MYRHS_SIZE, NPCOL, NPROCS, NPROW,
     $                   bwl, bwu, lda, i
*     ..
*     .. Local Arrays ..
      INTEGER            DESCA( 7 ), DESCB( 7 ), ipiv(8)
      REAL               A(200), B(200), WORK(LWORK)
*     ..
*     .. External Subroutines ..
      EXTERNAL           BLACS_EXIT, BLACS_GET, BLACS_GRIDEXIT,
     $                   BLACS_GRIDINFO, BLACS_GRIDINIT, BLACS_PINFO,
     $                   DESCINIT, PSGBSV
*     ..
*     .. External Functions ..
      INTEGER            NUMROC
      EXTERNAL           NUMROC
*     ..
*     .. Executable Statements ..
*
*     Get starting information
*
      CALL BLACS_PINFO( IAM, NPROCS )
      M = 8
      N = M
      bwl = 1
      bwu = 2
      NB = 4
      nrhs = 1
      NPROW = 1
      NPCOL = 2
*
*     Define process grid
*
      CALL BLACS_GET( -1, 0, ICTXT )
      CALL BLACS_GRIDINIT( ICTXT, 'Row-major', NPROW, NPCOL )
*
*     Go to bottom of process grid loop if this case doesn't use my
*     process
      CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL )
      IF( MYROW.LT.0 .OR. MYCOL.LT.0 ) THEN
         GO TO 50
      ENDIF
*
*
*     Initialize Array Descriptor for matrix A
*
      DESCA( 1 ) = 501
      DESCA( 2 ) = ICTXT
      DESCA( 3 ) = N
      DESCA( 4 ) = NB
      DESCA( 5 ) = 0
      DESCA( 6 ) = 2*(bwl+bwu)+1
      DESCA( 7 ) = 0
*
*     Initialize Array Descriptor for rhs
*     
      DESCB( 1 ) = 502
      DESCB( 2 ) = ICTXT
      DESCB( 3 ) = N
      DESCB( 4 ) = NB
      DESCB( 5 ) = 0
      DESCB( 6 ) = NB
      DESCB( 7 ) = 0
*
*     Generate matrix A
*
      lda = 2*(bwl+bwu)+1
      if ( iam .eq. 0 ) then
         A(6) = 4
         A(7) = 1
         A(5 + lda) = 1
         A(6 + lda) = 4
         A(7 + lda) = 1
         A(4 + 2*lda) = 1
         A(5 + 2*lda) = 1
         A(6 + 2*lda) = 4
         A(7 + 2*lda) = 1
         A(4 + 3*lda) = 1
         A(5 + 3*lda) = 1
         A(6 + 3*lda) = 4
         A(7 + 3*lda) = 1
      endif
      if ( iam .eq. 1 ) then
         A(4) = 1
         A(5) = 1
         A(6) = 4
         A(7) = 1
         A(4 + lda) = 1
         A(5 + lda) = 1
         A(6 + lda) = 4
         A(7 + lda) = 1
         A(4 + 2*lda) = 1
         A(5 + 2*lda) = 1
         A(6 + 2*lda) = 4
         A(7 + 2*lda) = 1
         A(4 + 3*lda) = 1
         A(5 + 3*lda) = 1
         A(6 + 3*lda) = 4
      endif
*
*     Generate RHS
*
      MYRHS_SIZE = NUMROC( N, NB, MYCOL, 0, NPCOL )
      do i = 1, myrhs_size
         B(i) = 1
      enddo
*
*     Solve the linear system
*
      CALL PSGBSV( N, BWL, BWU, NRHS, A, 1, DESCA, IPIV, B, 1,
     $             DESCB, WORK, LWORK, INFO )
*
*     Print the solution vector
*
      print *,'IAM = ',IAM
      IF( IAM.EQ.0 ) THEN
         print*, (B(i), i=1,MYRHS_SIZE)
      END IF
      CALL BLACS_BARRIER( ICTXT, 'All' )
      IF( IAM.EQ.1 ) THEN
         print*, (B(i), i=1,MYRHS_SIZE)
      END IF
*
      CALL BLACS_GRIDEXIT( ICTXT )
*
 50   continue
*
      CALL BLACS_EXIT( 0 )
*
      STOP
*
*     End of sample_psgbsv_call
*
      END
