← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/blas/double/dsyr2.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/double/dsyr2.f
1
 
      SUBROUTINE DSYR2 ( UPLO, N, ALPHA, X, INCX, Y, INCY, A, LDA )
2
 
*
3
 
* $Id: dsyr2.f 19695 2010-10-29 16:51:02Z d3y133 $
 
1
*> \brief \b DSYR2
 
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 DSYR2(UPLO,N,ALPHA,X,INCX,Y,INCY,A,LDA)
 
12
* 
 
13
*       .. Scalar Arguments ..
 
14
*       DOUBLE PRECISION ALPHA
 
15
*       INTEGER INCX,INCY,LDA,N
 
16
*       CHARACTER UPLO
 
17
*       ..
 
18
*       .. Array Arguments ..
 
19
*       DOUBLE PRECISION A(LDA,*),X(*),Y(*)
 
20
*       ..
 
21
*  
 
22
*
 
23
*> \par Purpose:
 
24
*  =============
 
25
*>
 
26
*> \verbatim
 
27
*>
 
28
*> DSYR2  performs the symmetric rank 2 operation
 
29
*>
 
30
*>    A := alpha*x*y**T + alpha*y*x**T + A,
 
31
*>
 
32
*> where alpha is a scalar, x and y are n element vectors and A is an n
 
33
*> by n symmetric matrix.
 
34
*> \endverbatim
 
35
*
 
36
*  Arguments:
 
37
*  ==========
 
38
*
 
39
*> \param[in] UPLO
 
40
*> \verbatim
 
41
*>          UPLO is CHARACTER*1
 
42
*>           On entry, UPLO specifies whether the upper or lower
 
43
*>           triangular part of the array A is to be referenced as
 
44
*>           follows:
 
45
*>
 
46
*>              UPLO = 'U' or 'u'   Only the upper triangular part of A
 
47
*>                                  is to be referenced.
 
48
*>
 
49
*>              UPLO = 'L' or 'l'   Only the lower triangular part of A
 
50
*>                                  is to be referenced.
 
51
*> \endverbatim
 
52
*>
 
53
*> \param[in] N
 
54
*> \verbatim
 
55
*>          N is INTEGER
 
56
*>           On entry, N specifies the order of the matrix A.
 
57
*>           N must be at least zero.
 
58
*> \endverbatim
 
59
*>
 
60
*> \param[in] ALPHA
 
61
*> \verbatim
 
62
*>          ALPHA is DOUBLE PRECISION.
 
63
*>           On entry, ALPHA specifies the scalar alpha.
 
64
*> \endverbatim
 
65
*>
 
66
*> \param[in] X
 
67
*> \verbatim
 
68
*>          X is DOUBLE PRECISION array of dimension at least
 
69
*>           ( 1 + ( n - 1 )*abs( INCX ) ).
 
70
*>           Before entry, the incremented array X must contain the n
 
71
*>           element vector x.
 
72
*> \endverbatim
 
73
*>
 
74
*> \param[in] INCX
 
75
*> \verbatim
 
76
*>          INCX is INTEGER
 
77
*>           On entry, INCX specifies the increment for the elements of
 
78
*>           X. INCX must not be zero.
 
79
*> \endverbatim
 
80
*>
 
81
*> \param[in] Y
 
82
*> \verbatim
 
83
*>          Y is DOUBLE PRECISION array of dimension at least
 
84
*>           ( 1 + ( n - 1 )*abs( INCY ) ).
 
85
*>           Before entry, the incremented array Y must contain the n
 
86
*>           element vector y.
 
87
*> \endverbatim
 
88
*>
 
89
*> \param[in] INCY
 
90
*> \verbatim
 
91
*>          INCY is INTEGER
 
92
*>           On entry, INCY specifies the increment for the elements of
 
93
*>           Y. INCY must not be zero.
 
94
*> \endverbatim
 
95
*>
 
96
*> \param[in,out] A
 
97
*> \verbatim
 
98
*>          A is DOUBLE PRECISION array of DIMENSION ( LDA, n ).
 
99
*>           Before entry with  UPLO = 'U' or 'u', the leading n by n
 
100
*>           upper triangular part of the array A must contain the upper
 
101
*>           triangular part of the symmetric matrix and the strictly
 
102
*>           lower triangular part of A is not referenced. On exit, the
 
103
*>           upper triangular part of the array A is overwritten by the
 
