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 DFNRMK (NEQ, Y, T, YPRIME, SAVR, R, CJ, WT, 00006 * SQRTN, RSQRTN, RES, IRES, PSOL, IRIN, IER, 00007 * FNORM, EPLIN, WP, IWP, PWK, RPAR, IPAR) 00008 C 00009 C***BEGIN PROLOGUE DFNRMK 00010 C***REFER TO DLINSK 00011 C***DATE WRITTEN 940830 (YYMMDD) 00012 C***REVISION DATE 951006 (SQRTN, RSQRTN, and scaling of WT added.) 00013 C 00014 C 00015 C----------------------------------------------------------------------- 00016 C***DESCRIPTION 00017 C 00018 C DFNRMK calculates the scaled preconditioned norm of the nonlinear 00019 C function used in the nonlinear iteration for obtaining consistent 00020 C initial conditions. Specifically, DFNRMK calculates the weighted 00021 C root-mean-square norm of the vector (P-inverse)*G(T,Y,YPRIME), 00022 C where P is the preconditioner matrix. 00023 C 00024 C In addition to the parameters described in the calling program 00025 C DLINSK, the parameters represent 00026 C 00027 C IRIN -- Flag showing whether the current residual vector is 00028 C input in SAVR. 1 means it is, 0 means it is not. 00029 C R -- Array of length NEQ that contains 00030 C (P-inverse)*G(T,Y,YPRIME) on return. 00031 C FNORM -- Scalar containing the weighted norm of R on return. 00032 C----------------------------------------------------------------------- 00033 C 00034 C***ROUTINES CALLED 00035 C RES, DCOPY, DSCAL, PSOL, DDWNRM 00036 C 00037 C***END PROLOGUE DFNRMK 00038 C 00039 C 00040 IMPLICIT DOUBLE PRECISION (A-H,O-Z) 00041 EXTERNAL RES, PSOL 00042 DIMENSION Y(*), YPRIME(*), WT(*), SAVR(*), R(*), PWK(*) 00043 DIMENSION WP(*), IWP(*), RPAR(*), IPAR(*) 00044 C----------------------------------------------------------------------- 00045 C Call RES routine if IRIN = 0. 00046 C----------------------------------------------------------------------- 00047 IF (IRIN .EQ. 0) THEN 00048 IRES = 0 00049 CALL RES (T, Y, YPRIME, CJ, SAVR, IRES, RPAR, IPAR) 00050 IF (IRES .LT. 0) RETURN 00051 ENDIF 00052 C----------------------------------------------------------------------- 00053 C Apply inverse of left preconditioner to vector R. 00054 C First scale WT array by 1/sqrt(N), and undo scaling afterward. 00055 C----------------------------------------------------------------------- 00056 CALL DCOPY(NEQ, SAVR, 1, R, 1) 00057 CALL DSCAL (NEQ, RSQRTN, WT, 1) 00058 IER = 0 00059 CALL PSOL (NEQ, T, Y, YPRIME, SAVR, PWK, CJ, WT, WP, IWP, 00060 * R, EPLIN, IER, RPAR, IPAR) 00061 CALL DSCAL (NEQ, SQRTN, WT, 1) 00062 IF (IER .NE. 0) RETURN 00063 C----------------------------------------------------------------------- 00064 C Calculate norm of R. 00065 C----------------------------------------------------------------------- 00066 FNORM = DDWNRM (NEQ, R, WT, RPAR, IPAR) 00067 C 00068 RETURN 00069 C----------------------- END OF SUBROUTINE DFNRMK ---------------------- 00070 END
1.7.1
