← Back to branch summary

~ubuntu-branches/ubuntu/trusty/nwchem/trusty-proposed

« back to all changes in this revision

Viewing changes to src/blas/single/sgemm.f

  • Committer: Package Import Robot
  • Author(s): Michael Banck, Daniel Leidert, Andreas Tille, Michael Banck
  • Date: 2013-07-04 12:14:55 UTC
  • mfrom: (1.1.2)
  • Revision ID: package-import@ubuntu.com-20130704121455-5tvsx2qabor3nrui
Tags: 6.3-1
http://bugs.debian.org/696361
* New upstream release.
* Fixes anisotropic properties (Closes: #696361).
* New features include:
  + Multi-reference coupled cluster (MRCC) approaches
  + Hybrid DFT calculations with short-range HF 
  + New density-functionals including Minnesota (M08, M11) and HSE hybrid
    functionals
  + X-ray absorption spectroscopy (XAS) with TDDFT
  + Analytical gradients for the COSMO solvation model
  + Transition densities from TDDFT 
  + DFT+U and Electron-Transfer (ET) methods for plane wave calculations
  + Exploitation of space group symmetry in plane wave geometry optimizations
  + Local density of states (LDOS) collective variable added to Metadynamics
  + Various new XC functionals added for plane wave calculations, including
    hybrid and range-corrected ones
  + Electric field gradients with relativistic corrections 
  + Nudged Elastic Band optimization method
  + Updated basis sets and ECPs 

[ Daniel Leidert ]
* debian/watch: Fixed.

[ Andreas Tille ]
* debian/upstream: References

[ Michael Banck ]
* debian/upstream (Name): New field.
* debian/patches/02_makefile_flags.patch: Refreshed.
* debian/patches/06_statfs_kfreebsd.patch: Likewise.
* debian/patches/07_ga_target_force_linux.patch: Likewise.
* debian/patches/05_avoid_inline_assembler.patch: Removed, no longer needed.
* debian/patches/09_backported_6.1.1_fixes.patch: Likewise.
* debian/control (Build-Depends): Added gfortran-4.7 and gcc-4.7.
* debian/patches/10_force_gcc-4.7.patch: New patch, explicitly sets
  gfortran-4.7 and gcc-4.7, fixes test suite hang with gcc-4.8 (Closes:
  #701328, #713262).
* debian/testsuite: Added tests for COSMO analytical gradients and MRCC.
* debian/rules (MRCC_METHODS): New variable, required to enable MRCC methods.

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/blas/single/sgemm.f
1
 
      SUBROUTINE SGEMM ( TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB,
2
 
     $                   BETA, C, LDC )
3
 
*
4
 
* $Id: sgemm.f 19695 2010-10-29 16:51:02Z d3y133 $
 
1
*> \brief \b SGEMM
 
2
*
 
3
*  =========== DOCUMENTATION ===========
 
4
*
 
5
* Online html documentation available at 
 
6
*            http://www.netlib.org/lapack/explore-html/ 
 
7
*
 
8
*  Definition:
 
9
*  ===========
 
10
*
 
11
*       SUBROUTINE SGEMM(TRANSA,TRANSB,M,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
 
12
* 
 
13
*       .. Scalar Arguments ..
 
14
*       REAL ALPHA,BETA
 
15
*       INTEGER K,LDA,LDB,LDC,M,N
 
16
*       CHARACTER TRANSA,TRANSB
 
17
*       ..
 
18
*       .. Array Arguments ..
 
19
*       REAL A(LDA,*),B(LDB,*),C(LDC,*)
 
20
*       ..
 
21
*  
 
22
*
 
23
*> \par Purpose:
 
24
*  =============
 
25
*>
 
26
*> \verbatim
 
27
*>
 
28
*> SGEMM  performs one of the matrix-matrix operations
 
29
*>
 
30
*>    C := alpha*op( A )*op( B ) + beta*C,
 
31
*>
 
32
*> where  op( X ) is one of
 
33
*>
 
34
*>    op( X ) = X   or   op( X ) = X**T,
 
35
*>
 
36
*> alpha and beta are scalars, and A, B and C are matrices, with op( A )
 
37
*> an m by k matrix,  op( B )  a  k by n matrix and  C an m by n matrix.
 
38
*> \endverbatim
 
39
*
 
40
*  Arguments:
 
41
*  ==========
 
42
*
 
43
*> \param[in] TRANSA
 
44
*> \verbatim
 
45
*>          TRANSA is CHARACTER*1
 
46
*>           On entry, TRANSA specifies the form of op( A ) to be used in
 
47
*>           the matrix multiplication as follows:
 
48
*>
 
49
*>              TRANSA = 'N' or 'n',  op( A ) = A.
 
50
*>
 
51
*>              TRANSA = 'T' or 't',  op( A ) = A**T.
 
52
*>
 
53
*>              TRANSA = 'C' or 'c',  op( A ) = A**T.
 
54
*> \endverbatim
 
55
*>
 
56
*> \param[in] TRANSB
 
57
*> \verbatim
 
58
*>          TRANSB is CHARACTER*1
 
59
*>           On entry, TRANSB specifies the form of op( B ) to be used in
 
60
*>           the matrix multiplication as follows:
 
61
*>
 
62
*>              TRANSB = 'N' or 'n',  op( B ) = B.
 
63
*>
 
64
*>              TRANSB = 'T' or 't',  op( B ) = B**T.
 
65
*>
 
66
*>              TRANSB = 'C' or 'c',  op( B ) = B**T.
 
67
*> \endverbatim
 
68
*>
 
69
*> \param[in] M
 
70
*> \verbatim
 
71
*>          M is INTEGER
 
72
*>           On entry,  M  specifies  the number  of rows  of the  matrix
 
73
*>           op( A )  and of the  matrix  C.  M  must  be at least  zero.
 
74
*> \endverbatim
 
75
*>
 
76
*> \param[in] N
 
77
*> \verbatim
 
78
*>          N is INTEGER
 
79
*>           On entry,  N  specifies the number  of columns of the matrix
 
80
*>           op( B ) and the number of columns of the matrix C. N must be
 
81
*>           at least zero.
 
82
*> \endverbatim
 
83
*>
 
84
*> \param[in] K
 
85
*> \verbatim
 
86
*>          K is INTEGER
 
87
*>           On entry,  K  specifies  the number of columns of the matrix
 
88
*>           op( A ) and the number of rows of the matrix op( B ). K must
 
89
*>           be at least  zero.
 
90
*> \endverbatim
 
91
*>
 
92
*> \param[in] ALPHA
 
93
*> \verbatim
 
94
*>          ALPHA is REAL
 
95
*>           On entry, ALPHA specifies the scalar alpha.
 
96
*> \endverbatim
 
97
*>
 
98
*> \param[in] A
 
99
*> \verbatim
 
100
*>          A is REAL array of DIMENSION ( LDA, ka ), where ka is
 
101
*>           k  when  TRANSA = 'N' or 'n',  and is  m  otherwise.
 
102
*>           Before entry with  TRANSA = 'N' or 'n',  the leading  m by k
 
103
*>           part of the array  A  must contain the matrix  A,  otherwise
 
104
*>           the leading  k by m  part of the array  A  must contain  the
 
105
*>           matrix A.
 
106
*> \endverbatim
 
107
*>
 
108
*> \param[in] LDA
 
109
*> \verbatim
 
110
*>          LDA is INTEGER
 
111
*>           On entry, LDA specifies the first dimension of A as declared
 
112
*>           in the calling (sub) program. When  TRANSA = 'N' or 'n' then
 
113
*>           LDA must be at least  max( 1, m ), otherwise  LDA must be at
 
114
*>           least  max( 1, k ).
 
115
*> \endverbatim
 
116
*>
 
117
*> \param[in] B
 
118
*> \verbatim
 
119
*>          B is REAL array of DIMENSION ( LDB, kb ), where kb is
 
120
*>           n  when  TRANSB = 'N' or 'n',  and is  k  otherwise.
 
121
*>           Before entry with  TRANSB = 'N' or 'n',  the leading  k by n
 
122
*>           part of the array  B  must contain the matrix  B,  otherwise
 
123
*>           the leading  n by k  part of the array  B  must contain  the
 
124
*>           matrix B.
 
125
*> \endverbatim
 
126
*>
 
127
*> \param[in] LDB
 
128
*> \verbatim
 
129
*>          LDB is INTEGER
 
130
*>           On entry, LDB specifies the first dimension of B as declared
 
131
*>           in the calling (sub) program. When  TRANSB = 'N' or 'n' then
 
132
*>           LDB must be at least  max( 1, k ), otherwise  LDB must be at
 
133
*>           least  max( 1, n ).
 
134
*> \endverbatim
 
135
*>
 
136
*> \param[in] BETA
 
137
*> \verbatim
 
138
*>          BETA is REAL
 
139
*>           On entry,  BETA  specifies the scalar  beta.  When  BETA  is
 
140
*>           supplied as zero then C need not be set on input.
 
141
*> \endverbatim
 
142
*>
 
143
*> \param[in,out] C
 
144
*> \verbatim
 
145
*>          C is REAL array of DIMENSION ( LDC, n ).
 
146
*>           Before entry, the leading  m by n  part of the array  C must
 
147
*>           contain the matrix  C,  except when  beta  is zero, in which
 
148
*>           case C need not be set on entry.
 
149
*>           On exit, the array  C  is overwritten by the  m by n  matrix
 
150
*>           ( alpha*op( A )*op( B ) + beta*C ).
 
151
*> \endverbatim
 
152
*>
 
153
*> \param[in] LDC
 
154
*> \verbatim
 
155
*>          LDC is INTEGER
 
156
*>           On entry, LDC specifies the first dimension of C as declared
 
157
*>           in  the  calling  (sub)  program.   LDC  must  be  at  least
 
158
*>           max( 1, m ).
 
159
*> \endverbatim
 
160
*
 
161
*  Authors:
 
162
*  ========
 
163
*
 
164
*> \author Univ. of Tennessee 
 
165
*> \author Univ. of California Berkeley 
 
166
*> \author Univ. of Colorado Denver 
 
167
*> \author NAG Ltd. 
 
168
*
 
169
*> \date November 2011
 
170
*
 
171
*> \ingroup single_blas_level3
 
172
*
 
173
*> \par Further Details:
 
174
*  =====================
 
175
*>
 
176
*> \verbatim
 
177
*>
 
178
*>  Level 3 Blas routine.
 
179
*>
 
180
*>  -- Written on 8-February-1989.
 
181
*>     Jack Dongarra, Argonne National Laboratory.
 
182
*>     Iain Duff, AERE Harwell.
 
183
*>     Jeremy Du Croz, Numerical Algorithms Group Ltd.
 
184
*>     Sven Hammarling, Numerical Algorithms Group Ltd.
 
185
*> \endverbatim
 
186
*>
 
187
*  =====================================================================
 
188
      SUBROUTINE SGEMM(TRANSA,TRANSB,M,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
 
189
*
 
190
*  -- Reference BLAS level3 routine (version 3.4.0) --
 
191
*  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 
192
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 
193
*     November 2011
5
194
*
6
195
*     .. Scalar Arguments ..
7
 
      CHARACTER*1        TRANSA, TRANSB
8
 
      INTEGER            M, N, K, LDA, LDB, LDC
9
 
      REAL               ALPHA, BETA
 
196
      REAL ALPHA,BETA
 
197
      INTEGER K,LDA,LDB,LDC,M,N
 
198
      CHARACTER TRANSA,TRANSB
 
199
*     ..
10
200
*     .. Array Arguments ..
11
 
      REAL               A( LDA, * ), B( LDB, * ), C( LDC, * )
 
201
      REAL A(LDA,*),B(LDB,*),C(LDC,*)
12
202
*     ..
13
203
*
14
 
*  Purpose
15
 
*  =======
16
 
*
17
 
*  SGEMM  performs one of the matrix-matrix operations
18
 
*
19
 
*     C := alpha*op( A )*op( B ) + beta*C,
20
 
*
21
 
*  where  op( X ) is one of
22
 
*
23
 
*     op( X ) = X   or   op( X ) = X',
24
 
*
25
 
*  alpha and beta are scalars, and A, B and C are matrices, with op( A )
26
 
*  an m by k matrix,  op( B )  a  k by n matrix and  C an m by n matrix.
27
 
*
28
 
*  Parameters
29
 
*  ==========
30
 
*
31
 
*  TRANSA - CHARACTER*1.
32
 
*           On entry, TRANSA specifies the form of op( A ) to be used in
33
 
*           the matrix multiplication as follows:
34
 
*
35
 
*              TRANSA = 'N' or 'n',  op( A ) = A.
36
 
*
37
 
*              TRANSA = 'T' or 't',  op( A ) = A'.
38
 
*
39
 
*              TRANSA = 'C' or 'c',  op( A ) = A'.
40
 
*
41
 
*           Unchanged on exit.
42
 
*
43
 
*  TRANSB - CHARACTER*1.
44
 
*           On entry, TRANSB specifies the form of op( B ) to be used in
45
 
*           the matrix multiplication as follows:
46
 
*
47
 
*              TRANSB = 'N' or 'n',  op( B ) = B.
48
 
*
49
 
*              TRANSB = 'T' or 't',  op( B ) = B'.
50
 
*
51
 
*              TRANSB = 'C' or 'c',  op( B ) = B'.
52
 
*
53
 
*           Unchanged on exit.
54
 
*
55
 
*  M      - INTEGER.
56
 
*           On entry,  M  specifies  the number  of rows  of the  matrix
57
 
*           op( A )  and of the  matrix  C.  M  must  be at least  zero.
58
 
*           Unchanged on exit.
59
 
*
60
 
*  N      - INTEGER.
61
 
*           On entry,  N  specifies the number  of columns of the matrix
62
 
*           op( B ) and the number of columns of the matrix C. N must be
63
 
*           at least zero.
64
 
*           Unchanged on exit.
65
 
*
66
 
*  K      - INTEGER.
67
 
*           On entry,  K  specifies  the number of columns of the matrix
68
 
*           op( A ) and the number of rows of the matrix op( B ). K must
69
 
*           be at least  zero.
70
 
*           Unchanged on exit.
71
 
*
72
 
*  ALPHA  - REAL            .
73
 
*           On entry, ALPHA specifies the scalar alpha.
74
 
*           Unchanged on exit.
75
 
*
76
 
*  A      - REAL             array of DIMENSION ( LDA, ka ), where ka is
77
 
*           k  when  TRANSA = 'N' or 'n',  and is  m  otherwise.
78
 
*           Before entry with  TRANSA = 'N' or 'n',  the leading  m by k
79
 
*           part of the array  A  must contain the matrix  A,  otherwise
80
 
*           the leading  k by m  part of the array  A  must contain  the
81
 
*           matrix A.
82
 
*           Unchanged on exit.
83
 
*
84
 
*  LDA    - INTEGER.
85
 
*           On entry, LDA specifies the first dimension of A as declared
86
 
*           in the calling (sub) program. When  TRANSA = 'N' or 'n' then
87
 
*           LDA must be at least  max( 1, m ), otherwise  LDA must be at
88
 
*           least  max( 1, k ).
89
 
*           Unchanged on exit.
90
 
*
91
 
*  B      - REAL             array of DIMENSION ( LDB, kb ), where kb is
92
 
*           n  when  TRANSB = 'N' or 'n',  and is  k  otherwise.
93
 
*           Before entry with  TRANSB = 'N' or 'n',  the leading  k by n
94
 
*           part of the array  B  must contain the matrix  B,  otherwise
95
 
*           the leading  n by k  part of the array  B  must contain  the
96
 
*           matrix B.
97
 
*           Unchanged on exit.
98
 
*
99
 
*  LDB    - INTEGER.
100
 
*           On entry, LDB specifies the first dimension of B as declared
101
 
*           in the calling (sub) program. When  TRANSB = 'N' or 'n' then
102
 
*           LDB must be at least  max( 1, k ), otherwise  LDB must be at
103
 
*           least  max( 1, n ).
104
 
*           Unchanged on exit.
105
 
*
106
 
*  BETA   - REAL            .
107
 
*           On entry,  BETA  specifies the scalar  beta.  When  BETA  is
108
 
*           supplied as zero then C need not be set on input.
109
 
*           Unchanged on exit.
110
 
*
111
 
*  C      - REAL             array of DIMENSION ( LDC, n ).
112
 
*           Before entry, the leading  m by n  part of the array  C must
113
 
*           contain the matrix  C,  except when  beta  is zero, in which
114
 
*           case C need not be set on entry.
115
 
*           On exit, the array  C  is overwritten by the  m by n  matrix
116
 
*           ( alpha*op( A )*op( B ) + beta*C ).
117
 
*
118
 
*  LDC    - INTEGER.
119
 
*           On entry, LDC specifies the first dimension of C as declared
120
 
*           in  the  calling  (sub)  program.   LDC  must  be  at  least
121
 
*           max( 1, m ).
122
 
*           Unchanged on exit.
123
 
*
124
 
*
125
 
*  Level 3 Blas routine.
126
 
*
127
 
*  -- Written on 8-February-1989.
128
 
*     Jack Dongarra, Argonne National Laboratory.
129
 
*     Iain Duff, AERE Harwell.
130
 
*     Jeremy Du Croz, Numerical Algorithms Group Ltd.
131
 
*     Sven Hammarling, Numerical Algorithms Group Ltd.
132
 
*
 
204
*  =====================================================================
133
205
*
134
206
*     .. External Functions ..
135
 
      LOGICAL            LSAME
136
 
      EXTERNAL           LSAME
 
207
      LOGICAL LSAME
 
208
      EXTERNAL LSAME
 
209
*     ..
137
210
*     .. External Subroutines ..
138
 
      EXTERNAL           XERBLA
 
211
      EXTERNAL XERBLA
 
212
*     ..
139
213
*     .. Intrinsic Functions ..
140
 
      INTRINSIC          MAX
 
214
      INTRINSIC MAX
 
215
*     ..
141
216
*     .. Local Scalars ..
142
 
      LOGICAL            NOTA, NOTB
143
 
      INTEGER            I, INFO, J, L, NCOLA, NROWA, NROWB
144
 
      REAL               TEMP
 
217
      REAL TEMP
 
218
      INTEGER I,INFO,J,L,NCOLA,NROWA,NROWB
 
219
      LOGICAL NOTA,NOTB
 
220
*     ..
145
221
*     .. Parameters ..
146
 
      REAL               ONE         , ZERO
147
 
      PARAMETER        ( ONE = 1.0E+0, ZERO = 0.0E+0 )
 
222
      REAL ONE,ZERO
 
223
      PARAMETER (ONE=1.0E+0,ZERO=0.0E+0)
148
224
*     ..
149
 
*     .. Executable Statements ..
150
225
*
151
226
*     Set  NOTA  and  NOTB  as  true if  A  and  B  respectively are not
152
227
*     transposed and set  NROWA, NCOLA and  NROWB  as the number of rows
153
228
*     and  columns of  A  and the  number of  rows  of  B  respectively.
154
229
*
155
 
      NOTA  = LSAME( TRANSA, 'N' )
156
 
      NOTB  = LSAME( TRANSB, 'N' )
157
 
      IF( NOTA )THEN
158
 
         NROWA = M
159
 
         NCOLA = K
 
230
      NOTA = LSAME(TRANSA,'N')
 
231
      NOTB = LSAME(TRANSB,'N')
 
232
      IF (NOTA) THEN
 
233
          NROWA = M
 
234
          NCOLA = K
160
235
      ELSE
161
 
         NROWA = K
162
 
         NCOLA = M
 
236
          NROWA = K
 
237
          NCOLA = M
163
238
      END IF
164
 
      IF( NOTB )THEN
165
 
         NROWB = K
 
239
      IF (NOTB) THEN
 
240
          NROWB = K
166
241
      ELSE
167
 
         NROWB = N
 
242
          NROWB = N
168
243
      END IF
169
244
*
170
245
*     Test the input parameters.
171
246
*
172
247
      INFO = 0
173
 
      IF(      ( .NOT.NOTA                 ).AND.
174
 
     $         ( .NOT.LSAME( TRANSA, 'C' ) ).AND.
175
 
     $         ( .NOT.LSAME( TRANSA, 'T' ) )      )THEN
176
 
         INFO = 1
177
 
      ELSE IF( ( .NOT.NOTB                 ).AND.
178
 
     $         ( .NOT.LSAME( TRANSB, 'C' ) ).AND.
179
 
     $         ( .NOT.LSAME( TRANSB, 'T' ) )      )THEN
180
 
         INFO = 2
181
 
      ELSE IF( M  .LT.0               )THEN
182
 
         INFO = 3
183
 
      ELSE IF( N  .LT.0               )THEN
184
 
         INFO = 4
185
 
      ELSE IF( K  .LT.0               )THEN
186
 
         INFO = 5
187
 
      ELSE IF( LDA.LT.MAX( 1, NROWA ) )THEN
188
 
         INFO = 8
189
 
      ELSE IF( LDB.LT.MAX( 1, NROWB ) )THEN
190
 
         INFO = 10
191
 
      ELSE IF( LDC.LT.MAX( 1, M     ) )THEN
192
 
         INFO = 13
 
248
      IF ((.NOT.NOTA) .AND. (.NOT.LSAME(TRANSA,'C')) .AND.
 
249
     +    (.NOT.LSAME(TRANSA,'T'))) THEN
 
250
          INFO = 1
 
251
      ELSE IF ((.NOT.NOTB) .AND. (.NOT.LSAME(TRANSB,'C')) .AND.
 
252
     +         (.NOT.LSAME(TRANSB,'T'))) THEN
 
253
          INFO = 2
 
254
      ELSE IF (M.LT.0) THEN
 
255
          INFO = 3
 
256
      ELSE IF (N.LT.0) THEN
 
257
          INFO = 4
 
258
      ELSE IF (K.LT.0) THEN
 
259
          INFO = 5
 
260
      ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
 
261
          INFO = 8
 
262
      ELSE IF (LDB.LT.MAX(1,NROWB)) THEN
 
263
          INFO = 10
 
264
      ELSE IF (LDC.LT.MAX(1,M)) THEN
 
265
          INFO = 13
193
266
      END IF
194
 
      IF( INFO.NE.0 )THEN
195
 
         CALL XERBLA( 'SGEMM ', INFO )
196
 
         RETURN
 
267
      IF (INFO.NE.0) THEN
 
268
          CALL XERBLA('SGEMM ',INFO)
 
269
          RETURN
197
270
      END IF
198
271
*
199
272
*     Quick return if possible.
200
273
*
201
 
      IF( ( M.EQ.0 ).OR.( N.EQ.0 ).OR.
202
 
     $    ( ( ( ALPHA.EQ.ZERO ).OR.( K.EQ.0 ) ).AND.( BETA.EQ.ONE ) ) )
203
 
     $   RETURN
 
274
      IF ((M.EQ.0) .OR. (N.EQ.0) .OR.
 
275
     +    (((ALPHA.EQ.ZERO).OR. (K.EQ.0)).AND. (BETA.EQ.ONE))) RETURN
204
276
*
205
277
*     And if  alpha.eq.zero.
206
278
*
207
 
      IF( ALPHA.EQ.ZERO )THEN
208
 
         IF( BETA.EQ.ZERO )THEN
209
 
            DO 20, J = 1, N
210
 
               DO 10, I = 1, M
211
 
                  C( I, J ) = ZERO
212
 
   10          CONTINUE
213
 
   20       CONTINUE
214
 
         ELSE
215
 
            DO 40, J = 1, N
216
 
               DO 30, I = 1, M
217
 
                  C( I, J ) = BETA*C( I, J )
218
 
   30          CONTINUE
219
 
   40       CONTINUE
220
 
         END IF
221
 
         RETURN
 
279
      IF (ALPHA.EQ.ZERO) THEN
 
280
          IF (BETA.EQ.ZERO) THEN
 
281
              DO 20 J = 1,N
 
282
                  DO 10 I = 1,M
 
283
                      C(I,J) = ZERO
 
284
   10             CONTINUE
 
285
   20         CONTINUE
 
286
          ELSE
 
287
              DO 40 J = 1,N
 
288
                  DO 30 I = 1,M
 
289
                      C(I,J) = BETA*C(I,J)
 
290
   30             CONTINUE
 
291
   40         CONTINUE
 
292
          END IF
 
293
          RETURN
222
294
      END IF
223
295
*
224
296
*     Start the operations.
225
297
*
226
 
      IF( NOTB )THEN
227
 
         IF( NOTA )THEN
 
298
      IF (NOTB) THEN
 
299
          IF (NOTA) THEN
228
300
*
229
301
*           Form  C := alpha*A*B + beta*C.
230
302
*
231
 
            DO 90, J = 1, N
232
 
               IF( BETA.EQ.ZERO )THEN
233
 
                  DO 50, I = 1, M
234
 
                     C( I, J ) = ZERO
235
 
   50             CONTINUE
236
 
               ELSE IF( BETA.NE.ONE )THEN
237
 
                  DO 60, I = 1, M
238
 
                     C( I, J ) = BETA*C( I, J )
239
 
   60             CONTINUE
240
 
               END IF
241
 
               DO 80, L = 1, K
242
 
                  IF( B( L, J ).NE.ZERO )THEN
243
 
                     TEMP = ALPHA*B( L, J )
244
 
                     DO 70, I = 1, M
245
 
                        C( I, J ) = C( I, J ) + TEMP*A( I, L )
246
 
   70                CONTINUE
247
 
                  END IF
248
 
   80          CONTINUE
249
 
   90       CONTINUE
250
 
         ELSE
251
 
*
252
 
*           Form  C := alpha*A'*B + beta*C
253
 
*
254
 
            DO 120, J = 1, N
255
 
               DO 110, I = 1, M
256
 
                  TEMP = ZERO
257
 
                  DO 100, L = 1, K
258
 
                     TEMP = TEMP + A( L, I )*B( L, J )
259
 
  100             CONTINUE
260
 
                  IF( BETA.EQ.ZERO )THEN
261
 
                     C( I, J ) = ALPHA*TEMP
262
 
                  ELSE
263
 
                     C( I, J ) = ALPHA*TEMP + BETA*C( I, J )
264
 
                  END IF
265
 
  110          CONTINUE
266
 
  120       CONTINUE
267
 
         END IF
 
303
              DO 90 J = 1,N
 
304
                  IF (BETA.EQ.ZERO) THEN
 
305
                      DO 50 I = 1,M
 
306
                          C(I,J) = ZERO
 
307
   50                 CONTINUE
 
308
                  ELSE IF (BETA.NE.ONE) THEN
 
309
                      DO 60 I = 1,M
 
310
                          C(I,J) = BETA*C(I,J)
 
311
   60                 CONTINUE
 
312
                  END IF
 
313
                  DO 80 L = 1,K
 
314
                      IF (B(L,J).NE.ZERO) THEN
 
315
                          TEMP = ALPHA*B(L,J)
 
316
                          DO 70 I = 1,M
 
317
                              C(I,J) = C(I,J) + TEMP*A(I,L)
 
318
   70                     CONTINUE
 
319
                      END IF
 
320
   80             CONTINUE
 
321
   90         CONTINUE
 
322
          ELSE
 
323
*
 
324
*           Form  C := alpha*A**T*B + beta*C
 
325
*
 
326
              DO 120 J = 1,N
 
327
                  DO 110 I = 1,M
 
328
                      TEMP = ZERO
 
329
                      DO 100 L = 1,K
 
330
                          TEMP = TEMP + A(L,I)*B(L,J)
 
331
  100                 CONTINUE
 
332
                      IF (BETA.EQ.ZERO) THEN
 
333
                          C(I,J) = ALPHA*TEMP
 
334
                      ELSE
 
335
                          C(I,J) = ALPHA*TEMP + BETA*C(I,J)
 
336
                      END IF
 
337
  110             CONTINUE
 
338
  120         CONTINUE
 
339
          END IF
268
340
      ELSE
269
 
         IF( NOTA )THEN
270
 
*
271
 
*           Form  C := alpha*A*B' + beta*C
272
 
*
273
 
            DO 170, J = 1, N
274
 
               IF( BETA.EQ.ZERO )THEN
275
 
                  DO 130, I = 1, M
276
 
                     C( I, J ) = ZERO
277
 
  130             CONTINUE
278
 
               ELSE IF( BETA.NE.ONE )THEN
279
 
                  DO 140, I = 1, M
280
 
                     C( I, J ) = BETA*C( I, J )
281
 
  140             CONTINUE
282
 
               END IF
283
 
               DO 160, L = 1, K
284
 
                  IF( B( J, L ).NE.ZERO )THEN
285
 
                     TEMP = ALPHA*B( J, L )
286
 
                     DO 150, I = 1, M
287
 
                        C( I, J ) = C( I, J ) + TEMP*A( I, L )
288
 
  150                CONTINUE
289
 
                  END IF
290
 
  160          CONTINUE
291
 
  170       CONTINUE
292
 
         ELSE
293
 
*
294
 
*           Form  C := alpha*A'*B' + beta*C
295
 
*
296
 
            DO 200, J = 1, N
297
 
               DO 190, I = 1, M
298
 
                  TEMP = ZERO
299
 
                  DO 180, L = 1, K
300
 
                     TEMP = TEMP + A( L, I )*B( J, L )
301
 
  180             CONTINUE
302
 
                  IF( BETA.EQ.ZERO )THEN
303
 
                     C( I, J ) = ALPHA*TEMP
304
 
                  ELSE
305
 
                     C( I, J ) = ALPHA*TEMP + BETA*C( I, J )
306
 
                  END IF
307
 
  190          CONTINUE
308
 
  200       CONTINUE
309
 
         END IF
 
341
          IF (NOTA) THEN
 
342
*
 
343
*           Form  C := alpha*A*B**T + beta*C
 
344
*
 
345
              DO 170 J = 1,N
 
346
                  IF (BETA.EQ.ZERO) THEN
 
347
                      DO 130 I = 1,M
 
348
                          C(I,J) = ZERO
 
349
  130                 CONTINUE
 
350
                  ELSE IF (BETA.NE.ONE) THEN
 
351
                      DO 140 I = 1,M
 
352
                          C(I,J) = BETA*C(I,J)
 
353
  140                 CONTINUE
 
354
                  END IF
 
355
                  DO 160 L = 1,K
 
356
                      IF (B(J,L).NE.ZERO) THEN
 
357
                          TEMP = ALPHA*B(J,L)
 
358
                          DO 150 I = 1,M
 
359
                              C(I,J) = C(I,J) + TEMP*A(I,L)
 
360
  150                     CONTINUE
 
361
                      END IF
 
362
  160             CONTINUE
 
363
  170         CONTINUE
 
364
          ELSE
 
365
*
 
366
*           Form  C := alpha*A**T*B**T + beta*C
 
367
*
 
368
              DO 200 J = 1,N
 
369
                  DO 190 I = 1,M
 
370
                      TEMP = ZERO
 
371
                      DO 180 L = 1,K
 
372
                          TEMP = TEMP + A(L,I)*B(J,L)
 
373
  180                 CONTINUE
 
374
                      IF (BETA.EQ.ZERO) THEN
 
375
                          C(I,J) = ALPHA*TEMP
 
376
                      ELSE
 
377
                          C(I,J) = ALPHA*TEMP + BETA*C(I,J)
 
378
                      END IF
 
379
  190             CONTINUE
 
380
  200         CONTINUE
 
381
          END IF
310
382
      END IF
311
383
*
312
384
      RETURN