pbstrsrt.f

Go to the documentation of this file.

      SUBROUTINE pbstrsrt( ICONTXT, ADIST, M, N, NB, A, LDA, BETA, B,
     $                     LDB, LCMP, LCMQ, NINT )
*
*  -- PB-BLAS routine (version 2.1) --
*     University of Tennessee, Knoxville, Oak Ridge National Laboratory.
*     April 28, 1996
*
*     .. Scalar Arguments ..
      CHARACTER*1        ADIST
      INTEGER            ICONTXT, LCMP, LCMQ, LDA, LDB, M, N, NB, NINT
      REAL               BETA
*     ..
*     .. Array Arguments ..
      REAL               A( LDA, * ), B( LDB, * )
*     ..
*
*  Purpose
*  =======
*
*  PBSTRSRT forms   T <== A + beta * T, where T is a sorted
*  condensed block row (or column) from a block column (or row) of A
*  with sorting index ISRT
*
*  =====================================================================
*
*     .. Parameters ..
      REAL               ONE
      parameter( one = 1.0e+0 )
*     ..
*     .. Local Variables ..
      INTEGER            JA, JB, K, KK, NJUMP
*     ..
*     .. External Subroutines ..
      EXTERNAL           pbsmatadd
*     ..
*     .. External Functions ..
      LOGICAL            LSAME
      INTEGER            ICEIL
      EXTERNAL           iceil, lsame
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          min, mod
*     ..
*     .. Executable Statements ..
*
      IF( lsame( adist, 'R' ) ) THEN
         njump = nb * lcmq
         DO 20 k = 0, lcmq-1
            ja = nint * mod( k*lcmp, lcmq ) + 1
            jb = k * nb + 1
*
            DO 10 kk = 1, iceil( nint, nb )
               IF( n.LT.jb ) GO TO 20
               CALL pbsmatadd( icontxt, 'G', m, min( n-jb+1, nb ), one,
     $                         a(1, ja), lda, beta, b(1, jb), ldb )
               ja = ja + nb
               jb = jb + njump
   10       CONTINUE
   20    CONTINUE
*
*     if( LSAME( ADIST, 'C') ) then
*
      ELSE
         njump = nb * lcmp
         DO 40 k = 0, lcmp-1
            ja = 1
            jb = k * nb + 1
*
            DO 30 kk = 1, iceil( nint, nb )
               IF( m.LT.jb ) GO TO 40
               CALL pbsmatadd( icontxt, 'G', min( m-jb+1, nb ), n, one,
     $                         a(ja, n*mod(k*lcmq,lcmp)+1), lda, beta,
     $                         b(jb, 1), ldb )
               ja = ja + nb
               jb = jb + njump
   30       CONTINUE
   40    CONTINUE
      END IF
*
      RETURN
*
*     End of PBSTRSRT
*
      END