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 DNSID(X,Y,YPRIME,NEQ,ICOPT,ID,RES,WT,RPAR,IPAR, 00006 * DELTA,R,YIC,YPIC,WM,IWM,CJ,EPCON,RATEMX,MAXIT,STPTOL, 00007 * ICNFLG,ICNSTR,IERNEW) 00008 C 00009 C***BEGIN PROLOGUE DNSID 00010 C***REFER TO DDASPK 00011 C***DATE WRITTEN 940701 (YYMMDD) 00012 C***REVISION DATE 950713 (YYMMDD) 00013 C 00014 C 00015 C----------------------------------------------------------------------- 00016 C***DESCRIPTION 00017 C 00018 C DNSID solves a nonlinear system of algebraic equations of the 00019 C form G(X,Y,YPRIME) = 0 for the unknown parts of Y and YPRIME 00020 C in the initial conditions. 00021 C 00022 C The method used is a modified Newton scheme. 00023 C 00024 C The parameters represent 00025 C 00026 C X -- Independent variable. 00027 C Y -- Solution vector. 00028 C YPRIME -- Derivative of solution vector. 00029 C NEQ -- Number of unknowns. 00030 C ICOPT -- Initial condition option chosen (1 or 2). 00031 C ID -- Array of dimension NEQ, which must be initialized 00032 C if ICOPT = 1. See DDASIC. 00033 C RES -- External user-supplied subroutine to evaluate the 00034 C residual. See RES description in DDASPK prologue. 00035 C WT -- Vector of weights for error criterion. 00036 C RPAR,IPAR -- Real and integer arrays used for communication 00037 C between the calling program and external user 00038 C routines. They are not altered within DASPK. 00039 C DELTA -- Residual vector on entry, and work vector of 00040 C length NEQ for DNSID. 00041 C WM,IWM -- Real and integer arrays storing matrix information 00042 C such as the matrix of partial derivatives, 00043 C permutation vector, and various other information. 00044 C CJ -- Matrix parameter = 1/H (ICOPT = 1) or 0 (ICOPT = 2). 00045 C R -- Array of length NEQ used as workspace by the 00046 C linesearch routine DLINSD. 00047 C YIC,YPIC -- Work vectors for DLINSD, each of length NEQ. 00048 C EPCON -- Tolerance to test for convergence of the Newton 00049 C iteration. 00050 C RATEMX -- Maximum convergence rate for which Newton iteration 00051 C is considered converging. 00052 C MAXIT -- Maximum allowed number of Newton iterations. 00053 C STPTOL -- Tolerance used in calculating the minimum lambda 00054 C value allowed. 00055 C ICNFLG -- Integer scalar. If nonzero, then constraint 00056 C violations in the proposed new approximate solution 00057 C will be checked for, and the maximum step length 00058 C will be adjusted accordingly. 00059 C ICNSTR -- Integer array of length NEQ containing flags for 00060 C checking constraints. 00061 C IERNEW -- Error flag for Newton iteration. 00062 C 0 ==> Newton iteration converged. 00063 C 1 ==> failed to converge, but RATE .le. RATEMX. 00064 C 2 ==> failed to converge, RATE .gt. RATEMX. 00065 C 3 ==> other recoverable error (IRES = -1, or 00066 C linesearch failed). 00067 C -1 ==> unrecoverable error (IRES = -2). 00068 C 00069 C----------------------------------------------------------------------- 00070 C 00071 C***ROUTINES CALLED 00072 C DSLVD, DDWNRM, DLINSD, DCOPY 00073 C 00074 C***END PROLOGUE DNSID 00075 C 00076 C 00077 IMPLICIT DOUBLE PRECISION(A-H,O-Z) 00078 DIMENSION Y(*),YPRIME(*),WT(*),R(*) 00079 DIMENSION ID(*),DELTA(*), YIC(*), YPIC(*) 00080 DIMENSION WM(*),IWM(*), RPAR(*),IPAR(*) 00081 DIMENSION ICNSTR(*) 00082 EXTERNAL RES 00083 C 00084 PARAMETER (LNNI=19, LLSOFF=35) 00085 C 00086 C 00087 C Initializations. M is the Newton iteration counter. 00088 C 00089 LSOFF = IWM(LLSOFF) 00090 M = 0 00091 RATE = 1.0D0 00092 RLX = 0.4D0 00093 C 00094 C Compute a new step vector DELTA by back-substitution. 00095 C 00096 CALL DSLVD (NEQ, DELTA, WM, IWM) 00097 C 00098 C Get norm of DELTA. Return now if norm(DELTA) .le. EPCON. 00099 C 00100 DELNRM = DDWNRM(NEQ,DELTA,WT,RPAR,IPAR) 00101 FNRM = DELNRM 00102 IF (FNRM .LE. EPCON) RETURN 00103 C 00104 C Newton iteration loop. 00105 C 00106 300 CONTINUE 00107 IWM(LNNI) = IWM(LNNI) + 1 00108 C 00109 C Call linesearch routine for global strategy and set RATE 00110 C 00111 OLDFNM = FNRM 00112 C 00113 CALL DLINSD (NEQ, Y, X, YPRIME, CJ, DELTA, DELNRM, WT, LSOFF, 00114 * STPTOL, IRET, RES, IRES, WM, IWM, FNRM, ICOPT, ID, 00115 * R, YIC, YPIC, ICNFLG, ICNSTR, RLX, RPAR, IPAR) 00116 C 00117 RATE = FNRM/OLDFNM 00118 C 00119 C Check for error condition from linesearch. 00120 IF (IRET .NE. 0) GO TO 390 00121 C 00122 C Test for convergence of the iteration, and return or loop. 00123 C 00124 IF (FNRM .LE. EPCON) RETURN 00125 C 00126 C The iteration has not yet converged. Update M. 00127 C Test whether the maximum number of iterations have been tried. 00128 C 00129 M = M + 1 00130 IF (M .GE. MAXIT) GO TO 380 00131 C 00132 C Copy the residual to DELTA and its norm to DELNRM, and loop for 00133 C another iteration. 00134 C 00135 CALL DCOPY (NEQ, R, 1, DELTA, 1) 00136 DELNRM = FNRM 00137 GO TO 300 00138 C 00139 C The maximum number of iterations was done. Set IERNEW and return. 00140 C 00141 380 IF (RATE .LE. RATEMX) THEN 00142 IERNEW = 1 00143 ELSE 00144 IERNEW = 2 00145 ENDIF 00146 RETURN 00147 C 00148 390 IF (IRES .LE. -2) THEN 00149 IERNEW = -1 00150 ELSE 00151 IERNEW = 3 00152 ENDIF 00153 RETURN 00154 C 00155 C 00156 C------END OF SUBROUTINE DNSID------------------------------------------ 00157 END