104
*>           upper triangular part of the updated matrix.
 
105
*>           Before entry with UPLO = 'L' or 'l', the leading n by n
 
106
*>           lower triangular part of the array A must contain the lower
 
107
*>           triangular part of the symmetric matrix and the strictly
 
108
*>           upper triangular part of A is not referenced. On exit, the
 
109
*>           lower triangular part of the array A is overwritten by the
 
110
*>           lower triangular part of the updated matrix.
 
111
*> \endverbatim
 
112
*>
 
113
*> \param[in] LDA
 
114
*> \verbatim
 
115
*>          LDA is INTEGER
 
116
*>           On entry, LDA specifies the first dimension of A as declared
 
117
*>           in the calling (sub) program. LDA must be at least
 
118
*>           max( 1, n ).
 
119
*> \endverbatim
 
120
*
 
121
*  Authors:
 
122
*  ========
 
123
*
 
124
*> \author Univ. of Tennessee 
 
125
*> \author Univ. of California Berkeley 
 
126
*> \author Univ. of Colorado Denver 
 
127
*> \author NAG Ltd. 
 
128
*
 
129
*> \date November 2011
 
130
*
 
131
*> \ingroup double_blas_level2
 
132
*
 
133
*> \par Further Details:
 
134
*  =====================
 
135
*>
 
136
*> \verbatim
 
137
*>
 
138
*>  Level 2 Blas routine.
 
139
*>
 
140
*>  -- Written on 22-October-1986.
 
141
*>     Jack Dongarra, Argonne National Lab.
 
142
*>     Jeremy Du Croz, Nag Central Office.
 
143
*>     Sven Hammarling, Nag Central Office.
 
144
*>     Richard Hanson, Sandia National Labs.
 
145
*> \endverbatim
 
146
*>
 
147
*  =====================================================================
 
148
      SUBROUTINE DSYR2(UPLO,N,ALPHA,X,INCX,Y,INCY,A,LDA)
 
149
*
 
150
*  -- Reference BLAS level2 routine (version 3.4.0) --
 
151
*  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 
152
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 
153
*     November 2011
4
154
*
5
155
*     .. Scalar Arguments ..
6
 
      DOUBLE PRECISION   ALPHA
7
 
      INTEGER            INCX, INCY, LDA, N
8
 
      CHARACTER*1        UPLO
 
156
      DOUBLE PRECISION ALPHA
 
157
      INTEGER INCX,INCY,LDA,N
 
158
      CHARACTER UPLO
 
159
*     ..
9
160
*     .. Array Arguments ..
10
 
      DOUBLE PRECISION   A( LDA, * ), X( * ), Y( * )
 
161
      DOUBLE PRECISION A(LDA,*),X(*),Y(*)
11
162
*     ..
12
163
*
13
 
*  Purpose
14
 
*  =======
15
 
*
16
 
*  DSYR2  performs the symmetric rank 2 operation
17
 
*
18
 
*     A := alpha*x*y' + alpha*y*x' + A,
19
 
*
20
 
*  where alpha is a scalar, x and y are n element vectors and A is an n
21
 
*  by n symmetric matrix.
22
 
*
23
 
*  Parameters
24
 
*  ==========
25
 
*
26
 
*  UPLO   - CHARACTER*1.
27
 
*           On entry, UPLO specifies whether the upper or lower
28
 
*           triangular part of the array A is to be referenced as
29
 
*           follows:
30
 
*
31
 
*              UPLO = 'U' or 'u'   Only the upper triangular part of A
32
 
*                                  is to be referenced.
33
 
*
34
 
*              UPLO = 'L' or 'l'   Only the lower triangular part of A
35
 
*                                  is to be referenced.
36
 
*
37
 
*           Unchanged on exit.
38
 
*
39
 
*  N      - INTEGER.
40
 
*           On entry, N specifies the order of the matrix A.
41
 
*           N must be at least zero.
42
 
*           Unchanged on exit.
43
 
*
44
 
*  ALPHA  - DOUBLE PRECISION.
45
 
*           On entry, ALPHA specifies the scalar alpha.
46
 
*           Unchanged on exit.
47
 
*
48
 
*  X      - DOUBLE PRECISION array of dimension at least
49
 
*           ( 1 + ( n - 1 )*abs( INCX ) ).
50
 
*           Before entry, the incremented array X must contain the n
51
 
