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 DSLVK (NEQ, Y, TN, YPRIME, SAVR, X, EWT, WM, IWM, 00006 * RES, IRES, PSOL, IERSL, CJ, EPLIN, SQRTN, RSQRTN, RHOK, 00007 * RPAR, IPAR) 00008 C 00009 C***BEGIN PROLOGUE DSLVK 00010 C***REFER TO DDASPK 00011 C***DATE WRITTEN 890101 (YYMMDD) 00012 C***REVISION DATE 900926 (YYMMDD) 00013 C***REVISION DATE 940928 Removed MNEWT and added RHOK in call list. 00014 C 00015 C 00016 C----------------------------------------------------------------------- 00017 C***DESCRIPTION 00018 C 00019 C DSLVK uses a restart algorithm and interfaces to DSPIGM for 00020 C the solution of the linear system arising from a Newton iteration. 00021 C 00022 C In addition to variables described elsewhere, 00023 C communication with DSLVK uses the following variables.. 00024 C WM = Real work space containing data for the algorithm 00025 C (Krylov basis vectors, Hessenberg matrix, etc.). 00026 C IWM = Integer work space containing data for the algorithm. 00027 C X = The right-hand side vector on input, and the solution vector 00028 C on output, of length NEQ. 00029 C IRES = Error flag from RES. 00030 C IERSL = Output flag .. 00031 C IERSL = 0 means no trouble occurred (or user RES routine 00032 C returned IRES < 0) 00033 C IERSL = 1 means the iterative method failed to converge 00034 C (DSPIGM returned IFLAG > 0.) 00035 C IERSL = -1 means there was a nonrecoverable error in the 00036 C iterative solver, and an error exit will occur. 00037 C----------------------------------------------------------------------- 00038 C***ROUTINES CALLED 00039 C DSCAL, DCOPY, DSPIGM 00040 C 00041 C***END PROLOGUE DSLVK 00042 C 00043 INTEGER NEQ, IWM, IRES, IERSL, IPAR 00044 DOUBLE PRECISION Y, TN, YPRIME, SAVR, X, EWT, WM, CJ, EPLIN, 00045 1 SQRTN, RSQRTN, RHOK, RPAR 00046 DIMENSION Y(*), YPRIME(*), SAVR(*), X(*), EWT(*), 00047 1 WM(*), IWM(*), RPAR(*), IPAR(*) 00048 C 00049 INTEGER IFLAG, IRST, NRSTS, NRMAX, LR, LDL, LHES, LGMR, LQ, LV, 00050 1 LWK, LZ, MAXLP1, NPSL 00051 INTEGER NLI, NPS, NCFL, NRE, MAXL, KMP, MITER 00052 EXTERNAL RES, PSOL 00053 C 00054 PARAMETER (LNRE=12, LNCFL=16, LNLI=20, LNPS=21) 00055 PARAMETER (LLOCWP=29, LLCIWP=30) 00056 PARAMETER (LMITER=23, LMAXL=24, LKMP=25, LNRMAX=26) 00057 C 00058 C----------------------------------------------------------------------- 00059 C IRST is set to 1, to indicate restarting is in effect. 00060 C NRMAX is the maximum number of restarts. 00061 C----------------------------------------------------------------------- 00062 DATA IRST/1/ 00063 C 00064 LIWP = IWM(LLCIWP) 00065 NLI = IWM(LNLI) 00066 NPS = IWM(LNPS) 00067 NCFL = IWM(LNCFL) 00068 NRE = IWM(LNRE) 00069 LWP = IWM(LLOCWP) 00070 MAXL = IWM(LMAXL) 00071 KMP = IWM(LKMP) 00072 NRMAX = IWM(LNRMAX) 00073 MITER = IWM(LMITER) 00074 IERSL = 0 00075 IRES = 0 00076 C----------------------------------------------------------------------- 00077 C Use a restarting strategy to solve the linear system 00078 C P*X = -F. Parse the work vector, and perform initializations. 00079 C Note that zero is the initial guess for X. 00080 C----------------------------------------------------------------------- 00081 MAXLP1 = MAXL + 1 00082 LV = 1 00083 LR = LV + NEQ*MAXL 00084 LHES = LR + NEQ + 1 00085 LQ = LHES + MAXL*MAXLP1 00086 LWK = LQ + 2*MAXL 00087 LDL = LWK + MIN0(1,MAXL-KMP)*NEQ 00088 LZ = LDL + NEQ 00089 CALL DSCAL (NEQ, RSQRTN, EWT, 1) 00090 CALL DCOPY (NEQ, X, 1, WM(LR), 1) 00091 DO 110 I = 1,NEQ 00092 110 X(I) = 0.D0 00093 C----------------------------------------------------------------------- 00094 C Top of loop for the restart algorithm. Initial pass approximates 00095 C X and sets up a transformed system to perform subsequent restarts 00096 C to update X. NRSTS is initialized to -1, because restarting 00097 C does not occur until after the first pass. 00098 C Update NRSTS; conditionally copy DL to R; call the DSPIGM 00099 C algorithm to solve A*Z = R; updated counters; update X with 00100 C the residual solution. 00101 C Note: if convergence is not achieved after NRMAX restarts, 00102 C then the linear solver is considered to have failed. 00103 C----------------------------------------------------------------------- 00104 NRSTS = -1 00105 115 CONTINUE 00106 NRSTS = NRSTS + 1 00107 IF (NRSTS .GT. 0) CALL DCOPY (NEQ, WM(LDL), 1, WM(LR),1) 00108 CALL DSPIGM (NEQ, TN, Y, YPRIME, SAVR, WM(LR), EWT, MAXL, MAXLP1, 00109 1 KMP, EPLIN, CJ, RES, IRES, NRES, PSOL, NPSL, WM(LZ), WM(LV), 00110 2 WM(LHES), WM(LQ), LGMR, WM(LWP), IWM(LIWP), WM(LWK), 00111 3 WM(LDL), RHOK, IFLAG, IRST, NRSTS, RPAR, IPAR) 00112 NLI = NLI + LGMR 00113 NPS = NPS + NPSL 00114 NRE = NRE + NRES 00115 DO 120 I = 1,NEQ 00116 120 X(I) = X(I) + WM(LZ+I-1) 00117 IF ((IFLAG .EQ. 1) .AND. (NRSTS .LT. NRMAX) .AND. (IRES .EQ. 0)) 00118 1 GO TO 115 00119 C----------------------------------------------------------------------- 00120 C The restart scheme is finished. Test IRES and IFLAG to see if 00121 C convergence was not achieved, and set flags accordingly. 00122 C----------------------------------------------------------------------- 00123 IF (IRES .LT. 0) THEN 00124 NCFL = NCFL + 1 00125 ELSE IF (IFLAG .NE. 0) THEN 00126 NCFL = NCFL + 1 00127 IF (IFLAG .GT. 0) IERSL = 1 00128 IF (IFLAG .LT. 0) IERSL = -1 00129 ENDIF 00130 C----------------------------------------------------------------------- 00131 C Update IWM with counters, rescale EWT, and return. 00132 C----------------------------------------------------------------------- 00133 IWM(LNLI) = NLI 00134 IWM(LNPS) = NPS 00135 IWM(LNCFL) = NCFL 00136 IWM(LNRE) = NRE 00137 CALL DSCAL (NEQ, SQRTN, EWT, 1) 00138 RETURN 00139 C 00140 C------END OF SUBROUTINE DSLVK------------------------------------------ 00141 END
1.7.1
