← Back to branch summary

~chaffra/+junk/trilinos

« back to all changes in this revision

Viewing changes to packages/zoltan/src/util/converters_for_JPDC_adaptive_mesh_experiments/exo2chaco/chaco/symmlq/symmlqblas.f

  • Committer: Bazaar Package Importer
  • Author(s): Christophe Prud'homme, Christophe Prud'homme, Johannes Ring
  • Date: 2009-12-13 12:53:22 UTC
  • mfrom: (5.1.2 sid)
  • Revision ID: james.westby@ubuntu.com-20091213125322-in0nrdjc55deqsw9
Tags: 10.0.3.dfsg-1
[Christophe Prud'homme]
* New upstream release

[Johannes Ring]
* debian/patches/libname.patch: Add prefix 'libtrilinos_' to all
  libraries. 
* debian/patches/soname.patch: Add soversion to libraries.
* debian/watch: Update download URL.
* debian/control:
  - Remove python-numeric from Build-Depends (virtual package).
  - Remove automake and autotools from Build-Depends and add cmake to
    reflect switch to CMake.
  - Add python-support to Build-Depends.
* debian/rules: 
  - Cleanup and updates for switch to CMake.

Show diffs side-by-side

added added

removed removed

Lines of Context:
packages/zoltan/src/util/converters_for_JPDC_adaptive_mesh_experiments/exo2chaco/chaco/symmlq/symmlqblas.f
 
1
*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
2
*
 
3
*     symmlqblas  fortran
 
4
*
 
5
*     daxpy    dcopy    ddot     dnrm2
 
6
*
 
7
*** from netlib, Thu May 16 21:00:13 EDT 1991 ***
 
8
*** Declarations of the form dx(1) changed to dx(*)
 
9
*
 
10
*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
11
*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
12
 
 
13
      subroutine daxpy(n,da,dx,incx,dy,incy)
 
14
c
 
15
c     constant times a vector plus a vector.
 
16
c     uses unrolled loops for increments equal to one.
 
17
c     jack dongarra, linpack, 3/11/78.
 
18
c
 
19
      double precision dx(*),dy(*),da
 
20
      integer i,incx,incy,ix,iy,m,mp1,n
 
21
c
 
22
      if(n.le.0)return
 
23
      if (da .eq. 0.0d0) return
 
24
      if(incx.eq.1.and.incy.eq.1)go to 20
 
25
c
 
26
c        code for unequal increments or equal increments
 
27
c          not equal to 1
 
28
c
 
29
      ix = 1
 
30
      iy = 1
 
31
      if(incx.lt.0)ix = (-n+1)*incx + 1
 
32
      if(incy.lt.0)iy = (-n+1)*incy + 1
 
33
      do 10 i = 1,n
 
34
        dy(iy) = dy(iy) + da*dx(ix)
 
35
        ix = ix + incx
 
36
        iy = iy + incy
 
37
   10 continue
 
38
      return
 
39
c
 
40
c        code for both increments equal to 1
 
41
c
 
42
c
 
43
c        clean-up loop
 
44
c
 
45
   20 m = mod(n,4)
 
46
      if( m .eq. 0 ) go to 40
 
47
      do 30 i = 1,m
 
48
        dy(i) = dy(i) + da*dx(i)
 
49
   30 continue
 
50
      if( n .lt. 4 ) return
 
51
   40 mp1 = m + 1
 
52
      do 50 i = mp1,n,4
 
53
        dy(i) = dy(i) + da*dx(i)
 
54
        dy(i + 1) = dy(i + 1) + da*dx(i + 1)
 
55
        dy(i + 2) = dy(i + 2) + da*dx(i + 2)
 
56
        dy(i + 3) = dy(i + 3) + da*dx(i + 3)
 
57
   50 continue
 
58
      return
 
59
      end
 
60
 
 
61
*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
62
 
 
63
      subroutine  dcopy(n,dx,incx,dy,incy)
 
64
c
 
65
c     copies a vector, x, to a vector, y.
 
66
c     uses unrolled loops for increments equal to one.
 
67
c     jack dongarra, linpack, 3/11/78.
 
68
c
 
69
      double precision dx(*),dy(*)
 
70
      integer i,incx,incy,ix,iy,m,mp1,n
 
71
c
 
72
      if(n.le.0)return
 
73
      if(incx.eq.1.and.incy.eq.1)go to 20
 
74
c
 
75
c        code for unequal increments or equal increments
 
76
c          not equal to 1
 
77
c
 
78
      ix = 1
 
79
      iy = 1
 
80
      if(incx.lt.0)ix = (-n+1)*incx + 1
 
81
      if(incy.lt.0)iy = (-n+1)*incy + 1
 
82
      do 10 i = 1,n
 
83
        dy(iy) = dx(ix)
 
84
        ix = ix + incx
 
85
        iy = iy + incy
 
86
   10 continue
 
87
      return
 
88
c
 
89
c        code for both increments equal to 1
 
90
c
 
91
c
 
92
c        clean-up loop
 
93
c
 
94
   20 m = mod(n,7)
 
95
      if( m .eq. 0 ) go to 40
 
96
      do 30 i = 1,m
 
97
        dy(i) = dx(i)
 
98
   30 continue
 
99
      if( n .lt. 7 ) return
 
100
   40 mp1 = m + 1
 
101
      do 50 i = mp1,n,7
 
102
        dy(i) = dx(i)
 
103
        dy(i + 1) = dx(i + 1)
 
104
        dy(i + 2) = dx(i + 2)
 
105
        dy(i + 3) = dx(i + 3)
 
106
        dy(i + 4) = dx(i + 4)
 
107
        dy(i + 5) = dx(i + 5)
 
108
        dy(i + 6) = dx(i + 6)
 
109
   50 continue
 
110
      return
 
111
      end
 
112
 
 
113
*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
114
 
 
115
      double precision function ddot(n,dx,incx,dy,incy)
 
116
c
 
117
c     forms the dot product of two vectors.
 
118
c     uses unrolled loops for increments equal to one.
 
119
c     jack dongarra, linpack, 3/11/78.
 
120
c
 
121
      double precision dx(*),dy(*),dtemp
 
122
      integer i,incx,incy,ix,iy,m,mp1,n
 
123
c
 
124
      ddot = 0.0d0
 
125
      dtemp = 0.0d0
 
126
      if(n.le.0)return
 
127
      if(incx.eq.1.and.incy.eq.1)go to 20
 
128
c
 
129
c        code for unequal increments or equal increments
 
130
c          not equal to 1
 
131
c
 
132
      ix = 1
 
133
      iy = 1
 
134
      if(incx.lt.0)ix = (-n+1)*incx + 1
 
135
      if(incy.lt.0)iy = (-n+1)*incy + 1
 
136
      do 10 i = 1,n
 
137
        dtemp = dtemp + dx(ix)*dy(iy)
 
138
        ix = ix + incx
 
139
        iy = iy + incy
 
140
   10 continue
 
141
      ddot = dtemp
 
142
      return
 
143
c
 
144
c        code for both increments equal to 1
 
145
c
 
146
c
 
147
c        clean-up loop
 
148
c
 
149
   20 m = mod(n,5)
 
150
      if( m .eq. 0 ) go to 40
 
151
      do 30 i = 1,m
 
152
        dtemp = dtemp + dx(i)*dy(i)
 
153
   30 continue
 
154
      if( n .lt. 5 ) go to 60
 
155
   40 mp1 = m + 1
 
156
      do 50 i = mp1,n,5
 
157
        dtemp = dtemp + dx(i)*dy(i) + dx(i + 1)*dy(i + 1) +
 
158
     *   dx(i + 2)*dy(i + 2) + dx(i + 3)*dy(i + 3) + dx(i + 4)*dy(i + 4)
 
159
   50 continue
 
160
   60 ddot = dtemp
 
161
      return
 
162
      end
 
163
 
 
164
*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
165
 
 
166
      double precision function dnrm2 ( n, dx, incx)
 
167
      integer          next
 
168
      double precision   dx(*), cutlo, cuthi, hitest, sum, xmax,zero,one
 
169
      data   zero, one /0.0d0, 1.0d0/
 
170
c
 
171
c     euclidean norm of the n-vector stored in dx() with storage
 
172
c     increment incx .
 
173
c     if    n .le. 0 return with result = 0.
 
174
c     if n .ge. 1 then incx must be .ge. 1
 
175
c
 
176
c           c.l.lawson, 1978 jan 08
 
177
c
 
178
c     four phase method     using two built-in constants that are
 
179
c     hopefully applicable to all machines.
 
180
c         cutlo = maximum of  dsqrt(u/eps)  over all known machines.
 
181
c         cuthi = minimum of  dsqrt(v)      over all known machines.
 
182
c     where
 
183
c         eps = smallest no. such that eps + 1. .gt. 1.
 
184
c         u   = smallest positive no.   (underflow limit)
 
185
c         v   = largest  no.            (overflow  limit)
 
186
c
 
187
c     brief outline of algorithm..
 
188
c
 
189
c     phase 1    scans zero components.
 
190
c     move to phase 2 when a component is nonzero and .le. cutlo
 
191
c     move to phase 3 when a component is .gt. cutlo
 
192
c     move to phase 4 when a component is .ge. cuthi/m
 
193
c     where m = n for x() real and m = 2*n for complex.
 
194
c
 
195
c     values for cutlo and cuthi..
 
196
c     from the environmental parameters listed in the imsl converter
 
197
c     document the limiting values are as follows..
 
198
c     cutlo, s.p.   u/eps = 2**(-102) for  honeywell.  close seconds are
 
199
c                   univac and dec at 2**(-103)
 
200
c                   thus cutlo = 2**(-51) = 4.44089e-16
 
201
c     cuthi, s.p.   v = 2**127 for univac, honeywell, and dec.
 
202
c                   thus cuthi = 2**(63.5) = 1.30438e19
 
203
c     cutlo, d.p.   u/eps = 2**(-67) for honeywell and dec.
 
204
c                   thus cutlo = 2**(-33.5) = 8.23181d-11
 
205
c     cuthi, d.p.   same as s.p.  cuthi = 1.30438d19
 
206
c     data cutlo, cuthi / 8.232d-11,  1.304d19 /
 
207
c     data cutlo, cuthi / 4.441e-16,  1.304e19 /
 
208
      data cutlo, cuthi / 8.232d-11,  1.304d19 /
 
209
c
 
210
      if(n .gt. 0) go to 10
 
211
         dnrm2  = zero
 
212
         go to 300
 
213
c
 
214
   10 assign 30 to next
 
215
      sum = zero
 
216
      nn = n * incx
 
217
c                                                 begin main loop
 
218
      i = 1
 
219
   20    go to next,(30, 50, 70, 110)
 
220
   30 if( dabs(dx(i)) .gt. cutlo) go to 85
 
221
      assign 50 to next
 
222
      xmax = zero
 
223
c
 
224
c                        phase 1.  sum is zero
 
225
c
 
226
   50 if( dx(i) .eq. zero) go to 200
 
227
      if( dabs(dx(i)) .gt. cutlo) go to 85
 
228
c
 
229
c                                prepare for phase 2.
 
230
      assign 70 to next
 
231
      go to 105
 
232
c
 
233
c                                prepare for phase 4.
 
234
c
 
235
  100 i = j
 
236
      assign 110 to next
 
237
      sum = (sum / dx(i)) / dx(i)
 
238
  105 xmax = dabs(dx(i))
 
239
      go to 115
 
240
c
 
241
c                   phase 2.  sum is small.
 
242
c                             scale to avoid destructive underflow.
 
243
c
 
244
   70 if( dabs(dx(i)) .gt. cutlo ) go to 75
 
245
c
 
246
c                     common code for phases 2 and 4.
 
247
c                     in phase 4 sum is large.  scale to avoid overflow.
 
248
c
 
249
  110 if( dabs(dx(i)) .le. xmax ) go to 115
 
250
         sum = one + sum * (xmax / dx(i))**2
 
251
         xmax = dabs(dx(i))
 
252
         go to 200
 
253
c
 
254
  115 sum = sum + (dx(i)/xmax)**2
 
255
      go to 200
 
256
c
 
257
c
 
258
c                  prepare for phase 3.
 
259
c
 
260
   75 sum = (sum * xmax) * xmax
 
261
c
 
262
c
 
263
c     for real or d.p. set hitest = cuthi/n
 
264
c     for complex      set hitest = cuthi/(2*n)
 
265
c
 
266
   85 hitest = cuthi/float( n )
 
267
c
 
268
c                   phase 3.  sum is mid-range.  no scaling.
 
269
c
 
270
      do 95 j =i,nn,incx
 
271
      if(dabs(dx(j)) .ge. hitest) go to 100
 
272
   95    sum = sum + dx(j)**2
 
273
      dnrm2 = dsqrt( sum )
 
274
      go to 300
 
275
c
 
276
  200 continue
 
277
      i = i + incx
 
278
      if ( i .le. nn ) go to 20
 
279
c
 
280
c              end of main loop.
 
281
c
 
282
c              compute square root and adjust for scaling.
 
283
c
 
284
      dnrm2 = xmax * dsqrt(sum)
 
285
  300 continue
 
286
      return
 
287
      end