smmddat.f

Go to the documentation of this file.

      SUBROUTINE smmddat( M, N, ALPHA, A, LDA, BETA, B, LDB )
*
*  -- PBLAS auxiliary routine (version 2.0) --
*     University of Tennessee, Knoxville, Oak Ridge National Laboratory,
*     and University of California, Berkeley.
*     April 1, 1998
*
*     .. Scalar Arguments ..
      INTEGER            LDA, LDB, M, N
      REAL               ALPHA, BETA
*     ..
*     .. Array Arguments ..
      REAL               A( LDA, * ), B( LDB, * )
*     ..
*
*  Purpose
*  =======
*
*  SMMDDAT performs the following operation:
*
*     A := alpha * A + beta * B',
*
*  where alpha, beta are scalars; A is an m by n matrix and B is an n by
*  m matrix.
*
*  Arguments
*  =========
*
*  M       (local input) INTEGER
*          On entry, M  specifies the number of rows of A and the number
*          of columns of B. M must be at least zero.
*
*  N       (local input) INTEGER
*          On entry, N  specifies the number of rows of B and the number
*          of columns of A. N must be at least zero.
*
*  ALPHA   (local input) REAL
*          On entry,  ALPHA  specifies the scalar alpha. When  ALPHA  is
*          supplied as zero then the local entries of the array  A  need
*          not be set on input.
*
*  A       (local input/local output) REAL array
*          On entry, A is an array of dimension ( LDA, N ). On exit, the
*          leading n by m part of B has been added to the leading m by n
*          part of A.
*
*  LDA     (local input) INTEGER
*          On entry, LDA specifies the leading dimension of the array A.
*          LDA must be at least max( 1, M ).
*
*  BETA    (local input) REAL
*          On entry,  BETA  specifies the scalar beta. When BETA is sup-
*          plied as zero then the local entries of the array B need  not
*          be set on input.
*
*  B       (local input) REAL array
*          On entry, B is an array of dimension ( LDB, M ).
*
*  LDB     (local input) INTEGER
*          On entry, LDB specifies the leading dimension of the array B.
*          LDB must be at least max( 1, N ).
*
*  -- Written on April 1, 1998 by
*     Antoine Petitet, University  of  Tennessee, Knoxville 37996, USA.
*
*  =====================================================================
*
*     .. Parameters ..
      REAL               ONE, ZERO
      parameter( one = 1.0e+0, zero = 0.0e+0 )
*     ..
*     .. Local Scalars ..
      INTEGER            I, J
*     ..
*     .. External Subroutines ..
      EXTERNAL           saxpy, scopy, sscal
*     ..
*     .. Executable Statements ..
*
      IF( m.GE.n ) THEN
         IF( beta.EQ.one ) THEN
            IF( alpha.EQ.zero ) THEN
               DO 20 j = 1, n
                  CALL scopy( m, b( j, 1 ), ldb, a( 1, j ), 1 )
*                 DO 10 I = 1, M
*                    A( I, J ) = B( J, I )
*  10             CONTINUE
   20          CONTINUE
            ELSE IF( alpha.NE.one ) THEN
               DO 40 j = 1, n
                  DO 30 i = 1, m
                     a( i, j ) = b( j, i ) + alpha * a( i, j )
   30             CONTINUE
   40          CONTINUE
            ELSE
               DO 60 j = 1, n
                  CALL saxpy( m, one, b( j, 1 ), ldb, a( 1, j ), 1 )
*                 DO 50 I = 1, M
*                    A( I, J ) = B( J, I ) + A( I, J )
*  50             CONTINUE
   60          CONTINUE
            END IF
         ELSE IF( beta.NE.zero ) THEN
            IF( alpha.EQ.zero ) THEN
               DO 80 j = 1, n
                  DO 70 i = 1, m
                     a( i, j ) = beta * b( j, i )
   70             CONTINUE
   80          CONTINUE
            ELSE IF( alpha.NE.one ) THEN
               DO 100 j = 1, n
                  DO 90 i = 1, m
                     a( i, j ) = beta * b( j, i ) + alpha * a( i, j )
   90             CONTINUE
  100          CONTINUE
            ELSE
               DO 120 j = 1, n
                  CALL saxpy( m, beta, b( j, 1 ), ldb, a( 1, j ), 1 )
*                 DO 110 I = 1, M
*                    A( I, J ) = BETA * B( J, I ) + A( I, J )
* 110             CONTINUE
  120          CONTINUE
            END IF
         ELSE
            IF( alpha.EQ.zero ) THEN
               DO 140 j = 1, n
                  DO 130 i = 1, m
                     a( i, j ) = zero
  130             CONTINUE
  140          CONTINUE
            ELSE IF( alpha.NE.one ) THEN
               DO 160 j = 1, n
                  CALL sscal( m, alpha, a( 1, j ), 1 )
*                 DO 150 I = 1, M
*                    A( I, J ) = ALPHA * A( I, J )
* 150             CONTINUE
  160          CONTINUE
            END IF
         END IF
      ELSE
         IF( beta.EQ.one ) THEN
            IF( alpha.EQ.zero ) THEN
               DO 180 j = 1, m
                  CALL scopy( n, b( 1, j ), 1, a( j, 1 ), lda )
*                 DO 170 I = 1, N
*                    A( J, I ) = B( I, J )
* 170             CONTINUE
  180          CONTINUE
            ELSE IF( alpha.NE.one ) THEN
               DO 200 j = 1, m
                  DO 190 i = 1, n
                     a( j, i ) = b( i, j ) + alpha * a( j, i )
  190             CONTINUE
  200          CONTINUE
            ELSE
               DO 220 j = 1, m
                  CALL saxpy( n, one, b( 1, j ), 1, a( j, 1 ), lda )
*                 DO 210 I = 1, N
*                    A( J, I ) = B( I, J ) + A( J, I )
* 210             CONTINUE
  220          CONTINUE
            END IF
         ELSE IF( beta.NE.zero ) THEN
            IF( alpha.EQ.zero ) THEN
               DO 240 j = 1, m
                  DO 230 i = 1, n
                     a( j, i ) = beta * b( i, j )
  230             CONTINUE
  240          CONTINUE
            ELSE IF( alpha.NE.one ) THEN
               DO 260 j = 1, m
                  DO 250 i = 1, n
                     a( j, i ) = beta * b( i, j ) + alpha * a( j, i )
  250             CONTINUE
  260          CONTINUE
            ELSE
               DO 280 j = 1, m
                  CALL saxpy( n, beta, b( 1, j ), 1, a( j, 1 ), lda )
*                 DO 270 I = 1, N
*                    A( J, I ) = BETA * B( I, J ) + A( J, I )
* 270             CONTINUE
  280          CONTINUE
            END IF
         ELSE
            IF( alpha.EQ.zero ) THEN
               DO 300 j = 1, n
                  DO 290 i = 1, m
                     a( i, j ) = zero
  290             CONTINUE
  300          CONTINUE
            ELSE IF( alpha.NE.one ) THEN
               DO 320 j = 1, n
                  CALL sscal( m, alpha, a( 1, j ), 1 )
*                 DO 310 I = 1, M
*                    A( I, J ) = ALPHA * A( I, J )
* 310             CONTINUE
  320          CONTINUE
            END IF
         END IF
      END IF
*
      RETURN
*
*     End of SMMDDAT
*
      END