*           element vector x.
52
 
*           Unchanged on exit.
53
 
*
54
 
*  INCX   - INTEGER.
55
 
*           On entry, INCX specifies the increment for the elements of
56
 
*           X. INCX must not be zero.
57
 
*           Unchanged on exit.
58
 
*
59
 
*  Y      - DOUBLE PRECISION array of dimension at least
60
 
*           ( 1 + ( n - 1 )*abs( INCY ) ).
61
 
*           Before entry, the incremented array Y must contain the n
62
 
*           element vector y.
63
 
*           Unchanged on exit.
64
 
*
65
 
*  INCY   - INTEGER.
66
 
*           On entry, INCY specifies the increment for the elements of
67
 
*           Y. INCY must not be zero.
68
 
*           Unchanged on exit.
69
 
*
70
 
*  A      - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
71
 
*           Before entry with  UPLO = 'U' or 'u', the leading n by n
72
 
*           upper triangular part of the array A must contain the upper
73
 
*           triangular part of the symmetric matrix and the strictly
74
 
*           lower triangular part of A is not referenced. On exit, the
75
 
*           upper triangular part of the array A is overwritten by the
76
 
*           upper triangular part of the updated matrix.
77
 
*           Before entry with UPLO = 'L' or 'l', the leading n by n
78
 
*           lower triangular part of the array A must contain the lower
79
 
*           triangular part of the symmetric matrix and the strictly
80
 
*           upper triangular part of A is not referenced. On exit, the
81
 
*           lower triangular part of the array A is overwritten by the
82
 
*           lower triangular part of the updated matrix.
83
 
*
84
 
*  LDA    - INTEGER.
85
 
*           On entry, LDA specifies the first dimension of A as declared
86
 
*           in the calling (sub) program. LDA must be at least
87
 
*           max( 1, n ).
88
 
*           Unchanged on exit.
89
 
*
90
 
*
91
 
*  Level 2 Blas routine.
92
 
*
93
 
*  -- Written on 22-October-1986.
94
 
*     Jack Dongarra, Argonne National Lab.
95
 
*     Jeremy Du Croz, Nag Central Office.
96
 
*     Sven Hammarling, Nag Central Office.
97
 
*     Richard Hanson, Sandia National Labs.
98
 
*
 
164
*  =====================================================================
99
165
*
100
166
*     .. Parameters ..
101
 
      DOUBLE PRECISION   ZERO
102
 
      PARAMETER        ( ZERO = 0.0D+0 )
 
167
      DOUBLE PRECISION ZERO
 
168
      PARAMETER (ZERO=0.0D+0)
 
169
*     ..
103
170
*     .. Local Scalars ..
104
 
      DOUBLE PRECISION   TEMP1, TEMP2
105
 
      INTEGER            I, INFO, IX, IY, J, JX, JY, KX, KY
 
171
      DOUBLE PRECISION TEMP1,TEMP2
 
172
      INTEGER I,INFO,IX,IY,J,JX,JY,KX,KY
 
173
*     ..
106
174
*     .. External Functions ..
107
 
      LOGICAL            LSAME
108
 
      EXTERNAL           LSAME
 
175
      LOGICAL LSAME
 
176
      EXTERNAL LSAME
 
177
*     ..
109
178
*     .. External Subroutines ..
110
 
      EXTERNAL           XERBLA
 
179
      EXTERNAL XERBLA
 
180
*     ..
111
181
*     .. Intrinsic Functions ..
112
 
      INTRINSIC          MAX
 
182
      INTRINSIC MAX
113
183
*     ..
114
 
*     .. Executable Statements ..
115
184
*
116
185
*     Test the input parameters.
117
186
*
118
187
      INFO = 0
119
 
      IF     ( .NOT.LSAME( UPLO, 'U' ).AND.
120
 
     $         .NOT.LSAME( UPLO, 'L' )      )THEN
121
 
         INFO = 1
122
 
      ELSE IF( N.LT.0 )THEN
123
 
         INFO = 2
124
 
      ELSE IF( INCX.EQ.0 )THEN
125
 
         INFO = 5
126
 
      ELSE IF( INCY.EQ.0 )THEN
127
 
         INFO = 7
128
 
      ELSE IF( LDA.LT.MAX( 1, N ) )THEN
129
 
         INFO = 9
 
188
      IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
 
189
          INFO = 1
 
