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

« back to all changes in this revision

Viewing changes to src/blas/single/sger.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
* 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:
1
 
      SUBROUTINE SGER  ( M, N, ALPHA, X, INCX, Y, INCY, A, LDA )
2
 
*
3
 
* $Id: sger.f 19695 2010-10-29 16:51:02Z d3y133 $
 
1
*> \brief \b SGER
 
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 SGER(M,N,ALPHA,X,INCX,Y,INCY,A,LDA)
 
12
 
13
*       .. Scalar Arguments ..
 
14
*       REAL ALPHA
 
15
*       INTEGER INCX,INCY,LDA,M,N
 
16
*       ..
 
17
*       .. Array Arguments ..
 
18
*       REAL A(LDA,*),X(*),Y(*)
 
19
*       ..
 
20
*  
 
21
*
 
22
*> \par Purpose:
 
23
*  =============
 
24
*>
 
25
*> \verbatim
 
26
*>
 
27
*> SGER   performs the rank 1 operation
 
28
*>
 
29
*>    A := alpha*x*y**T + A,
 
30
*>
 
31
*> where alpha is a scalar, x is an m element vector, y is an n element
 
32
*> vector and A is an m by n matrix.
 
33
*> \endverbatim
 
34
*
 
35
*  Arguments:
 
36
*  ==========
 
37
*
 
38
*> \param[in] M
 
39
*> \verbatim
 
40
*>          M is INTEGER
 
41
*>           On entry, M specifies the number of rows of the matrix A.
 
42
*>           M must be at least zero.
 
43
*> \endverbatim
 
44
*>
 
45
*> \param[in] N
 
46
*> \verbatim
 
47
*>          N is INTEGER
 
48
*>           On entry, N specifies the number of columns of the matrix A.
 
49
*>           N must be at least zero.
 
50
*> \endverbatim
 
51
*>
 
52
*> \param[in] ALPHA
 
53
*> \verbatim
 
54
*>          ALPHA is REAL
 
55
*>           On entry, ALPHA specifies the scalar alpha.
 
56
*> \endverbatim
 
57
*>
 
58
*> \param[in] X
 
59
*> \verbatim
 
60
*>          X is REAL array of dimension at least
 
61
*>           ( 1 + ( m - 1 )*abs( INCX ) ).
 
62
*>           Before entry, the incremented array X must contain the m
 
63
*>           element vector x.
 
64
*> \endverbatim
 
65
*>
 
66
*> \param[in] INCX
 
67
*> \verbatim
 
68
*>          INCX is INTEGER
 
69
*>           On entry, INCX specifies the increment for the elements of
 
70
*>           X. INCX must not be zero.
 
71
*> \endverbatim
 
72
*>
 
73
*> \param[in] Y
 
74
*> \verbatim
 
75
*>          Y is REAL array of dimension at least
 
76
*>           ( 1 + ( n - 1 )*abs( INCY ) ).
 
77
*>           Before entry, the incremented array Y must contain the n
 
78
*>           element vector y.
 
79
*> \endverbatim
 
80
*>
 
81
*> \param[in] INCY
 
82
*> \verbatim
 
83
*>          INCY is INTEGER
 
84
*>           On entry, INCY specifies the increment for the elements of
 
85
*>           Y. INCY must not be zero.
 
86
*> \endverbatim
 
87
*>
 
88
*> \param[in,out] A
 
89
*> \verbatim
 
90
*>          A is REAL array of DIMENSION ( LDA, n ).
 
91
*>           Before entry, the leading m by n part of the array A must
 
92
*>           contain the matrix of coefficients. On exit, A is
 
93
*>           overwritten by the updated matrix.
 
94
*> \endverbatim
 
95
*>
 
96
*> \param[in] LDA
 
97
*> \verbatim
 
98
*>          LDA is INTEGER
 
99
*>           On entry, LDA specifies the first dimension of A as declared
 
100
*>           in the calling (sub) program. LDA must be at least
 
101
*>           max( 1, m ).
 
102
*> \endverbatim
 
103
*
 
104
*  Authors:
 
105
*  ========
 
106
*
 
107
*> \author Univ. of Tennessee 
 
108
*> \author Univ. of California Berkeley 
 
109
*> \author Univ. of Colorado Denver 
 
110
*> \author NAG Ltd. 
 
111
*
 
112
*> \date November 2011
 
113
*
 
114
*> \ingroup single_blas_level2
 
115
*
 
116
*> \par Further Details:
 
117
*  =====================
 
118
*>
 
119
*> \verbatim
 
120
*>
 
121
*>  Level 2 Blas routine.
 
122
*>
 
123
*>  -- Written on 22-October-1986.
 
124
*>     Jack Dongarra, Argonne National Lab.
 
