1 SUBROUTINE SMMTCADD( 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* SMMTCADD performs the following operation: 20* 21* B := 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) REAL array 43* On entry, A is an array of dimension ( LDA, N ). 44* 45* LDA (local input) INTEGER 46* On entry, LDA specifies the leading dimension of the array A. 47* LDA must be at least max( 1, M ). 48* 49* BETA (local input) REAL 50* On entry, BETA specifies the scalar beta. When BETA is sup- 51* plied as zero then the local entries of the array B need not 52* be set on input. 53* 54* B (local input/local output) REAL array 55* On entry, B is an array of dimension ( LDB, M ). On exit, the 56* leading m by n part of A has been added to the leading n by m 57* part of B. 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( ALPHA.EQ.ONE ) THEN 82 IF( BETA.EQ.ZERO ) THEN 83 DO 20 J = 1, N 84 CALL SCOPY( M, A( 1, J ), 1, B( J, 1 ), LDB ) 85* DO 10 I = 1, M 86* B( J, I ) = A( I, J ) 87* 10 CONTINUE 88 20 CONTINUE 89 ELSE IF( BETA.NE.ONE ) THEN 90 DO 40 J = 1, N 91 DO 30 I = 1, M 92 B( J, I ) = A( I, J ) + BETA * B( J, I ) 93 30 CONTINUE 94 40 CONTINUE 95 ELSE 96 DO 60 J = 1, N 97 CALL SAXPY( M, ONE, A( 1, J ), 1, B( J, 1 ), LDB ) 98* DO 50 I = 1, M 99* B( J, I ) = A( I, J ) + B( J, I ) 100* 50 CONTINUE 101 60 CONTINUE 102 END IF 103 ELSE IF( ALPHA.NE.ZERO ) THEN 104 IF( BETA.EQ.ZERO ) THEN 105 DO 80 J = 1, N 106 DO 70 I = 1, M 107 B( J, I ) = ALPHA * A( I, J ) 108 70 CONTINUE 109 80 CONTINUE 110 ELSE IF( BETA.NE.ONE ) THEN 111 DO 100 J = 1, N 112 DO 90 I = 1, M 113 B( J, I ) = ALPHA * A( I, J ) + BETA * B( J, I ) 114 90 CONTINUE 115 100 CONTINUE 116 ELSE 117 DO 120 J = 1, N 118 CALL SAXPY( M, ALPHA, A( 1, J ), 1, B( J, 1 ), LDB ) 119* DO 110 I = 1, M 120* B( J, I ) = ALPHA * A( I, J ) + B( J, I ) 121* 110 CONTINUE 122 120 CONTINUE 123 END IF 124 ELSE 125 IF( BETA.EQ.ZERO ) THEN 126 DO 140 J = 1, M 127 DO 130 I = 1, N 128 B( I, J ) = ZERO 129 130 CONTINUE 130 140 CONTINUE 131 ELSE IF( BETA.NE.ONE ) THEN 132 DO 160 J = 1, M 133 CALL SSCAL( N, BETA, B( 1, J ), 1 ) 134* DO 150 I = 1, N 135* B( I, J ) = BETA * B( I, J ) 136* 150 CONTINUE 137 160 CONTINUE 138 END IF 139 END IF 140 ELSE 141 IF( ALPHA.EQ.ONE ) THEN 142 IF( BETA.EQ.ZERO ) THEN 143 DO 180 J = 1, M 144 CALL SCOPY( N, A( J, 1 ), LDA, B( 1, J ), 1 ) 145* DO 170 I = 1, N 146* B( I, J ) = A( J, I ) 147* 170 CONTINUE 148 180 CONTINUE 149 ELSE IF( BETA.NE.ONE ) THEN 150 DO 200 J = 1, M 151 DO 190 I = 1, N 152 B( I, J ) = A( J, I ) + BETA * B( I, J ) 153 190 CONTINUE 154 200 CONTINUE 155 ELSE 156 DO 220 J = 1, M 157 CALL SAXPY( N, ONE, A( J, 1 ), LDA, B( 1, J ), 1 ) 158* DO 210 I = 1, N 159* B( I, J ) = A( J, I ) + B( I, J ) 160* 210 CONTINUE 161 220 CONTINUE 162 END IF 163 ELSE IF( ALPHA.NE.ZERO ) THEN 164 IF( BETA.EQ.ZERO ) THEN 165 DO 240 J = 1, M 166 DO 230 I = 1, N 167 B( I, J ) = ALPHA * A( J, I ) 168 230 CONTINUE 169 240 CONTINUE 170 ELSE IF( BETA.NE.ONE ) THEN 171 DO 260 J = 1, M 172 DO 250 I = 1, N 173 B( I, J ) = ALPHA * A( J, I ) + BETA * B( I, J ) 174 250 CONTINUE 175 260 CONTINUE 176 ELSE 177 DO 280 J = 1, M 178 CALL SAXPY( N, ALPHA, A( J, 1 ), LDA, B( 1, J ), 1 ) 179* DO 270 I = 1, N 180* B( I, J ) = ALPHA * A( J, I ) + B( I, J ) 181* 270 CONTINUE 182 280 CONTINUE 183 END IF 184 ELSE 185 IF( BETA.EQ.ZERO ) THEN 186 DO 300 J = 1, M 187 DO 290 I = 1, N 188 B( I, J ) = ZERO 189 290 CONTINUE 190 300 CONTINUE 191 ELSE IF( BETA.NE.ONE ) THEN 192 DO 320 J = 1, M 193 CALL SSCAL( N, BETA, B( 1, J ), 1 ) 194* DO 310 I = 1, N 195* B( I, J ) = BETA * B( I, J ) 196* 310 CONTINUE 197 320 CONTINUE 198 END IF 199 END IF 200 END IF 201* 202 RETURN 203* 204* End of SMMTCADD 205* 206 END 207