00001 C Work performed under the auspices of the U.S. Department of Energy 00002 C by Lawrence Livermore National Laboratory under contract number 00003 C W-7405-Eng-48. 00004 C 00005 SUBROUTINE DCNST0 (NEQ, Y, ICNSTR, IRET) 00006 C 00007 C***BEGIN PROLOGUE DCNST0 00008 C***DATE WRITTEN 950808 (YYMMDD) 00009 C***REVISION DATE 950808 (YYMMDD) 00010 C 00011 C 00012 C----------------------------------------------------------------------- 00013 C***DESCRIPTION 00014 C 00015 C This subroutine checks for constraint violations in the initial 00016 C approximate solution u. 00017 C 00018 C On entry 00019 C 00020 C NEQ -- size of the nonlinear system, and the length of arrays 00021 C Y and ICNSTR. 00022 C 00023 C Y -- real array containing the initial approximate root. 00024 C 00025 C ICNSTR -- INTEGER array of length NEQ containing flags indicating 00026 C which entries in Y are to be constrained. 00027 C if ICNSTR(I) = 2, then Y(I) must be .GT. 0, 00028 C if ICNSTR(I) = 1, then Y(I) must be .GE. 0, 00029 C if ICNSTR(I) = -1, then Y(I) must be .LE. 0, while 00030 C if ICNSTR(I) = -2, then Y(I) must be .LT. 0, while 00031 C if ICNSTR(I) = 0, then Y(I) is not constrained. 00032 C 00033 C On return 00034 C 00035 C IRET -- output flag. 00036 C IRET=0 means that u satisfied all constraints. 00037 C IRET.NE.0 means that Y(IRET) failed to satisfy its 00038 C constraint. 00039 C 00040 C----------------------------------------------------------------------- 00041 IMPLICIT DOUBLE PRECISION(A-H,O-Z) 00042 DIMENSION Y(NEQ), ICNSTR(NEQ) 00043 SAVE ZERO 00044 DATA ZERO/0.D0/ 00045 C----------------------------------------------------------------------- 00046 C Check constraints for initial Y. If a constraint has been violated, 00047 C set IRET = I to signal an error return to calling routine. 00048 C----------------------------------------------------------------------- 00049 IRET = 0 00050 DO 100 I = 1,NEQ 00051 IF (ICNSTR(I) .EQ. 2) THEN 00052 IF (Y(I) .LE. ZERO) THEN 00053 IRET = I 00054 RETURN 00055 ENDIF 00056 ELSEIF (ICNSTR(I) .EQ. 1) THEN 00057 IF (Y(I) .LT. ZERO) THEN 00058 IRET = I 00059 RETURN 00060 ENDIF 00061 ELSEIF (ICNSTR(I) .EQ. -1) THEN 00062 IF (Y(I) .GT. ZERO) THEN 00063 IRET = I 00064 RETURN 00065 ENDIF 00066 ELSEIF (ICNSTR(I) .EQ. -2) THEN 00067 IF (Y(I) .GE. ZERO) THEN 00068 IRET = I 00069 RETURN 00070 ENDIF 00071 ENDIF 00072 100 CONTINUE 00073 RETURN 00074 C----------------------- END OF SUBROUTINE DCNST0 ---------------------- 00075 END
1.7.1
