 GNU Octave  4.2.1 A high-level interpreted language, primarily intended for numerical computations, mostly compatible with Matlab
dcnst0.f
Go to the documentation of this file.
1 C Work performed under the auspices of the U.S. Department of Energy
2 C by Lawrence Livermore National Laboratory under contract number
3 C W-7405-Eng-48.
4 C
5  SUBROUTINE dcnst0 (NEQ, Y, ICNSTR, IRET)
6 C
7 C***BEGIN PROLOGUE DCNST0
8 C***DATE WRITTEN 950808 (YYMMDD)
9 C***REVISION DATE 950808 (YYMMDD)
10 C
11 C
12 C-----------------------------------------------------------------------
13 C***DESCRIPTION
14 C
15 C This subroutine checks for constraint violations in the initial
16 C approximate solution u.
17 C
18 C On entry
19 C
20 C NEQ -- size of the nonlinear system, and the length of arrays
21 C Y and ICNSTR.
22 C
23 C Y -- real array containing the initial approximate root.
24 C
25 C ICNSTR -- INTEGER array of length NEQ containing flags indicating
26 C which entries in Y are to be constrained.
27 C if ICNSTR(I) = 2, then Y(I) must be .GT. 0,
28 C if ICNSTR(I) = 1, then Y(I) must be .GE. 0,
29 C if ICNSTR(I) = -1, then Y(I) must be .LE. 0, while
30 C if ICNSTR(I) = -2, then Y(I) must be .LT. 0, while
31 C if ICNSTR(I) = 0, then Y(I) is not constrained.
32 C
33 C On return
34 C
35 C IRET -- output flag.
36 C IRET=0 means that u satisfied all constraints.
37 C IRET.NE.0 means that Y(IRET) failed to satisfy its
38 C constraint.
39 C
40 C-----------------------------------------------------------------------
41  IMPLICIT DOUBLE PRECISION(a-h,o-z)
42  dimension y(neq), icnstr(neq)
43  SAVE zero
44  DATA zero/0.d0/
45 C-----------------------------------------------------------------------
46 C Check constraints for initial Y. If a constraint has been violated,
47 C set IRET = I to signal an error return to calling routine.
48 C-----------------------------------------------------------------------
49  iret = 0
50  DO 100 i = 1,neq
51  IF (icnstr(i) .EQ. 2) THEN
52  IF (y(i) .LE. zero) THEN
53  iret = i
54  RETURN
55  ENDIF
56  ELSEIF (icnstr(i) .EQ. 1) THEN
57  IF (y(i) .LT. zero) THEN
58  iret = i
59  RETURN
60  ENDIF
61  ELSEIF (icnstr(i) .EQ. -1) THEN
62  IF (y(i) .GT. zero) THEN
63  iret = i
64  RETURN
65  ENDIF
66  ELSEIF (icnstr(i) .EQ. -2) THEN
67  IF (y(i) .GE. zero) THEN
68  iret = i
69  RETURN
70  ENDIF
71  ENDIF
72  100 CONTINUE
73  RETURN
74 C----------------------- END OF SUBROUTINE DCNST0 ----------------------
75  END
is greater than zero