← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/blas/f77reference/chpr.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/chpr.f
 
1
      SUBROUTINE CHPR(UPLO,N,ALPHA,X,INCX,AP)
 
2
*     .. Scalar Arguments ..
 
3
      REAL ALPHA
 
4
      INTEGER INCX,N
 
5
      CHARACTER UPLO
 
6
*     ..
 
7
*     .. Array Arguments ..
 
8
      COMPLEX AP(*),X(*)
 
9
*     ..
 
10
*
 
11
*  Purpose
 
12
*  =======
 
13
*
 
14
*  CHPR    performs the hermitian rank 1 operation
 
15
*
 
16
*     A := alpha*x*conjg( x' ) + A,
 
17
*
 
18
*  where alpha is a real scalar, x is an n element vector and A is an
 
19
*  n by n hermitian matrix, supplied in packed form.
 
20
*
 
21
*  Arguments
 
22
*  ==========
 
23
*
 
24
*  UPLO   - CHARACTER*1.
 
25
*           On entry, UPLO specifies whether the upper or lower
 
26
*           triangular part of the matrix A is supplied in the packed
 
27
*           array AP as follows:
 
28
*
 
29
*              UPLO = 'U' or 'u'   The upper triangular part of A is
 
30
*                                  supplied in AP.
 
31
*
 
32
*              UPLO = 'L' or 'l'   The lower triangular part of A is
 
33
*                                  supplied in AP.
 
34
*
 
35
*           Unchanged on exit.
 
36
*
 
37
*  N      - INTEGER.
 
38
*           On entry, N specifies the order of the matrix A.
 
39
*           N must be at least zero.
 
40
*           Unchanged on exit.
 
41
*
 
42
*  ALPHA  - REAL            .
 
43
*           On entry, ALPHA specifies the scalar alpha.
 
44
*           Unchanged on exit.
 
45
*
 
46
*  X      - COMPLEX          array of dimension at least
 
47
*           ( 1 + ( n - 1 )*abs( INCX ) ).
 
48
*           Before entry, the incremented array X must contain the n
 
49
*           element vector x.
 
50
*           Unchanged on exit.
 
51
*
 
52
*  INCX   - INTEGER.
 
53
*           On entry, INCX specifies the increment for the elements of
 
54
*           X. INCX must not be zero.
 
55
*           Unchanged on exit.
 
56
*
 
57
*  AP     - COMPLEX          array of DIMENSION at least
 
58
*           ( ( n*( n + 1 ) )/2 ).
 
59
*           Before entry with  UPLO = 'U' or 'u', the array AP must
 
60
*           contain the upper triangular part of the hermitian matrix
 
61
*           packed sequentially, column by column, so that AP( 1 )
 
62
*           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 )
 
63
*           and a( 2, 2 ) respectively, and so on. On exit, the array
 
64
*           AP is overwritten by the upper triangular part of the
 
65
*           updated matrix.
 
66
*           Before entry with UPLO = 'L' or 'l', the array AP must
 
67
*           contain the lower triangular part of the hermitian matrix
 
68
*           packed sequentially, column by column, so that AP( 1 )
 
69
*           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 )
 
70
*           and a( 3, 1 ) respectively, and so on. On exit, the array
 
71
*           AP is overwritten by the lower triangular part of the
 
72
*           updated matrix.
 
73
*           Note that the imaginary parts of the diagonal elements need
 
74
*           not be set, they are assumed to be zero, and on exit they
 
75
*           are set to zero.
 
76
*
 
77
*
 
78
*  Level 2 Blas routine.
 
79
*
 
80
*  -- Written on 22-October-1986.
 
81
*     Jack Dongarra, Argonne National Lab.
 
82
*     Jeremy Du Croz, Nag Central Office.
 
83
*     Sven Hammarling, Nag Central Office.
 
84
*     Richard Hanson, Sandia National Labs.
 
85
*
 
86
*
 
87
*     .. Parameters ..
 
88
      COMPLEX ZERO
 
89
      PARAMETER (ZERO= (0.0E+0,0.0E+0))
 
90
*     ..
 
91
*     .. Local Scalars ..
 
92
      COMPLEX TEMP
 
93
      INTEGER I,INFO,IX,J,JX,K,KK,KX
 
94
*     ..
 
95
*     .. External Functions ..
 
96
      LOGICAL LSAME
 
97
      EXTERNAL LSAME
 
98
*     ..
 
99
*     .. External Subroutines ..
 
100
      EXTERNAL XERBLA
 
101
*     ..
 
102
*     .. Intrinsic Functions ..
 
103
      INTRINSIC CONJG,REAL
 
104
*     ..
 
105
*
 
106
*     Test the input parameters.
 
107
*
 
108
      INFO = 0
 