125
*>     Jeremy Du Croz, Nag Central Office.
 
126
*>     Sven Hammarling, Nag Central Office.
 
127
*>     Richard Hanson, Sandia National Labs.
 
128
*> \endverbatim
 
129
*>
 
130
*  =====================================================================
 
131
      SUBROUTINE SGER(M,N,ALPHA,X,INCX,Y,INCY,A,LDA)
 
132
*
 
133
*  -- Reference BLAS level2 routine (version 3.4.0) --
 
134
*  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 
135
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 
136
*     November 2011
4
137
*
5
138
*     .. Scalar Arguments ..
6
 
      REAL               ALPHA
7
 
      INTEGER            INCX, INCY, LDA, M, N
 
139
      REAL ALPHA
 
140
      INTEGER INCX,INCY,LDA,M,N
 
141
*     ..
8
142
*     .. Array Arguments ..
9
 
      REAL               A( LDA, * ), X( * ), Y( * )
 
143
      REAL A(LDA,*),X(*),Y(*)
10
144
*     ..
11
145
*
12
 
*  Purpose
13
 
*  =======
14
 
*
15
 
*  SGER   performs the rank 1 operation
16
 
*
17
 
*     A := alpha*x*y' + A,
18
 
*
19
 
*  where alpha is a scalar, x is an m element vector, y is an n element
20
 
*  vector and A is an m by n matrix.
21
 
*
22
 
*  Parameters
23
 
*  ==========
24
 
*
25
 
*  M      - INTEGER.
26
 
*           On entry, M specifies the number of rows of the matrix A.
27
 
*           M must be at least zero.
28
 
*           Unchanged on exit.
29
 
*
30
 
*  N      - INTEGER.
31
 
*           On entry, N specifies the number of columns of the matrix A.
32
 
*           N must be at least zero.
33
 
*           Unchanged on exit.
34
 
*
35
 
*  ALPHA  - REAL            .
36
 
*           On entry, ALPHA specifies the scalar alpha.
37
 
*           Unchanged on exit.
38
 
*
39
 
*  X      - REAL             array of dimension at least
40
 
*           ( 1 + ( m - 1 )*abs( INCX ) ).
41
 
*           Before entry, the incremented array X must contain the m
42
 
*           element vector x.
43
 
*           Unchanged on exit.
44
 
*
45
 
*  INCX   - INTEGER.
46
 
*           On entry, INCX specifies the increment for the elements of
47
 
*           X. INCX must not be zero.
48
 
*           Unchanged on exit.
49
 
*
50
 
*  Y      - REAL             array of dimension at least
51
 
*           ( 1 + ( n - 1 )*abs( INCY ) ).
52
 
*           Before entry, the incremented array Y must contain the n
53
 
*           element vector y.
54
 
*           Unchanged on exit.
55
 
*
56
 
*  INCY   - INTEGER.
57
 
*           On entry, INCY specifies the increment for the elements of
58
 
*           Y. INCY must not be zero.
59
 
*           Unchanged on exit.
60
 
*
61
 
*  A      - REAL             array of DIMENSION ( LDA, n ).
62
 
*           Before entry, the leading m by n part of the array A must
63
 
*           contain the matrix of coefficients. On exit, A is
64
 
*           overwritten by the updated matrix.
65
 
*
66
 
*  LDA    - INTEGER.
67
 
*           On entry, LDA specifies the first dimension of A as declared
68
 
*           in the calling (sub) program. LDA must be at least
69
 
*           max( 1, m ).
70
 
*           Unchanged on exit.
71
 
*
72
 
*
73
 
*  Level 2 Blas routine.
74
 
*
75
 
*  -- Written on 22-October-1986.
76
 
*     Jack Dongarra, Argonne National Lab.
77
 
*     Jeremy Du Croz, Nag Central Office.
78
 
*     Sven Hammarling, Nag Central Office.
79
 
*     Richard Hanson, Sandia National Labs.
80
 
*
 
146
*  =====================================================================
81
147
*
82
148
*     .. Parameters ..
83
 
      REAL               ZERO
84
 
      PARAMETER        ( ZERO = 0.0E+0 )
 
149
      REAL ZERO
 
150
      PARAMETER (ZERO=0.0E+0)
 
151
*     ..
85
152
*     .. Local Scalars ..
86
 
      REAL               TEMP
87
 
      INTEGER            I, INFO, IX, J, JY, KX
 
153
      REAL TEMP
 
154
      INTEGER I,INFO,IX,J,JY,KX
 
155
*     ..
88
156
*     .. External Subroutines ..
89
 
      EXTERNAL           XERBLA
 
157
      EXTERNAL XERBLA
 
158
*     ..
90
159
*     .. Intrinsic Functions ..
91
 
      INTRINSIC          MAX
 
