/[ascend]/trunk/minos54/miascend.f
ViewVC logotype

Contents of /trunk/minos54/miascend.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1 - (show annotations) (download)
Fri Oct 29 20:54:12 2004 UTC (19 years, 7 months ago) by aw0a
File size: 9137 byte(s)
Setting up web subdirectory in repository
1 c********************************************************************\
2 c minos C interface
3 c ASCEND
4 c (C) Ben Allan, August 9, 1994
5 c $Revision: 1.1.1.1 $
6 c $Date: 1996/04/30 16:34:15 $
7 c
8 c MINOS 5.4 is proprietary software sitelicensed to Carnegie Mellon.
9 c Others who wish to use minos with ASCEND must get their own license
10 c and MINOS 5.4 sources. We provide only interface code to feed problems
11 c to MINOS 5.4.
12 c********************************************************************/
13
14
15 c********************************************************************\
16 c Function to return values of various common block values.
17 c major: number of major iterations by minos (int)
18 c minor: number of minor iterations by minos (int)
19 c********************************************************************/
20 subroutine get_minos_common(major,minor)
21
22 implicit double precision (a-h,o-z)
23 common /m8save/ vimax ,virel ,maxvi ,majits,minits,nssave
24 integer major, minor
25 major= majits
26 minor= minits
27
28 return
29 end
30
31 *********************************************************************
32 * The following utilities are also used by minos.
33 * They are defined in mi15blas.f in normal minos installations.
34 *
35 * dddiv ddscl dload dnorm1
36 * hcopy hload icopy iload iload1
37 *
38 * These could be tuned to the machine being used.
39 * dload is used the most.
40 *
41 *++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
42
43
44 subroutine dddiv ( n, d, incd, x, incx )
45
46 implicit double precision (a-h,o-z)
47 double precision d(*), x(*)
48
49 * dddiv performs the diagonal scaling x = x / d.
50
51 integer i, id, ix
52 external dscal
53 intrinsic abs
54 parameter ( one = 1.0d+0 )
55
56 if (n .gt. 0) then
57 if (incd .eq. 0 .and. incx .ne. 0) then
58 call dscal ( n, one/d(1), x, abs(incx) )
59 else if (incd .eq. incx .and. incd .gt. 0) then
60 do 10 id = 1, 1 + (n - 1)*incd, incd
61 x(id) = x(id) / d(id)
62 10 continue
63 else
64 if (incx .ge. 0) then
65 ix = 1
66 else
67 ix = 1 - (n - 1)*incx
68 end if
69 if (incd .gt. 0) then
70 do 20 id = 1, 1 + (n - 1)*incd, incd
71 x(ix) = x(ix) / d(id)
72 ix = ix + incx
73 20 continue
74 else
75 id = 1 - (n - 1)*incd
76 do 30 i = 1, n
77 x(ix) = x(ix) / d(id)
78 id = id + incd
79 ix = ix + incx
80 30 continue
81 end if
82 end if
83 end if
84
85 * end of dddiv
86 end
87
88 *++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
89
90 subroutine ddscl ( n, d, incd, x, incx )
91
92 integer incd, incx, n
93 double precision d(*), x(*)
94
95 * ddscl performs the diagonal scaling x = d * x.
96
97 integer i, id, ix
98 external dscal
99 intrinsic abs
100
101 if (n .gt. 0) then
102 if (incd .eq. 0 .and. incx .ne. 0) then
103 call dscal ( n, d(1), x, abs(incx) )
104 else if (incd .eq. incx .and. incd .gt. 0) then
105 do 10 id = 1, 1 + (n - 1)*incd, incd
106 x(id) = d(id)*x(id)
107 10 continue
108 else
109 if (incx .ge. 0) then
110 ix = 1
111 else
112 ix = 1 - (n - 1)*incx
113 end if
114 if (incd .gt. 0) then
115 do 20 id = 1, 1 + (n - 1)*incd, incd
116 x(ix) = d(id)*x(ix)
117 ix = ix + incx
118 20 continue
119 else
120 id = 1 - (n - 1)*incd
121 do 30 i = 1, n
122 x(ix) = d(id)*x(ix)
123 id = id + incd
124 ix = ix + incx
125 30 continue
126 end if
127 end if
128 end if
129
130 * end of ddscl
131 end
132
133 *++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
134
135 subroutine dload ( n, const, x, incx )
136
137 double precision const
138 integer incx, n
139 double precision x(*)
140
141 * dload loads elements of x with const.
142
143 double precision zero
144 parameter ( zero = 0.0d+0 )
145 integer ix
146
147 if (n .gt. 0) then
148 if (incx .eq. 1 .and. const .eq. zero) then
149 do 10 ix = 1, n
150 x(ix) = zero
151 10 continue
152 else
153 do 20 ix = 1, 1 + (n - 1)*incx, incx
154 x(ix) = const
155 20 continue
156 end if
157 end if
158
159 * end of dload
160 end
161
162 *++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
163
164 function dnorm1( n, x, incx )
165
166 implicit double precision (a-h,o-z)
167 double precision x(*)
168
169 * dnorm1 returns the 1-norm of the vector x, scaled by root(n).
170 * This approximates an "average" element of x with some allowance
171 * for x being sparse.
172
173 intrinsic sqrt
174 external dasum
175
176 d = n
177 d = dasum ( n, x, incx ) / sqrt(d)
178 dnorm1 = d
179
180 * end of dnorm1
181 end
182
183 *++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
184
185 subroutine hcopy ( n, hx, incx, hy, incy )
186
187 integer*4 hx(*), hy(*)
188 integer incx, incy
189
190 * hcopy is the half-integer version of dcopy.
191 * In this version of MINOS we no longer use half integers.
192
193 integer ix, iy
194
195 if (n .gt. 0) then
196 if (incx .eq. incy .and. incy .gt. 0) then
197 do 10 iy = 1, 1 + (n - 1)*incy, incy
198 hy(iy) = hx(iy)
199 10 continue
200 else
201 if (incx .ge. 0) then
202 ix = 1
203 else
204 ix = 1 - (n - 1)*incx
205 end if
206 if (incy .gt. 0) then
207 do 20 iy = 1, 1 + ( n - 1 )*incy, incy
208 hy(iy) = hx(ix)
209 ix = ix + incx
210 20 continue
211 else
212 iy = 1 - (n - 1)*incy
213 do 30 i = 1, n
214 hy(iy) = hx(ix)
215 iy = iy + incy
216 ix = ix + incx
217 30 continue
218 end if
219 end if
220 end if
221
222 * end of hcopy
223 end
224
225 *++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
226
227 subroutine hload ( n, const, hx, incx )
228
229 integer incx, n
230 integer const
231 integer*4 hx(*)
232
233 * hload loads elements of hx with const.
234 * Beware that const is INTEGER, not half integer.
235
236 integer ix
237
238 if (n .gt. 0) then
239 if (incx .eq. 1 .and. const .eq. 0) then
240 do 10 ix = 1, n
241 hx(ix) = 0
242 10 continue
243 else
244 do 20 ix = 1, 1 + (n - 1)*incx, incx
245 hx(ix) = const
246 20 continue
247 end if
248 end if
249
250 * end of hload
251 end
252
253 *++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
254
255 subroutine icopy ( n, x, incx, y, incy )
256
257 integer x(*), y(*)
258 integer incx, incy
259
260 * icopy is the integer version of dcopy.
261
262 integer ix, iy
263
264 if (n .gt. 0) then
265 if (incx .eq. incy .and. incy .gt. 0) then
266 do 10 iy = 1, 1 + (n - 1)*incy, incy
267 y(iy) = x(iy)
268 10 continue
269 else
270 if (incx .ge. 0) then
271 ix = 1
272 else
273 ix = 1 - (n - 1)*incx
274 end if
275 if (incy .gt. 0) then
276 do 20 iy = 1, 1 + ( n - 1 )*incy, incy
277 y(iy) = x(ix)
278 ix = ix + incx
279 20 continue
280 else
281 iy = 1 - (n - 1)*incy
282 do 30 i = 1, n
283 y(iy) = x(ix)
284 iy = iy + incy
285 ix = ix + incx
286 30 continue
287 end if
288 end if
289 end if
290
291 * end of icopy
292 end
293
294 *++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
295
296 subroutine iload ( n, const, x, incx )
297
298 integer incx, n
299 integer const
300 integer x(*)
301
302 * iload loads elements of x with const.
303
304 integer ix
305
306 if (n .gt. 0) then
307 if (incx .eq. 1 .and. const .eq. 0) then
308 do 10 ix = 1, n
309 x(ix) = 0
310 10 continue
311 else
312 do 20 ix = 1, 1 + (n - 1)*incx, incx
313 x(ix) = const
314 20 continue
315 end if
316 end if
317
318 * end of iload
319 end
320
321 *++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
322
323 subroutine iload1( n, const, x, incx )
324
325 integer incx, n
326 integer const
327 integer x(*)
328
329 * iload1 loads elements of x with const, by calling iload.
330 * iload1 is needed in MINOS because iload is a file number.
331
332 call iload ( n, const, x, incx )
333
334 * end of iload1
335 end

john.pye@anu.edu.au
ViewVC Help
Powered by ViewVC 1.1.22