190
      ELSE IF (N.LT.0) THEN
 
191
          INFO = 2
 
192
      ELSE IF (INCX.EQ.0) THEN
 
193
          INFO = 5
 
194
      ELSE IF (INCY.EQ.0) THEN
 
195
          INFO = 7
 
196
      ELSE IF (LDA.LT.MAX(1,N)) THEN
 
197
          INFO = 9
130
198
      END IF
131
 
      IF( INFO.NE.0 )THEN
132
 
         CALL XERBLA( 'DSYR2 ', INFO )
133
 
         RETURN
 
199
      IF (INFO.NE.0) THEN
 
200
          CALL XERBLA('DSYR2 ',INFO)
 
201
          RETURN
134
202
      END IF
135
203
*
136
204
*     Quick return if possible.
137
205
*
138
 
      IF( ( N.EQ.0 ).OR.( ALPHA.EQ.ZERO ) )
139
 
     $   RETURN
 
206
      IF ((N.EQ.0) .OR. (ALPHA.EQ.ZERO)) RETURN
140
207
*
141
208
*     Set up the start points in X and Y if the increments are not both
142
209
*     unity.
143
 
*     The next 4 lines are to satisfy compiler warnings.
144
210
*
145
 
      JX = 1
146
 
      JY = 1
147
 
      KX = 1
148
 
      KY = 1
149
 
      IF( ( INCX.NE.1 ).OR.( INCY.NE.1 ) )THEN
150
 
         IF( INCX.GT.0 )THEN
151
 
            KX = 1
152
 
         ELSE
153
 
            KX = 1 - ( N - 1 )*INCX
154
 
         END IF
155
 
         IF( INCY.GT.0 )THEN
156
 
            KY = 1
157
 
         ELSE
158
 
            KY = 1 - ( N - 1 )*INCY
159
 
         END IF
160
 
         JX = KX
161
 
         JY = KY
 
211
      IF ((INCX.NE.1) .OR. (INCY.NE.1)) THEN
 
212
          IF (INCX.GT.0) THEN
 
213
              KX = 1
 
214
          ELSE
 
215
              KX = 1 - (N-1)*INCX
 
216
          END IF
 
217
          IF (INCY.GT.0) THEN
 
218
              KY = 1
 
219
          ELSE
 
220
              KY = 1 - (N-1)*INCY
 
221
          END IF
 
222
          JX = KX
 
223
          JY = KY
162
224
      END IF
163
225
*
164
226
*     Start the operations. In this version the elements of A are
165
227
*     accessed sequentially with one pass through the triangular part
166
228
*     of A.
167
229
*
168
 
      IF( LSAME( UPLO, 'U' ) )THEN
 
230
      IF (LSAME(UPLO,'U')) THEN
169
231
*
170
232
*        Form  A  when A is stored in the upper triangle.
171
233
*
172
 
         IF( ( INCX.EQ.1 ).AND.( INCY.EQ.1 ) )THEN
173
 
            DO 20, J = 1, N
174
 
               IF( ( X( J ).NE.ZERO ).OR.( Y( J ).NE.ZERO ) )THEN
175
 
                  TEMP1 = ALPHA*Y( J )
176
 
                  TEMP2 = ALPHA*X( J )
177
 
                  DO 10, I = 1, J
178
 
                     A( I, J ) = A( I, J ) + X( I )*TEMP1 + Y( I )*TEMP2
179
 
   10             CONTINUE
180
 
               END IF
181
 
   20       CONTINUE
182
 
         ELSE
183
 
            DO 40, J = 1, N
184
 
               IF( ( X( JX ).NE.ZERO ).OR.( Y( JY ).NE.ZERO ) )THEN
185
 
                  TEMP1 = ALPHA*Y( JY )
186
 
                  TEMP2 = ALPHA*X( JX )
187
 
                  IX    = KX
188
 
                  IY    = KY
189
 
                  DO 30, I = 1, J
190
 
                     A( I, J ) = A( I, J ) + X( IX )*TEMP1
191
 
     $                                     + Y( IY )*TEMP2
192
 
                     IX        = IX        + INCX
193
 
                     IY        = IY        + INCY
194
 
   30             CONTINUE
195
 
               END IF
196
 
               JX = JX + INCX
197
 
               JY = JY + INCY
198
 
   40       CONTINUE
199
 
         END IF
 
234
          IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
 
235
              DO 20 J = 1,N
 
