ScaLAPACK  2.0.2
ScaLAPACK: Scalable Linear Algebra PACKage
smmtcadd.f
Go to the documentation of this file.
00001       SUBROUTINE SMMTCADD( M, N, ALPHA, A, LDA, BETA, B, LDB )
00002 *
00003 *  -- PBLAS auxiliary routine (version 2.0) --
00004 *     University of Tennessee, Knoxville, Oak Ridge National Laboratory,
00005 *     and University of California, Berkeley.
00006 *     April 1, 1998
00007 *
00008 *     .. Scalar Arguments ..
00009       INTEGER            LDA, LDB, M, N
00010       REAL               ALPHA, BETA
00011 *     ..
00012 *     .. Array Arguments ..
00013       REAL               A( LDA, * ), B( LDB, * )
00014 *     ..
00015 *
00016 *  Purpose
00017 *  =======
00018 *
00019 *  SMMTCADD performs the following operation:
00020 *
00021 *     B := alpha * A' + beta * B,
00022 *
00023 *  where alpha, beta are scalars; A is an m by n matrix and B is an n by
00024 *  m matrix.
00025 *
00026 *  Arguments
00027 *  =========
00028 *
00029 *  M       (local input) INTEGER
00030 *          On entry, M  specifies the number of rows of A and the number
00031 *          of columns of B. M must be at least zero.
00032 *
00033 *  N       (local input) INTEGER
00034 *          On entry, N  specifies the number of rows of B and the number
00035 *          of columns of A. N must be at least zero.
00036 *
00037 *  ALPHA   (local input) REAL
00038 *          On entry,  ALPHA  specifies the scalar alpha. When  ALPHA  is
00039 *          supplied as zero then the local entries of the array  A  need
00040 *          not be set on input.
00041 *
00042 *  A       (local input) REAL array
00043 *          On entry, A is an array of dimension ( LDA, N ).
00044 *
00045 *  LDA     (local input) INTEGER
00046 *          On entry, LDA specifies the leading dimension of the array A.
00047 *          LDA must be at least max( 1, M ).
00048 *
00049 *  BETA    (local input) REAL
00050 *          On entry,  BETA  specifies the scalar beta. When BETA is sup-
00051 *          plied as zero then the local entries of the array B need  not
00052 *          be set on input.
00053 *
00054 *  B       (local input/local output) REAL array
00055 *          On entry, B is an array of dimension ( LDB, M ). On exit, the
00056 *          leading m by n part of A has been added to the leading n by m
00057 *          part of B.
00058 *
00059 *  LDB     (local input) INTEGER
00060 *          On entry, LDB specifies the leading dimension of the array B.
00061 *          LDB must be at least max( 1, N ).
00062 *
00063 *  -- Written on April 1, 1998 by
00064 *     Antoine Petitet, University  of  Tennessee, Knoxville 37996, USA.
00065 *
00066 *  =====================================================================
00067 *
00068 *     .. Parameters ..
00069       REAL               ONE, ZERO
00070       PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
00071 *     ..
00072 *     .. Local Scalars ..
00073       INTEGER            I, J
00074 *     ..
00075 *     .. External Subroutines ..
00076       EXTERNAL           SAXPY, SCOPY, SSCAL
00077 *     ..
00078 *     .. Executable Statements ..
00079 *
00080       IF( M.GE.N ) THEN
00081          IF( ALPHA.EQ.ONE ) THEN
00082             IF( BETA.EQ.ZERO ) THEN
00083                DO 20 J = 1, N
00084                   CALL SCOPY( M, A( 1, J ), 1, B( J, 1 ), LDB )
00085 *                 DO 10 I = 1, M
00086 *                    B( J, I ) = A( I, J )
00087 *  10             CONTINUE
00088    20          CONTINUE
00089             ELSE IF( BETA.NE.ONE ) THEN
00090                DO 40 J = 1, N
00091                   DO 30 I = 1, M
00092                      B( J, I ) = A( I, J ) + BETA * B( J, I )
00093    30             CONTINUE
00094    40          CONTINUE
00095             ELSE
00096                DO 60 J = 1, N
00097                   CALL SAXPY( M, ONE, A( 1, J ), 1, B( J, 1 ), LDB )
00098 *                 DO 50 I = 1, M
00099 *                    B( J, I ) = A( I, J ) + B( J, I )
00100 *  50             CONTINUE
00101    60          CONTINUE
00102             END IF
00103          ELSE IF( ALPHA.NE.ZERO ) THEN
00104             IF( BETA.EQ.ZERO ) THEN
00105                DO 80 J = 1, N
00106                   DO 70 I = 1, M
00107                      B( J, I ) = ALPHA * A( I, J )
00108    70             CONTINUE
00109    80          CONTINUE
00110             ELSE IF( BETA.NE.ONE ) THEN
00111                DO 100 J = 1, N
00112                   DO 90 I = 1, M
00113                      B( J, I ) = ALPHA * A( I, J ) + BETA * B( J, I )
00114    90             CONTINUE
00115   100          CONTINUE
00116             ELSE
00117                DO 120 J = 1, N
00118                   CALL SAXPY( M, ALPHA, A( 1, J ), 1, B( J, 1 ), LDB )
00119 *                 DO 110 I = 1, M
00120 *                    B( J, I ) = ALPHA * A( I, J ) + B( J, I )
00121 * 110             CONTINUE
00122   120          CONTINUE
00123             END IF
00124          ELSE
00125             IF( BETA.EQ.ZERO ) THEN
00126                DO 140 J = 1, M
00127                   DO 130 I = 1, N
00128                      B( I, J ) = ZERO
00129   130             CONTINUE
00130   140          CONTINUE
00131             ELSE IF( BETA.NE.ONE ) THEN
00132                DO 160 J = 1, M
00133                   CALL SSCAL( N, BETA, B( 1, J ), 1 )
00134 *                 DO 150 I = 1, N
00135 *                    B( I, J ) = BETA * B( I, J )
00136 * 150             CONTINUE
00137   160          CONTINUE
00138             END IF
00139          END IF
00140       ELSE
00141          IF( ALPHA.EQ.ONE ) THEN
00142             IF( BETA.EQ.ZERO ) THEN
00143                DO 180 J = 1, M
00144                   CALL SCOPY( N, A( J, 1 ), LDA, B( 1, J ), 1 )
00145 *                 DO 170 I = 1, N
00146 *                    B( I, J ) = A( J, I )
00147 * 170             CONTINUE
00148   180          CONTINUE
00149             ELSE IF( BETA.NE.ONE ) THEN
00150                DO 200 J = 1, M
00151                   DO 190 I = 1, N
00152                      B( I, J ) = A( J, I ) + BETA * B( I, J )
00153   190             CONTINUE
00154   200          CONTINUE
00155             ELSE
00156                DO 220 J = 1, M
00157                   CALL SAXPY( N, ONE, A( J, 1 ), LDA, B( 1, J ), 1 )
00158 *                 DO 210 I = 1, N
00159 *                    B( I, J ) = A( J, I ) + B( I, J )
00160 * 210             CONTINUE
00161   220          CONTINUE
00162             END IF
00163          ELSE IF( ALPHA.NE.ZERO ) THEN
00164             IF( BETA.EQ.ZERO ) THEN
00165                DO 240 J = 1, M
00166                   DO 230 I = 1, N
00167                      B( I, J ) = ALPHA * A( J, I )
00168   230             CONTINUE
00169   240          CONTINUE
00170             ELSE IF( BETA.NE.ONE ) THEN
00171                DO 260 J = 1, M
00172                   DO 250 I = 1, N
00173                      B( I, J ) = ALPHA * A( J, I ) + BETA * B( I, J )
00174   250             CONTINUE
00175   260          CONTINUE
00176             ELSE
00177                DO 280 J = 1, M
00178                   CALL SAXPY( N, ALPHA, A( J, 1 ), LDA, B( 1, J ), 1 )
00179 *                 DO 270 I = 1, N
00180 *                    B( I, J ) = ALPHA * A( J, I ) + B( I, J )
00181 * 270             CONTINUE
00182   280          CONTINUE
00183             END IF
00184          ELSE
00185             IF( BETA.EQ.ZERO ) THEN
00186                DO 300 J = 1, M
00187                   DO 290 I = 1, N
00188                      B( I, J ) = ZERO
00189   290             CONTINUE
00190   300          CONTINUE
00191             ELSE IF( BETA.NE.ONE ) THEN
00192                DO 320 J = 1, M
00193                   CALL SSCAL( N, BETA, B( 1, J ), 1 )
00194 *                 DO 310 I = 1, N
00195 *                    B( I, J ) = BETA * B( I, J )
00196 * 310             CONTINUE
00197   320          CONTINUE
00198             END IF
00199          END IF
00200       END IF
00201 *
00202       RETURN
00203 *
00204 *     End of SMMTCADD
00205 *
00206       END