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

Contents of /trunk/minos54/mi10unix.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: 76254 byte(s)
Setting up web subdirectory in repository
1 ************************************************************************
2 *
3 * File mi10unix fortran.
4 *--> Unix version of mi10mach fortran
5 *
6 * minoss minos1 minos2 minos3
7 * mifile mispec misolv
8 * m1clos m1envt m1init
9 * m1open m1page m1time m1timp m1cpu
10 *
11 * mi10vms and mi10unix are the same except for
12 * minos2 m1cpu
13 *
14 *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
15
16 subroutine minoss( start, m, n, nb, ne, nname,
17 $ nncon, nnobj, nnjac,
18 $ iobj, objadd, names,
19 $ a, ha, ka, bl, bu, name1, name2,
20 $ hs, xn, pi, rc,
21 $ inform, mincor, ns, ninf, sinf, obj,
22 $ z, nwcore )
23
24 implicit double precision (a-h,o-z)
25 character*(10) start
26 character*8 names(5)
27 integer*4 ha(ne), hs(nb)
28 integer ka(n+1), name1(nname), name2(nname)
29 double precision a(ne), bl(nb), bu(nb)
30 double precision xn(nb), pi(m), rc(nb), z(nwcore)
31
32 * ------------------------------------------------------------------
33 * minoss (pronounced minos-s) is the subroutine version of MINOS.
34 * It has all the data passed to it as parameters instead of reading
35 * it from an MPS file.
36 *
37 * ON ENTRY:
38 *
39 * start specifies how a starting basis (and certain other items)
40 * are to be obtained.
41 * start = 'Cold' means that Crash should be used to choose
42 * an initial basis, unless a basis file is given
43 * via Old basis, Insert or Load in the Specs file.
44 * start = 'Basis file' means the same (but is more
45 * meaningful in the latter case).
46 * start = 'Warm' means that a basis is already defined in hs
47 * (probably from an earlier call).
48 * start = 'Hot' or 'Hot FHS' implies a hot start.
49 * hs defines a basis and an earlier call has
50 * defined certain other things that should also be
51 * kept. The problem dimensions and the array z(*)
52 * must not have changed.
53 * F refers to the LU factors of the basis.
54 * H refers to the approximate reduced Hessian R.
55 * S refers to column and row scales.
56 * start = 'Hot H' (for example) means that only the Hessian
57 * is defined.
58 *
59 * m is the number of general constraints. For LP problems
60 * this means the number of rows in the constraint matrix A.
61 * m > 0 in principle, though sometimes m = 0 may be ok.
62 * (Strictly speaking, Fortran declarations of the form
63 * double precision pi(m)
64 * require m > 0. In debug mode, compilers will probably
65 * enforce m > 0, but optimized code may run ok with m = 0.)
66 *
67 * n is the number of variables, excluding slacks.
68 * For LP problems, this is the number of columns in A.
69 * n > 0.
70 *
71 * nb is n + m.
72 *
73 * ne is the number of nonzero entries in A (including the
74 * Jacobian for any nonlinear constraints).
75 * ne > 0 in principle, though again m = 0, ne = 0 may work
76 * with some compilers.
77 *
78 * nname is the number of column and row names provided in the
79 * arrays name1 and name2. If nname = 1, there are NO names.
80 * Generic names will be used in the printed solution.
81 * Otherwise, nname = nb and all names must be provided.
82 *
83 * nncon is the number of nonlinear constraints.
84 * nncon ge 0.
85 *
86 * nnobj is the number of nonlinear objective variables.
87 * nnobj ge 0.
88 *
89 * nnjac is the number of nonlinear Jacobian variables.
90 * If nncon = 0, nnjac = 0.
91 * if nncon > 0, nnjac > 0.
92 *
93 * iobj says which row of A is a free row containing a linear
94 * objective vector c (iobj = 0 if none).
95 * iobj = 0 or nncon < iobj le m.
96 *
97 * objadd is a constant that will be added to the objective.
98 * Typically objadd = 0.0d+0.
99 *
100 * names(5)is a set of 8-character names for the problem, the linear
101 * objective, the rhs, the ranges and bounds. (This is a
102 * hangover from MPS files. The names are used in the
103 * printed solution and in some of the basis files.)
104 *
105 * a(ne) is the constraint matrix (Jacobian), stored column-wise.
106 *
107 * ha(ne) is the list of row indices for each nonzero in a(*).
108 *
109 * ka(n+1) is a set of pointers to the beginning of each column of
110 * the constraint matrix within a(*) and ha(*).
111 * Must have ka(1) = 1 and ka(n+1) = ne+1.
112 *
113 * NOTES: 1. If the problem has a nonlinear objective,
114 * the first nnobj columns of a and ha belong to the
115 * nonlinear objective variables.
116 * Subroutine funobj deals with these variables.
117 *
118 * 2. If the problem has nonlinear constraints,
119 * the first nnjac columns of a and ha belong to the
120 * nonlinear Jacobian variables, and
121 * the first nncon rows of a and ha belong to the
122 * nonlinear constraints.
123 * Subroutine funcon deals with these variables and
124 * constraints.
125 *
126 * 3. If nnobj > 0 and nnjac > 0, the two sets of
127 * nonlinear variables overlap. The total number of
128 * nonlinear variables is nn = max( nnobj, nnjac ).
129 *
130 * 4. The Jacobian forms the top left corner of a and ha.
131 * If a Jacobian column j (1 le j le nnjac) contains
132 * any entries a(k), ha(k) associated with nonlinear
133 * constraints (1 le ha(k) le nncon), those entries must
134 * come before any other (linear) entries.
135 *
136 * 5. The row indices ha(k) for a column may be in any order
137 * (subject to Jacobian entries appearing first).
138 * Subroutine funcon must define Jacobian entries in the
139 * same order.
140 *
141 * 6. If column j contains no entries, perhaps
142 * ka(j) = ka(j+1) is acceptable. (Must check this.
143 * When MINOS reads an MPS with empty columns,
144 * it inserts a dummy entry a(k) = 0.0d+0, ha(k) = 1.
145 * This may not be necessary.)
146 *
147 * 7. To allocate storage, MINOS needs to know if the Jacobian
148 * is dense or sparse. The default is dense. If this is
149 * not appropriate, define
150 * Jacobian Sparse
151 * in the Specs file, or
152 * call miopt ( 'Jacobian Sparse', 0, 0, inform )
153 * before calling minoss.
154 *
155 * bl(nb) is the lower bounds on the variables and slacks (x, s).
156 *
157 * bu(nb) is the upper bounds on (x, s).
158 *
159 * BEWARE: MINOS represents general constraints as Ax + s = 0.
160 * Constraints of the form l <= Ax <= u
161 * therefore mean l <= -s <= u,
162 * so that -u <= s <= -l.
163 * The last m components of bl and bu are -u and -l.
164 *
165 * name1(nname), name2(nname) are two integer arrays.
166 * If nname = 1, name1 and name2 are not used. The printed
167 * solution will use generic names for the columns and row.
168 * If nname = nb, name1(j) and name2(j) should contain the
169 * name of the j-th variable in 2a4 format (j = 1, nb).
170 * If j = n+i, the j-th variable is the i-th row.
171 *
172 * hs(nb) sometimes contains a set of initial states for each
173 * variable x or for each column and slack (x, s).
174 * See the following NOTES.
175 *
176 * xn(nb) sometimes contains a set of initial values for each
177 * variable x or for each column and slack (x, s).
178 * See the following NOTES.
179 *
180 * NOTES: 1. If start = 'Cold' or 'Basis file' and a BASIS file
181 * of some sort is to be input
182 * (an OLD BASIS file, INSERT file or LOAD file),
183 * hs and xn need not be set at all.
184 *
185 * 2. Otherwise, hs(j) and xn(j), j=1:n, must be defined for a
186 * Cold start. (The values for j=n+1:nb need not be set.)
187 * If nothing special is known about the problem, or if
188 * there is no wish to provide special information,
189 * you may set hs(j) = 0, xn(j) = 0.0d+0 for all j=1:n.
190 * All variables will be eligible for the initial basis.
191 *
192 * Less trivially, to say that variable j will probably
193 * be equal to one of its bounds,
194 * set hs(j) = 4 and xn(j) = bl(j)
195 * or hs(j) = 5 and xn(j) = bu(j) as appropriate.
196 *
197 * 3. For Cold starts with no basis file, a Crash procedure
198 * is used to select an initial basis. The initial basis
199 * matrix will be triangular (ignoring certain small
200 * entries in each column).
201 * The values hs(j) = 0, 1, 2, 3, 4, 5 have the following
202 * meaning:
203 *
204 * hs(j) State of variable j during Crash
205 *
206 * 0, 1, 3 Eligible for the basis. 3 is given preference.
207 * 2, 4, 5 Ignored.
208 *
209 * After Crash, hs(j) = 2 entries are made superbasic.
210 * Other entries not selected for the basis are made
211 * nonbasic at the value xn(j) if bl(j) <= xn(j) <= bu(j),
212 * or at the value bl(j) or bu(j) closest to xn(j).
213 *
214 * 4. For Warm or Hot starts, all of hs(1:nb) is assumed to be
215 * set to the values 0, 1, 2 or 3 (probably from some
216 * previous call) and all of xn(1:nb) must have values.
217 *
218 * pi(m) contains an estimate of the vector of Lagrange multipliers
219 * (shadow prices) for the NONLINEAR constraints. The first
220 * nncon components must be defined. They will be used as
221 * lambda in the subproblem objective function for the first
222 * major iteration. If nothing is known about lambda,
223 * set pi(i) = 0.0d+0, i = 1 to nncon.
224 *
225 * ns need not be specified for Cold starts,
226 * but should retain its value from a previous call
227 * when a Warm or Hot start is used.
228 *
229 *
230 * ON EXIT:
231 *
232 * hs(nb) is the final state vector:
233 *
234 * hs(j) State of variable j Normal value of xn(j)
235 *
236 * 0 nonbasic bl(j)
237 * 1 nonbasic bu(j)
238 * 2 superbasic Between bl(j) and bu(j)
239 * 3 basic ditto
240 *
241 * Very occasionally there may be nonbasic variables for
242 * which xn(j) lies strictly between its bounds.
243 * If ninf = 0, basic and superbasic variables may be outside
244 * their bounds by as much as the Feasibility tolerance.
245 * Note that if Scale is specified, the Feasibility tolerance
246 * applies to the variables of the SCALED problem.
247 * In this case, the variables of the original problem may be
248 * as much as 0.1 outside their bounds, but this is unlikely
249 * unless the problem is very badly scaled.
250 *
251 * xn(nb) is the final variables and slacks (x, s).
252 *
253 * pi(m) is the vector of Lagrange multipliers (shadow prices)
254 * for the general constraints.
255 *
256 * rc(nb) is a vector of reduced costs: rc = g - (A I)'pi, where g
257 * is the gradient of the objective function if xn is feasible
258 * (or the gradient of the Phase-1 objective otherwise).
259 * If ninf = 0, the last m entries are -pi (negative pi).
260 *
261 * inform says what happened; see Chapter 6.3 of the User's Guide.
262 * A summary of possible values follows:
263 *
264 * inform Meaning
265 *
266 * 0 Optimal solution found.
267 * 1 The problem is infeasible.
268 * 2 The problem is unbounded (or badly scaled).
269 * 3 Too many iterations.
270 * 4 Apparent stall. The solution has not changed
271 * for a large number of iterations (e.g. 1000).
272 * 5 The Superbasics limit is too small.
273 * 6 Subroutine funobj or funcon requested termination
274 * by returning mode < 0.
275 * 7 Subroutine funobj seems to be giving incorrect
276 * gradients.
277 * 8 Subroutine funcon seems to be giving incorrect
278 * gradients.
279 * 9 The current point cannot be improved.
280 * 10 Numerical error in trying to satisfy the linear
281 * constraints (or the linearized nonlinear
282 * constraints). The basis is very ill-conditioned.
283 * 11 Cannot find a superbasic to replace a basic
284 * variable.
285 * 12 Basis factorization requested twice in a row.
286 * Should probably be treated as inform = 9.
287 * 13 Near-optimal solution found.
288 * Should probably be treated as inform = 9.
289 *
290 * 20 Not enough storage for the basis factorization.
291 * 21 Error in basis package.
292 * 22 The basis is singular after several attempts to
293 * factorize it (and add slacks where necessary).
294 *
295 * 30 An OLD BASIS file had dimensions that did not
296 * match the current problem.
297 * 32 System error. Wrong number of basic variables.
298 *
299 * 40 Fatal errors in the MPS file.
300 * 41 Not enough storage to read the MPS file.
301 * 42 Not enough storage to solve the problem.
302 *
303 * mincor says how much storage is needed to solve the problem.
304 * If inform = 42, the work array z(nwcore) was too small.
305 * minoss may be called again with nwcore suitably larger
306 * than mincor. (The bigger the better, since it is
307 * not certain how much storage the basis factors need.)
308 *
309 * ns is the final number of superbasics.
310 *
311 * ninf is the number of infeasibilities.
312 *
313 * sinf is the sum of infeasibilities.
314 *
315 * obj is the value of the objective function.
316 * If ninf = 0, obj includes the nonlinear objective if any.
317 * If ninf > 0, obj is just the linear objective if any.
318 *
319 * 30 Sep 1991: First version.
320 * 06 Dec 1991: A few more output parameters.
321 * 10 Apr 1992: Parameter objadd added. Parameters reordered.
322 * 20 Apr 1992: Parameters nname, name1, name2 added.
323 * 27 Apr 1992: Parameter mincor added to allow reentry with more
324 * storage.
325 * 27 Jun 1992: Parameter start implemented. Passed to misolv.
326 * ------------------------------------------------------------------
327 * NOTE:
328 * In /m7len / and /m8len /, nnobjx, nnconx, nnjacx are normally
329 * nnobj , nncon , nnjac .
330 * Here it is better to save those names for the minoss parameters.
331
332 common /m2len / mrows,mcols,melms
333 common /m2mapz/ maxw ,maxz
334 common /m3mps4/ name(2),mobj(2),mrhs(2),mrng(2),mbnd(2),minmax
335 common /m7len / fobj ,fobj2 ,nnobjx,nnobj0
336 common /m8len / njac ,nnconx,nncon0,nnjacx
337 common /m8al1 / penpar,rowtol,ncom,nden,nlag,nmajor,nminor
338 common /cycle2/ objtru,suminf,numinf
339
340 character*5 f1
341 data f1 /'(2a4)'/
342 * ------------------------------------------------------------------
343
344 * Initialize timers.
345
346 call m1time( 0,0 )
347
348 * Load the Common variables with various problem dimensions.
349
350 mrows = m
351 mcols = n
352 melms = ne
353 nnconx = nncon
354 nnobjx = nnobj
355 nnjacx = nnjac
356
357 * Say how much z(*) we've got, in case mispec wasn't called,
358 * or nwcore has been altered since mispec was called.
359 * This means the Specs file can't set Workspace (TOTAL) .
360
361 maxz = nwcore
362
363 * The Specs file has been read (or the options have been
364 * otherwise defined). Check that the options have sensible values.
365
366 call m3dflt( 2 )
367
368 * ------------------------------------------------------------------
369 * Determine storage requirements using the
370 * following Common variables:
371 * (m2len ) mrows, mcols, melms
372 * (m3len ) nscl (determined by lscale)
373 * (m5len ) maxr, maxs, nn
374 * (m7len ) nnobj
375 * (m8len ) njac, nncon, nnjac
376 * All have to be known exactly before calling m2core( 4, ... ).
377 * The only one in doubt is njac, the number of Jacobian elements.
378 * If Jacobian = dense (nden = 1), m2core sets njac = nncon*nnjac.
379 * If Jacobian = sparse (nden = 2), we have to set njac here.
380 * ------------------------------------------------------------------
381
382 njac = 0
383 if (nncon .gt. 0 .and. nden .eq. 2) then
384 last = ka(nnjac+1) - 1
385 if (nncon .eq. m) then
386 njac = last
387 else
388 do 100 k = 1, last
389 i = ha(k)
390 if (i .le. nncon) njac = njac + 1
391 100 continue
392 end if
393 end if
394
395 call m2core( 4, mincor )
396
397 if (mincor .gt. nwcore) then
398 inform = 42
399 return
400 end if
401
402 * ------------------------------------------------------------------
403 * Open files needed for this problem.
404 * Print the options if iprint > 0, Print level > 0 and iparm(3) > 0.
405 * ------------------------------------------------------------------
406 call mifile( 2 )
407 call m3dflt( 3 )
408
409 * ------------------------------------------------------------------
410 * Load names into the MINOS arrays.
411 * ------------------------------------------------------------------
412 read (names(1), f1) name
413 read (names(2), f1) mobj
414 read (names(3), f1) mrhs
415 read (names(4), f1) mrng
416 read (names(5), f1) mbnd
417
418 * ------------------------------------------------------------------
419 * Solve the problem.
420 * ------------------------------------------------------------------
421 mimode = 2
422 nka = n + 1
423 call misolv( mimode, start, m, n, nb, ne, nka, nname,
424 $ iobj, objadd,
425 $ a, ha, ka, bl, bu, name1, name2,
426 $ hs, xn, pi, rc,
427 $ inform, ns, z, nwcore )
428
429 ninf = numinf
430 sinf = suminf
431 obj = objtru
432
433 * Print times for all clocks (if ltime > 0).
434
435 call m1time( 0,2 )
436
437 * end of minoss
438 end
439
440 *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
441
442 subroutine minos1( z, nwcore )
443
444 implicit double precision (a-h,o-z)
445 double precision z(nwcore)
446
447 * ------------------------------------------------------------------
448 * minos1 is used for the stand-alone version of MINOS.
449 * It is called by the main program (or equivalent driver).
450 * It repeatedly looks for a new problem in the SPECS file
451 * and asks for it to be solved, until opfile returns inform gt 1,
452 * which means an ENDRUN card was found in the SPECS file,
453 * or end-of-file was encountered.
454 *
455 * 06 Oct 1985: minos1 calls minos2 to allow reallocation of z(*),
456 * following suggestions from David Gay,
457 * AT&T Bell Laboratories (for Unix).
458 * 22 Dec 1987: For DEC VAX VMS, newz tells minos2 whether or not to
459 * re-allocate z(*).
460 * 03 Mar 1988: f77 version calls opfile.
461 * 01 Oct 1991: mispec and misolv implemented.
462 * ------------------------------------------------------------------
463
464 common /m1file/ iread,iprint,isumm
465 common /m1savz/ nbytes,newz
466 common /m2file/ iback,idump,iload,imps,inewb,insrt,
467 $ ioldb,ipnch,iprob,iscr,isoln,ispecs,ireprt
468 common /m2mapz/ maxw ,maxz
469 common /m8len / njac ,nncon ,nncon0,nnjac
470
471 external m3key
472 character*30 title
473
474 newz = 0
475
476 * ------------------------------------------------------------------
477 * Define global files (reader, printer, etc.)
478 * ------------------------------------------------------------------
479 ispecs = 4
480 iprint = 9
481 isumm = 6
482 call mifile( 1 )
483
484 * ==================================================================
485 * Loop through each problem in the SPECS file.
486 * ==================================================================
487 do 100 loop = 1, 100000
488 ncalls = loop
489 maxw = 0
490 maxz = nwcore
491
492 * Initialize timers.
493
494 call m1time( 0,0 )
495
496 * ---------------------------------------------------------------
497 * Define the MINOS title and read the Specs file.
498 * ---------------------------------------------------------------
499 call m1init( title )
500 call opfile( ncalls, ispecs, m3key,
501 $ title , iprint, isumm, inform )
502
503 if (inform .ge. 2) then
504 inform = 100 + inform
505 return
506 end if
507
508 * ---------------------------------------------------------------
509 * Check options.
510 * Open files needed for this problem.
511 * ---------------------------------------------------------------
512 call m3dflt( 2 )
513 call mifile( 2 )
514
515 * ---------------------------------------------------------------
516 * Estimate storage requirements using the
517 * following Common variables:
518 * (m2len ) mrows, mcols, melms
519 * (m3len ) nscl
520 * (m5len ) maxr, maxs
521 * (m7len ) nnobj
522 * (m8len ) njac, nncon, nnjac
523 * All except njac have been set by default or by the SPECS file.
524 * We haven't read the MPS file yet, so m2core estimates njac.
525 * ---------------------------------------------------------------
526 call m2core( 1, mincor )
527
528 * ---------------------------------------------------------------
529 * Solve the problem.
530 * ---------------------------------------------------------------
531 call minos2( z, nwcore, mincor, inform )
532 100 continue
533 * ==================================================================
534 * End of loop through SPECS file.
535 * ==================================================================
536
537 * end of minos1
538 end
539
540 *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
541
542 subroutine minos2( z, nwcore, mincor, inform )
543
544 implicit double precision (a-h,o-z)
545 double precision z(nwcore)
546
547 * ------------------------------------------------------------------
548 * minos2 asks minos3 to solve the problem just found in the SPECS
549 * file. For standard Fortran installations, that is all.
550 *
551 * For some installations, this is an appropriate place to
552 * increase the size of the workspace array z, to allow
553 * solution of arbitrarily large problems without recompiling
554 * the main program, in which z(nwcore) is originally declared.
555 *
556 * z might have to be in blank common if it is to be expanded.
557 * The default size nwcore should be large enough to solve
558 * reasonably big problems without change (e.g., nwcore = 100000).
559 *
560 * At this stage, the SPECS file has been read and values are known
561 * for maxw, maxz and mincor. The default values for the first two
562 * are maxw = 0 and maxz = nwcore, but we allow the user to alter
563 * these by means of two cards in the SPECS file of the following
564 * form...
565 *
566 * Workspace (user) 10000 words (This sets maxw = 10000)
567 * Workspace (total) 90000 words (This sets maxz = 90000)
568 *
569 * MINOS will use only Z(maxw+1), ..., Z(maxz). Hence,
570 * z(1), ..., z(maxw) and possibly z(maxz+1), ..., z(nwcore)
571 * may be used as workspace by the user during solution of this
572 * particular problem (e.g., within funobj or funcon).
573 *
574 * If maxz is set to a value less than nwcore, it may serve to
575 * reduce paging activity on a machine with virtual memory, by
576 * confining MINOS (in particular the basis-factorization routines)
577 * to an area of core that is sensible for the current problem.
578 * On some systems (e.g., Burroughs), this will allow z(nwcore)
579 * to be declared arbitrarily large at compile time.
580 *
581 * mincor contains an estimate of the minimum core requirements,
582 * allowing for maxw but ignoring maxz. z is already large enough
583 * if nwcore .ge. max( maxz, mincor ). Systems that allow z to be
584 * re-allocated at run-time should make appropriate use of the
585 * logical variable enough.
586 *
587 * 22 Dec 1987: VAX dynamic storage added by Steve White, DSIR.
588 * ------------------------------------------------------------------
589
590 common /m1file/ iread,iprint,isumm
591 common /m1savz/ nbytes,newz
592 common /m2mapz/ maxw ,maxz
593
594 intrinsic max, min
595 logical enough
596
597 if (iprint .gt. 0) write(iprint, 1100) maxw, mincor
598 nwcor2 = max( maxz, mincor )
599 *--> enough = nwcore .ge. nwcor2
600 enough = .true.
601
602 if ( enough ) then
603
604 * Use the storage already available.
605
606 maxz = min( maxz, nwcore )
607 if (iprint .gt. 0) write(iprint, 1200) maxw, maxz, nwcore
608 call minos3( z, nwcore, inform )
609 else
610 *-->
611 * Re-allocate z (using some non-standard Fortran).
612 * newz says if we have to free z from an earlier call.
613 * The following is for DEC VAX/VMS.
614 *
615 * nwcor2 = max( nwcore, maxz, mincor )
616 * if (newz .ne. 0) then
617 * istat = lib$free_vm( nbytes, newz )
618 * if (.not. istat) then
619 * call lib$signal( %val(istat) )
620 * end if
621 * end if
622 * maxz = nwcor2
623 * nbytes = nwcor2*8
624 * istat = lib$get_vm( nbytes, newz )
625 * if (.not. istat) then
626 * call lib$signal( %val(istat) )
627 * else
628 * if (iprint .gt. 0) write(iprint, 1200) maxw, maxz, nwcor2
629 * call minos3( %val(newz), nwcor2, inform )
630 * end if
631 end if
632 return
633
634 1100 format(/ ' Reasonable Workspace limits are', i10, ' ...', i8)
635 1200 format( ' Actual Workspace limits are', i10, ' ...',
636 $ i8, ' ...', i8, ' words of z.')
637
638 * end of minos2
639 end
640
641 *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
642
643 subroutine minos3( z, nwcore, inform )
644
645 implicit double precision (a-h,o-z)
646 double precision z(nwcore)
647
648 * ------------------------------------------------------------------
649 * minos3 prints the options (sometimes),
650 * then reads a problem from an MPS file
651 * and asks misolv to solve it.
652 *
653 * 01 Oct 1991: misolv implemented.
654 * 20 Apr 1992: name1, name2, nname added as parameters to misolv.
655 * 26 Apr 1992: call m3dflt( 3 ) added.
656 * ------------------------------------------------------------------
657
658 common /m2mapa/ ne ,nka ,la ,lha ,lka
659 common /m3len / m ,n ,nb ,nscl
660 common /m3loc / lascal,lbl ,lbu ,lbbl ,lbbu ,
661 $ lhrtyp,lhs ,lkb
662 common /m3mps1/ lname1,lname2,lkeynm,nname
663 common /m5loc / lpi ,lpi2 ,lw ,lw2 ,
664 $ lx ,lx2 ,ly ,ly2 ,
665 $ lgsub ,lgsub2,lgrd ,lgrd2 ,
666 $ lr ,lrg ,lrg2 ,lxn
667 common /m5lobj/ sinf,wtobj,minimz,ninf,iobj,jobj,kobj
668 common /m5log1/ idebug,ierr ,lprint
669 * ------------------------------------------------------------------
670
671 call m3dflt( 3 )
672 call m1time( 1,0 )
673 call m3inpt( objadd, z, nwcore )
674 call m1time(-1,0 )
675
676 if (ierr .ne. 0) return
677
678 mimode = 1
679 nname = nb
680 lrc = lpi + m
681
682 call misolv( mimode, 'Cold', m, n, nb, ne, nka, nname,
683 $ iobj , objadd,
684 $ z(la), z(lha), z(lka), z(lbl), z(lbu),
685 $ z(lname1), z(lname2),
686 $ z(lhs), z(lxn), z(lpi), z(lrc),
687 $ inform, ns , z , nwcore )
688
689 * Print times for all clocks (if ltime > 0).
690
691 call m1time( 0,2 )
692
693 * end of minos3
694 end
695
696 *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
697
698 subroutine mifile( mode )
699
700 * ------------------------------------------------------------------
701 * mifile is a (possibly) machine-dependent routine for opening
702 * various files.
703 * Some systems (e.g. DEC VAX/VMS) open files automatically.
704 * Other systems may require explicit OPEN statements.
705 *
706 * 19 Jun 1989: Modified to call m1open.
707 * 11 Nov 1991: mode 1 now assumes that ispecs, iprint, isumm
708 * have been set by minos1 (for MINOS)
709 * or by mispec (for minoss).
710 *
711 * ------------------------------------------------------------------
712
713 common /m1file/ iread,iprint,isumm
714 common /m2file/ iback,idump,iload,imps,inewb,insrt,
715 $ ioldb,ipnch,iprob,iscr,isoln,ispecs,ireprt
716
717 integer iprinx, isummx
718 save iprinx, isummx
719
720 if (mode .eq. 1) then
721 * ---------------------------------------------------------------
722 * Mode 1: Open default files (if opens are necessary).
723 *
724 * iread and iprint have the following use:
725 * Input files (MPS, INSERT, LOAD, OLD BASIS) are rewound
726 * after being read, but not if they are the same as iread.
727 * Output files (DUMP, NEW BASIS, PUNCH, SOLUTION) are rewound
728 * after being written, but not if they are the same as iprint.
729 *
730 * iread = (conceptually) the CARD READER that can't be rewound.
731 * If there are no such units, use 0.
732 * MINOS does not use this file directly, so there is
733 * no 'open'.
734 * iprint = the PRINT file.
735 * isumm = the SUMMARY file. Sometimes this is the screen.
736 * If so, it may not need to be opened.
737 * ispecs = the SPECS file, containing one or more problem specs.
738 * This file is not rewound after use, because it may
739 * contain another SPECS file.
740 * iscr = SCRATCH file -- no longer used.
741 *
742 * Files may be opened directly or by calling m1open, e.g.
743 * if (iprint .gt. 0) open( unit=iprint, file='minos.print' )
744 * or
745 * call m1open( iprint, 'OUT' )
746 *
747 * iread and ispecs remain the same throughout the run.
748 * iprint and isumm may be altered by the SPECS file
749 * and therefore need to be opened twice.
750 * ---------------------------------------------------------------
751
752 iread = 5
753 iprinx = iprint
754 isummx = isumm
755 if (ispecs .gt. 0) open(unit=ispecs, file='minos.specs',
756 * status='OLD')
757 if ((iprint .gt. 0) .and. (iprint .ne. 6))
758 * open(unit=iprint, file='minos.print', status='UNKNOWN')
759 if ((isumm .gt. 0) .and. (isumm .ne. 6))
760 * open(unit=isumm, file='minos.summary', status='UNKNOWN')
761 else
762 * ---------------------------------------------------------------
763 * Mode 2: Define files mentioned in the SPECS file just read.
764 * Input files are opened first. Only one basis file is needed.
765 * ---------------------------------------------------------------
766 if (imps .le. 0 ) imps = ispecs
767 if (imps .ne. ispecs) open(unit=imps, file='minos.mps',
768 * status='OLD')
769
770 if (ioldb .gt. 0) then
771 open(unit=ioldb, file='minos.oldb',
772 * status='OLD')
773 else if (insrt .gt. 0) then
774 open(unit=insrt, file='minos.insert',
775 * status='OLD')
776 else if (iload .gt. 0) then
777 open(unit=iload, file='minos.load',
778 * status='OLD')
779 end if
780
781 if (iback .gt. 0) open(unit=iback, file='minos.back',
782 * status='UNKNOWN')
783 if (idump .gt. 0) open(unit=idump, file='minos.dump',
784 * status='UNKNOWN')
785 if (inewb .gt. 0) open(unit=inewb, file='minos.newb',
786 * status='UNKNOWN')
787 if (ipnch .gt. 0) open(unit=ipnch, file='minos.punch',
788 * status='UNKNOWN')
789 if (isoln .gt. 0) open(unit=isoln, file='minos.soln',
790 * status='UNKNOWN')
791
792 * Open new Print or Summary files if they were altered
793 * by the Specs file.
794
795 if (iprint .ne. iprinx) then
796 if (iprint .gt. 0) open(unit=iprint, file='minos.print',
797 * status='UNKNOWN')
798 end if
799 if (isumm .ne. isummx) then
800 if (isumm .gt. 0) open(unit=isumm, file='minos.summary',
801 * status='UNKNOWN')
802 end if
803 end if
804
805 * end of mifile
806 end
807
808 *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
809
810 subroutine mispec( ispecx, iprinx, isummx, nwcore, inform )
811
812 * ------------------------------------------------------------------
813 * mispec is called by minoss (not by MINOS) to do the following:
814 * 1. Open default files (Specs, Print, Summary).
815 * 2. Initialize title.
816 * 3. Set options to default values.
817 * 4. Read the Specs file if any.
818 *
819 * 01 Oct 1991: First version.
820 * 27 Jun 1992: Don't read a Specs file if ispecs <= 0.
821 * ------------------------------------------------------------------
822
823 common /m1file/ iread,iprint,isumm
824 common /m2file/ iback,idump,iload,imps,inewb,insrt,
825 $ ioldb,ipnch,iprob,iscr,isoln,ispecs,ireprt
826 common /m2mapz/ maxw ,maxz
827
828 external m3key
829 character*30 title
830
831 * Open the specified Specs, Print and Summary files.
832
833 ispecs = ispecx
834 iprint = iprinx
835 isumm = isummx
836 call mifile( 1 )
837
838 ncalls = 1
839 maxw = 0
840 maxz = nwcore
841 inform = 0
842
843 * ------------------------------------------------------------------
844 * Define the MINOS title and read the Specs file (if any).
845 * minoss will check the options later and maybe print them.
846 * ------------------------------------------------------------------
847 call m1init( title )
848 if (ispecs .gt. 0) then
849 call opfile( ncalls, ispecs, m3key,
850 $ title , iprint, isumm, inform )
851 else
852 * Just set options to default values.
853 call m3dflt( 1 )
854 end if
855
856 * end of mispec
857 end
858
859 *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
860
861 subroutine misolv( mimode, start,
862 $ mxx, nxx, nbxx, nexx, nkax, nnamex,
863 $ iobjxx, objadd,
864 $ a, ha, ka, bl, bu, name1, name2,
865 $ hs, xn, pi, rc,
866 $ inform, ns, z, nwcore )
867
868 implicit double precision (a-h,o-z)
869 character*(*) start
870 integer*4 ha(nexx), hs(nbxx)
871 integer ka(nkax), name1(nnamex), name2(nnamex)
872 double precision a(nexx) , bl(nbxx), bu(nbxx)
873 double precision xn(nbxx), pi(mxx) , rc(nxx) , z(nwcore)
874
875 * ------------------------------------------------------------------
876 * misolv solves the current problem.
877 *
878 * On entry,
879 * the SPECS file has been read,
880 * all data items have been loaded (including a, ha, ka, ...),
881 * and workspace has been allocated within z.
882 *
883 * mimode = 1 if the call is from minos3 (stand-alone MINOS).
884 * ge 2 if the call is from minoss.
885 *
886 * On exit,
887 * inform = 0 if an optimal solution was found,
888 * = 1 if the problem was infeasible,
889 * = 2 if the problem was unbounded,
890 * = 3 if the Iteration limit was exceeded,
891 * ge 4 if iterations were terminated by some other
892 * error condition (see the MINOS user's guide).
893 *
894 * 01 Oct 1991: minoss, mispec and misolv implemented.
895 * minos1, minos2, minos3 reorganized
896 * to facilitate calling MINOS as a subroutine.
897 * 25 Nov 1991: nname and rc added as parameters of matmod.
898 * 10 Apr 1992: objadd added as input parameter.
899 * 20 Apr 1992: Parameter list revised. nname, name1, name2 added.
900 * 27 Jun 1992: Cold, Warm, Hot start implemented.
901 * 09 Jul 1992: ns initialized here only for Cold starts, just to
902 * help debugging. m4chek always sets it later.
903 * ------------------------------------------------------------------
904 *
905 * All common blocks are listed here for reference.
906 *
907 *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
908 *
909 * File mcommon fortran.
910
911
912 * Machine-dependent items.
913
914 logical alone, AMPL, GAMS, MINT, page1, page2
915 common /m1env / alone, AMPL, GAMS, MINT, page1, page2
916 common /m1eps / eps,eps0,eps1,eps2,eps3,eps4,eps5,plinfy
917 common /m1file/ iread,iprint,isumm
918 common /m1savz/ nbytes,newz
919 parameter ( ntime = 5 )
920 common /m1tim / tlast(ntime), tsum(ntime), numt(ntime), ltime
921 common /m1word/ nwordr,nwordi,nwordh
922
923
924 * Files, maps, parameters.
925
926 common /m2file/ iback,idump,iload,imps,inewb,insrt,
927 $ ioldb,ipnch,iprob,iscr,isoln,ispecs,ireprt
928 common /m2len / mrows,mcols,melms
929 common /m2lu1 / minlu,maxlu,lena,nbelem,ip,iq,lenc,lenr,
930 $ locc,locr,iploc,iqloc,lua,indc,indr
931 common /m2lu2 / factol(5),lamin,nsing1,nsing2
932 common /m2lu3 / lenl,lenu,ncp,lrow,lcol
933 common /m2lu4 / parmlu(30),luparm(30)
934 common /m2mapa/ ne ,nka ,la ,lha ,lka
935 common /m2mapz/ maxw ,maxz
936 common /m2parm/ dparm(30),iparm(30)
937
938
939 * Problem size, MPS names, Scale options.
940
941 common /m3len / m ,n ,nb ,nscl
942 common /m3loc / lascal,lbl ,lbu ,lbbl ,lbbu ,
943 $ lhrtyp,lhs ,lkb
944 common /m3mps1/ lname1,lname2,lkeynm,nname
945 common /m3mps3/ aijtol,bstruc(2),mlst,mer,
946 $ aijmin,aijmax,na0,line,ier(20)
947 common /m3mps4/ name(2),mobj(2),mrhs(2),mrng(2),mbnd(2),minmax
948 common /m3mps5/ aelem(2), id(6), iblank
949 common /m3scal/ sclobj,scltol,lscale
950
951
952 * LP items.
953
954 common /m5len / maxr ,maxs ,mbs ,nn ,nn0 ,nr ,nx
955 common /m5loc / lpi ,lpi2 ,lw ,lw2 ,
956 $ lx ,lx2 ,ly ,ly2 ,
957 $ lgsub ,lgsub2,lgrd ,lgrd2 ,
958 $ lr ,lrg ,lrg2 ,lxn
959 common /m5freq/ kchk,kinv,ksav,klog,ksumm,i1freq,i2freq,msoln
960 common /m5inf / prinf, duinf, jprinf, jduinf
961 common /m5lobj/ sinf,wtobj,minimz,ninf,iobj,jobj,kobj
962 common /m5log1/ idebug,ierr,lprint
963 common /m5log2/ jq1,jq2,jr1,jr2,lines1,lines2
964 common /m5log3/ djq,theta,pivot,cond,nonopt,jp,jq,modr1,modr2
965 logical prnt0 ,prnt1 ,summ0 ,summ1 ,newhed
966 common /m5log4/ prnt0 ,prnt1 ,summ0 ,summ1 ,newhed
967 common /m5lp1 / itn,itnlim,nphs,kmodlu,kmodpi
968 common /m5lp2 / invrq,invitn,invmod
969 common /m5prc / nparpr,nmulpr,kprc,newsb
970 common /m5step/ featol, tolx0,tolinc,kdegen,ndegen,
971 $ itnfix, nfix(2)
972 common /m5tols/ toldj(3),tolx,tolpiv,tolrow,rowerr,xnorm
973
974
975 * Nonlinear objective.
976
977 logical conv,restrt
978 common /m7len / fobj ,fobj2 ,nnobj ,nnobj0
979 common /m7loc / lgobj ,lgobj2
980 common /m7cg1 / cgbeta,itncg,msgcg,modcg,restrt
981 common /m7cg2 / lcg1,lcg2,lcg3,lcg4,modtcg,nitncg,nsubsp
982 common /m7conv/ etash,etarg,lvltol,nfail,conv(4)
983 common /m7phes/ rgmin1,rgnrm1,rgnrm2,jz1,jz2,labz,nfullz,mfullz
984 common /m7tols/ xtol(2),ftol(2),gtol(2),pinorm,rgnorm,tolrg
985
986
987 * Nonlinear constraints.
988
989 common /m8len / njac ,nncon ,nncon0,nnjac
990 common /m8loc / lfcon ,lfcon2,lfdif ,lfdif2,lfold ,
991 $ lblslk,lbuslk,lxlam ,lrhs ,
992 $ lgcon ,lgcon2,lxdif ,lxold
993 common /m8al1 / penpar,rowtol,ncom,nden,nlag,nmajor,nminor
994 common /m8al2 / radius,rhsmod,modpen,modrhs
995 common /m8diff/ difint(2),gdummy,lderiv,lvldif,knowng(2)
996 common /m8func/ nfcon(4),nfobj(4),nprob,nstat1,nstat2
997 common /m8save/ vimax ,virel ,maxvi ,majits,minits,nssave
998 common /m8veri/ jverif(4),lverif(2)
999
1000
1001 * Miscellaneous.
1002
1003 logical gotbas,gotfac,gothes,gotscl
1004 common /cycle1/ gotbas,gotfac,gothes,gotscl
1005 common /cycle2/ objtru,suminf,numinf
1006 common /cyclcm/ cnvtol,jnew,materr,maxcy,nephnt,nphant,nprint
1007
1008 ***** end of file mcommon fortran.
1009 * ------------------------------------------------------------------
1010
1011 character*1 ch1
1012 logical finish, lincon, nlncon, nlnobj
1013
1014 * For minoss we have to copy m, n, etc into common.
1015
1016 m = mxx
1017 n = nxx
1018 nb = nbxx
1019 ne = nexx
1020 nka = nkax
1021 nname = nnamex
1022 iobj = iobjxx
1023
1024 * Initialize a few things.
1025
1026 lincon = nncon .eq. 0
1027 nlncon = nncon .gt. 0
1028 nlnobj = nnobj .gt. 0
1029 ierr = 0
1030 lenl = 0
1031 lenu = 0
1032 ncycle = 0
1033 ninf = 0
1034 nstat1 = 1
1035 nstat2 = 1
1036 sclobj = 1.0d+0
1037 jobj = 0
1038 if (iobj .gt. 0) jobj = n + iobj
1039
1040 * ------------------------------------------------------------------
1041 * Decode 'start'.
1042 * ------------------------------------------------------------------
1043 gotbas = .false.
1044 gotfac = .false.
1045 gothes = .false.
1046 gotscl = .false.
1047 ch1 = start(1:1)
1048
1049 if (ch1 .eq. 'C' .or. ch1 .eq. 'c' .or.
1050 $ ch1 .eq. 'B' .or. ch1 .eq. 'b') then
1051
1052 * Cold start or Basis file.
1053
1054 istart = 0
1055 gotbas = (ioldb + insrt + iload) .gt. 0
1056 ns = 0
1057
1058 else if (ch1 .eq. 'W' .or. ch1 .eq. 'w') then
1059
1060 * Warm start.
1061
1062 istart = 1
1063 gotbas = .true.
1064
1065 else if (ch1 .eq. 'H' .or. ch1 .eq. 'h') then
1066
1067 * Hot start.
1068 * 'Hot' is the same as 'Hot FHS'.
1069 * Look for 'Hot F', 'Hot FH', etc.
1070
1071 istart = 2
1072 gotbas = .true.
1073 nchar = len( start )
1074 if (nchar .lt. 5) then
1075 gotfac = .true.
1076 gothes = .true.
1077 gotscl = .true.
1078 else
1079 do 100 j = 5, nchar
1080 ch1 = start(j:j)
1081 if (ch1 .eq. 'F' .or. ch1 .eq. 'f') gotfac = .true.
1082 if (ch1 .eq. 'H' .or. ch1 .eq. 'h') gothes = .true.
1083 if (ch1 .eq. 'S' .or. ch1 .eq. 's') gotscl = .true.
1084 100 continue
1085 end if
1086
1087 if (iprint .gt. 0) then
1088 write(iprint, 1020) gotbas, gotfac, gothes, gotscl
1089 end if
1090
1091 else
1092 istart = 0
1093 if (iprint .gt. 0) write(iprint, 1030) start
1094 if (isumm .gt. 0) write(isumm , 1030) start
1095 end if
1096
1097 nssave = ns
1098
1099 * ------------------------------------------------------------------
1100 * 1. Fiddle with partial price parameter to avoid foolish values.
1101 * We reduce nparpr if both the row and column section sizes
1102 * would be smaller than minprc (= 10 say).
1103 * 2. Change Scale option 1 to 0 if all variables are nonlinear.
1104 * ------------------------------------------------------------------
1105 minprc = 10
1106 npr1 = n / nparpr
1107 npr2 = m / nparpr
1108 if (max( npr1, npr2 ) .lt. minprc) then
1109 maxmn = max( m, n )
1110 nparpr = maxmn / min( maxmn, minprc )
1111 npr1 = n / nparpr
1112 npr2 = m / nparpr
1113 end if
1114
1115 if (lscale .eq. 1 .and. nn .eq. n) lscale = 0
1116
1117 if (iprint .gt. 0) write(iprint, 1100) lscale, nparpr, npr1, npr2
1118 if (isumm .gt. 0) write(isumm , 1110) lscale, nparpr
1119
1120 * ------------------------------------------------------------------
1121 * Set the vector of row types and print the matrix statistics.
1122 * ------------------------------------------------------------------
1123 call m2amat( 1, m, n, nb,
1124 $ ne, nka, a, ha, ka,
1125 $ bl, bu, z(lhrtyp) )
1126
1127 * ------------------------------------------------------------------
1128 * Load Jacobian elements in the MPS file from A into gcon and gcon2.
1129 * ------------------------------------------------------------------
1130 if (nlncon) then
1131 call m8augl( 1, m, n, nb, ns, inform,
1132 $ ne, nka, a, ha, ka,
1133 $ hs, bl, bu, xn, z, nwcore )
1134 end if
1135
1136 * ------------------------------------------------------------------
1137 * Input a basis file if one exists, thereby defining hs and xn.
1138 * (Otherwise, m2crsh will be called later to define hs.)
1139 * At this stage, ncycle = 0.
1140 * ------------------------------------------------------------------
1141 call m1page( 1 )
1142 if (iprint .gt. 0) then
1143 write(iprint, 1200)
1144 if (.not. gotbas) write(iprint, 1210)
1145 end if
1146
1147 call m4getb( ncycle, istart, m, mbs, n, nb, nn, nname, nscl,
1148 $ lcrash, ns,
1149 $ ne, nka, a, ha, ka,
1150 $ z(lhrtyp), hs, z(lkb), z(lascal), bl, bu,
1151 $ pi, xn, z(ly), z(ly2), name1, name2,
1152 $ z, nwcore )
1153 if (ierr .ne. 0) go to 900
1154
1155
1156 * ------------------------------------------------------------------
1157 * CYCLE PROCEDURE
1158 *
1159 * The following notes are relevant if Cycle limit = 2 or more.
1160 *
1161 * 1. Scaling and/or Crash are controlled on each cycle by the following
1162 * logical variables:
1163 *
1164 * If gotscl is true, scales are retained from the previous cycle.
1165 * Otherwise, scales are recomputed (if lscale>0).
1166 *
1167 * If gotbas is true, the basis is retained. Otherwise, Crash is
1168 * called.
1169 *
1170 *
1171 * 2. When m5solv is called, Flying Starts are controlled by the
1172 * following logical variables:
1173 *
1174 * If gotfac is true, an LU factorization of the basis is assumed
1175 * to be present. (Ignored if there are any
1176 * nonlinear constraints.)
1177 *
1178 * If gothes is true, z(lr) is assumed to contain a useful
1179 * reduced-Hessian approximation.
1180 *
1181 *
1182 * 3. For the next cycle,
1183 * m4getb sets gotscl and gotbas to be true, and
1184 * m5solv sets gotfac and gothes to current values (usually true).
1185 * These values will often be appropriate. However, the expert user
1186 * of matmod must set some or all of the logical variables to .false.
1187 * if the problem data or state have been significantly altered.
1188 *
1189 * For example, if the Jacobian was used by the scaling routine
1190 * (Scale option 2) and if the Jacobian could be rather different
1191 * from its value at the start of the previous cycle, it may be
1192 * advisable to request new scales by setting gotscl = .false.
1193 *
1194 * Similarly, if matmod alters some matrix elements in columns that
1195 * are currently basic, one should set gotfac = .false. to force
1196 * refactorization. In particular, if the linear objective row c is
1197 * altered, gotfac should be set to .false., since c is part of the
1198 * LU factors.
1199 * ------------------------------------------------------------------
1200
1201 finish = .false.
1202 jnew = n - nphant
1203 materr = 0
1204 nprntd = 0
1205 nsolvd = ncycle
1206
1207 * If Cycle limit is more than 1, call matmod with ncycle = 0 in case
1208 * the user wants a chance to set things up before any solves.
1209
1210 if (maxcy .gt. 1) then
1211 if (iprint .gt. 0) write(iprint, 3000) ncycle
1212 if (isumm .gt. 0) write(isumm , 3000) ncycle
1213
1214 call matmod( ncycle, nprob, finish,
1215 $ m, n, nb, ne, nka, ns, nscl, nname,
1216 $ a, ha, ka, bl, bu,
1217 $ z(lascal), hs, name1, name2,
1218 $ xn, pi, rc, z, nwcore )
1219 if (finish) go to 800
1220 end if
1221
1222 * ------------------------------------------------------------------
1223 * Check gradients if requested, before scaling interferes.
1224 * m4getb has made sure nonlinear xn(j)s are within their bounds.
1225 * ------------------------------------------------------------------
1226 if (nlncon) then
1227 call m8chkj( nncon, nnjac, njac, nx,
1228 $ ne, nka, ha, ka,
1229 $ bl, bu, z(lfcon), z(lfcon2),
1230 $ z(lgcon), z(lgcon2),
1231 $ xn, z(ly), z(ly2), z, nwcore )
1232 if (ierr .gt. 0) go to 900
1233 end if
1234
1235 if (nlnobj) then
1236 call m7chkg( nnobj,
1237 $ bl, bu, z(lgobj), z(lgobj2),
1238 $ xn, z(ly), z(ly2), z, nwcore )
1239 if (ierr .gt. 0) go to 900
1240 end if
1241
1242 * ==================================================================
1243 * Start of the Cycle loop.
1244 * ==================================================================
1245 500 ncycle = ncycle + 1
1246 nsolvd = ncycle
1247 ierr = 0
1248 if (.not. gotbas) then
1249 gotfac = .false.
1250 gothes = .false.
1251 end if
1252 if (ncycle .gt. 1) then
1253 call m1page( 1 )
1254 if (iprint .gt. 0) then
1255 write(iprint, 2000) ncycle
1256 write(iprint, 1020) gotbas, gotfac, gothes, gotscl
1257 end if
1258 if (isumm .gt. 0) then
1259 write(isumm , 2000) ncycle
1260 end if
1261 end if
1262
1263 * Make sure the Jacobian variables are inside their bounds.
1264
1265 if (nlncon) then
1266 call m8augl( 2, m, n, nb, ns, inform,
1267 $ ne, nka, a, ha, ka,
1268 $ hs, bl, bu, xn, z, nwcore )
1269 end if
1270
1271 * For the first cycle, the row types have been set by m2amat.
1272 * Reset them for later cycles in case m2scal or m2crsh are
1273 * called.
1274
1275 if (ncycle .ge. 2) then
1276 call m2amat( 2, m, n, nb,
1277 $ ne, nka, a, ha, ka,
1278 $ bl, bu, z(lhrtyp) )
1279 end if
1280
1281 * ---------------------------------------------------------------
1282 * Evaluate the Jacobian and store it in A (unscaled) for the
1283 * first major iteration.
1284 * Compute scales from a, bl, bu (except if gotscl is true).
1285 * Scale a, bl, bu, xn, pi and fcon.
1286 * Initialize xlam from pi.
1287 * Call CRASH if a basis file was not supplied
1288 * (or if gotbas is false).
1289 * ---------------------------------------------------------------
1290 call m4getb( ncycle, istart, m, mbs, n, nb, nn, nname, nscl,
1291 $ lcrash, ns,
1292 $ ne, nka, a, ha, ka,
1293 $ z(lhrtyp), hs, z(lkb), z(lascal), bl, bu,
1294 $ pi, xn, z(ly), z(ly2), name1, name2,
1295 $ z, nwcore )
1296 if (ierr .ne. 0) go to 900
1297
1298 * 1. Set ns to match hs(*).
1299 * 2. Set kb(m+1) thru kb(m+ns) to define the initial set of
1300 * superbasics, except if a Hot start
1301 * (gotbas and gothes are both true).
1302 * 3. Check that nonbasic xn are within bounds.
1303
1304 call m4chek( m, maxs, mbs, n, nb, ns,
1305 $ hs, z(lkb), bl, bu, xn )
1306
1307 * ---------------------------------------------------------------
1308 * Solve the current problem.
1309 * Bail out if there is a fatal error.
1310 * ---------------------------------------------------------------
1311 call m1page( 1 )
1312 if (iprint .gt. 0) write(iprint, 2100)
1313
1314 call m1time( 2,0 )
1315 call m5solv( m, maxr, maxs, mbs, n, nb, nn, nn0, nr,
1316 $ lcrash, ns, nscl, nx, objadd,
1317 $ ne, nka, a, ha, ka,
1318 $ z(lhrtyp), hs, z(lkb), z(lascal), bl, bu,
1319 $ z(lbbl), z(lbbu), fsub, z(lgsub),
1320 $ z(lgrd), z(lgrd2),
1321 $ pi, z(lr), rc, z(lrg), z(lrg2),
1322 $ z(lx), xn, z(ly), z(ly2), z, nwcore )
1323 call m1time(-2,0 )
1324
1325 if (ierr .ge. 30 ) go to 900
1326 if (ierr .ge. 20 .and. itn .eq. 0) go to 900
1327
1328 * ---------------------------------------------------------------
1329 * Unscale, compute nonlinear constraint violations,
1330 * save basis files and prepare to print the solution.
1331 * Clock 3 is "Output time".
1332 * ---------------------------------------------------------------
1333 call m1time( 3,0 )
1334 call m4savb( 1, m, mbs, n, nb, nn, nname, nscl, msoln, ns,
1335 $ ne, nka, a, ha, ka,
1336 $ hs, z(lkb), z(lascal), bl, bu,
1337 $ name1, name2,
1338 $ pi, rc, xn, z(ly), z, nwcore )
1339
1340 * In some Cycling applications, it may be desirable to suppress
1341 * the printing of intermediate solutions. Otherwise if mode = 2,
1342 * m4savb prints the solution under the control of msoln
1343 * (which is set by the Solution keyword in the SPECS file).
1344 * The printed solution may or may not be wanted, as follows:
1345 *
1346 * msoln = 0 means No
1347 * = 1 means If optimal, infeasible or unbounded
1348 * = 2 means Yes
1349 * = 3 means If error condition
1350 *
1351 * This call normally prints the solution when there is no
1352 * Cycling, because the default values are maxcy = nprint = 1.
1353
1354 if (ncycle .gt. maxcy - nprint) then
1355 nprntd = nsolvd
1356 call m4savb( 2, m, mbs, n, nb, nn, nname, nscl, msoln, ns,
1357 $ ne, nka, a, ha, ka,
1358 $ hs, z(lkb), z(lascal), bl, bu,
1359 $ name1, name2,
1360 $ pi, rc, xn, z(ly), z, nwcore )
1361 end if
1362 call m1time(-3,0 )
1363
1364 * ---------------------------------------------------------------
1365 * Call the functions one last time with nstate .ge. 2.
1366 * We have to disable scaling.
1367 * mode = 0 tells the functions that gradients are not required.
1368 * ---------------------------------------------------------------
1369 if (ierr .eq. 6) go to 800
1370 lssave = lscale
1371 lscale = 0
1372 nstat1 = 2 + ierr
1373 nstat2 = nstat1
1374 mode = 0
1375 if (nlncon) then
1376 call m6fcon( mode, nncon, nnjac, njac, z(lfcon), z(lgcon2),
1377 $ ne, nka, ha, ka,
1378 $ xn, z, nwcore )
1379 end if
1380 if (nlnobj) then
1381 call m6fobj( mode, nnobj, fobj, z(lgobj2), xn, z, nwcore )
1382 end if
1383 lscale = lssave
1384 if (mode .lt. 0) go to 800
1385 nstat1 = 0
1386 nstat2 = 0
1387
1388 * ---------------------------------------------------------------
1389 * Terminate Cycles if m5solv gave a serious error.
1390 * Otherwise, let the user modify the problem for the next Cycle.
1391 * ---------------------------------------------------------------
1392 if (ierr .ge. 20) go to 800
1393 if (ncycle .ge. maxcy) go to 800
1394 if (iprint .gt. 0) write(iprint, 3000) ncycle
1395 if (isumm .gt. 0) write(isumm , 3000) ncycle
1396
1397 call matmod( ncycle, nprob, finish,
1398 $ m, n, nb, ne, nka, ns, nscl, nname,
1399 $ a, ha, ka, bl, bu,
1400 $ z(lascal), hs, name1, name2,
1401 $ xn, pi, rc, z, nwcore )
1402
1403 if (.not. finish) go to 500
1404 * ==================================================================
1405 * End of the Cycle loop.
1406 * ==================================================================
1407
1408
1409 * Print the final solution if it has not already been printed.
1410
1411 800 if (nprntd .ne. nsolvd) then
1412 call m1time( 3,0 )
1413 call m4savb( 2, m, mbs, n, nb, nn, nname, nscl, msoln, ns,
1414 $ ne, nka, a, ha, ka,
1415 $ hs, z(lkb), z(lascal), bl, bu,
1416 $ name1, name2,
1417 $ pi, rc, xn, z(ly), z, nwcore )
1418 call m1time(-3,0 )
1419 end if
1420 * ------------------------------------------------------------------
1421 * Exit.
1422 * ------------------------------------------------------------------
1423
1424 900 inform = ierr
1425 return
1426
1427 1020 format(/ ' gotbas =', l2, 4x, ' gotfac =', l2, 4x,
1428 $ ' gothes =', l2, 4x, ' gotscl =', l2)
1429 1030 format(/ ' XXX Start parameter not recognized: ', a)
1430 1100 format( ' Scale option', i3, ', Partial price', i8
1431 $ / ' Partial price section size (A) ', i12
1432 $ / ' Partial price section size (I) ', i12)
1433 1110 format(/ ' Scale option', i3, ', Partial price', i4)
1434 1200 format( ' Initial basis' / ' -------------')
1435 1210 format(/ ' No basis file supplied')
1436 2000 format(/ ' Start of Cycle', i5,
1437 $ / ' -------------------')
1438 2100 format( ' Iterations' / ' ----------')
1439 3000 format(/ ' matmod called with ncycle =', i5)
1440
1441 * end of misolv
1442 end
1443
1444 *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1445
1446 subroutine m1clos( lun )
1447
1448 * ------------------------------------------------------------------
1449 * m1clos closes the file with logical unit number lun.
1450 * This version is trivial and so far is not even used by MINOS.
1451 * Perhaps some implementations will need something fancier.
1452 * ------------------------------------------------------------------
1453
1454 close( lun )
1455
1456 * end of m1clos
1457 end
1458
1459 *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1460
1461 subroutine m1envt( mode )
1462
1463 * ------------------------------------------------------------------
1464 * m1envt specifies the environment within which MINOS is being used.
1465 *
1466 * When mode = 0, the various logicals should be initialized.
1467 * page1 says whether new pages are ever wanted on file iprint.
1468 * page2 says whether new pages are ever wanted on file isumm.
1469 *
1470 * When mode is in the range 1 to 99, each environment does its
1471 * own thing.
1472 *
1473 * When mode = 999, MINOS is asking if resource limits have been
1474 * reached. To indicate YES, set ierr = 19.
1475 *
1476 * The various environments are as follows:
1477 *
1478 * ALONE:
1479 * This means MINOS is in stand-alone mode---the normal case.
1480 * Nothing special is done.
1481 *
1482 * GAMS:
1483 * When mode = 1, 2, ..., 9 the characters =1, =2, ..., =9
1484 * are output to the print file.
1485 * When mode = 999, the resource limits are tested.
1486 *
1487 * MINT:
1488 * Since branch-and-bound means a lot of CYCLES, we suppress
1489 * page ejects. Otherwise, nothing special as yet.
1490 *
1491 * AMPL:
1492 * Nothing special yet, but might want to test resource limits.
1493 *
1494 * 16 Sep 1987 Initial version.
1495 * 24 Apr 1992 AMPL added.
1496 * ------------------------------------------------------------------
1497
1498 logical alone, AMPL, GAMS, MINT, page1, page2
1499 common /m1env / alone, AMPL, GAMS, MINT, page1, page2
1500 common /m1file/ iread,iprint,isumm
1501 common /m5log1/ idebug,ierr,lprint
1502
1503 * GAMS resource info:
1504 * ARESLM is limit on cpu time.
1505 * ATIME0 is starting time.
1506 * ATMGET is a function returning time so far.
1507 *
1508 *X REAL ARESLM, ATIME0, ADELT
1509 *X COMMON /GAMS00/ ARESLM, ATIME0, ADELT
1510 *X REAL ATMGET
1511 *X EXTERNAL ATMGET
1512
1513 if (mode .le. 0) then
1514 * ---------------------------------------------------------------
1515 * mode = 0. Initialize.
1516 * page1 and page2 should be false for applications involving
1517 * many Cycles (e.g. MINT).
1518 * ---------------------------------------------------------------
1519 alone = .true.
1520 AMPL = .false.
1521 GAMS = .false.
1522 MINT = .false.
1523 page1 = .true.
1524 page2 = .false.
1525
1526 else if (mode .lt. 999) then
1527 * ---------------------------------------------------------------
1528 * mode = 1 or more. Do what has to be done in each environment.
1529 * ---------------------------------------------------------------
1530 if (GAMS .and. iprint .gt. 0) then
1531 write(iprint, '(a1, i1)') '=', mode
1532 end if
1533
1534 else if (mode .eq. 999) then
1535 * ---------------------------------------------------------------
1536 * mode = 999. Test for excess time, etc.
1537 * ---------------------------------------------------------------
1538 if (GAMS) then
1539 *X IF (ATMGET() - ATIME0 .GE. ARESLM) IERR = 19
1540 else if (AMPL) then
1541 *X
1542 end if
1543 end if
1544
1545 * end of m1envt
1546 end
1547
1548 *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1549
1550 subroutine m1init( title )
1551
1552 implicit double precision (a-h,o-z)
1553 character*30 title
1554
1555 * ------------------------------------------------------------------
1556 * m1init defines certain machine-dependent constants.
1557 *
1558 * eps = floating-point precision (e.g., 2.0**(-47) for CDC)
1559 * nwordr = no. of reals per word of z(*)
1560 * nwordi = no. of integers per word of z(*)
1561 * nwordh = no. of half integers per word of z(*)
1562 * where z(*) is the main array of storage.
1563 *
1564 * Original version: integer*2 and nwordh = 4 used throughout for
1565 * certain arrays:
1566 * ha, hs in MINOS (and maybe a few others),
1567 * indc, indr, ip, iq in LUSOL.
1568 * A quirk in LUSOL limits MINOS to 16383 rows
1569 * when the limit should have been 32767.
1570 *
1571 * At present, nwordr is not used because there
1572 * are no real*4 arrays.
1573 *
1574 * 22 May 1992: integer*4 and nwordh = 2 now used to allow
1575 * essentially any number of rows.
1576 * ------------------------------------------------------------------
1577
1578 common /m1eps / eps,eps0,eps1,eps2,eps3,eps4,eps5,plinfy
1579 common /m1word/ nwordr,nwordi,nwordh
1580
1581 title = 'M I N O S 5.4 (Dec 1992)'
1582 *---------------123456789|123456789|123456789|--------------------------
1583
1584 *---+ IEEE standard: eps = 2**(-52) = 2.22e-16
1585 eps = 2.0d+0**(-52)
1586 nwordr = 2
1587 nwordi = 2
1588 nwordh = 2
1589
1590 * Set other machine-precision constants.
1591
1592 eps0 = eps**(0.8 d+0)
1593 eps1 = eps**(0.67d+0)
1594 eps2 = eps**(0.5 d+0)
1595 eps3 = eps**(0.33d+0)
1596 eps4 = eps**(0.25d+0)
1597 eps5 = eps**(0.2 d+0)
1598 plinfy = 1.0d+20
1599
1600 * Set the environment (for later use).
1601
1602 call m1envt( 0 )
1603
1604 * end of m1init
1605 end
1606
1607 *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1608
1609 subroutine m1open( lun, state )
1610
1611 integer lun
1612 character*3 state
1613
1614 * ------------------------------------------------------------------
1615 * m1open is a machine-dependent routine.
1616 * It opens the file with logical unit number lun.
1617 *
1618 * state is intended to be input as 'IN ' or 'OUT'. It may
1619 * be helpful on some systems. MINOS uses sequential files only
1620 * and does not need to read and write to the same file.
1621 *
1622 * 'IN ' refers to an existing input file that will not be altered.
1623 * 'OUT' means that a new file will be output. If the file already
1624 * exists, it might be OK to overwrite it, but on some systems it
1625 * is better to create a new version of the file. The choice is
1626 * open (to coin a phrase).
1627 *
1628 *
1629 * 15 Jul 1989: First version, follows some of the advice offered
1630 * by David Gay, AT&T.
1631 * ------------------------------------------------------------------
1632
1633 if ( state .eq. 'IN ' ) then
1634
1635 * Open an input file (e.g. MPS, OLD BASIS).
1636 * 'OLD' means there will be an error if the file does not exist.
1637 * Since some systems position existing files at the end
1638 * (rather than the beginning), a rewind is performed.
1639
1640 open ( unit = lun, status = 'OLD' )
1641 rewind( lun, err=900 )
1642
1643
1644 else if ( state .eq. 'OUT' ) then
1645
1646 * Open an output file (e.g. DUMP, SOLUTION).
1647 * If it is OK to overwrite an existing file, we could do the
1648 * same as for input:
1649
1650 *--- open ( lun )
1651 *--- rewind( lun, err=900 )
1652
1653 * On DEC VAX/VMS systems it is better to let a new generation
1654 * be created when the first write occurs, so we do nothing:
1655
1656 end if
1657
1658 900 return
1659
1660 * end of m1open
1661 end
1662
1663 *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1664
1665 subroutine m1page( mode )
1666
1667 * ------------------------------------------------------------------
1668 * m1page is an installation-dependent routine. It is called at
1669 * points where some users might want output to files iprint or isumm
1670 * to begin on a new page.
1671 *
1672 * page1 and page2 have already been set by m1envt.
1673 * If they are true, a page eject and a blank line are output.
1674 * Otherwise, just a blank line is output.
1675 *
1676 * If mode = 1, just the page control is relevant.
1677 * If mode = 2, GAMS wants m1envt to print an =.
1678 * If mode = 0 and Summary level = 0, we don't want anything output
1679 * to the Summary file. At present, this is so m8setj
1680 * will print just one line per major iteration, with
1681 * no blank line in between.
1682 *
1683 * 16-Sep-1987: First version.
1684 * 20-Mar-1988: mode 2 added.
1685 * 12-Dec-1991: mode 0 added.
1686 * ------------------------------------------------------------------
1687
1688 logical alone, AMPL, GAMS, MINT, page1, page2
1689 common /m1env / alone, AMPL, GAMS, MINT, page1, page2
1690 common /m1file/ iread,iprint,isumm
1691 logical prnt0 ,prnt1 ,summ0 ,summ1 ,newhed
1692 common /m5log4/ prnt0 ,prnt1 ,summ0 ,summ1 ,newhed
1693
1694 if (iprint .gt. 0) then
1695 if ( page1 ) write(iprint, 1001)
1696 write(iprint, 1002)
1697 end if
1698
1699 if (mode .eq. 2) call m1envt( 1 )
1700
1701 if (isumm .gt. 0) then
1702 if ( page2 ) write(isumm , 1001)
1703 if ( summ1 .or. mode .ne. 0 )
1704 $ write(isumm , 1002)
1705 end if
1706 return
1707
1708 1001 format('1')
1709 1002 format(' ')
1710
1711 * end of m1page
1712 end
1713
1714 *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1715
1716 subroutine m1time( clock, prtopt )
1717
1718 implicit double precision (a-h,o-z)
1719 integer clock, prtopt
1720
1721 * ------------------------------------------------------------------
1722 * m1time, m1timp and m1cpu are derived from timer, timout and nowcpu
1723 * written for DEC VAX/VMS systems by Irvin Lustig,
1724 * Department of Operations Research, Stanford University, 1987.
1725 *
1726 * MINOS calls m1time only. m1time calls m1cpu and m1timp.
1727 * Only m1cpu is intrinsically machine dependent.
1728 *
1729 * If a timer is available, call it in m1cpu and arrange that
1730 * m1cpu returns the current CPU time in seconds.
1731 *
1732 * If a timer is not available or not wanted, set time = 0.0 in m1cpu.
1733 * Timing will be turned off and m1timp will not be called.
1734 * ------------------------------------------------------------------
1735 *
1736 * m1time turns on or off a selected clock and optionally prints
1737 * statistics regarding all clocks or just the clock chosen.
1738 *
1739 * The value of abs(clock) is which clock to use.
1740 * If clock = 0 and prtopt = 0, all clocks and statistics are reset.
1741 * If clock > 0, the clock is reset to start timing at the
1742 * current time (determined by calling the
1743 * machine-dependent subroutine m1cpu).
1744 * If clock < 0, the clock is turned off and the statistic is
1745 * recorded for the amount of time since the clock
1746 * was turned on.
1747 *
1748 * prtopt is the print option.
1749 * If ltime < 0, nothing is printed. Otherwise,
1750 * prtopt = 0 indicates print nothing,
1751 * = 1 indicates print last time for this clock,
1752 * only if clock < 0 (it has just been turned off),
1753 * = 2 indicates print total time for all clocks,
1754 * = 3 indicates print mean time for all clocks.
1755 *
1756 * The procedure for adding a new timer n is as follows:
1757 * 1) Change ntime to n in the parameter statement below (and in
1758 * all other routines referencing common block /m1tim /).
1759 * 2) Expand the array "label" to length n in subroutine m1timp.
1760 *
1761 * 04 Jun 1989: Irv's VMS/VAXC version of m1cpu installed,
1762 * with changes to return time in seconds.
1763 * 10 Jul 1992: More clocks added for use in AMPL (and elsewhere).
1764 * ------------------------------------------------------------------
1765 *
1766 * Clock 1 is for input time.
1767 * Clock 2 is for solve time.
1768 * Clock 3 is for output time.
1769 * Clock 4 is for the nonlinear constraint functions.
1770 * Clock 5 is for the nonlinear objective.
1771 *
1772 * numt(i) is the number of times clock i has been turned on.
1773 * tlast(i) is the time at which clock i was last turned on.
1774 * tsum(i) is the total time elapsed while clock i was on.
1775 * ltime is the Timing level set in the Specs file.
1776
1777 parameter ( ntime = 5 )
1778 common /m1tim / tlast(ntime), tsum(ntime), numt(ntime), ltime
1779
1780 external m1cpu
1781 double precision stat, time
1782 integer iclock, ilo, ihi
1783
1784 if (ltime .eq. 0) return
1785 iclock = iabs(clock)
1786
1787 if (clock .eq. 0) then
1788 if (prtopt .eq. 0) then
1789
1790 * clock = 0, prtopt = 0. Reset everything.
1791
1792 call m1cpu ( 1, time )
1793 call m1cpu ( 0, time )
1794 do 100 i = 1, ntime
1795 tlast(i) = time
1796 tsum(i) = 0.0
1797 numt(i) = 0
1798 100 continue
1799
1800 * If the m1cpu( 0, time ) gave time = 0.0, we assume that
1801 * the clock is a dummy. Turn off future timing.
1802
1803 if (time .le. 0.0) ltime = 0
1804 end if
1805
1806 else
1807 call m1cpu ( 0, time )
1808 if (clock .gt. 0) then
1809 tlast(iclock) = time
1810 else
1811 stat = time - tlast(iclock)
1812 tsum(iclock) = tsum(iclock) + stat
1813 numt(iclock) = numt(iclock) + 1
1814 end if
1815 end if
1816
1817 * Now deal with print options.
1818
1819 if (prtopt .eq. 0 .or. ltime .lt. 0) then
1820
1821 * Do nothing.
1822
1823 else if (prtopt .eq. 1) then
1824
1825 * Print statistic for last clock if just turned off.
1826
1827 if (clock .lt. 0) then
1828 call m1timp( iclock, 'Last time', stat )
1829 end if
1830
1831 else
1832
1833 * prtopt >= 2. Print all statistics if clock = 0,
1834 * or print statistic for individual clock.
1835
1836 if (clock .eq. 0) then
1837 call m1cpu ( -1, time )
1838 ilo = 1
1839 ihi = ntime
1840 else
1841 ilo = iclock
1842 ihi = iclock
1843 end if
1844
1845 do 400 i = ilo, ihi
1846 stat = tsum(i)
1847 if (prtopt .eq. 2) then
1848 call m1timp( i, 'Time', stat )
1849 else if (prtopt .eq. 3) then
1850 istat = numt(i)
1851 if (istat .gt. 0) stat = stat / istat
1852 call m1timp( i, 'Mean time', stat )
1853 end if
1854 400 continue
1855 end if
1856
1857 * end of m1time
1858 end
1859
1860 *++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1861
1862 subroutine m1timp( iclock, lstat, stat )
1863
1864 integer iclock
1865 character*(*) lstat
1866 double precision stat
1867
1868 * ------------------------------------------------------------------
1869 * m1timp prints CPU time for m1time on file iprint and/or isumm.
1870 * It is not intrinsically machine dependent.
1871 *
1872 * iclock selects the correct label.
1873 * lstat is a string to print to tell which type of statistic.
1874 * stat is the statistic to print out.
1875 * If it is zero, we figure it was never timed, so no print.
1876 *
1877 * 12 Jul 1992: Array of labels avoids multiple formats.
1878 * ------------------------------------------------------------------
1879
1880 common /m1file/ iread,iprint,isumm
1881
1882 character*24 label(5)
1883 data label
1884 $ / 'for MPS input',
1885 $ 'for solving problem',
1886 $ 'for solution output',
1887 $ 'for constraint functions',
1888 $ 'for objective function' /
1889
1890 if (iclock .eq. 1) then
1891 if (iprint .gt. 0) write(iprint, 1000)
1892 if (isumm .gt. 0) write(isumm , 1000)
1893 end if
1894
1895 if (stat .eq. 0.0) return
1896
1897 if (iprint .gt. 0) write(iprint, 1000) lstat, label(iclock), stat
1898 if (isumm .gt. 0) write(isumm , 1000) lstat, label(iclock), stat
1899 return
1900
1901 1000 format( 1x, a, 1x, a, t38, f13.2,' seconds')
1902
1903 * end of m1timp
1904 end
1905
1906 *++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1907
1908 subroutine m1cpu ( mode, time )
1909
1910 integer mode
1911 double precision time
1912
1913 * ------------------------------------------------------------------
1914 * m1cpu is a machine-dependent routine to return time = cpu time
1915 * in seconds, so that 2 consecutive calls will indicate the
1916 * time difference of operations between the 2 calls.
1917 * The parameter 'mode' indicates what function should be done
1918 * to the timer. This allows necessary initialization for certain
1919 * machines.
1920 * mode = 1 indicates initialization,
1921 * mode = 0 indicates normal use,
1922 * mode = -1 indicates stop the timer.
1923 *
1924 * For the MicroVax II under VMS, we need to call the correct library
1925 * routine to get the timer statistics. These statistics are
1926 * found by using the times() function in the VaX C Runtime library.
1927 * To use this version of m1cpu, one must create an options file
1928 * called vmsc.opt with the line
1929 * SYS$LIBRARY:VAXCRTL/SHARE
1930 * in it. Then link using the usual command and append ,vmsc/opt
1931 * to the end of the line. The name vmsc can be anything you desire.
1932 * ------------------------------------------------------------------
1933
1934 *--> DEC VAX/VMS
1935 *--> integer itimad(4)
1936
1937 *--> Unix (DECstation)
1938 real tarray(2)
1939
1940 if (mode .eq. 1) then
1941 * ---------------------------------------------------------------
1942 * Initialize.
1943 * ---------------------------------------------------------------
1944 time = 0.0
1945
1946 else if (mode .eq. 0) then
1947 * ---------------------------------------------------------------
1948 * Normal call.
1949 * Return current timer value here.
1950 * ---------------------------------------------------------------
1951 *--> On VAX/VMS, itimad(1) returns the number of centiseconds.
1952 * call times ( itimad )
1953 * time = itimad(1)
1954 * time = time * 0.01d+0
1955
1956 *--> On Unix (DECstation MIPS RISC F77), etime returns seconds.
1957 * time = etime ( tarray )
1958
1959 *--> On other machines, to forget about timing, just say
1960 time = 0.0
1961
1962 else if (mode .eq. -1) then
1963 * ---------------------------------------------------------------
1964 * Stop the clock.
1965 * ---------------------------------------------------------------
1966 time = 0.0
1967 end if
1968
1969 * end of m1cpu
1970 end

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