236
                  IF ((X(J).NE.ZERO) .OR. (Y(J).NE.ZERO)) THEN
 
237
                      TEMP1 = ALPHA*Y(J)
 
238
                      TEMP2 = ALPHA*X(J)
 
239
                      DO 10 I = 1,J
 
240
                          A(I,J) = A(I,J) + X(I)*TEMP1 + Y(I)*TEMP2
 
241
   10                 CONTINUE
 
242
                  END IF
 
243
   20         CONTINUE
 
244
          ELSE
 
245
              DO 40 J = 1,N
 
246
                  IF ((X(JX).NE.ZERO) .OR. (Y(JY).NE.ZERO)) THEN
 
247
                      TEMP1 = ALPHA*Y(JY)
 
248
                      TEMP2 = ALPHA*X(JX)
 
249
                      IX = KX
 
250
                      IY = KY
 
251
                      DO 30 I = 1,J
 
252
                          A(I,J) = A(I,J) + X(IX)*TEMP1 + Y(IY)*TEMP2
 
253
                          IX = IX + INCX
 
254
                          IY = IY + INCY
 
255
   30                 CONTINUE
 
256
                  END IF
 
257
                  JX = JX + INCX
 
258
                  JY = JY + INCY
 
259
   40         CONTINUE
 
260
          END IF
200
261
      ELSE
201
262
*
202
263
*        Form  A  when A is stored in the lower triangle.
203
264
*
204
 
         IF( ( INCX.EQ.1 ).AND.( INCY.EQ.1 ) )THEN
205
 
            DO 60, J = 1, N
206
 
               IF( ( X( J ).NE.ZERO ).OR.( Y( J ).NE.ZERO ) )THEN
207
 
                  TEMP1 = ALPHA*Y( J )
208
 
                  TEMP2 = ALPHA*X( J )
209
 
                  DO 50, I = J, N
210
 
                     A( I, J ) = A( I, J ) + X( I )*TEMP1 + Y( I )*TEMP2
211
 
   50             CONTINUE
212
 
               END IF
213
 
   60       CONTINUE
214
 
         ELSE
215
 
            DO 80, J = 1, N
216
 
               IF( ( X( JX ).NE.ZERO ).OR.( Y( JY ).NE.ZERO ) )THEN
217
 
                  TEMP1 = ALPHA*Y( JY )
218
 
                  TEMP2 = ALPHA*X( JX )
219
 
                  IX    = JX
220
 
                  IY    = JY
221
 
                  DO 70, I = J, N
222
 
                     A( I, J ) = A( I, J ) + X( IX )*TEMP1
223
 
     $                                     + Y( IY )*TEMP2
224
 
                     IX        = IX        + INCX
225
 
                     IY        = IY        + INCY
226
 
   70             CONTINUE
227
 
               END IF
228
 
               JX = JX + INCX
229
 
               JY = JY + INCY
230
 
   80       CONTINUE
231
 
         END IF
 
265
          IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
 
266
              DO 60 J = 1,N
 
267
                  IF ((X(J).NE.ZERO) .OR. (Y(J).NE.ZERO)) THEN
 
268
                      TEMP1 = ALPHA*Y(J)
 
269
                      TEMP2 = ALPHA*X(J)
 
270
                      DO 50 I = J,N
 
271
                          A(I,J) = A(I,J) + X(I)*TEMP1 + Y(I)*TEMP2
 
272
   50                 CONTINUE
 
273
                  END IF
 
274
   60         CONTINUE
 
275
          ELSE
 
276
              DO 80 J = 1,N
 
277
                  IF ((X(JX).NE.ZERO) .OR. (Y(JY).NE.ZERO)) THEN
 
278
                      TEMP1 = ALPHA*Y(JY)
 
279
                      TEMP2 = ALPHA*X(JX)
 
280
                      IX = JX
 
281
                      IY = JY
 
282
                      DO 70 I = J,N
 
283
                          A(I,J) = A(I,J) + X(IX)*TEMP1 + Y(IY)*TEMP2
 
284
                          IX = IX + INCX
 
285
                          IY = IY + INCY
 
286
   70                 CONTINUE
 
287
                  END IF
 
288
                  JX = JX + INCX
 
289
                  JY = JY + INCY
 
290
   80         CONTINUE
 
291
          END IF
232
292
      END IF
233
293
*
234
294
      RETURN