1 SUBROUTINE SMMDDACT( M, N, ALPHA, A, LDA, BETA, B, LDB ) 2* 3* -- PBLAS auxiliary routine (version 2.0) -- 4* University of Tennessee, Knoxville, Oak Ridge National Laboratory, 5* and University of California, Berkeley. 6* April 1, 1998 7* 8* .. Scalar Arguments .. 9 INTEGER LDA, LDB, M, N 10 REAL ALPHA, BETA 11* .. 12* .. Array Arguments .. 13 REAL A( LDA, * ), B( LDB, * ) 14* .. 15* 16* Purpose 17* ======= 18* 19* SMMDDACT performs the following operation: 20* 21* A := alpha * A + beta * B', 22* 23* where alpha, beta are scalars; A is an m by n matrix and B is an n by 24* m matrix. 25* 26* Arguments 27* ========= 28* 29* M (local input) INTEGER 30* On entry, M specifies the number of rows of A and the number 31* of columns of B. M must be at least zero. 32* 33* N (local input) INTEGER 34* On entry, N specifies the number of rows of B and the number 35* of columns of A. N must be at least zero. 36* 37* ALPHA (local input) REAL 38* On entry, ALPHA specifies the scalar alpha. When ALPHA is 39* supplied as zero then the local entries of the array A need 40* not be set on input. 41* 42* A (local input/local output) REAL array 43* On entry, A is an array of dimension ( LDA, N ). On exit, the 44* leading n by m part of B has been added into the leading m by 45* n part of A. 46* 47* LDA (local input) INTEGER 48* On entry, LDA specifies the leading dimension of the array A. 49* LDA must be at least max( 1, M ). 50* 51* BETA (local input) REAL 52* On entry, BETA specifies the scalar beta. When BETA is sup- 53* plied as zero then the local entries of the array B need not 54* be set on input. 55* 56* B (local input) REAL array 57* On entry, B is an array of dimension ( LDB, M ). 58* 59* LDB (local input) INTEGER 60* On entry, LDB specifies the leading dimension of the array B. 61* LDB must be at least max( 1, N ). 62* 63* -- Written on April 1, 1998 by 64* Antoine Petitet, University of Tennessee, Knoxville 37996, USA. 65* 66* ===================================================================== 67* 68* .. Parameters .. 69 REAL ONE, ZERO 70 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) 71* .. 72* .. Local Scalars .. 73 INTEGER I, J 74* .. 75* .. External Subroutines .. 76 EXTERNAL SAXPY, SCOPY, SSCAL 77* .. 78* .. Executable Statements .. 79* 80 IF( M.GE.N ) THEN 81 IF( BETA.EQ.ONE ) THEN 82 IF( ALPHA.EQ.ZERO ) THEN 83 DO 20 J = 1, N 84 CALL SCOPY( M, B( J, 1 ), LDB, A( 1, J ), 1 ) 85* DO 10 I = 1, M 86* A( I, J ) = B( J, I ) 87* 10 CONTINUE 88 20 CONTINUE 89 ELSE IF( ALPHA.NE.ONE ) THEN 90 DO 40 J = 1, N 91 DO 30 I = 1, M 92 A( I, J ) = B( J, I ) + ALPHA * A( I, J ) 93 30 CONTINUE 94 40 CONTINUE 95 ELSE 96 DO 60 J = 1, N 97 CALL SAXPY( M, ONE, B( J, 1 ), LDB, A( 1, J ), 1 ) 98* DO 50 I = 1, M 99* A( I, J ) = B( J, I ) + A( I, J ) 100* 50 CONTINUE 101 60 CONTINUE 102 END IF 103 ELSE IF( BETA.NE.ZERO ) THEN 104 IF( ALPHA.EQ.ZERO ) THEN 105 DO 80 J = 1, N 106 DO 70 I = 1, M 107 A( I, J ) = BETA * B( J, I ) 108 70 CONTINUE 109 80 CONTINUE 110 ELSE IF( ALPHA.NE.ONE ) THEN 111 DO 100 J = 1, N 112 DO 90 I = 1, M 113 A( I, J ) = BETA * B( J, I ) + ALPHA * A( I, J ) 114 90 CONTINUE 115 100 CONTINUE 116 ELSE 117 DO 120 J = 1, N 118 CALL SAXPY( M, BETA, B( J, 1 ), LDB, A( 1, J ), 1 ) 119* DO 110 I = 1, M 120* A( I, J ) = BETA * B( J, I ) + A( I, J ) 121* 110 CONTINUE 122 120 CONTINUE 123 END IF 124 ELSE 125 IF( ALPHA.EQ.ZERO ) THEN 126 DO 140 J = 1, N 127 DO 130 I = 1, M 128 A( I, J ) = ZERO 129 130 CONTINUE 130 140 CONTINUE 131 ELSE IF( ALPHA.NE.ONE ) THEN 132 DO 160 J = 1, N 133 CALL SSCAL( M, ALPHA, A( 1, J ), 1 ) 134* DO 150 I = 1, M 135* A( I, J ) = ALPHA * A( I, J ) 136* 150 CONTINUE 137 160 CONTINUE 138 END IF 139 END IF 140 ELSE 141 IF( BETA.EQ.ONE ) THEN 142 IF( ALPHA.EQ.ZERO ) THEN 143 DO 180 J = 1, M 144 CALL SCOPY( N, B( 1, J ), 1, A( J, 1 ), LDA ) 145* DO 170 I = 1, N 146* A( J, I ) = B( I, J ) 147* 170 CONTINUE 148 180 CONTINUE 149 ELSE IF( ALPHA.NE.ONE ) THEN 150 DO 200 J = 1, M 151 DO 190 I = 1, N 152 A( J, I ) = B( I, J ) + ALPHA * A( J, I ) 153 190 CONTINUE 154 200 CONTINUE 155 ELSE 156 DO 220 J = 1, M 157 CALL SAXPY( N, ONE, B( 1, J ), 1, A( J, 1 ), LDA ) 158* DO 210 I = 1, N 159* A( J, I ) = B( I, J ) + A( J, I ) 160* 210 CONTINUE 161 220 CONTINUE 162 END IF 163 ELSE IF( BETA.NE.ZERO ) THEN 164 IF( ALPHA.EQ.ZERO ) THEN 165 DO 240 J = 1, M 166 DO 230 I = 1, N 167 A( J, I ) = BETA * B( I, J ) 168 230 CONTINUE 169 240 CONTINUE 170 ELSE IF( ALPHA.NE.ONE ) THEN 171 DO 260 J = 1, M 172 DO 250 I = 1, N 173 A( J, I ) = BETA * B( I, J ) + ALPHA * A( J, I ) 174 250 CONTINUE 175 260 CONTINUE 176 ELSE 177 DO 280 J = 1, M 178 CALL SAXPY( N, BETA, B( 1, J ), 1, A( J, 1 ), LDA ) 179* DO 270 I = 1, N 180* A( J, I ) = BETA * B( I, J ) + A( J, I ) 181* 270 CONTINUE 182 280 CONTINUE 183 END IF 184 ELSE 185 IF( ALPHA.EQ.ZERO ) THEN 186 DO 300 J = 1, N 187 DO 290 I = 1, M 188 A( I, J ) = ZERO 189 290 CONTINUE 190 300 CONTINUE 191 ELSE IF( ALPHA.NE.ONE ) THEN 192 DO 320 J = 1, N 193 CALL SSCAL( M, ALPHA, A( 1, J ), 1 ) 194* DO 310 I = 1, M 195* A( I, J ) = ALPHA * A( I, J ) 196* 310 CONTINUE 197 320 CONTINUE 198 END IF 199 END IF 200 END IF 201* 202 RETURN 203* 204* End of SMMDDACT 205* 206 END 207