← Back to branch summary

~ubuntu-branches/ubuntu/vivid/atlas/vivid

« back to all changes in this revision

Viewing changes to src/blas/f77reference/dsyrk.f

  • Committer: Package Import Robot
  • Author(s): Sébastien Villemot, Sylvestre Ledru, Sébastien Villemot
  • Date: 2013-06-11 15:58:16 UTC
  • mfrom: (1.1.4) (25 sid)
  • mto: This revision was merged to the branch mainline in revision 26.
  • Revision ID: package-import@ubuntu.com-20130611155816-8xeeiziu1iml040c
Tags: 3.10.1-1
http://bugs.debian.org/609287
http://bugs.debian.org/602524
http://bugs.debian.org/701921
http://bugs.debian.org/666203
http://bugs.debian.org/701068
http://bugs.debian.org/697431
[ Sylvestre Ledru ]
* New upstream release (Closes: #609287)

[ Sébastien Villemot ]
* Provide architectural defaults (i.e. precomputed timings) for all
  release archs (except armel and mips for the time being, due to slow
  porterboxes). This will make the package build much faster and should
  eliminate transient build failures due to excessive variance in the
  timings.
* Move symlinks for lib{cblas,f77blas,atlas,lapack_atlas} out of the
  libblas.so.3 alternative and make them always present, so that
  software relying on these libs do not break when another alternative
  is selected for BLAS
* ATLAS now has improved ARM support with native asm constructs. This required
  the following tunes:
  + armel-is-v4t.diff: new patch, prevents FTBFS on armel; otherwise,
    ATLAS uses asm constructs too recent for the platform (armel is only v4t)
  + debian/rules: on armhf, define the ATL_ARM_HARDFP flag; otherwise the asm
    constructs use the soft-float ABI for passing floating points
  + on armhf, ensure that -mfloat-abi=softfp and -mcpu=vfpv3 flags are never
    used; this is implemented via a patch (armhf.diff) and by the use of fixed
    archdefs
* The generic package is now built without multi-threading, because otherwise
  the package fails to build on some single-processor machines (this required
  the introduction of a patch: fix-non-threaded-build.diff). As a side effect,
  the build of the custom package gracefully handles non-threaded
  builds. (Closes: #602524)
* Add libblas.a as slave in the libblas.so alternative (Closes: #701921)
* Add symlinks for lib{f77blas,atlas}.a in /usr/lib (Closes: #666203)
* Modify shlibs file of libatlas3-base, such that packages using
  libblas/liblapack depend on any BLAS/LAPACK alternative, while packages
  depending on ATLAS-specific libraries (e.g. libatlas.so) depend specifically
  on libatlas3-base.
* corei1.diff: remove patch, applied upstream
* Use my @debian.org email address
* Remove obsolete DM-Upload-Allowed flag
* Switch VCS to git
* Remove Conflicts/Replaces against pre-squeeze packages
* libatlas-base-dev now provides libblas.so, as libblas-dev
* No longer use -Wa,--noexecstack in CFLAGS, it makes the package FTBFS
* Do not use POWER3 arch for powerpcspe port (Closes: #701068)
* Bump to debhelper compat level 9
* README.Debian: mention that devscripts is needed to compile the custom
  package (Closes: #697431)
* Bump Standards-Version to 3.9.4. As a consequence, add Built-Using
  fields because the package embeds stuff from liblapack-pic

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/blas/f77reference/dsyrk.f
 
1
      SUBROUTINE DSYRK(UPLO,TRANS,N,K,ALPHA,A,LDA,BETA,C,LDC)
 
2
*     .. Scalar Arguments ..
 
3
      DOUBLE PRECISION ALPHA,BETA
 
4
      INTEGER K,LDA,LDC,N
 
5
      CHARACTER TRANS,UPLO
 
6
*     ..
 
7
*     .. Array Arguments ..
 
8
      DOUBLE PRECISION A(LDA,*),C(LDC,*)
 
9
*     ..
 
10
*
 
11
*  Purpose
 
12
*  =======
 
13
*
 
14
*  DSYRK  performs one of the symmetric rank k operations
 
15
*
 
16
*     C := alpha*A*A' + beta*C,
 
17
*
 
18
*  or
 
19
*
 
20
*     C := alpha*A'*A + beta*C,
 
21
*
 
22
*  where  alpha and beta  are scalars, C is an  n by n  symmetric matrix
 
23
*  and  A  is an  n by k  matrix in the first case and a  k by n  matrix
 
24
*  in the second case.
 
25
*
 
26
*  Arguments
 
27
*  ==========
 
28
*
 
29
*  UPLO   - CHARACTER*1.
 
30
*           On  entry,   UPLO  specifies  whether  the  upper  or  lower
 
31
*           triangular  part  of the  array  C  is to be  referenced  as
 
32
*           follows:
 
33
*
 
34
*              UPLO = 'U' or 'u'   Only the  upper triangular part of  C
 
35
*                                  is to be referenced.
 
36
*
 
37
*              UPLO = 'L' or 'l'   Only the  lower triangular part of  C
 
38
*                                  is to be referenced.
 
39
*
 
40
*           Unchanged on exit.
 
41
*
 
42
*  TRANS  - CHARACTER*1.
 
43
*           On entry,  TRANS  specifies the operation to be performed as
 
44
*           follows:
 
45
*
 
46
*              TRANS = 'N' or 'n'   C := alpha*A*A' + beta*C.
 
47
*
 
48
*              TRANS = 'T' or 't'   C := alpha*A'*A + beta*C.
 
49
*
 
50
*              TRANS = 'C' or 'c'   C := alpha*A'*A + beta*C.
 
51
*
 
52
*           Unchanged on exit.
 
53
*
 
54
*  N      - INTEGER.
 
55
*           On entry,  N specifies the order of the matrix C.  N must be
 
56
*           at least zero.
 
57
*           Unchanged on exit.
 
58
*
 
59
*  K      - INTEGER.
 
60
*           On entry with  TRANS = 'N' or 'n',  K  specifies  the number
 
61
*           of  columns   of  the   matrix   A,   and  on   entry   with
 
62
*           TRANS = 'T' or 't' or 'C' or 'c',  K  specifies  the  number
 
63
*           of rows of the matrix  A.  K must be at least zero.
 
64
*           Unchanged on exit.
 
65
*
 
66
*  ALPHA  - DOUBLE PRECISION.
 
67
*           On entry, ALPHA specifies the scalar alpha.
 
68
*           Unchanged on exit.
 
69
*
 
70
*  A      - DOUBLE PRECISION array of DIMENSION ( LDA, ka ), where ka is
 
71
*           k  when  TRANS = 'N' or 'n',  and is  n  otherwise.
 
72
*           Before entry with  TRANS = 'N' or 'n',  the  leading  n by k
 
73
*           part of the array  A  must contain the matrix  A,  otherwise
 
74
*           the leading  k by n  part of the array  A  must contain  the
 
75
*           matrix A.
 
76
*           Unchanged on exit.
 
77
*
 
78
*  LDA    - INTEGER.
 
79
*           On entry, LDA specifies the first dimension of A as declared
 
80
*           in  the  calling  (sub)  program.   When  TRANS = 'N' or 'n'
 
81
*           then  LDA must be at least  max( 1, n ), otherwise  LDA must
 
82
*           be at least  max( 1, k ).
 
83
*           Unchanged on exit.
 
84
*
 
85
*  BETA   - DOUBLE PRECISION.
 
86
*           On entry, BETA specifies the scalar beta.
 
87
*           Unchanged on exit.
 
88
*
 
89
*  C      - DOUBLE PRECISION array of DIMENSION ( LDC, n ).
 
90
*           Before entry  with  UPLO = 'U' or 'u',  the leading  n by n
 
91
*           upper triangular part of the array C must contain the upper
 
92
*           triangular part  of the  symmetric matrix  and the strictly
 
93
*           lower triangular part of C is not referenced.  On exit, the
 
94
*           upper triangular part of the array  C is overwritten by the
 
95
*           upper triangular part of the updated matrix.
 
96
*           Before entry  with  UPLO = 'L' or 'l',  the leading  n by n
 
97
*           lower triangular part of the array C must contain the lower
 
98
*           triangular part  of the  symmetric matrix  and the strictly
 
99
*           upper triangular part of C is not referenced.  On exit, the
 
100
*           lower triangular part of the array  C is overwritten by the
 
101
*           lower triangular part of the updated matrix.
 
102
*
 
103
*  LDC    - INTEGER.
 
104
*           On entry, LDC specifies the first dimension of C as declared
 
105
*           in  the  calling  (sub)  program.   LDC  must  be  at  least
 
106
*           max( 1, n ).
 
107
*           Unchanged on exit.
 
108
*
 
109
*
 
110
*  Level 3 Blas routine.
 
111
*
 
112
*  -- Written on 8-February-1989.
 
113
*     Jack Dongarra, Argonne National Laboratory.
 
114
*     Iain Duff, AERE Harwell.
 
115
*     Jeremy Du Croz, Numerical Algorithms Group Ltd.
 
116
*     Sven Hammarling, Numerical Algorithms Group Ltd.
 
117
*
 
118
*
 
119
*     .. External Functions ..
 
120
      LOGICAL LSAME
 
121
      EXTERNAL LSAME
 
122
*     ..
 
123
*     .. External Subroutines ..
 
124
      EXTERNAL XERBLA
 
125
*     ..
 
126
*     .. Intrinsic Functions ..
 
127
      INTRINSIC MAX
 
128
*     ..
 
129
*     .. Local Scalars ..
 
130
      DOUBLE PRECISION TEMP
 
131
      INTEGER I,INFO,J,L,NROWA
 
132
      LOGICAL UPPER
 
133
*     ..
 
134
*     .. Parameters ..
 
135
      DOUBLE PRECISION ONE,ZERO
 
136
      PARAMETER (ONE=1.0D+0,ZERO=0.0D+0)
 
137
*     ..
 
138
*
 
139
*     Test the input parameters.
 
140
*
 
141
      IF (LSAME(TRANS,'N')) THEN
 
142
          NROWA = N
 
143
      ELSE
 
144
          NROWA = K
 
145
      END IF
 
146
      UPPER = LSAME(UPLO,'U')
 
147
*
 
148
      INFO = 0
 
149
      IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN
 
150
          INFO = 1
 
151
      ELSE IF ((.NOT.LSAME(TRANS,'N')) .AND.
 
152
     +         (.NOT.LSAME(TRANS,'T')) .AND.
 
153
     +         (.NOT.LSAME(TRANS,'C'))) THEN
 
154
          INFO = 2
 
155
      ELSE IF (N.LT.0) THEN
 
156
          INFO = 3
 
157
      ELSE IF (K.LT.0) THEN
 
158
          INFO = 4
 
159
      ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
 
160
          INFO = 7
 
161
      ELSE IF (LDC.LT.MAX(1,N)) THEN
 
162
          INFO = 10
 
163
      END IF
 
164
      IF (INFO.NE.0) THEN
 
165
          CALL XERBLA('DSYRK ',INFO)
 
166
          RETURN
 
167
      END IF
 
168
*
 
169
*     Quick return if possible.
 
170
*
 
171
      IF ((N.EQ.0) .OR. (((ALPHA.EQ.ZERO).OR.
 
172
     +    (K.EQ.0)).AND. (BETA.EQ.ONE))) RETURN
 
173
*
 
174
*     And when  alpha.eq.zero.
 
175
*
 
176
      IF (ALPHA.EQ.ZERO) THEN
 
177
          IF (UPPER) THEN
 
178
              IF (BETA.EQ.ZERO) THEN
 
179
                  DO 20 J = 1,N
 
180
                      DO 10 I = 1,J
 
181
                          C(I,J) = ZERO
 
182
   10                 CONTINUE
 
183
   20             CONTINUE
 
184
              ELSE
 
185
                  DO 40 J = 1,N
 
186
                      DO 30 I = 1,J
 
187
                          C(I,J) = BETA*C(I,J)
 
188
   30                 CONTINUE
 
189
   40             CONTINUE
 
190
              END IF
 
191
          ELSE
 
192
              IF (BETA.EQ.ZERO) THEN
 
193
                  DO 60 J = 1,N
 
194
                      DO 50 I = J,N
 
195
                          C(I,J) = ZERO
 
196
   50                 CONTINUE
 
197
   60             CONTINUE
 
198
              ELSE
 
199
                  DO 80 J = 1,N
 
200
                      DO 70 I = J,N
 
201
                          C(I,J) = BETA*C(I,J)
 
202
   70                 CONTINUE
 
203
   80             CONTINUE
 
204
              END IF
 
205
          END IF
 
206
          RETURN
 
207
      END IF
 
208
*
 
209
*     Start the operations.
 
210
*
 
211
      IF (LSAME(TRANS,'N')) THEN
 
212
*
 
213
*        Form  C := alpha*A*A' + beta*C.
 
214
*
 
215
          IF (UPPER) THEN
 
216
              DO 130 J = 1,N
 
217
                  IF (BETA.EQ.ZERO) THEN
 
218
                      DO 90 I = 1,J
 
219
                          C(I,J) = ZERO
 
220
   90                 CONTINUE
 
221
                  ELSE IF (BETA.NE.ONE) THEN
 
222
                      DO 100 I = 1,J
 
223
                          C(I,J) = BETA*C(I,J)
 
224
  100                 CONTINUE
 
225
                  END IF
 
226
                  DO 120 L = 1,K
 
227
                      IF (A(J,L).NE.ZERO) THEN
 
228
                          TEMP = ALPHA*A(J,L)
 
229
                          DO 110 I = 1,J
 
230
                              C(I,J) = C(I,J) + TEMP*A(I,L)
 
231
  110                     CONTINUE
 
232
                      END IF
 
233
  120             CONTINUE
 
234
  130         CONTINUE
 
235
          ELSE
 
236
              DO 180 J = 1,N
 
237
                  IF (BETA.EQ.ZERO) THEN
 
238
                      DO 140 I = J,N
 
239
                          C(I,J) = ZERO
 
240
  140                 CONTINUE
 
241
                  ELSE IF (BETA.NE.ONE) THEN
 
242
                      DO 150 I = J,N
 
243
                          C(I,J) = BETA*C(I,J)
 
244
  150                 CONTINUE
 
245
                  END IF
 
246
                  DO 170 L = 1,K
 
247
                      IF (A(J,L).NE.ZERO) THEN
 
248
                          TEMP = ALPHA*A(J,L)
 
249
                          DO 160 I = J,N
 
250
                              C(I,J) = C(I,J) + TEMP*A(I,L)
 
251
  160                     CONTINUE
 
252
                      END IF
 
253
  170             CONTINUE
 
254
  180         CONTINUE
 
255
          END IF
 
256
      ELSE
 
257
*
 
258
*        Form  C := alpha*A'*A + beta*C.
 
259
*
 
260
          IF (UPPER) THEN
 
261
              DO 210 J = 1,N
 
262
                  DO 200 I = 1,J
 
263
                      TEMP = ZERO
 
264
                      DO 190 L = 1,K
 
265
                          TEMP = TEMP + A(L,I)*A(L,J)
 
266
  190                 CONTINUE
 
267
                      IF (BETA.EQ.ZERO) THEN
 
268
                          C(I,J) = ALPHA*TEMP
 
269
                      ELSE
 
270
                          C(I,J) = ALPHA*TEMP + BETA*C(I,J)
 
271
                      END IF
 
272
  200             CONTINUE
 
273
  210         CONTINUE
 
274
          ELSE
 
275
              DO 240 J = 1,N
 
276
                  DO 230 I = J,N
 
277
                      TEMP = ZERO
 
278
                      DO 220 L = 1,K
 
279
                          TEMP = TEMP + A(L,I)*A(L,J)
 
280
  220                 CONTINUE
 
281
                      IF (BETA.EQ.ZERO) THEN
 
282
                          C(I,J) = ALPHA*TEMP
 
283
                      ELSE
 
284
                          C(I,J) = ALPHA*TEMP + BETA*C(I,J)
 
285
                      END IF
 
286
  230             CONTINUE
 
287
  240         CONTINUE
 
288
          END IF
 
289
      END IF
 
290
*
 
291
      RETURN
 
292
*
 
293
*     End of DSYRK .
 
294
*
 
295
      END