109
      IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
 
110
          INFO = 1
 
111
      ELSE IF (N.LT.0) THEN
 
112
          INFO = 2
 
113
      ELSE IF (INCX.EQ.0) THEN
 
114
          INFO = 5
 
115
      END IF
 
116
      IF (INFO.NE.0) THEN
 
117
          CALL XERBLA('CHPR  ',INFO)
 
118
          RETURN
 
119
      END IF
 
120
*
 
121
*     Quick return if possible.
 
122
*
 
123
      IF ((N.EQ.0) .OR. (ALPHA.EQ.REAL(ZERO))) RETURN
 
124
*
 
125
*     Set the start point in X if the increment is not unity.
 
126
*
 
127
      IF (INCX.LE.0) THEN
 
128
          KX = 1 - (N-1)*INCX
 
129
      ELSE IF (INCX.NE.1) THEN
 
130
          KX = 1
 
131
      END IF
 
132
*
 
133
*     Start the operations. In this version the elements of the array AP
 
134
*     are accessed sequentially with one pass through AP.
 
135
*
 
136
      KK = 1
 
137
      IF (LSAME(UPLO,'U')) THEN
 
138
*
 
139
*        Form  A  when upper triangle is stored in AP.
 
140
*
 
141
          IF (INCX.EQ.1) THEN
 
142
              DO 20 J = 1,N
 
143
                  IF (X(J).NE.ZERO) THEN
 
144
                      TEMP = ALPHA*CONJG(X(J))
 
145
                      K = KK
 
146
                      DO 10 I = 1,J - 1
 
147
                          AP(K) = AP(K) + X(I)*TEMP
 
148
                          K = K + 1
 
149
   10                 CONTINUE
 
150
                      AP(KK+J-1) = REAL(AP(KK+J-1)) + REAL(X(J)*TEMP)
 
151
                  ELSE
 
152
                      AP(KK+J-1) = REAL(AP(KK+J-1))
 
153
                  END IF
 
154
                  KK = KK + J
 
155
   20         CONTINUE
 
156
          ELSE
 
157
              JX = KX
 
158
              DO 40 J = 1,N
 
159
                  IF (X(JX).NE.ZERO) THEN
 
160
                      TEMP = ALPHA*CONJG(X(JX))
 
161
                      IX = KX
 
162
                      DO 30 K = KK,KK + J - 2
 
163
                          AP(K) = AP(K) + X(IX)*TEMP
 
164
                          IX = IX + INCX
 
165
   30                 CONTINUE
 
166
                      AP(KK+J-1) = REAL(AP(KK+J-1)) + REAL(X(JX)*TEMP)
 
167
                  ELSE
 
168
                      AP(KK+J-1) = REAL(AP(KK+J-1))
 
169
                  END IF
 
170
                  JX = JX + INCX
 
171
                  KK = KK + J
 
172
   40         CONTINUE
 
173
          END IF
 
174
      ELSE
 
175
*
 
176
*        Form  A  when lower triangle is stored in AP.
 
177
*
 
178
          IF (INCX.EQ.1) THEN
 
179
              DO 60 J = 1,N
 
180
                  IF (X(J).NE.ZERO) THEN
 
181
                      TEMP = ALPHA*CONJG(X(J))
 
182
                      AP(KK) = REAL(AP(KK)) + REAL(TEMP*X(J))
 
183
                      K = KK + 1
 
184
                      DO 50 I = J + 1,N
 
185
                          AP(K) = AP(K) + X(I)*TEMP
 
186
                          K = K + 1
 
187
   50                 CONTINUE
 
188
                  ELSE
 
189
                      AP(KK) = REAL(AP(KK))
 
190
                  END IF
 
191
                  KK = KK + N - J + 1
 
192
   60         CONTINUE
 
193
          ELSE
 
194
              JX = KX
 
195
              DO 80 J = 1,N
 
196
                  IF (X(JX).NE.ZERO) THEN
 
197
                      TEMP = ALPHA*CONJG(X(JX))
 
198
                      AP(KK) = REAL(AP(KK)) + REAL(TEMP*X(JX))
 
199
                      IX = JX
 
200
                      DO 70 K = KK + 1,KK + N - J
 
201
                          IX = IX + INCX
 
202
                          AP(K) = AP(K) + X(IX)*TEMP
 
203
   70                 CONTINUE
 
204
                  ELSE
 
205
                      AP(KK) = REAL(AP(KK))
 
206
                  END IF
 
207
                  JX = JX + INCX
 
208
                  KK = KK + N - J + 1
 
209
   80         CONTINUE
 
210
          END IF
 
211
      END IF
 
212
*
 
213
      RETURN
 
214
*
 
215
*     End of CHPR  .
 
216
*
 
217
      END