← Back to branch summary

~ubuntu-branches/ubuntu/saucy/nwchem/saucy

« back to all changes in this revision

Viewing changes to src/tools/ga-5-1/LinAlg/lapack+blas/zgemm.f

  • Committer: Package Import Robot
  • Author(s): Michael Banck, Michael Banck, Daniel Leidert
  • Date: 2012-02-09 20:02:41 UTC
  • mfrom: (1.1.1)
  • Revision ID: package-import@ubuntu.com-20120209200241-jgk03qfsphal4ug2
Tags: 6.1-1
http://bugs.debian.org/632611
https://launchpad.net/bugs/791308
* New upstream release.

[ Michael Banck ]
* debian/patches/02_makefile_flags.patch: Updated.
* debian/patches/02_makefile_flags.patch: Use internal blas and lapack code.
* debian/patches/02_makefile_flags.patch: Define GCC4 for LINUX and LINUX64
  (Closes: #632611 and LP: #791308).
* debian/control (Build-Depends): Added openssh-client.
* debian/rules (USE_SCALAPACK, SCALAPACK): Removed variables (Closes:
  #654658).
* debian/rules (LIBDIR, USE_MPIF4, ARMCI_NETWORK): New variables.
* debian/TODO: New file.
* debian/control (Build-Depends): Removed libblas-dev, liblapack-dev and
  libscalapack-mpi-dev.
* debian/patches/04_show_testsuite_diff_output.patch: New patch, shows the
  diff output for failed tests.
* debian/patches/series: Adjusted.
* debian/testsuite: Optionally run all tests if "all" is passed as option.
* debian/rules: Run debian/testsuite with "all" if DEB_BUILD_OPTIONS
  contains "checkall".

[ Daniel Leidert ]
* debian/control: Used wrap-and-sort. Added Vcs-Svn and Vcs-Browser fields.
  (Priority): Moved to extra according to policy section 2.5.
  (Standards-Version): Bumped to 3.9.2.
  (Description): Fixed a typo.
* debian/watch: Added.
* debian/patches/03_hurd-i386_define_path_max.patch: Added.
  - Define MAX_PATH if not defines to fix FTBFS on hurd.
* debian/patches/series: Adjusted.

Show diffs side-by-side

added added

removed removed

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