Mercurial > octave-nkf
comparison libcruft/npsol/mcmin.f @ 2329:30c606bec7a8
[project @ 1996-07-19 01:29:05 by jwe]
Initial revision
| author | jwe |
|---|---|
| date | Fri, 19 Jul 1996 01:29:55 +0000 |
| parents | |
| children |
comparison
equal
deleted
inserted
replaced
| 2328:b44c3b2a5fce | 2329:30c606bec7a8 |
|---|---|
| 1 *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 2 | |
| 3 SUBROUTINE MCMIN ( EMIN, START, XBASE, RBASE, BASE ) | |
| 4 INTEGER EMIN, BASE | |
| 5 DOUBLE PRECISION START, XBASE, RBASE | |
| 6 | |
| 7 * Service routine for MCENV2. | |
| 8 * | |
| 9 * | |
| 10 * Nag Fortran 77 O( 1 ) basic linear algebra routine (GETMIN). | |
| 11 * | |
| 12 * -- Written on 6-January-1986. | |
| 13 * Sven Hammarling and Mick Pont, Nag Central Office. | |
| 14 | |
| 15 EXTERNAL MCSTOR | |
| 16 INTEGER I | |
| 17 DOUBLE PRECISION A , B1 , B2 , C1 , C2 , D1 | |
| 18 DOUBLE PRECISION D2 , MCSTOR, ZERO | |
| 19 | |
| 20 A = START | |
| 21 ZERO = 0 | |
| 22 EMIN = 1 | |
| 23 B1 = MCSTOR( A/XBASE, ZERO ) | |
| 24 C1 = A | |
| 25 C2 = A | |
| 26 D1 = A | |
| 27 D2 = A | |
| 28 *+ WHILE( ( C1.EQ.A ).AND.( C2.EQ.A ).AND. | |
| 29 *+ $ ( D1.EQ.A ).AND.( D2.EQ.A ) )LOOP | |
| 30 10 IF ( ( C1.EQ.A ).AND.( C2.EQ.A ).AND. | |
| 31 $ ( D1.EQ.A ).AND.( D2.EQ.A ) )THEN | |
| 32 EMIN = EMIN - 1 | |
| 33 A = B1 | |
| 34 B1 = MCSTOR( A /XBASE, ZERO ) | |
| 35 C1 = MCSTOR( B1*XBASE, ZERO ) | |
| 36 D1 = ZERO | |
| 37 DO 20, I = 1, BASE | |
| 38 D1 = D1 + B1 | |
| 39 20 CONTINUE | |
| 40 B2 = MCSTOR( A *RBASE, ZERO ) | |
| 41 C2 = MCSTOR( B2/RBASE, ZERO ) | |
| 42 D2 = ZERO | |
| 43 DO 30, I = 1, BASE | |
| 44 D2 = D2 + B2 | |
| 45 30 CONTINUE | |
| 46 GO TO 10 | |
| 47 END IF | |
| 48 *+ END WHILE | |
| 49 RETURN | |
| 50 | |
| 51 * End of MCMIN (GETMIN). | |
| 52 | |
| 53 END |