GNU Octave  3.8.0
A high-level interpreted language, primarily intended for numerical computations, mostly compatible with Matlab
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Properties Friends Macros Pages
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