Mercurial > hg > octave-lyh

annotate libcruft/daspk/dyypnw.f @ 14459:a22a41ab6824

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
doc: Add Colin Macdonald and Mike Miller to contributors.in
author Jordi Gutiérrez Hermoso <jordigh@octave.org>
date Tue, 13 Mar 2012 01:30:26 -0400
parents 8389e78e67d4
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
3911
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
1 C Work performed under the auspices of the U.S. Department of Energy
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
2 C by Lawrence Livermore National Laboratory under contract number
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
3 C W-7405-Eng-48.
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
4 C
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
5 SUBROUTINE DYYPNW (NEQ, Y, YPRIME, CJ, RL, P, ICOPT, ID,
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
6 * YNEW, YPNEW)
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
7 C
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
8 C***BEGIN PROLOGUE DYYPNW
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
9 C***REFER TO DLINSK
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
10 C***DATE WRITTEN 940830 (YYMMDD)
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
11 C
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
12 C
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
13 C-----------------------------------------------------------------------
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
14 C***DESCRIPTION
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
15 C
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
16 C DYYPNW calculates the new (Y,YPRIME) pair needed in the
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
17 C linesearch algorithm based on the current lambda value. It is
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
18 C called by DLINSK and DLINSD. Based on the ICOPT and ID values,
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
19 C the corresponding entry in Y or YPRIME is updated.
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
20 C
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
21 C In addition to the parameters described in the calling programs,
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
22 C the parameters represent
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
23 C
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
24 C P -- Array of length NEQ that contains the current
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
25 C approximate Newton step.
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
26 C RL -- Scalar containing the current lambda value.
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
27 C YNEW -- Array of length NEQ containing the updated Y vector.
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
28 C YPNEW -- Array of length NEQ containing the updated YPRIME
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
29 C vector.
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
30 C-----------------------------------------------------------------------
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
31 C
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
32 C***ROUTINES CALLED (NONE)
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
33 C
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
34 C***END PROLOGUE DYYPNW
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
35 C
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
36 C
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
37 IMPLICIT DOUBLE PRECISION (A-H,O-Z)
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
38 DIMENSION Y(*), YPRIME(*), YNEW(*), YPNEW(*), ID(*), P(*)
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
39 C
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
40 IF (ICOPT .EQ. 1) THEN
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
41 DO 10 I=1,NEQ
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
42 IF(ID(I) .LT. 0) THEN
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
43 YNEW(I) = Y(I) - RL*P(I)
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
44 YPNEW(I) = YPRIME(I)
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
45 ELSE
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
46 YNEW(I) = Y(I)
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
47 YPNEW(I) = YPRIME(I) - RL*CJ*P(I)
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
48 ENDIF
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
49 10 CONTINUE
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
50 ELSE
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
51 DO 20 I = 1,NEQ
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
52 YNEW(I) = Y(I) - RL*P(I)
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
53 YPNEW(I) = YPRIME(I)
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
54 20 CONTINUE
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
55 ENDIF
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
56 RETURN
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
57 C----------------------- END OF SUBROUTINE DYYPNW ----------------------
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
58 END