160
      INTRINSIC MAX
92
161
*     ..
93
 
*     .. Executable Statements ..
94
162
*
95
163
*     Test the input parameters.
96
164
*
97
165
      INFO = 0
98
 
      IF     ( M.LT.0 )THEN
99
 
         INFO = 1
100
 
      ELSE IF( N.LT.0 )THEN
101
 
         INFO = 2
102
 
      ELSE IF( INCX.EQ.0 )THEN
103
 
         INFO = 5
104
 
      ELSE IF( INCY.EQ.0 )THEN
105
 
         INFO = 7
106
 
      ELSE IF( LDA.LT.MAX( 1, M ) )THEN
107
 
         INFO = 9
 
166
      IF (M.LT.0) THEN
 
167
          INFO = 1
 
168
      ELSE IF (N.LT.0) THEN
 
169
          INFO = 2
 
170
      ELSE IF (INCX.EQ.0) THEN
 
171
          INFO = 5
 
172
      ELSE IF (INCY.EQ.0) THEN
 
173
          INFO = 7
 
174
      ELSE IF (LDA.LT.MAX(1,M)) THEN
 
175
          INFO = 9
108
176
      END IF
109
 
      IF( INFO.NE.0 )THEN
110
 
         CALL XERBLA( 'SGER  ', INFO )
111
 
         RETURN
 
177
      IF (INFO.NE.0) THEN
 
178
          CALL XERBLA('SGER  ',INFO)
 
179
          RETURN
112
180
      END IF
113
181
*
114
182
*     Quick return if possible.
115
183
*
116
 
      IF( ( M.EQ.0 ).OR.( N.EQ.0 ).OR.( ALPHA.EQ.ZERO ) )
117
 
     $   RETURN
 
184
      IF ((M.EQ.0) .OR. (N.EQ.0) .OR. (ALPHA.EQ.ZERO)) RETURN
118
185
*
119
186
*     Start the operations. In this version the elements of A are
120
187
*     accessed sequentially with one pass through A.
121
188
*
122
 
      IF( INCY.GT.0 )THEN
123
 
         JY = 1
 
189
      IF (INCY.GT.0) THEN
 
190
          JY = 1
124
191
      ELSE
125
 
         JY = 1 - ( N - 1 )*INCY
 
192
          JY = 1 - (N-1)*INCY
126
193
      END IF
127
 
      IF( INCX.EQ.1 )THEN
128
 
         DO 20, J = 1, N
129
 
            IF( Y( JY ).NE.ZERO )THEN
130
 
               TEMP = ALPHA*Y( JY )
131
 
               DO 10, I = 1, M
132
 
                  A( I, J ) = A( I, J ) + X( I )*TEMP
133
 
   10          CONTINUE
134
 
            END IF
135
 
            JY = JY + INCY
136
 
   20    CONTINUE
 
194
      IF (INCX.EQ.1) THEN
 
195
          DO 20 J = 1,N
 
196
              IF (Y(JY).NE.ZERO) THEN
 
197
                  TEMP = ALPHA*Y(JY)
 
198
                  DO 10 I = 1,M
 
199
                      A(I,J) = A(I,J) + X(I)*TEMP
 
200
   10             CONTINUE
 
201
              END IF
 
202
              JY = JY + INCY
 
203
   20     CONTINUE
137
204
      ELSE
138
 
         IF( INCX.GT.0 )THEN
139
 
            KX = 1
140
 
         ELSE
141
 
            KX = 1 - ( M - 1 )*INCX
142
 
         END IF
143
 
         DO 40, J = 1, N
144
 
            IF( Y( JY ).NE.ZERO )THEN
145
 
               TEMP = ALPHA*Y( JY )
146
 
               IX   = KX
147
 
               DO 30, I = 1, M
148
 
                  A( I, J ) = A( I, J ) + X( IX )*TEMP
149
 
                  IX        = IX        + INCX
150
 
   30          CONTINUE
151
 
            END IF
152
 
            JY = JY + INCY
153
 
   40    CONTINUE
 
205
          IF (INCX.GT.0) THEN
 
206
              KX = 1
 
207
          ELSE
 
208
              KX = 1 - (M-1)*INCX
 
209
          END IF
 
210
          DO 40 J = 1,N
 
211
              IF (Y(JY).NE.ZERO) THEN
 
212
                  TEMP = ALPHA*Y(JY)
 
213
                  IX = KX
 
214
                  DO 30 I = 1,M
 
215
                      A(I,J) = A(I,J) + X(IX)*TEMP
 
216
                      IX = IX + INCX
 
217
   30             CONTINUE
 
218
              END IF
 
219
              JY = JY + INCY
 
220
   40     CONTINUE
154
221
      END IF
155
222
*
156
223
      RETURN