C ALGORITHM 759, COLLECTED ALGORITHMS FROM ACM. C THIS WORK PUBLISHED IN TRANSACTIONS ON MATHEMATICAL SOFTWARE, C VOL. 22, NO. 3, September, 1996, P. 329--347. C #! /bin/sh # This is a shell archive, meaning: # 1. Remove everything above the #! /bin/sh line. # 2. Save the resulting text in a file. # 3. Execute the file with /bin/sh (not csh) to create the files: # Doc # Drivers # Info # Src # This archive created: Wed Sep 25 11:41:19 1996 export PATH; PATH=/bin:$PATH if test ! -d 'Doc' then mkdir 'Doc' fi cd 'Doc' if test -f 'readme' then echo shar: will not over-write existing file "'readme'" else cat << \SHAR_EOF > 'readme' `VLUGR3: A Vectorizable Adaptive Grid Solver for PDEs in 3D. Part II. Code Description' by J.G. Blom and J.G. Verwer. This code solves systems of PDEs of the type F(t,x,y,z,U,Ut,Ux,Uy,Uz,Uxx,Uyy,Uzz,Uxy,Uxz,Uyz)=0 with boundary conditions B(t,x,y,z,U,Ut,Ux,Uy,Uz)=0 and initial values U(t0,x,y,z)=U0 on a 3D domain bounded by right-angled polyhedrons. In space Local Uniform Grid Refinement is applied to resolve local sharp gradients in the solution. For the time integration the implicit BDF2 method is used with variable stepsizes. Description of contents of source code files -------------------------------------------- (Both single precision and double precision available) VLUGR3.f Main module, contains documentation ILUBSn.f ILU decomposition and backsolve for arbitrary number of PDE components ILUBS1.f ILU decomposition and backsolve for optimal vector performance for PDE with 1 component ILUBS2.f ILU decomposition and backsolve for optimal vector performance for PDE with 2 components ILUBS3.f ILU decomposition and backsolve for optimal vector performance for PDE with 3 components USER.f Default modules that can be replaced by user's own (see description in paper) blas.f BLAS modules EXMPL.f Calling program for the first time interval of the example in the paper EXMPLR.f Calling program for the second time interval of the example in the paper ProbI?.f Calling programs for the first two problems in the companion paper `VLUGR3: A Vectorizable Adaptive Grid Solver for PDEs in 3D. I. Algorithmic Aspects and Applications' PRTSOL.f Program to print out solution from file generated by the DUMP routine WRTUNI.f Program that reads the file generated by the DUMP routine and writes the (interpolated) solution on a uniform grid of a specified grid level and the maximum used grid level in each point to file. Plot.m Matlab plotting routine to plot the data generated by WRTUNI.f How to use the solver: ---------------------- Compile and link the files EXMPL.f USER.f (only the SUBROUTINE DERIVF) VLUGR3.f ILUBSn.f blas.f (if the BLAS library is not available on the platform) The module blas.f contains, a.o., the functions I1MACH and R/D1MACH which set machine-dependent values. These functions need to be adapted to the platform. The results and integration information can be found in the files EXMPL_28 EXMPL_RunInfo EXMPL_output A file DUMP is created that contains all the necessary information to restart the integration on the second time interval. For the second run one should compile and link the files EXMPLR.f USER.f (only (a dummy) FUNCTION INIDOM and SUBROUTINE CHSPCM) VLUGR3.f ILUBSn.f blas.f (if the BLAS library is not available on the platform) The results for this run is in the files EXMPLR_28 EXMPLR_output To get an optimal vector performance for a small number of PDE components one should use the specific ILUBS#.f code, in this case: ILUBS3.f SHAR_EOF fi # end of overwriting check cd .. if test ! -d 'Drivers' then mkdir 'Drivers' fi cd 'Drivers' if test ! -d 'Dp' then mkdir 'Dp' fi cd 'Dp' if test -f 'exmpl.f' then echo shar: will not over-write existing file "'exmpl.f'" else cat << \SHAR_EOF > 'exmpl.f' PROGRAM EXMPL C C Ccc INCLUDE 'PARNEWTON' C C PARNEWTON C C Parameters for Newton process C MAXNIT : Max. number of Newton iterations C MAXJAC : Max. number of Jacobian / preconditioner evaluations during C a Newton process C TOLNEW : Tolerance for Newton process: C rho/(1-rho)*|| corr.||_w < TOLNEW INTEGER MAXNIT, MAXJAC DOUBLE PRECISION TOLNEW PARAMETER (MAXNIT = 10, MAXJAC = 2, TOLNEW = 1.0) C C end INCLUDE 'PARNEWTON' C C Ccc INCLUDE 'PARGCRO' C C PARGCRO C C Parameters for linear system solver GCRO + (block-)diagonal C preconditioner C IDIAGP : 0: block-diagonal + first order derivatives C 1: block-diagonal neglecting first order derivatives C 2: diagonal + first order derivatives C 3: diagonal neglecting first order derivatives C NRRMAX : Max. number of restarts of outer loop C MAXLR : Max. number of iterations in outer loop C MAXL : Max. number of iterations in GMRES inner loop C TOLLSC : Tolerance for linear system solver INTEGER IDIAGP, NRRMAX, MAXLR, MAXL DOUBLE PRECISION TOLLSC PARAMETER (NRRMAX = 1, MAXLR = 5, MAXL = 20) C PARAMETER (NRRMAX = 1, MAXLR = 3, MAXL = 15) PARAMETER (TOLLSC = TOLNEW/10) COMMON /IGCRO/ IDIAGP SAVE /IGCRO/ C C end INCLUDE 'PARGCRO' C INTEGER MXLEV, NPD, NPTS, LENIWK, LENRWK, LENLWK PARAMETER (MXLEV=2, NPD=3, NPTS=61000) PARAMETER (LENIWK=NPTS*(7*MXLEV+7), + LENRWK=NPTS*NPD*(5*MXLEV+13 + (2*MAXLR+MAXL+7)), + LENLWK=2*NPTS) C C----------------------------------------------------------------------- C INTEGER LUNDMP PARAMETER (LUNDMP = 89) C INTEGER NPDE, INFO(7), IWK(LENIWK), MNTR LOGICAL LWK(LENLWK) DOUBLE PRECISION T, TOUT, DT, XL, YF, ZD, XR, YB, ZU, DX, DY, DZ, + TOLS, TOLT, RINFO(2+3*NPD), RWK(LENRWK) C First call of VLUGR3 MNTR = 0 NPDE = 3 T = 0.0 TOUT = 1.0 DT = 0.001 C Since domain is not a rectangular prism the grid parameters need not C to be specified here (cf. INIDOM) TOLS = 0.1 TOLT = 0.1 INFO(1) = 1 C MAXLEV INFO(2) = 4 C Domain not a rectangular prism INFO(3) = 1 C Linear system solver: matrix-free GCRO + Diagonal scaling C (no first order derivatives at the boundaries) INFO(4) = 13 OPEN (UNIT=61,FILE='RunInfo') C Write integration history to unit # 61 INFO(5) = 61 C Write Newton info to unit # 61 INFO(6) = 61 C Write GCRO info to unit # 61 INFO(7) = 61 C DTMIN = 1D-7 RINFO(1) = 1.0D-7 C DTMAX = 1.0 RINFO(2) = 1.0 C UMAX = 1.0 RINFO(3) = 1.0 RINFO(4) = 1.0 RINFO(5) = 1.0 C SPCWGT = 1.0 RINFO(6) = 1.0 RINFO(7) = 1.0 RINFO(8) = 1.0 C TIMWGT = 1.0 RINFO( 9) = 1.0 RINFO(10) = 1.0 RINFO(11) = 1.0 C C Call main routine CALL VLUGR3 (NPDE, T, TOUT, DT, XL,YF,ZD, XR,YB,ZU, DX, DY, DZ, + TOLS, TOLT, INFO, RINFO, RWK, LENRWK, IWK, LENIWK, LWK, LENLWK, + MNTR) PRINT *, 'VLUGR3 returned with MNTR=', MNTR C C Save info on file OPEN(UNIT=LUNDMP,FILE='DUMP',FORM='UNFORMATTED') CALL DUMP (LUNDMP, RWK, IWK) CLOSE(LUNDMP) END LOGICAL FUNCTION INIDOM (MAXPTS, + XL, YF, ZD, XR, YB, ZU, DX, DY, DZ, + LPLN, IPLN, LROW, IROW, ICOL, LLBND, ILBND, LBND) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER MAXPTS, LPLN(0:*), IPLN(*), LROW(*), IROW(*), ICOL(*), + LLBND(0:*), ILBND(*), LBND(*) DOUBLE PRECISION XL, YF, ZD, XR, YB, ZU, DX, DY, DZ C Ccc PURPOSE: C Define initial domain. NB. Boundaries should consist of as many points C as are necessary to employ second order space discretization, i.e., C a boundary enclosing the internal part of the domain should not C include less than 3 grid points in any coordinate direction including C the corners. If Neumann boundaries are used the minimum is 4 since C otherwise the Jacobian matrix will be singular. C C A (virtual) box is placed upon the (irregular) domain. C The left/front/down point of this box is (XL,YF,ZD) in physical C coordinates and (0,0,0) in column, row, plane coordinates, resp.. C The right/back/upper point is (XR,YB,ZU) resp. (Nx,Ny,Nz), where C Nx = (XR-XL)/DX, Ny = (YB-YF)/DY, and Nz = (ZU-ZD)/DZ. C Only real grid points are stored. C The coordinate values of the initial grid should be stored plane C after plane and rowwise in LPLN, IPLN, LROW, IROW, ICOL. C Pointers to the boundary points should be stored in a list together C with the type of the boundary. (LLBND, ILBND, LBND) C C On exit INIDOM = .FALSE. if the # grid points required is larger C than MAXPTS and MAXPTS is set to the required # points. C Ccc PARAMETER DESCRIPTION: C MAXPTS : INOUT. C IN: Max. # grid points allowed by the available workspace C OUT: # grid points required, if larger than # points allowed C XL : OUT. X-coordinate of left/front/down point of virtual box C YF : OUT. Y-coordinate of left/front/down point of virtual box C ZD : OUT. Z-coordinate of left/front/down point of virtual box C XR : OUT. X-coordinate of right/back/upper point of virtual box C YB : OUT. Y-coordinate of right/back/upper point of virtual box C ZU : OUT. Z-coordinate of right/back/upper point of virtual box C DX : OUT. Grid width in X-direction C DY : OUT. Grid width in Y-direction C DZ : OUT. Grid width in Z-direction C LPLN : OUT. (0:LPLN(0)+1) C LPLN(0) = NPLNS: Actual # horizontal planes in LROW C LPLN(1:NPLNS): pointers to the start of a plane in LROW C LPLN(NPLNS+1) = NROWS+1: Total # rows in grid + 1 C IPLN : OUT. (NPLNS) C IPLN(IP): plane number of plane IP in virtual box C LROW : OUT. (NROWS+1) C LROW(1:NROWS): pointers to the start of a row in the grid C LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 C IROW : OUT. (NROWS) C IROW(IR): row number of row IR in virtual box C ICOL : OUT. (NPTS) C ICOL(IPT): column number of grid point IPT in virtual box C LLBND : OUT. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : OUT. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : OUT. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C structure C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C C Domain [0,1]x[0,1]x[0,1] with hole in the middle and projection C at [1,1.333]x[0,1]x[0.666,1]. C Virtual box: [0,1.333]x[0,1]x[0,1] C INTEGER NX, NY, NZ PARAMETER (NX = 8, NY = 6, NZ = 6) INTEGER IDOM(0:(NX+1)*(NY+1)*(NZ+1)) C INTEGER I, IPT, IR, J, K, NPLNS, NROWS, NPTS, NBNDS, + NPTSP1, NPTSP2 NPLNS = NZ+1 NROWS = (NY+1)*NPLNS NPTS = (NX+1)*NROWS-1-2*(NY+1)*(NZ-2) IF (MAXPTS .LT. NPTS) THEN INIDOM = .FALSE. MAXPTS = NPTS RETURN ELSE INIDOM = .TRUE. ENDIF XL = 0.0 YF = 0.0 ZD = 0.0 XR = 4.0/3.0 YB = 1.0 ZU = 1.0 DX = (XR-XL)/NX DY = (YB-YF)/NY DZ = (ZU-ZD)/NZ C C Make grid structure LPLN(0) = NPLNS IPT = 1 IR = 1 DO 10 K = 0, 2 LPLN(K+1) = IR IPLN(K+1) = K DO 20 I = 0, NY LROW(IR) = IPT IROW(IR) = I IR = IR+1 DO 30 J = 0, NX-2 ICOL(IPT) = J IPT = IPT + 1 30 CONTINUE 20 CONTINUE 10 CONTINUE K = 3 LPLN(K+1) = IR IPLN(K+1) = K DO 40 I = 0, 2 LROW(IR) = IPT IROW(IR) = I IR = IR+1 DO 50 J = 0, NX-2 ICOL(IPT) = J IPT = IPT + 1 50 CONTINUE 40 CONTINUE I = 3 LROW(IR) = IPT IROW(IR) = I IR = IR+1 DO 60 J = 0, 2 ICOL(IPT) = J IPT = IPT + 1 60 CONTINUE DO 70 J = 4, NX-2 ICOL(IPT) = J IPT = IPT + 1 70 CONTINUE DO 80 I = 4, NY LROW(IR) = IPT IROW(IR) = I IR = IR+1 DO 90 J = 0, NX-2 ICOL(IPT) = J IPT = IPT + 1 90 CONTINUE 80 CONTINUE DO 100 K = 4, NZ LPLN(K+1) = IR IPLN(K+1) = K DO 110 I = 0, NY LROW(IR) = IPT IROW(IR) = I IR = IR+1 DO 120 J = 0, NX ICOL(IPT) = J IPT = IPT + 1 120 CONTINUE 110 CONTINUE 100 CONTINUE LROW(NROWS+1) = NPTS+1 LPLN(NPLNS+1) = NROWS+1 C Ccc Boundaries NBNDS = 14 ILBND( 1) = 1 ILBND( 2) = 2 ILBND( 3) = 3 ILBND( 4) = 2 ILBND( 5) = 3 ILBND( 6) = 4 ILBND( 7) = 5 ILBND( 8) = 6 ILBND( 9) = 1 ILBND(10) = 2 ILBND(11) = 3 ILBND(12) = 4 ILBND(13) = 5 ILBND(14) = 6 LLBND( 0) = NBNDS LLBND( 1) = 1 LLBND( 2) = LLBND( 1) + (NY+1)*(NZ+1) LLBND( 3) = LLBND( 2) + (NX-1)*(NY+1) LLBND( 4) = LLBND( 3) + (NY+1)*(NZ-1) LLBND( 5) = LLBND( 4) + 3 *(NY+1) LLBND( 6) = LLBND( 5) + (NY+1)* 3 LLBND( 7) = LLBND( 6) + (NX+1)*(NY+1) LLBND( 8) = LLBND( 7) + (NX-1)*(NZ-2)+(NX+1)*3 LLBND( 9) = LLBND( 8) + (NX-1)*(NZ-2)+(NX+1)*3 LLBND(10) = LLBND( 9) + 9 LLBND(11) = LLBND(10) + 9 LLBND(12) = LLBND(11) + 9 LLBND(13) = LLBND(12) + 9 LLBND(14) = LLBND(13) + 9 LLBND(15) = LLBND(14) + 9 C Ccc Outer planes C Left boundary plane pointers NPTSP1 = (NX-1)*(NY+1) NPTSP2 = (NX+1)*(NY+1) DO 200 K = 0, 3 DO 201 I = 0, NY IPT = K*NPTSP1 + I*(NX-1) + 1 IF (K .EQ. 3 .AND. I .GT. 3) IPT = IPT-1 LBND(LLBND(1)+K*(NY+1)+I) = IPT 201 CONTINUE 200 CONTINUE DO 202 K = NZ-2, NZ DO 203 I = 0, NY IPT = (NZ-2)*NPTSP1+(K-NZ+2)*NPTSP2 + I*(NX+1) LBND(LLBND(1)+K*(NY+1)+I) = IPT 203 CONTINUE 202 CONTINUE C Right boundary plane pointers DO 210 K = 0, 3 DO 211 I = 0, NY IPT = (K+1)*NPTSP1 - I*(NX-1) IF (K .EQ. 3 .AND. I .LE. 3) IPT = IPT-1 LBND(LLBND(3)+K*(NY+1)+I) = IPT 211 CONTINUE 210 CONTINUE K = NZ-2 DO 209 I = 0, NY IPT = 4*NPTSP1 + NPTSP2-3 - I*(NX+1) LBND(LLBND(3)+K*(NY+1)+I) = IPT 209 CONTINUE DO 212 I = 0, NY DO 213 J = NX-2, NX IPT = NPTSP1*(NZ-2)+I*(NX+1) + J LBND(LLBND(4)+I*3+J-NX+2) = IPT 213 CONTINUE 212 CONTINUE DO 214 K = NZ-2, NZ DO 215 I = 0, NY IPT = NPTSP1*(NZ-2)+(K-NZ+3)*NPTSP2 - I*(NX+1) - 1 LBND(LLBND(5)+(K-NZ+2)*(NY+1)+I) = IPT 215 CONTINUE 214 CONTINUE C Down and up boundary plane pointers DO 220 I = 0, NY DO 221 J = 0, NX-2 IPT = I*(NX-1) + J + 1 LBND(LLBND(2)+I*(NX-1)+J) = IPT 221 CONTINUE 220 CONTINUE DO 230 I = 0, NY DO 231 J = 0, NX IPT = (NPTS - (I*(NX+1)+J)) LBND(LLBND(6)+I*(NX+1)+J) = IPT 231 CONTINUE 230 CONTINUE C Front and back boundary plane pointers DO 240 K = 0, 3 DO 241 J = 0, NX-2 IPT = K*NPTSP1 + J + 1 LBND(LLBND(7)+K*(NX-1)+J) = IPT IPT = (K+1)*NPTSP1 - J IF (K .EQ. 3) IPT = IPT-1 LBND(LLBND(8)+K*(NX-1)+J) = IPT 241 CONTINUE 240 CONTINUE DO 242 K = NZ-2, NZ DO 243 J = 0, NX IPT = (NZ-2)*NPTSP1+(K-NZ+2)*NPTSP2 + J LBND(LLBND(7)+4*(NX-1)+(K-NZ+2)*(NX+1)+J) = IPT IPT = 4*NPTSP1+(K-NZ+3)*NPTSP2 - J - 1 LBND(LLBND(8)+4*(NX-1)+(K-NZ+2)*(NX+1)+J) = IPT 243 CONTINUE 242 CONTINUE C Ccc Inner planes C Left and right boundary plane pointers LBND(LLBND( 9) ) = 117 LBND(LLBND( 9)+1) = 124 LBND(LLBND( 9)+2) = 131 LBND(LLBND( 9)+3) = 166 LBND(LLBND( 9)+4) = 172 LBND(LLBND( 9)+5) = 179 LBND(LLBND( 9)+6) = 218 LBND(LLBND( 9)+7) = 227 LBND(LLBND( 9)+8) = 236 LBND(LLBND(11) ) = 115 LBND(LLBND(11)+1) = 122 LBND(LLBND(11)+2) = 129 LBND(LLBND(11)+3) = 164 LBND(LLBND(11)+4) = 171 LBND(LLBND(11)+5) = 177 LBND(LLBND(11)+6) = 216 LBND(LLBND(11)+7) = 225 LBND(LLBND(11)+8) = 234 C Down and up boundary plane pointers DO 260 I = 0, 2 DO 270 J = 0, 2 LBND(LLBND(10)+I*3+J) = 236 - (I*(NX+1)+J) LBND(LLBND(12)+I*3+J) = 115 + I*(NX-1) + J 270 CONTINUE 260 CONTINUE C Front and back boundary plane pointers LBND(LLBND(13) ) = 129 LBND(LLBND(13)+1) = 130 LBND(LLBND(13)+2) = 131 LBND(LLBND(13)+3) = 177 LBND(LLBND(13)+4) = 178 LBND(LLBND(13)+5) = 179 LBND(LLBND(13)+6) = 234 LBND(LLBND(13)+7) = 235 LBND(LLBND(13)+8) = 236 LBND(LLBND(14) ) = 115 LBND(LLBND(14)+1) = 116 LBND(LLBND(14)+2) = 117 LBND(LLBND(14)+3) = 164 LBND(LLBND(14)+4) = 165 LBND(LLBND(14)+5) = 166 LBND(LLBND(14)+6) = 216 LBND(LLBND(14)+7) = 217 LBND(LLBND(14)+8) = 218 C LLBND(NBNDS+2) = LLBND(NBNDS+1) PRINT *, 'Input domain:' CALL PRDOM (LPLN, IPLN, LROW, IROW, ICOL, LLBND, ILBND, LBND, + IDOM, NX, NY, NZ) RETURN END SUBROUTINE CHSPCM (T, LEVEL, NPTS, X, Y, Z, NPDE, U, SPCMON, TOL) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER LEVEL, NPTS, NPDE DOUBLE PRECISION T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE), + SPCMON(NPTS), TOL C Ccc PURPOSE: C Force grid refinement. C If for a node IPT SPCMON(IPT) > TOL the 64 surrounding cells will be C refined. C Ccc PARAMETER DESCRIPTION: C T : IN. Current value of time variable C LEVEL : IN. Current grid level C NPTS : IN. Number of grid points at this level C X,Y,Z : IN. Arrays of physical coordinates for the gridpoints C NPDE : IN. Number of PDE components C U : IN. Array of PDE components for the gridpoints C SPCMON : INOUT. C IN: Space monitor values as determined by VLUGR3 C OUT: Changed to a value > TOL where refinement is required C TOL : IN. Tolerance with which SPCMON will be compared C C----------------------------------------------------------------------- INTEGER I C IF (LEVEL .GE. 3) RETURN DO 10 I = 1, NPTS IF (ABS(X(I)-1.0) .LT. 0.0001 .AND. + ABS(Y(I)-0.5) .LT. 0.0001 .AND. + ABS(Z(I)) .LT. 0.0001) THEN SPCMON(I) = 2*TOL ENDIF 10 CONTINUE C RETURN END SUBROUTINE MONITR (T, DT, DTNEW, XL, YF, ZD, DXB, DYB, DZB, + LGRID, ISTRUC, LSOL, SOL) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER LGRID(0:*), ISTRUC(*), LSOL(*) DOUBLE PRECISION T, DT, DTNEW, XL, YF, ZD, DXB, DYB, DZB, SOL(*) C Ccc PURPOSE: C Control after a successful time step. The solution can be printed, C plotted or compared with the exact solution. C Ccc PARAMETER DESCRIPTION: C T : IN. Current value of time variable C DT : IN. Current time step size C DTNEW : IN. Time step size for next time step C XL : IN. X-coordinate of left/front/down point of (virtual) box C YF : IN. Y-coordinate of left/front/down point of (virtual) box C ZD : IN. Z-coordinate of left/front/down point of (virtual) box C DXB : IN. Cell width in X-direction of base grid C DYB : IN. Cell width in Y-direction of base grid C DZB : IN. Cell width in Z-direction of base grid C LGRID : IN. (0:*) C LGRID(0) = max. grid level used at T C LGRID(1): pointer to base grid structure ISTRUC C LGRID(LEVEL): pointer to grid structure C (LPLN,IPLN,LROW,IROW,ICOL) of refinement C level LEVEL for time T C ISTRUC : IN. (*) C ISTRUC(LGRID(LEVEL):.) contains (LPLN,IPLN,LROW,IROW,ICOL) C of grid level LEVEL, C LPLN : (0:LPLN(0)+1) C LPLN(0) = NPLNS: Actual # planes in LROW C LPLN(1:NPLNS): pointers to the start of a plane in LROW C LPLN(NPLNS+1) = NROWS+1: Total # rows in grid + 1 C IPLN : (NPLNS) C IPLN(IP): plane number of plane IP in virtual box C LROW : (NROWS+1) C LROW(1:NROWS): pointers to the start of a row in the grid C LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 C IROW : (NROWS) C IROW(IR): row number of row IR in virtual box C ICOL : (NPTS) C ICOL(IPT): column number of grid point IPT in virtual box C LSOL : IN. (*) C LSOL(LEVEL): pointer to (injected) solution at grid C of refinement level LEVEL for time T C SOL : IN. (*) C SOL(LSOL(LEVEL)+1:LSOL(LEVEL)+NPTS(LEVEL)*NPDE) contains C U_LEVEL(NPTS,NPDE) C C C Local arrays: INTEGER MAXPTS, NPDE PARAMETER (MAXPTS=250000, NPDE=3) DOUBLE PRECISION X(MAXPTS), Y(MAXPTS), Z(MAXPTS), UEX(MAXPTS*NPDE) C C----------------------------------------------------------------------- C INTEGER MAXLEV, LEVEL, LLPLN, LIPLN, LLROW, LIROW, LICOL, + NPLNS, NROWS, NPTS DOUBLE PRECISION DX, DY, DZ C C Loop over the grid levels from coarse to fine. C Get physical coordinates of grid points C Compute ||err||_max MAXLEV = LGRID(0) DX = DXB DY = DYB DZ = DZB DO 10 LEVEL = 1, MAXLEV LLPLN = LGRID(LEVEL) NPLNS = ISTRUC(LLPLN) NROWS = ISTRUC(LLPLN+NPLNS+1)-1 LIPLN = LLPLN+NPLNS+2 LLROW = LIPLN+NPLNS NPTS = ISTRUC(LLROW+NROWS)-1 IF (NPTS .GT. MAXPTS) stop 'MONITR' LIROW = LLROW+NROWS+1 LICOL = LIROW+NROWS CALL SETXYZ (XL, YF, ZD, DX, DY, DZ, + ISTRUC(LLPLN), ISTRUC(LIPLN), + ISTRUC(LLROW), ISTRUC(LIROW), ISTRUC(LICOL), X, Y, Z) DX = DX/2 DY = DY/2 DZ = DZ/2 CALL PRERR (LEVEL, T, NPTS, NPDE, X, Y, Z, SOL(LSOL(LEVEL)+1), + UEX) 10 CONTINUE RETURN END SUBROUTINE PRERR (LEVEL, T, NPTS, NPDE, X, Y, Z, U, UEX) INTEGER LEVEL, NPTS, NPDE DOUBLE PRECISION T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE), + UEX(NPTS,NPDE) INTEGER I,J DOUBLE PRECISION RMAX(3) CALL PDEIV (T, X, Y, Z, UEX, NPTS, NPDE) DO 1 J = 1,NPDE RMAX(J) = 0.0 DO 10 I = 1, NPTS RMAX(J) = MAX(RMAX(J),ABS(UEX(I,J)-U(I,J))) 10 CONTINUE 1 CONTINUE WRITE(28,'(''Error at T='',E9.3,'', level='',I1,'' :'', + I10,3E12.3)') + T, LEVEL, NPTS, (RMAX(J), J=1, NPDE) RETURN END SUBROUTINE PDEIV (T, X, Y, Z, U, NPTS, NPDE) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE DOUBLE PRECISION T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE) C Ccc PURPOSE: C Define (initial) solution of PDE. C Ccc PARAMETER DESCRIPTION: C T : IN. Time at which (initial) solution should be given C X,Y,Z : IN. Arrays of physical coordinates for the gridpoints C U : OUT. Array of PDE component values for the gridpoints. C NPTS : IN. Number of gridpoints C NPDE : IN. # PDE components C C----------------------------------------------------------------------- C C INTEGER I DOUBLE PRECISION EPS PARAMETER (EPS = 5.0D-3) DO 10 I = 1, NPTS U(I,1) = 1-0.5/(1+EXP((-X(I)+Y(I)+Z(I)-0.75*T)/(4*EPS))) U(I,2) = 1.5-U(I,1) U(I,3) = 1.5-U(I,1) 10 CONTINUE RETURN END SUBROUTINE PDEF (T, X, Y, Z, U, + UT, UX, UY, UZ, UXX, UYY, UZZ, UXY, UXZ, UYZ, RES, NPTS, NPDE) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE DOUBLE PRECISION T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE), + UT(NPTS,NPDE), UX(NPTS,NPDE), UY(NPTS,NPDE), UZ(NPTS,NPDE), + UXX(NPTS,NPDE), UYY(NPTS,NPDE), UZZ(NPTS,NPDE), + UXY(NPTS,NPDE), UXZ(NPTS,NPDE), UYZ(NPTS,NPDE), + RES(NPTS,NPDE) C Ccc PURPOSE: C Define residual of PDE on interior of domain. Boundary values will be C overwritten later on. C Ccc PARAMETER DESCRIPTION: C T : IN. Time at which residual should be evaluated C X,Y,Z : IN. Physical coordinates of gridpoints C U : IN. Array of PDE components for the gridpoints. C UT : IN. Array of time derivative of PDE components C UX : IN. -I C UY : IN. I C UZ : IN. I C UXX : IN. I C UYY : IN. I Space derivatives of U on current grid C UZZ : IN. I C UXY : IN. I C UXZ : IN. I C UYZ : IN. -I C RES : OUT. Array containg PDE residual at gridpoints in interior of C domain. The residual values at boundary points will be C overwritten by a call to PDEBC. C NPTS : IN. Number of gridpoints C NPDE : IN. Number of PDE components C C----------------------------------------------------------------------- C INTEGER I DOUBLE PRECISION EPS PARAMETER (EPS = 5.0D-3) DO 10 I = 1, NPTS RES(I,1) = UT(I,1) + U(I,1)*UX(I,1) + + U(I,2)*UY(I,1) + U(I,3)*UZ(I,1) - + EPS*(UXX(I,1)+UYY(I,1)+UZZ(I,1)) RES(I,2) = UT(I,2) + U(I,1)*UX(I,2) + + U(I,2)*UY(I,2) + U(I,3)*UZ(I,2) - + EPS*(UXX(I,2)+UYY(I,2)+UZZ(I,2)) RES(I,3) = UT(I,3) + U(I,1)*UX(I,3) + + U(I,2)*UY(I,3) + U(I,3)*UZ(I,3) - + EPS*(UXX(I,3)+UYY(I,3)+UZZ(I,3)) 10 CONTINUE RETURN END SUBROUTINE PDEBC (T, X, Y, Z, U, UT, UX, UY, UZ, RES, NPTS, NPDE, + LLBND, ILBND, LBND) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE, LLBND(0:*), ILBND(*), LBND(*) DOUBLE PRECISION T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE), + UT(NPTS,NPDE), UX(NPTS,NPDE), UY(NPTS,NPDE), UZ(NPTS,NPDE), + RES(NPTS,NPDE) C Ccc PURPOSE: C Define residual of boundary equations of PDE. The residual on interior C points has already been stored in RES. C Ccc PARAMETER DESCRIPTION: C T : IN. Time at which BC's should be evaluated C X,Y,Z : IN. Physical coordinates of gridpoints C U : IN. Array of PDE components for the gridpoints. C UT : IN. Array of time derivative of PDE components C UX : IN. -I C UY : IN. I Arrays containing space derivatives of PDE components C UZ : IN. -I C RES : INOUT. C IN: PDE residual for interior points (set by PDEF) C OUT: Array with PDE residual at physical boundary points C inserted C NPTS : IN. Number of grid components C NPDE : IN. Number of PDE components C LLBND : IN. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C C----------------------------------------------------------------------- C INTEGER I, J, K, NBNDS DOUBLE PRECISION EPS, UI PARAMETER (EPS = 5.0D-3) NBNDS = LLBND(0) DO 10 J = 1, NBNDS DO 20 K = LLBND(J), LLBND(J+1)-1 I = LBND(K) UI = 1-0.5/(1+EXP((-X(I)+Y(I)+Z(I)-0.75*T)/(4*EPS))) RES(I,1) = U(I,1) - UI RES(I,2) = U(I,2) - (1.5-UI) RES(I,3) = U(I,3) - (1.5-UI) 20 CONTINUE 10 CONTINUE RETURN END SHAR_EOF fi # end of overwriting check if test -f 'exmplr.f' then echo shar: will not over-write existing file "'exmplr.f'" else cat << \SHAR_EOF > 'exmplr.f' PROGRAM EXMPLR C INTEGER MXLEV, NPD, NPTS, LENIWK, LENRWK, LENLWK PARAMETER (MXLEV=2, NPD=3, NPTS=60000) PARAMETER (LENIWK=NPTS*(7*MXLEV+25), + LENRWK=NPTS*NPD*(5*MXLEV+13+38*NPD), + LENLWK=2*NPTS) C C----------------------------------------------------------------------- C INTEGER LUNDMP PARAMETER (LUNDMP = 89) C INTEGER NPDE, INFO(7), IWK(LENIWK), MNTR LOGICAL LWK(LENLWK) DOUBLE PRECISION T, TOUT, DT, XL, YF, ZD, XR, YB, ZU, DX, DY, DZ, + TOLS, TOLT, RINFO(2+3*NPD), RWK(LENRWK) C Continuation call of VLUGR3 MNTR = 1 TOUT = 2.0 TOLS = 0.1 TOLT = 0.1 C Default choices INFO(1) = 0 C C Read info from file OPEN(UNIT=LUNDMP,FILE='DUMP',FORM='UNFORMATTED') CALL RDDUMP (LUNDMP, RWK, LENRWK, IWK, LENIWK) CLOSE(LUNDMP) C C Call main routine CALL VLUGR3 (NPDE, T, TOUT, DT, XL,YF,ZD, XR,YB,ZU, DX, DY, DZ, + TOLS, TOLT, INFO, RINFO, RWK, LENRWK, IWK, LENIWK, LWK, LENLWK, + MNTR) PRINT *, 'VLUGR3 returned with MNTR=', MNTR C C Save info on file OPEN(UNIT=LUNDMP,FILE='DUMP2',FORM='UNFORMATTED') CALL DUMP (LUNDMP, RWK, IWK) CLOSE(LUNDMP) END SUBROUTINE DERIVF (F, T, X, Y, Z, NPTS, NPDE, U, + A0, DT, DX, DY, DZ, + LLBND, ILBND, LBND, UIB, UT, UX, UY, UZ, UXX, UYY, UZZ, + UXY, UXZ, UYZ, ATOL, DEL, WORK, + FU, FUX, FUY, FUZ, FUXX, FUYY, FUZZ, FUXY, FUXZ, FUYZ) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE, LLBND(0:*), ILBND(*), LBND(*) DOUBLE PRECISION F(NPTS,NPDE), T, X(NPTS), Y(NPTS), Z(NPTS), + U(NPTS,NPDE), + A0, DT, DX, DY, DZ, UIB(*), + UT(NPTS,NPDE), UX(NPTS,NPDE), UY(NPTS,NPDE), UZ(NPTS,NPDE), + UXX(NPTS,NPDE), UYY(NPTS,NPDE), UZZ(NPTS,NPDE), + UXY(NPTS,NPDE), UXZ(NPTS,NPDE), UYZ(NPTS,NPDE), + ATOL(NPDE), DEL(NPTS), WORK(2*NPTS*NPDE), + FU(NPTS,NPDE,NPDE), + FUX(NPTS,NPDE,NPDE), FUY(NPTS,NPDE,NPDE), FUZ(NPTS,NPDE,NPDE), + FUXX(NPTS,NPDE,NPDE),FUYY(NPTS,NPDE,NPDE),FUZZ(NPTS,NPDE,NPDE), + FUXY(NPTS,NPDE,NPDE),FUXZ(NPTS,NPDE,NPDE),FUYZ(NPTS,NPDE,NPDE) C Ccc PURPOSE: C Compute derivatives of residual wrt (derivatives of) U C C PARAMETER DESCRIPTION: C F : IN. Residual F(t,U,Ut) C T : IN. Current time C X,Y,Z : IN. Physical coordinates of gridpoints C NPTS : IN. # grid points C NPDE : IN. # PDE components C U : IN. Solution at T on current grid C A0 : IN. Coefficient of U_n+1 in time derivative C DT : IN. Current time step size C DX : IN. Cell width in X-direction for current grid C DY : IN. Cell width in Y-direction for current grid C DZ : IN. Cell width in Z-direction for current grid C LLBND : IN. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C UIB : IN. Solution at T on internal boundaries C UT : IN. Time derivative of U on current grid C UX : IN. -I C UY : IN. I C UZ : IN. I C UXX : IN. I C UYY : IN. I Space derivatives of U on current grid C UZZ : IN. I C UXY : IN. I C UXZ : IN. I C UYZ : IN. -I C ATOL : IN. Absolute tolerance for Newton process C DEL : WORK. (NPTS) C WORK : WORK. (2.LENU) C FU : OUT. dF(U,Ut)dU C FUX : OUT. dF(Ux)dUx C FUY : OUT. dF(Uy)dUy C FUZ : OUT. dF(Uz)dUz C FUXX : OUT. dF(Uxx)dUxx C FUYY : OUT. dF(Uyy)dUyy C FUZZ : OUT. dF(Uzz)dUzz C FUXY : OUT. dF(Uxy)dUxy C FUXZ : OUT. dF(Uxz)dUxz C FUYZ : OUT. dF(Uyz)dUyz C Ccc EXTERNALS USED: EXTERNAL ZERO C C----------------------------------------------------------------------- C DOUBLE PRECISION EPS PARAMETER (EPS = 5D-3) C INTEGER IC, IPT, JC, LB, NBNDS C CALL ZERO (NPTS*NPDE*NPDE, FUX) CALL ZERO (NPTS*NPDE*NPDE, FUY) CALL ZERO (NPTS*NPDE*NPDE, FUZ) CALL ZERO (NPTS*NPDE*NPDE, FUXX) CALL ZERO (NPTS*NPDE*NPDE, FUYY) CALL ZERO (NPTS*NPDE*NPDE, FUZZ) CALL ZERO (NPTS*NPDE*NPDE, FUXY) CALL ZERO (NPTS*NPDE*NPDE, FUXZ) CALL ZERO (NPTS*NPDE*NPDE, FUYZ) C DO 10 IPT = 1, NPTS C dF_1(U,Ut)/dU_ic FU(IPT,1,1) = UX(IPT,1) + A0 FU(IPT,1,2) = UY(IPT,1) FU(IPT,1,3) = UZ(IPT,1) C dF_1(Up)/dUp_ic FUX(IPT,1,1) = U(IPT,1) FUY(IPT,1,1) = U(IPT,2) FUZ(IPT,1,1) = U(IPT,3) C dF_1(Upp)/dUpp_ic FUXX(IPT,1,1) = -EPS FUYY(IPT,1,1) = -EPS FUZZ(IPT,1,1) = -EPS C dF_2(U,Ut)/dU_ic FU(IPT,2,1) = UX(IPT,2) FU(IPT,2,2) = UY(IPT,2) + A0 FU(IPT,2,3) = UZ(IPT,2) C dF_2(Up)/dUp_ic FUX(IPT,2,2) = U(IPT,1) FUY(IPT,2,2) = U(IPT,2) FUZ(IPT,2,2) = U(IPT,3) C dF_2(Upp)/dUpp_ic FUXX(IPT,2,2) = -EPS FUYY(IPT,2,2) = -EPS FUZZ(IPT,2,2) = -EPS C dF_3(U,Ut)/dU_ic FU(IPT,3,1) = UX(IPT,3) FU(IPT,3,2) = UY(IPT,3) FU(IPT,3,3) = UZ(IPT,3) + A0 C dF_3(Up)/dUp_ic FUX(IPT,3,3) = U(IPT,1) FUY(IPT,3,3) = U(IPT,2) FUZ(IPT,3,3) = U(IPT,3) C dF_3(Upp)/dUpp_ic FUXX(IPT,3,3) = -EPS FUYY(IPT,3,3) = -EPS FUZZ(IPT,3,3) = -EPS 10 CONTINUE C C Correct boundaries (incl. the internal) NBNDS = LLBND(0) DO 100 LB = LLBND(1), LLBND(NBNDS+2)-1 IPT = LBND(LB) DO 110 IC = 1, NPDE DO 120 JC = 1, NPDE FU (IPT,IC,JC) = 0.0 FUX (IPT,IC,JC) = 0.0 FUY (IPT,IC,JC) = 0.0 FUZ (IPT,IC,JC) = 0.0 FUXX(IPT,IC,JC) = 0.0 FUYY(IPT,IC,JC) = 0.0 FUZZ(IPT,IC,JC) = 0.0 120 CONTINUE FU(IPT,IC,IC) = 1.0 110 CONTINUE 100 CONTINUE RETURN END SUBROUTINE MONITR (T, DT, DTNEW, XL, YF, ZD, DXB, DYB, DZB, + LGRID, ISTRUC, LSOL, SOL) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER LGRID(0:*), ISTRUC(*), LSOL(*) DOUBLE PRECISION T, DT, DTNEW, XL, YF, ZD, DXB, DYB, DZB, SOL(*) C Ccc PURPOSE: C Control after a successful time step. The solution can be printed, C plotted or compared with the exact solution. C Ccc PARAMETER DESCRIPTION: C T : IN. Current value of time variable C DT : IN. Current time step size C DTNEW : IN. Time step size for next time step C XL : IN. X-coordinate of left/front/down point of (virtual) box C YF : IN. Y-coordinate of left/front/down point of (virtual) box C ZD : IN. Z-coordinate of left/front/down point of (virtual) box C DXB : IN. Cell width in X-direction of base grid C DYB : IN. Cell width in Y-direction of base grid C DZB : IN. Cell width in Z-direction of base grid C LGRID : IN. (0:*) C LGRID(0) = max. grid level used at T C LGRID(1): pointer to base grid structure ISTRUC C LGRID(LEVEL): pointer to grid structure C (LPLN,IPLN,LROW,IROW,ICOL) of refinement C level LEVEL for time T C ISTRUC : IN. (*) C ISTRUC(LGRID(LEVEL):.) contains (LPLN,IPLN,LROW,IROW,ICOL) C of grid level LEVEL, C LPLN : (0:LPLN(0)+1) C LPLN(0) = NPLNS: Actual # planes in LROW C LPLN(1:NPLNS): pointers to the start of a plane in LROW C LPLN(NPLNS+1) = NROWS+1: Total # rows in grid + 1 C IPLN : (NPLNS) C IPLN(IP): plane number of plane IP in virtual box C LROW : (NROWS+1) C LROW(1:NROWS): pointers to the start of a row in the grid C LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 C IROW : (NROWS) C IROW(IR): row number of row IR in virtual box C ICOL : (NPTS) C ICOL(IPT): column number of grid point IPT in virtual box C LSOL : IN. (*) C LSOL(LEVEL): pointer to (injected) solution at grid C of refinement level LEVEL for time T C SOL : IN. (*) C SOL(LSOL(LEVEL)+1:LSOL(LEVEL)+NPTS(LEVEL)*NPDE) contains C U_LEVEL(NPTS,NPDE) C C C Local arrays: INTEGER MAXPTS, NPDE PARAMETER (MAXPTS=75000, NPDE=3) DOUBLE PRECISION X(MAXPTS), Y(MAXPTS), Z(MAXPTS), UEX(MAXPTS*NPDE) C C----------------------------------------------------------------------- C INTEGER MAXLEV, LEVEL, LLPLN, LIPLN, LLROW, LIROW, LICOL, + NPLNS, NROWS, NPTS DOUBLE PRECISION DX, DY, DZ C C Loop over the grid levels from coarse to fine. C Get physical coordinates of grid points C Compute ||err||_max MAXLEV = LGRID(0) DX = DXB DY = DYB DZ = DZB DO 10 LEVEL = 1, MAXLEV LLPLN = LGRID(LEVEL) NPLNS = ISTRUC(LLPLN) NROWS = ISTRUC(LLPLN+NPLNS+1)-1 LIPLN = LLPLN+NPLNS+2 LLROW = LIPLN+NPLNS NPTS = ISTRUC(LLROW+NROWS)-1 IF (NPTS .GT. MAXPTS) stop 'MONITR' LIROW = LLROW+NROWS+1 LICOL = LIROW+NROWS CALL SETXYZ (XL, YF, ZD, DX, DY, DZ, + ISTRUC(LLPLN), ISTRUC(LIPLN), + ISTRUC(LLROW), ISTRUC(LIROW), ISTRUC(LICOL), X, Y, Z) DX = DX/2 DY = DY/2 DZ = DZ/2 CALL PRERR (LEVEL, T, NPTS, NPDE, X, Y, Z, SOL(LSOL(LEVEL)+1), + UEX) 10 CONTINUE RETURN END SUBROUTINE PRERR (LEVEL, T, NPTS, NPDE, X, Y, Z, U, UEX) INTEGER LEVEL, NPTS, NPDE DOUBLE PRECISION T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE), + UEX(NPTS,NPDE) INTEGER I,J DOUBLE PRECISION RMAX(3) CALL PDEIV (T, X, Y, Z, UEX, NPTS, NPDE) DO 1 J = 1, NPDE RMAX(J) = 0.0 DO 10 I = 1, NPTS RMAX(J) = MAX(RMAX(J),ABS(UEX(I,J)-U(I,J))) 10 CONTINUE 1 CONTINUE WRITE(28,'(''Error at T='',E9.3,'', level='',I1,'' :'', + I10,3E12.3)') + T, LEVEL, NPTS, (RMAX(J), J=1, NPDE) RETURN END SUBROUTINE PDEIV (T, X, Y, Z, U, NPTS, NPDE) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE DOUBLE PRECISION T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE) C Ccc PURPOSE: C Define (initial) solution of PDE. C Ccc PARAMETER DESCRIPTION: C T : IN. Time at which (initial) solution should be given C X,Y,Z : IN. Arrays of physical coordinates for the gridpoints C U : OUT. Array of PDE component values for the gridpoints. C NPTS : IN. Number of gridpoints C NPDE : IN. # PDE components C C----------------------------------------------------------------------- C C INTEGER I DOUBLE PRECISION EPS PARAMETER (EPS = 5.0D-3) DO 10 I = 1, NPTS U(I,1) = 1-0.5/(1+EXP((-X(I)+Y(I)+Z(I)-0.75*T)/(4*EPS))) U(I,2) = 1.5-U(I,1) U(I,3) = 1.5-U(I,1) 10 CONTINUE RETURN END SUBROUTINE PDEF (T, X, Y, Z, U, + UT, UX, UY, UZ, UXX, UYY, UZZ, UXY, UXZ, UYZ, RES, NPTS, NPDE) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE DOUBLE PRECISION T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE), + UT(NPTS,NPDE), UX(NPTS,NPDE), UY(NPTS,NPDE), UZ(NPTS,NPDE), + UXX(NPTS,NPDE), UYY(NPTS,NPDE), UZZ(NPTS,NPDE), + UXY(NPTS,NPDE), UXZ(NPTS,NPDE), UYZ(NPTS,NPDE), + RES(NPTS,NPDE) C Ccc PURPOSE: C Define residual of PDE on interior of domain. Boundary values will be C overwritten later on. C Ccc PARAMETER DESCRIPTION: C T : IN. Time at which residual should be evaluated C X,Y,Z : IN. Physical coordinates of gridpoints C U : IN. Array of PDE components for the gridpoints. C UT : IN. Array of time derivative of PDE components C UX : IN. -I C UY : IN. I C UZ : IN. I C UXX : IN. I C UYY : IN. I Space derivatives of U on current grid C UZZ : IN. I C UXY : IN. I C UXZ : IN. I C UYZ : IN. -I C RES : OUT. Array containg PDE residual at gridpoints in interior of C domain. The residual values at boundary points will be C overwritten by a call to PDEBC. C NPTS : IN. Number of gridpoints C NPDE : IN. Number of PDE components C C----------------------------------------------------------------------- C INTEGER I DOUBLE PRECISION EPS PARAMETER (EPS = 5.0D-3) DO 10 I = 1, NPTS RES(I,1) = UT(I,1) + U(I,1)*UX(I,1) + + U(I,2)*UY(I,1) + U(I,3)*UZ(I,1) - + EPS*(UXX(I,1)+UYY(I,1)+UZZ(I,1)) RES(I,2) = UT(I,2) + U(I,1)*UX(I,2) + + U(I,2)*UY(I,2) + U(I,3)*UZ(I,2) - + EPS*(UXX(I,2)+UYY(I,2)+UZZ(I,2)) RES(I,3) = UT(I,3) + U(I,1)*UX(I,3) + + U(I,2)*UY(I,3) + U(I,3)*UZ(I,3) - + EPS*(UXX(I,3)+UYY(I,3)+UZZ(I,3)) 10 CONTINUE RETURN END SUBROUTINE PDEBC (T, X, Y, Z, U, UT, UX, UY, UZ, RES, NPTS, NPDE, + LLBND, ILBND, LBND) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE, LLBND(0:*), ILBND(*), LBND(*) DOUBLE PRECISION T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE), + UT(NPTS,NPDE), UX(NPTS,NPDE), UY(NPTS,NPDE), UZ(NPTS,NPDE), + RES(NPTS,NPDE) C Ccc PURPOSE: C Define residual of boundary equations of PDE. The residual on interior C points has already been stored in RES. C Ccc PARAMETER DESCRIPTION: C T : IN. Time at which BC's should be evaluated C X,Y,Z : IN. Physical coordinates of gridpoints C U : IN. Array of PDE components for the gridpoints. C UT : IN. Array of time derivative of PDE components C UX : IN. -I C UY : IN. I Arrays containing space derivatives of PDE components C UZ : IN. -I C RES : INOUT. C IN: PDE residual for interior points (set by PDEF) C OUT: Array with PDE residual at physical boundary points C inserted C NPTS : IN. Number of grid components C NPDE : IN. Number of PDE components C LLBND : IN. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C C----------------------------------------------------------------------- C INTEGER I, J, K, NBNDS DOUBLE PRECISION EPS, UI PARAMETER (EPS = 5.0D-3) NBNDS = LLBND(0) DO 10 J = 1, NBNDS DO 20 K = LLBND(J), LLBND(J+1)-1 I = LBND(K) UI = 1-0.5/(1+EXP((-X(I)+Y(I)+Z(I)-0.75*T)/(4*EPS))) RES(I,1) = U(I,1) - UI RES(I,2) = U(I,2) - (1.5-UI) RES(I,3) = U(I,3) - (1.5-UI) 20 CONTINUE 10 CONTINUE RETURN END SHAR_EOF fi # end of overwriting check if test -f 'probia.f' then echo shar: will not over-write existing file "'probia.f'" else cat << \SHAR_EOF > 'probia.f' PROGRAM EXIA C INTEGER MXLEV, NPD, NPTS, LENIWK, LENRWK, LENLWK PARAMETER (MXLEV=2, NPD=1, NPTS=170000) PARAMETER (LENIWK=NPTS*(7*MXLEV+25), + LENRWK=NPTS*NPD*(5*MXLEV+38*NPD+13), + LENLWK=2*NPTS) C C----------------------------------------------------------------------- C INTEGER LUNDMP PARAMETER (LUNDMP = 89) C INTEGER NPDE, INFO(7), IWK(LENIWK), MNTR LOGICAL LWK(LENLWK) DOUBLE PRECISION T, TOUT, DT, XL, YF, ZD, XR, YB, ZU, DX, DY, DZ, + TOLS, TOLT, RINFO(2+3*NPD), RWK(LENRWK) C First call of VLUGR3 MNTR = 0 NPDE = 1 T = 0.0 TOUT = 1.0 DT = 0.001 XL = 0.0 YF = 0.0 ZD = 0.0 XR = 1.0 YB = 1.0 ZU = 1.0 DX = 0.1 DY = 0.1 DZ = 0.1 TOLS = 0.1 TOLT = 0.1 INFO(1) = 1 C MAXLEV INFO(2) = 4 C Domain a rectangular prism INFO(3) = 0 C Linear system solver print *, 'Lin.sys.solver BiCGStab or GCRO (0 / 10,11,12,13) ?' read *, INFO(4) OPEN (UNIT=61,FILE='RunInfo') C Write integration history to unit # 61 INFO(5) = 61 C Write Newton info to unit # 61 INFO(6) = 61 C Write linear solver info to unit # 61 INFO(7) = 61 C DTMIN = 1D-7 RINFO(1) = 1.0D-7 C DTMAX = 1.0 RINFO(2) = 1.0 C UMAX = 1.0 RINFO(3) = 1.0 C SPCWGT = 1.0 RINFO(4) = 1.0 C TIMWGT = 1.0 RINFO(5) = 1.0 C C Call main routine CALL VLUGR3 (NPDE, T, TOUT, DT, XL,YF,ZD, XR,YB,ZU, DX, DY, DZ, + TOLS, TOLT, INFO, RINFO, RWK, LENRWK, IWK, LENIWK, LWK, LENLWK, + MNTR) PRINT *, 'VLUGR3 returned with MNTR=', MNTR C C Save info on file OPEN(UNIT=LUNDMP,FILE='DUMP',FORM='UNFORMATTED') CALL DUMP (LUNDMP, RWK, IWK) CLOSE(LUNDMP) END SUBROUTINE MONITR (T, DT, DTNEW, XL, YF, ZD, DXB, DYB, DZB, + LGRID, ISTRUC, LSOL, SOL) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER LGRID(0:*), ISTRUC(*), LSOL(*) DOUBLE PRECISION T, DT, DTNEW, XL, YF, ZD, DXB, DYB, DZB, SOL(*) C Ccc PURPOSE: C Control after a successful time step. The solution can be printed, C plotted or compared with the exact solution. C Ccc PARAMETER DESCRIPTION: C T : IN. Current value of time variable C DT : IN. Current time step size C DTNEW : IN. Time step size for next time step C XL : IN. X-coordinate of left/front/down point of (virtual) box C YF : IN. Y-coordinate of left/front/down point of (virtual) box C ZD : IN. Z-coordinate of left/front/down point of (virtual) box C DXB : IN. Cell width in X-direction of base grid C DYB : IN. Cell width in Y-direction of base grid C DZB : IN. Cell width in Z-direction of base grid C LGRID : IN. (0:*) C LGRID(0) = max. grid level used at T C LGRID(1): pointer to base grid structure ISTRUC C LGRID(LEVEL): pointer to grid structure C (LPLN,IPLN,LROW,IROW,ICOL) of refinement C level LEVEL for time T C ISTRUC : IN. (*) C ISTRUC(LGRID(LEVEL):.) contains (LPLN,IPLN,LROW,IROW,ICOL) C of grid level LEVEL, C LPLN : (0:LPLN(0)+1) C LPLN(0) = NPLNS: Actual # planes in LROW C LPLN(1:NPLNS): pointers to the start of a plane in LROW C LPLN(NPLNS+1) = NROWS+1: Total # rows in grid + 1 C IPLN : (NPLNS) C IPLN(IP): plane number of plane IP in virtual box C LROW : (NROWS+1) C LROW(1:NROWS): pointers to the start of a row in the grid C LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 C IROW : (NROWS) C IROW(IR): row number of row IR in virtual box C ICOL : (NPTS) C ICOL(IPT): column number of grid point IPT in virtual box C LSOL : IN. (*) C LSOL(LEVEL): pointer to (injected) solution at grid C of refinement level LEVEL for time T C SOL : IN. (*) C SOL(LSOL(LEVEL)+1:LSOL(LEVEL)+NPTS(LEVEL)*NPDE) contains C U_LEVEL(NPTS,NPDE) C C C Local arrays: INTEGER MAXPTS, NPDE PARAMETER (MAXPTS=250000, NPDE=1) DOUBLE PRECISION X(MAXPTS), Y(MAXPTS), Z(MAXPTS), UEX(MAXPTS*NPDE) C C----------------------------------------------------------------------- C INTEGER MAXLEV, LEVEL, LLPLN, LIPLN, LLROW, LIROW, LICOL, + NPLNS, NROWS, NPTS DOUBLE PRECISION DX, DY, DZ C C Loop over the grid levels from coarse to fine. C Get physical coordinates of grid points C Compute ||err||_max MAXLEV = LGRID(0) DX = DXB DY = DYB DZ = DZB DO 10 LEVEL = 1, MAXLEV LLPLN = LGRID(LEVEL) NPLNS = ISTRUC(LLPLN) NROWS = ISTRUC(LLPLN+NPLNS+1)-1 LIPLN = LLPLN+NPLNS+2 LLROW = LIPLN+NPLNS NPTS = ISTRUC(LLROW+NROWS)-1 IF (NPTS .GT. MAXPTS) stop 'MONITR' LIROW = LLROW+NROWS+1 LICOL = LIROW+NROWS CALL SETXYZ (XL, YF, ZD, DX, DY, DZ, + ISTRUC(LLPLN), ISTRUC(LIPLN), + ISTRUC(LLROW), ISTRUC(LIROW), ISTRUC(LICOL), X, Y, Z) DX = DX/2 DY = DY/2 DZ = DZ/2 CALL PRERR (LEVEL, T, NPTS, NPDE, X, Y, Z, SOL(LSOL(LEVEL)+1), + UEX) 10 CONTINUE RETURN END SUBROUTINE PRERR (LEVEL, T, NPTS, NPDE, X, Y, Z, U, UEX) INTEGER LEVEL, NPTS, NPDE DOUBLE PRECISION T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE), + UEX(NPTS,NPDE) INTEGER I,J DOUBLE PRECISION RMAX CALL PDEIV (T, X, Y, Z, UEX, NPTS, NPDE) RMAX = 0.0 J = 1 DO 10 I = 1, NPTS RMAX = MAX(RMAX,ABS(UEX(I,J)-U(I,J))) 10 CONTINUE WRITE(28,'(''Error at T='',E9.3,'', level='',I1,'' :'',E9.3,I10)') + T, LEVEL, RMAX, NPTS RETURN END SUBROUTINE PDEIV (T, X, Y, Z, U, NPTS, NPDE) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE DOUBLE PRECISION T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE) C Ccc PURPOSE: C Define (initial) solution of PDE. C Ccc PARAMETER DESCRIPTION: C T : IN. Time at which (initial) solution should be given C X,Y,Z : IN. Arrays of physical coordinates for the gridpoints C U : OUT. Array of PDE component values for the gridpoints. C NPTS : IN. Number of gridpoints C NPDE : IN. # PDE components C C----------------------------------------------------------------------- C INTEGER I DOUBLE PRECISION EPS PARAMETER (EPS = 2.0D-3) DO 10 I = 1, NPTS U(I,1) = 1-0.5/(1+EXP((-X(I)+Y(I)+Z(I)-0.75*T)/(4*EPS))) 10 CONTINUE RETURN END SUBROUTINE PDEF (T, X, Y, Z, U, + UT, UX, UY, UZ, UXX, UYY, UZZ, UXY, UXZ, UYZ, RES, NPTS, NPDE) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE DOUBLE PRECISION T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE), + UT(NPTS,NPDE), UX(NPTS,NPDE), UY(NPTS,NPDE), UZ(NPTS,NPDE), + UXX(NPTS,NPDE), UYY(NPTS,NPDE), UZZ(NPTS,NPDE), + UXY(NPTS,NPDE), UXZ(NPTS,NPDE), UYZ(NPTS,NPDE), + RES(NPTS,NPDE) C Ccc PURPOSE: C Define residual of PDE on interior of domain. Boundary values will be C overwritten later on. C Ccc PARAMETER DESCRIPTION: C T : IN. Time at which residual should be evaluated C X,Y,Z : IN. Physical coordinates of gridpoints C U : IN. Array of PDE components for the gridpoints. C UT : IN. Array of time derivative of PDE components C UX : IN. -I C UY : IN. I C UZ : IN. I C UXX : IN. I C UYY : IN. I Space derivatives of U on current grid C UZZ : IN. I C UXY : IN. I C UXZ : IN. I C UYZ : IN. -I C RES : OUT. Array containg PDE residual at gridpoints in interior of C domain. The residual values at boundary points will be C overwritten by a call to PDEBC. C NPTS : IN. Number of gridpoints C NPDE : IN. Number of PDE components C C----------------------------------------------------------------------- C INTEGER I DOUBLE PRECISION EPS PARAMETER (EPS = 2.0D-3) DO 10 I = 1, NPTS RES(I,1) = UT(I,1) + U(I,1)*UX(I,1) + + (1.5-U(I,1))*(UY(I,1)+UZ(I,1)) - + EPS*(UXX(I,1)+UYY(I,1)+UZZ(I,1)) 10 CONTINUE RETURN END SUBROUTINE PDEBC (T, X, Y, Z, U, UT, UX, UY, UZ, RES, NPTS, NPDE, + LLBND, ILBND, LBND) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE, LLBND(0:*), ILBND(*), LBND(*) DOUBLE PRECISION T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE), + UT(NPTS,NPDE), UX(NPTS,NPDE), UY(NPTS,NPDE), UZ(NPTS,NPDE), + RES(NPTS,NPDE) C Ccc PURPOSE: C Define residual of boundary equations of PDE. The residual on interior C points has already been stored in RES. C Ccc PARAMETER DESCRIPTION: C T : IN. Time at which BC's should be evaluated C X,Y,Z : IN. Physical coordinates of gridpoints C U : IN. Array of PDE components for the gridpoints. C UT : IN. Array of time derivative of PDE components C UX : IN. -I C UY : IN. I Arrays containing space derivatives of PDE components C UZ : IN. -I C RES : INOUT. C IN: PDE residual for interior points (set by PDEF) C OUT: Array with PDE residual at physical boundary points C inserted C NPTS : IN. Number of grid components C NPDE : IN. Number of PDE components C LLBND : IN. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C C----------------------------------------------------------------------- C INTEGER I, J, K, NBNDS DOUBLE PRECISION EPS, UI PARAMETER (EPS = 2.0D-3) NBNDS = LLBND(0) DO 10 J = 1, NBNDS DO 20 K = LLBND(J), LLBND(J+1)-1 I = LBND(K) UI = 1-0.5/(1+EXP((-X(I)+Y(I)+Z(I)-0.75*T)/(4*EPS))) RES(I,1) = U(I,1) - UI 20 CONTINUE 10 CONTINUE RETURN END SHAR_EOF fi # end of overwriting check if test -f 'probib.f' then echo shar: will not over-write existing file "'probib.f'" else cat << \SHAR_EOF > 'probib.f' PROGRAM EXIB C C PARAMETER (NRRMAX = 1, MAXLR = 3, MAXL = 15) INTEGER MXLEV, NPD, NPTS, LENIWK, LENRWK, LENLWK PARAMETER (MXLEV=1, NPD=3, NPTS=190000) PARAMETER (LENIWK=NPTS*(9*MXLEV+24), + LENRWK=NPTS*NPD*(5*MXLEV+26+13), + LENLWK=2*NPTS) C C----------------------------------------------------------------------- C INTEGER LUNDMP PARAMETER (LUNDMP = 89) C INTEGER NPDE, INFO(7), IWK(LENIWK), MNTR LOGICAL LWK(LENLWK) DOUBLE PRECISION T, TOUT, DT, XL, YF, ZD, XR, YB, ZU, DX, DY, DZ, + TOLS, TOLT, RINFO(2+3*NPD), RWK(LENRWK) C First call of VLUGR3 MNTR = 0 NPDE = 3 T = 0.0 TOUT = 1.0 DT = 0.001 XL = 0.0 YF = 0.0 ZD = 0.0 XR = 1.0 YB = 1.0 ZU = 1.0 DX = 0.1 DY = 0.1 DZ = 0.1 TOLS = 0.1 TOLT = 0.1 INFO(1) = 1 C MAXLEV INFO(2) = 4 C Domain a rectangular prism INFO(3) = 0 C Linear system solver print *, 'Lin.sys.solver BiCGStab or GCRO (0 / 10,11,12,13) ?' read *, INFO(4) OPEN (UNIT=61,FILE='RunInfo') C Write integration history to unit # 61 INFO(5) = 61 C Write Newton info to unit # 61 INFO(6) = 61 C Write linear solver info to unit # 61 INFO(7) = 61 C DTMIN = 1D-7 RINFO(1) = 1.0D-7 C DTMAX = 1.0 RINFO(2) = 1.0 C UMAX = 1.0 RINFO(3) = 1.0 RINFO(4) = 1.0 RINFO(5) = 1.0 C SPCWGT = 1.0 RINFO(6) = 1.0 RINFO(7) = 1.0 RINFO(8) = 1.0 C TIMWGT = 1.0 RINFO(9) = 1.0 RINFO(10) = 1.0 RINFO(11) = 1.0 C C Call main routine CALL VLUGR3 (NPDE, T, TOUT, DT, XL,YF,ZD, XR,YB,ZU, DX, DY, DZ, + TOLS, TOLT, INFO, RINFO, RWK, LENRWK, IWK, LENIWK, LWK, LENLWK, + MNTR) PRINT *, 'VLUGR3 returned with MNTR=', MNTR C C Save info on file OPEN(UNIT=LUNDMP,FILE='DUMP',FORM='UNFORMATTED') CALL DUMP (LUNDMP, RWK, IWK) CLOSE(LUNDMP) END SUBROUTINE MONITR (T, DT, DTNEW, XL, YF, ZD, DXB, DYB, DZB, + LGRID, ISTRUC, LSOL, SOL) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER LGRID(0:*), ISTRUC(*), LSOL(*) DOUBLE PRECISION T, DT, DTNEW, XL, YF, ZD, DXB, DYB, DZB, SOL(*) C Ccc PURPOSE: C Control after a successful time step. The solution can be printed, C plotted or compared with the exact solution. C Ccc PARAMETER DESCRIPTION: C T : IN. Current value of time variable C DT : IN. Current time step size C DTNEW : IN. Time step size for next time step C XL : IN. X-coordinate of left/front/down point of (virtual) box C YF : IN. Y-coordinate of left/front/down point of (virtual) box C ZD : IN. Z-coordinate of left/front/down point of (virtual) box C DXB : IN. Cell width in X-direction of base grid C DYB : IN. Cell width in Y-direction of base grid C DZB : IN. Cell width in Z-direction of base grid C LGRID : IN. (0:*) C LGRID(0) = max. grid level used at T C LGRID(1): pointer to base grid structure ISTRUC C LGRID(LEVEL): pointer to grid structure C (LPLN,IPLN,LROW,IROW,ICOL) of refinement C level LEVEL for time T C ISTRUC : IN. (*) C ISTRUC(LGRID(LEVEL):.) contains (LPLN,IPLN,LROW,IROW,ICOL) C of grid level LEVEL, C LPLN : (0:LPLN(0)+1) C LPLN(0) = NPLNS: Actual # planes in LROW C LPLN(1:NPLNS): pointers to the start of a plane in LROW C LPLN(NPLNS+1) = NROWS+1: Total # rows in grid + 1 C IPLN : (NPLNS) C IPLN(IP): plane number of plane IP in virtual box C LROW : (NROWS+1) C LROW(1:NROWS): pointers to the start of a row in the grid C LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 C IROW : (NROWS) C IROW(IR): row number of row IR in virtual box C ICOL : (NPTS) C ICOL(IPT): column number of grid point IPT in virtual box C LSOL : IN. (*) C LSOL(LEVEL): pointer to (injected) solution at grid C of refinement level LEVEL for time T C SOL : IN. (*) C SOL(LSOL(LEVEL)+1:LSOL(LEVEL)+NPTS(LEVEL)*NPDE) contains C U_LEVEL(NPTS,NPDE) C C C Local arrays: INTEGER MAXPTS, NPDE PARAMETER (MAXPTS=170000, NPDE=3) DOUBLE PRECISION X(MAXPTS), Y(MAXPTS), Z(MAXPTS), UEX(MAXPTS*NPDE) C C----------------------------------------------------------------------- C INTEGER MAXLEV, LEVEL, LLPLN, LIPLN, LLROW, LIROW, LICOL, + NPLNS, NROWS, NPTS DOUBLE PRECISION DX, DY, DZ C C Loop over the grid levels from coarse to fine. C Get physical coordinates of grid points C Compute ||err||_max MAXLEV = LGRID(0) DX = DXB DY = DYB DZ = DZB DO 10 LEVEL = 1, MAXLEV LLPLN = LGRID(LEVEL) NPLNS = ISTRUC(LLPLN) NROWS = ISTRUC(LLPLN+NPLNS+1)-1 LIPLN = LLPLN+NPLNS+2 LLROW = LIPLN+NPLNS NPTS = ISTRUC(LLROW+NROWS)-1 IF (NPTS .GT. MAXPTS) stop 'MONITR' LIROW = LLROW+NROWS+1 LICOL = LIROW+NROWS CALL SETXYZ (XL, YF, ZD, DX, DY, DZ, + ISTRUC(LLPLN), ISTRUC(LIPLN), + ISTRUC(LLROW), ISTRUC(LIROW), ISTRUC(LICOL), X, Y, Z) DX = DX/2 DY = DY/2 DZ = DZ/2 CALL PRERR (LEVEL, T, NPTS, NPDE, X, Y, Z, SOL(LSOL(LEVEL)+1), + UEX) 10 CONTINUE RETURN END SUBROUTINE PRERR (LEVEL, T, NPTS, NPDE, X, Y, Z, U, UEX) INTEGER LEVEL, NPTS, NPDE DOUBLE PRECISION T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE), + UEX(NPTS,NPDE) INTEGER I,J DOUBLE PRECISION RMAX(3) CALL PDEIV (T, X, Y, Z, UEX, NPTS, NPDE) DO 1 J = 1, NPDE RMAX(J) = 0.0 DO 10 I = 1, NPTS RMAX(J) = MAX(RMAX(J),ABS(UEX(I,J)-U(I,J))) 10 CONTINUE 1 CONTINUE WRITE(28,'(''Error at T='',E9.3,'', level='',I1,'' :'', + I10,3E10.3)') T, LEVEL, NPTS, (RMAX(J), J=1, NPDE) RETURN END SUBROUTINE PDEIV (T, X, Y, Z, U, NPTS, NPDE) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE DOUBLE PRECISION T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE) C Ccc PURPOSE: C Define (initial) solution of PDE. C Ccc PARAMETER DESCRIPTION: C T : IN. Time at which (initial) solution should be given C X,Y,Z : IN. Arrays of physical coordinates for the gridpoints C U : OUT. Array of PDE component values for the gridpoints. C NPTS : IN. Number of gridpoints C NPDE : IN. # PDE components C C----------------------------------------------------------------------- C C INTEGER I DOUBLE PRECISION EPS PARAMETER (EPS = 2.0D-3) DO 10 I = 1, NPTS U(I,1) = 1-0.5/(1+EXP((-X(I)+Y(I)+Z(I)-0.75*T)/(4*EPS))) U(I,2) = 1.5-U(I,1) U(I,3) = 1.5-U(I,1) 10 CONTINUE RETURN END SUBROUTINE PDEF (T, X, Y, Z, U, + UT, UX, UY, UZ, UXX, UYY, UZZ, UXY, UXZ, UYZ, RES, NPTS, NPDE) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE DOUBLE PRECISION T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE), + UT(NPTS,NPDE), UX(NPTS,NPDE), UY(NPTS,NPDE), UZ(NPTS,NPDE), + UXX(NPTS,NPDE), UYY(NPTS,NPDE), UZZ(NPTS,NPDE), + UXY(NPTS,NPDE), UXZ(NPTS,NPDE), UYZ(NPTS,NPDE), + RES(NPTS,NPDE) C Ccc PURPOSE: C Define residual of PDE on interior of domain. Boundary values will be C overwritten later on. C Ccc PARAMETER DESCRIPTION: C T : IN. Time at which residual should be evaluated C X,Y,Z : IN. Physical coordinates of gridpoints C U : IN. Array of PDE components for the gridpoints. C UT : IN. Array of time derivative of PDE components C UX : IN. -I C UY : IN. I C UZ : IN. I C UXX : IN. I C UYY : IN. I Space derivatives of U on current grid C UZZ : IN. I C UXY : IN. I C UXZ : IN. I C UYZ : IN. -I C RES : OUT. Array containg PDE residual at gridpoints in interior of C domain. The residual values at boundary points will be C overwritten by a call to PDEBC. C NPTS : IN. Number of gridpoints C NPDE : IN. Number of PDE components C C----------------------------------------------------------------------- C INTEGER I DOUBLE PRECISION EPS PARAMETER (EPS = 2.0D-3) DO 10 I = 1, NPTS RES(I,1) = UT(I,1) + U(I,1)*UX(I,1) + + U(I,2)*UY(I,1) + U(I,3)*UZ(I,1) - + EPS*(UXX(I,1)+UYY(I,1)+UZZ(I,1)) RES(I,2) = UT(I,2) + U(I,1)*UX(I,2) + + U(I,2)*UY(I,2) + U(I,3)*UZ(I,2) - + EPS*(UXX(I,2)+UYY(I,2)+UZZ(I,2)) RES(I,3) = UT(I,3) + U(I,1)*UX(I,3) + + U(I,2)*UY(I,3) + U(I,3)*UZ(I,3) - + EPS*(UXX(I,3)+UYY(I,3)+UZZ(I,3)) 10 CONTINUE RETURN END SUBROUTINE PDEBC (T, X, Y, Z, U, UT, UX, UY, UZ, RES, NPTS, NPDE, + LLBND, ILBND, LBND) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE, LLBND(0:*), ILBND(*), LBND(*) DOUBLE PRECISION T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE), + UT(NPTS,NPDE), UX(NPTS,NPDE), UY(NPTS,NPDE), UZ(NPTS,NPDE), + RES(NPTS,NPDE) C Ccc PURPOSE: C Define residual of boundary equations of PDE. The residual on interior C points has already been stored in RES. C Ccc PARAMETER DESCRIPTION: C T : IN. Time at which BC's should be evaluated C X,Y,Z : IN. Physical coordinates of gridpoints C U : IN. Array of PDE components for the gridpoints. C UT : IN. Array of time derivative of PDE components C UX : IN. -I C UY : IN. I Arrays containing space derivatives of PDE components C UZ : IN. -I C RES : INOUT. C IN: PDE residual for interior points (set by PDEF) C OUT: Array with PDE residual at physical boundary points C inserted C NPTS : IN. Number of grid components C NPDE : IN. Number of PDE components C LLBND : IN. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C C----------------------------------------------------------------------- C INTEGER I, J, K, NBNDS DOUBLE PRECISION EPS, UI PARAMETER (EPS = 2.0D-3) NBNDS = LLBND(0) DO 10 J = 1, NBNDS DO 20 K = LLBND(J), LLBND(J+1)-1 I = LBND(K) UI = 1-0.5/(1+EXP((-X(I)+Y(I)+Z(I)-0.75*T)/(4*EPS))) RES(I,1) = U(I,1) - UI RES(I,2) = U(I,2) - (1.5-UI) RES(I,3) = U(I,3) - (1.5-UI) 20 CONTINUE 10 CONTINUE RETURN END SHAR_EOF fi # end of overwriting check if test -f 'probic.f' then echo shar: will not over-write existing file "'probic.f'" else cat << \SHAR_EOF > 'probic.f' PROGRAM EXIC C INTEGER MXLEV, NPD, NPTS, LENIWK, LENRWK, LENLWK PARAMETER (MXLEV=2, NPD=3, NPTS=40000) PARAMETER (LENIWK=NPTS*(7*MXLEV+25), + LENRWK=NPTS*NPD*(5*MXLEV+38*NPD+13), + LENLWK=2*NPTS) C C----------------------------------------------------------------------- C INTEGER LUNDMP PARAMETER (LUNDMP = 89) C INTEGER NPDE, INFO(7), IWK(LENIWK), MNTR LOGICAL LWK(LENLWK) DOUBLE PRECISION T, TOUT, DT, XL, YF, ZD, XR, YB, ZU, DX, DY, DZ, + TOLS, TOLT, RINFO(2+3*NPD), RWK(LENRWK) C First call of VLUGR3 MNTR = 0 NPDE = 3 T = 0.0 TOUT = 1.0 DT = 0.001 XL = 0.0 YF = 0.0 ZD = 0.0 XR = 1.0 YB = 1.0 ZU = 1.0 DX = 0.1 DY = 0.1 DZ = 0.1 TOLS = 0.1 TOLT = 0.1 INFO(1) = 1 C MAXLEV INFO(2) = 3 C Domain a rectangular prism INFO(3) = 0 C Linear system solver print *, 'Lin.sys.solver BiCGStab or GCRO (0 / 10,11,12,13) ?' read *, INFO(4) OPEN (UNIT=61,FILE='RunInfo') C Write integration history to unit # 61 INFO(5) = 61 C Write Newton info to unit # 61 INFO(6) = 61 C Write linear solver info to unit # 61 INFO(7) = 61 C DTMIN = 1D-7 RINFO(1) = 1.0D-7 C DTMAX = 1.0 RINFO(2) = 1.0 C UMAX = 1.0 RINFO(3) = 1.0 RINFO(4) = 1.0 RINFO(5) = 1.0 C SPCWGT = 1.0 RINFO(6) = 1.0 RINFO(7) = 1.0 RINFO(8) = 1.0 C TIMWGT = 1.0 RINFO(9) = 1.0 RINFO(10) = 1.0 RINFO(11) = 1.0 C C Call main routine CALL VLUGR3 (NPDE, T, TOUT, DT, XL,YF,ZD, XR,YB,ZU, DX, DY, DZ, + TOLS, TOLT, INFO, RINFO, RWK, LENRWK, IWK, LENIWK, LWK, LENLWK, + MNTR) PRINT *, 'VLUGR3 returned with MNTR=', MNTR C C Save info on file OPEN(UNIT=LUNDMP,FILE='DUMP',FORM='UNFORMATTED') CALL DUMP (LUNDMP, RWK, IWK) CLOSE(LUNDMP) END SUBROUTINE MONITR (T, DT, DTNEW, XL, YF, ZD, DXB, DYB, DZB, + LGRID, ISTRUC, LSOL, SOL) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER LGRID(0:*), ISTRUC(*), LSOL(*) DOUBLE PRECISION T, DT, DTNEW, XL, YF, ZD, DXB, DYB, DZB, SOL(*) C Ccc PURPOSE: C Control after a successful time step. The solution can be printed, C plotted or compared with the exact solution. C Ccc PARAMETER DESCRIPTION: C T : IN. Current value of time variable C DT : IN. Current time step size C DTNEW : IN. Time step size for next time step C XL : IN. X-coordinate of left/front/down point of (virtual) box C YF : IN. Y-coordinate of left/front/down point of (virtual) box C ZD : IN. Z-coordinate of left/front/down point of (virtual) box C DXB : IN. Cell width in X-direction of base grid C DYB : IN. Cell width in Y-direction of base grid C DZB : IN. Cell width in Z-direction of base grid C LGRID : IN. (0:*) C LGRID(0) = max. grid level used at T C LGRID(1): pointer to base grid structure ISTRUC C LGRID(LEVEL): pointer to grid structure C (LPLN,IPLN,LROW,IROW,ICOL) of refinement C level LEVEL for time T C ISTRUC : IN. (*) C ISTRUC(LGRID(LEVEL):.) contains (LPLN,IPLN,LROW,IROW,ICOL) C of grid level LEVEL, C LPLN : (0:LPLN(0)+1) C LPLN(0) = NPLNS: Actual # planes in LROW C LPLN(1:NPLNS): pointers to the start of a plane in LROW C LPLN(NPLNS+1) = NROWS+1: Total # rows in grid + 1 C IPLN : (NPLNS) C IPLN(IP): plane number of plane IP in virtual box C LROW : (NROWS+1) C LROW(1:NROWS): pointers to the start of a row in the grid C LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 C IROW : (NROWS) C IROW(IR): row number of row IR in virtual box C ICOL : (NPTS) C ICOL(IPT): column number of grid point IPT in virtual box C LSOL : IN. (*) C LSOL(LEVEL): pointer to (injected) solution at grid C of refinement level LEVEL for time T C SOL : IN. (*) C SOL(LSOL(LEVEL)+1:LSOL(LEVEL)+NPTS(LEVEL)*NPDE) contains C U_LEVEL(NPTS,NPDE) C C C Local arrays: INTEGER MAXPTS, NPDE PARAMETER (MAXPTS=250000, NPDE=1) DOUBLE PRECISION X(MAXPTS), Y(MAXPTS), Z(MAXPTS), UEX(MAXPTS*NPDE) C C----------------------------------------------------------------------- C INTEGER MAXLEV, LEVEL, LLPLN, LIPLN, LLROW, LIROW, LICOL, + NPLNS, NROWS, NPTS DOUBLE PRECISION DX, DY, DZ C C Loop over the grid levels from coarse to fine. C Get physical coordinates of grid points C Compute ||err||_max MAXLEV = LGRID(0) DX = DXB DY = DYB DZ = DZB DO 10 LEVEL = 1, MAXLEV LLPLN = LGRID(LEVEL) NPLNS = ISTRUC(LLPLN) NROWS = ISTRUC(LLPLN+NPLNS+1)-1 LIPLN = LLPLN+NPLNS+2 LLROW = LIPLN+NPLNS NPTS = ISTRUC(LLROW+NROWS)-1 IF (NPTS .GT. MAXPTS) stop 'MONITR' LIROW = LLROW+NROWS+1 LICOL = LIROW+NROWS CALL SETXYZ (XL, YF, ZD, DX, DY, DZ, + ISTRUC(LLPLN), ISTRUC(LIPLN), + ISTRUC(LLROW), ISTRUC(LIROW), ISTRUC(LICOL), X, Y, Z) DX = DX/2 DY = DY/2 DZ = DZ/2 CALL PRERR (LEVEL, T, NPTS, NPDE, X, Y, Z, SOL(LSOL(LEVEL)+1), + UEX) 10 CONTINUE RETURN END SUBROUTINE PRERR (LEVEL, T, NPTS, NPDE, X, Y, Z, U, UEX) INTEGER LEVEL, NPTS, NPDE DOUBLE PRECISION T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE), + UEX(NPTS,NPDE) INTEGER I,J DOUBLE PRECISION RMAX(3) CALL PDEIV (T, X, Y, Z, UEX, NPTS, NPDE) DO 1 J = 1, NPDE RMAX(J) = 0.0 DO 10 I = 1, NPTS RMAX(J) = MAX(RMAX(J),ABS(UEX(I,J)-U(I,J))) 10 CONTINUE 1 CONTINUE WRITE(28,'(''Error at T='',E9.3,'', level='',I1,'' :'', + I10,3E10.3)') T, LEVEL, NPTS, (RMAX(J), J=1, NPDE) RETURN END SUBROUTINE PDEIV (T, X, Y, Z, U, NPTS, NPDE) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE DOUBLE PRECISION T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE) C Ccc PURPOSE: C Define (initial) solution of PDE. C Ccc PARAMETER DESCRIPTION: C T : IN. Time at which (initial) solution should be given C X,Y,Z : IN. Arrays of physical coordinates for the gridpoints C U : OUT. Array of PDE component values for the gridpoints. C NPTS : IN. Number of gridpoints C NPDE : IN. # PDE components C C----------------------------------------------------------------------- C C INTEGER I DOUBLE PRECISION EPS PARAMETER (EPS = 5.0D-3) DO 10 I = 1, NPTS U(I,1) = 1-0.5/(1+EXP((-X(I)+Y(I)+Z(I)-0.75*T)/(4*EPS))) U(I,2) = 1.5-U(I,1) U(I,3) = 1.5-U(I,1) 10 CONTINUE RETURN END SUBROUTINE PDEF (T, X, Y, Z, U, + UT, UX, UY, UZ, UXX, UYY, UZZ, UXY, UXZ, UYZ, RES, NPTS, NPDE) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE DOUBLE PRECISION T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE), + UT(NPTS,NPDE), UX(NPTS,NPDE), UY(NPTS,NPDE), UZ(NPTS,NPDE), + UXX(NPTS,NPDE), UYY(NPTS,NPDE), UZZ(NPTS,NPDE), + UXY(NPTS,NPDE), UXZ(NPTS,NPDE), UYZ(NPTS,NPDE), + RES(NPTS,NPDE) C Ccc PURPOSE: C Define residual of PDE on interior of domain. Boundary values will be C overwritten later on. C Ccc PARAMETER DESCRIPTION: C T : IN. Time at which residual should be evaluated C X,Y,Z : IN. Physical coordinates of gridpoints C U : IN. Array of PDE components for the gridpoints. C UT : IN. Array of time derivative of PDE components C UX : IN. -I C UY : IN. I C UZ : IN. I C UXX : IN. I C UYY : IN. I Space derivatives of U on current grid C UZZ : IN. I C UXY : IN. I C UXZ : IN. I C UYZ : IN. -I C RES : OUT. Array containg PDE residual at gridpoints in interior of C domain. The residual values at boundary points will be C overwritten by a call to PDEBC. C NPTS : IN. Number of gridpoints C NPDE : IN. Number of PDE components C C----------------------------------------------------------------------- C INTEGER I DOUBLE PRECISION EPS PARAMETER (EPS = 5.0D-3) DO 10 I = 1, NPTS RES(I,1) = UT(I,1) + U(I,1)*UX(I,1) + + U(I,2)*UY(I,1) + U(I,3)*UZ(I,1) - + EPS*(UXX(I,1)+UYY(I,1)+UZZ(I,1)) RES(I,2) = UT(I,2) + U(I,1)*UX(I,2) + + U(I,2)*UY(I,2) + U(I,3)*UZ(I,2) - + EPS*(UXX(I,2)+UYY(I,2)+UZZ(I,2)) RES(I,3) = UT(I,3) + U(I,1)*UX(I,3) + + U(I,2)*UY(I,3) + U(I,3)*UZ(I,3) - + EPS*(UXX(I,3)+UYY(I,3)+UZZ(I,3)) 10 CONTINUE RETURN END SUBROUTINE PDEBC (T, X, Y, Z, U, UT, UX, UY, UZ, RES, NPTS, NPDE, + LLBND, ILBND, LBND) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE, LLBND(0:*), ILBND(*), LBND(*) DOUBLE PRECISION T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE), + UT(NPTS,NPDE), UX(NPTS,NPDE), UY(NPTS,NPDE), UZ(NPTS,NPDE), + RES(NPTS,NPDE) C Ccc PURPOSE: C Define residual of boundary equations of PDE. The residual on interior C points has already been stored in RES. C Ccc PARAMETER DESCRIPTION: C T : IN. Time at which BC's should be evaluated C X,Y,Z : IN. Physical coordinates of gridpoints C U : IN. Array of PDE components for the gridpoints. C UT : IN. Array of time derivative of PDE components C UX : IN. -I C UY : IN. I Arrays containing space derivatives of PDE components C UZ : IN. -I C RES : INOUT. C IN: PDE residual for interior points (set by PDEF) C OUT: Array with PDE residual at physical boundary points C inserted C NPTS : IN. Number of grid components C NPDE : IN. Number of PDE components C LLBND : IN. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C C----------------------------------------------------------------------- C INTEGER I, J, K, NBNDS DOUBLE PRECISION EPS, UI PARAMETER (EPS = 5.0D-3) NBNDS = LLBND(0) DO 10 J = 1, NBNDS DO 20 K = LLBND(J), LLBND(J+1)-1 I = LBND(K) UI = 1-0.5/(1+EXP((-X(I)+Y(I)+Z(I)-0.75*T)/(4*EPS))) RES(I,1) = U(I,1) - UI RES(I,2) = U(I,2) - (1.5-UI) RES(I,3) = U(I,3) - (1.5-UI) 20 CONTINUE 10 CONTINUE RETURN END SHAR_EOF fi # end of overwriting check if test -f 'probii.f' then echo shar: will not over-write existing file "'probii.f'" else cat << \SHAR_EOF > 'probii.f' PROGRAM EXII C INTEGER MXLEV, NPD, NPTS, LENIWK, LENRWK, LENLWK PARAMETER (MXLEV=2, NPD=2, NPTS=70000) C PARAMETER (LENIWK=NPTS*(7*MXLEV+43), C + LENRWK=NPTS*NPD*(5*MXLEV+38*NPD+13), PARAMETER (LENIWK=NPTS*(7*MXLEV+24), + LENRWK=NPTS*NPD*(5*MXLEV+37+21), + LENLWK=2*NPTS) C C----------------------------------------------------------------------- C INTEGER LUNDMP PARAMETER (LUNDMP = 89) C CHARACTER*2 NR INTEGER I, NPDE, INFO(7), IWK(LENIWK), MNTR LOGICAL LWK(LENLWK) DOUBLE PRECISION T, TOUT, TE, DT, XL, YF, ZD, XR, YB, ZU, DX, DY, + DZ, + TOLS, TOLT, RINFO(2+3*NPD), RWK(LENRWK) C First call of VLUGR3 MNTR = 0 NPDE = 2 T = 0.0 TOUT = 1.0 DT = 1D-5 XL = 0.0 YF = 0.0 ZD = 0.0 XR = 1.0 YB = 1.0 ZU = 1.0 DX = 0.1 DY = 0.1 DZ = 0.1 TOLS = 0.1 TOLT = 0.1 INFO(1) = 1 C MAXLEV INFO(2) = 4 C Domain a rectangular prism INFO(3) = 0 C Linear system solver print *, 'Lin.sys.solver BiCGStab or GCRO (0 / 10,11,12,13) ?' read *, INFO(4) OPEN (UNIT=61,FILE='RunInfo') C Write integration history to unit # 61 INFO(5) = 61 C Write Newton info to unit # 61 INFO(6) = 61 C Write linear solver info to unit # 61 INFO(7) = 61 C DTMIN = 1D-9 RINFO(1) = 1.0D-9 C DTMAX = TE - TS RINFO(2) = 0.0 C UMAX = 1.0 RINFO(3) = 1.0 RINFO(4) = 1.0 C SPCWGT = 1.0 RINFO(5) = 1.0 RINFO(6) = 1.0 C TIMWGT = 1.0 RINFO(7) = 1.0 RINFO(8) = 1.0 C C Call main routine DO 10 I = 1, 10 TE = T + TOUT/10 CALL VLUGR3 (NPDE, T, TE, DT, XL,YF,ZD, XR,YB,ZU, DX, DY, DZ, + TOLS, TOLT, INFO, RINFO, RWK, LENRWK, IWK, LENIWK, LWK, LENLWK, + MNTR) PRINT *, 'VLUGR3 returned with MNTR=', MNTR C C Save info on file WRITE(NR,'(I2.2)') I OPEN(UNIT=LUNDMP,FILE='DUMP'//NR,FORM='UNFORMATTED') CALL DUMP (LUNDMP, RWK, IWK) CLOSE(LUNDMP) 10 CONTINUE END SUBROUTINE MONITR (T, DT, DTNEW, XL, YF, ZD, DXB, DYB, DZB, + LGRID, ISTRUC, LSOL, SOL) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER LGRID(0:*), ISTRUC(*), LSOL(*) DOUBLE PRECISION T, DT, DTNEW, XL, YF, ZD, DXB, DYB, DZB, SOL(*) C Ccc PURPOSE: C Control after a successful time step. The solution can be printed, C plotted or compared with the exact solution. C Ccc PARAMETER DESCRIPTION: C T : IN. Current value of time variable C DT : IN. Current time step size C DTNEW : IN. Time step size for next time step C XL : IN. X-coordinate of left/front/down point of (virtual) box C YF : IN. Y-coordinate of left/front/down point of (virtual) box C ZD : IN. Z-coordinate of left/front/down point of (virtual) box C DXB : IN. Cell width in X-direction of base grid C DYB : IN. Cell width in Y-direction of base grid C DZB : IN. Cell width in Z-direction of base grid C LGRID : IN. (0:*) C LGRID(0) = max. grid level used at T C LGRID(1): pointer to base grid structure ISTRUC C LGRID(LEVEL): pointer to grid structure C (LPLN,IPLN,LROW,IROW,ICOL) of refinement C level LEVEL for time T C ISTRUC : IN. (*) C ISTRUC(LGRID(LEVEL):.) contains (LPLN,IPLN,LROW,IROW,ICOL) C of grid level LEVEL, C LPLN : (0:LPLN(0)+1) C LPLN(0) = NPLNS: Actual # planes in LROW C LPLN(1:NPLNS): pointers to the start of a plane in LROW C LPLN(NPLNS+1) = NROWS+1: Total # rows in grid + 1 C IPLN : (NPLNS) C IPLN(IP): plane number of plane IP in virtual box C LROW : (NROWS+1) C LROW(1:NROWS): pointers to the start of a row in the grid C LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 C IROW : (NROWS) C IROW(IR): row number of row IR in virtual box C ICOL : (NPTS) C ICOL(IPT): column number of grid point IPT in virtual box C LSOL : IN. (*) C LSOL(LEVEL): pointer to (injected) solution at grid C of refinement level LEVEL for time T C SOL : IN. (*) C SOL(LSOL(LEVEL)+1:LSOL(LEVEL)+NPTS(LEVEL)*NPDE) contains C U_LEVEL(NPTS,NPDE) C C C Local arrays: INTEGER MAXPTS, NPDE PARAMETER (MAXPTS=50000, NPDE=2) DOUBLE PRECISION X(MAXPTS), Y(MAXPTS), Z(MAXPTS), UEX(MAXPTS*NPDE) C C----------------------------------------------------------------------- C INTEGER MAXLEV, LEVEL, LLPLN, LIPLN, LLROW, LIROW, LICOL, + NPLNS, NROWS, NPTS DOUBLE PRECISION DX, DY, DZ C C Loop over the grid levels from coarse to fine. C Get physical coordinates of grid points C Compute ||err||_max and clip negative solution values MAXLEV = LGRID(0) DX = DXB DY = DYB DZ = DZB DO 10 LEVEL = 1, MAXLEV LLPLN = LGRID(LEVEL) NPLNS = ISTRUC(LLPLN) NROWS = ISTRUC(LLPLN+NPLNS+1)-1 LIPLN = LLPLN+NPLNS+2 LLROW = LIPLN+NPLNS NPTS = ISTRUC(LLROW+NROWS)-1 IF (NPTS .GT. MAXPTS) stop 'MONITR' LIROW = LLROW+NROWS+1 LICOL = LIROW+NROWS CALL SETXYZ (XL, YF, ZD, DX, DY, DZ, + ISTRUC(LLPLN), ISTRUC(LIPLN), + ISTRUC(LLROW), ISTRUC(LIROW), ISTRUC(LICOL), X, Y, Z) DX = DX/2 DY = DY/2 DZ = DZ/2 CALL PRERR (LEVEL, T, NPTS, NPDE, X, Y, Z, SOL(LSOL(LEVEL)+1), + UEX) 10 CONTINUE RETURN END SUBROUTINE PRERR (LEVEL, T, NPTS, NPDE, X, Y, Z, U, UEX) INTEGER LEVEL, NPTS, NPDE DOUBLE PRECISION T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE), + UEX(NPTS,NPDE) INTEGER I DOUBLE PRECISION RMAX1, RMAX2 CALL PDEIV (T, X, Y, Z, UEX, NPTS, NPDE) RMAX1 = 0.0 RMAX2 = 0.0 DO 10 I = 1, NPTS RMAX1 = MAX(RMAX1,ABS(UEX(I,1)-U(I,1))) RMAX2 = MAX(RMAX2,ABS(UEX(I,2)-U(I,2))) IF (U(I,1) .LT. 0) U(I,1) = 0.0 IF (U(I,2) .LT. 0) U(I,2) = 0.0 10 CONTINUE WRITE(28,'("Error at T=",E9.3,", level=",I1," :",2E10.3,I10)') + T, LEVEL, RMAX1, RMAX2, NPTS RETURN END SUBROUTINE PDEIV (T, X, Y, Z, U, NPTS, NPDE) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE DOUBLE PRECISION T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE) C Ccc PURPOSE: C Define (initial) solution of PDE. C Ccc PARAMETER DESCRIPTION: C T : IN. Time at which (initial) solution should be given C X,Y,Z : IN. Arrays of physical coordinates for the gridpoints C U : OUT. Array of PDE component values for the gridpoints. C NPTS : IN. Number of gridpoints C NPDE : IN. # PDE components C C----------------------------------------------------------------------- C C DOUBLE PRECISION PI, S2, R, S, D, K1, K2, C2, EDKT PARAMETER (PI = 3.141592653589793, S2 = 1.414213562373095) PARAMETER (K1 = 1000.0, K2 = 1.0) PARAMETER (C2 = -K1/K2) INTEGER I R = (2+SIN(2*PI*T))/4 S = (2+S2/2*COS(2*PI*T))/4 DO 10 I = 1, NPTS D = EXP(-80*((X(I)-R)**2+(Y(I)-S)**2+(Z(I)-S)**2)) EDKT = EXP(-D*K2*T) U(I,1) = D/(K1+K2) * (K1*(1-C2)+(K1+K2)*C2*EDKT)/(1-C2+C2*EDKT) U(I,2) = D - U(I,1) 10 CONTINUE RETURN END SUBROUTINE PDEF (T, X, Y, Z, U, + UT, UX, UY, UZ, UXX, UYY, UZZ, UXY, UXZ, UYZ, RES, NPTS, NPDE) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE DOUBLE PRECISION T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE), + UT(NPTS,NPDE), UX(NPTS,NPDE), UY(NPTS,NPDE), UZ(NPTS,NPDE), + UXX(NPTS,NPDE), UYY(NPTS,NPDE), UZZ(NPTS,NPDE), + UXY(NPTS,NPDE), UXZ(NPTS,NPDE), UYZ(NPTS,NPDE), + RES(NPTS,NPDE) C Ccc PURPOSE: C Define residual of PDE on interior of domain. Boundary values will be C overwritten later on. C Ccc PARAMETER DESCRIPTION: C T : IN. Time at which residual should be evaluated C X,Y,Z : IN. Physical coordinates of gridpoints C U : IN. Array of PDE components for the gridpoints. C UT : IN. Array of time derivative of PDE components C UX : IN. -I C UY : IN. I C UZ : IN. I C UXX : IN. I C UYY : IN. I Space derivatives of U on current grid C UZZ : IN. I C UXY : IN. I C UXZ : IN. I C UYZ : IN. -I C RES : OUT. Array containg PDE residual at gridpoints in interior of C domain. The residual values at boundary points will be C overwritten by a call to PDEBC. C NPTS : IN. Number of gridpoints C NPDE : IN. Number of PDE components C C----------------------------------------------------------------------- C DOUBLE PRECISION PI, S2, K1, K2 PARAMETER (PI = 3.141592653589793, S2 = 1.414213562373095) PARAMETER (K1 = 1000.0, K2 = 1.0) INTEGER I DO 10 I = 1, NPTS RES(I,1) = UT(I,1) + + 2*PI*S2*((Y(I)+Z(I))/2-0.5)*UX(I,1) - + 2*PI/S2*(X(I)-0.5)*(UY(I,1)+UZ(I,1)) + - (-K2*U(I,1)*U(I,2) + K1*U(I,2)*U(I,2)) RES(I,2) = UT(I,2) + + 2*PI*S2*((Y(I)+Z(I))/2-0.5)*UX(I,2) - + 2*PI/S2*(X(I)-0.5)*(UY(I,2)+UZ(I,2)) + - (-K1*U(I,2)*U(I,2) + K2*U(I,1)*U(I,2)) 10 CONTINUE RETURN END SUBROUTINE PDEBC (T, X, Y, Z, U, UT, UX, UY, UZ, RES, NPTS, NPDE, + LLBND, ILBND, LBND) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE, LLBND(0:*), ILBND(*), LBND(*) DOUBLE PRECISION T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE), + UT(NPTS,NPDE), UX(NPTS,NPDE), UY(NPTS,NPDE), UZ(NPTS,NPDE), + RES(NPTS,NPDE) C Ccc PURPOSE: C Define residual of boundary equations of PDE. The residual on interior C points has already been stored in RES. C Ccc PARAMETER DESCRIPTION: C T : IN. Time at which BC's should be evaluated C X,Y,Z : IN. Physical coordinates of gridpoints C U : IN. Array of PDE components for the gridpoints. C UT : IN. Array of time derivative of PDE components C UX : IN. -I C UY : IN. I Arrays containing space derivatives of PDE components C UZ : IN. -I C RES : INOUT. C IN: PDE residual for interior points (set by PDEF) C OUT: Array with PDE residual at physical boundary points C inserted C NPTS : IN. Number of grid components C NPDE : IN. Number of PDE components C LLBND : IN. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C C----------------------------------------------------------------------- C DOUBLE PRECISION PI, S2, R, S, D, K1, K2, C2, EDKT, UI1 PARAMETER (PI = 3.141592653589793, S2 = 1.414213562373095) PARAMETER (K1 = 1000.0, K2 = 1.0) PARAMETER (C2 = -K1/K2) INTEGER I, J, K, NBNDS R = (2+SIN(2*PI*T))/4 S = (2+S2/2*COS(2*PI*T))/4 C NBNDS = LLBND(0) DO 10 J = 1, NBNDS C C Change the inflow boundaries IF (ILBND(J) .EQ. 1) THEN DO 20 K = LLBND(J), LLBND(J+1)-1 I = LBND(K) IF (Y(I)+Z(I) .GE. 1.0) THEN D = EXP(-80*((X(I)-R)**2+(Y(I)-S)**2+(Z(I)-S)**2)) EDKT = EXP(-D*K2*T) UI1 = D/(K1+K2) * + (K1*(1-C2)+(K1+K2)*C2*EDKT)/(1-C2+C2*EDKT) RES(I,1) = U(I,1) - UI1 RES(I,2) = U(I,2) - (D - UI1) ENDIF 20 CONTINUE ELSE IF (ILBND(J) .EQ. 2 .OR. ILBND(J) .EQ. 5) THEN DO 30 K = LLBND(J), LLBND(J+1)-1 I = LBND(K) IF (X(I) .LE. 0.5) THEN D = EXP(-80*((X(I)-R)**2+(Y(I)-S)**2+(Z(I)-S)**2)) EDKT = EXP(-D*K2*T) UI1 = D/(K1+K2) * + (K1*(1-C2)+(K1+K2)*C2*EDKT)/(1-C2+C2*EDKT) RES(I,1) = U(I,1) - UI1 RES(I,2) = U(I,2) - (D - UI1) ENDIF 30 CONTINUE ELSE IF (ILBND(J) .EQ. 3)THEN DO 40 K = LLBND(J), LLBND(J+1)-1 I = LBND(K) IF (Y(I)+Z(I) .LE. 1.0) THEN D = EXP(-80*((X(I)-R)**2+(Y(I)-S)**2+(Z(I)-S)**2)) EDKT = EXP(-D*K2*T) UI1 = D/(K1+K2) * + (K1*(1-C2)+(K1+K2)*C2*EDKT)/(1-C2+C2*EDKT) RES(I,1) = U(I,1) - UI1 RES(I,2) = U(I,2) - (D - UI1) ENDIF 40 CONTINUE ELSE IF (ILBND(J) .EQ. 4 .OR. ILBND(J) .EQ. 6) THEN DO 50 K = LLBND(J), LLBND(J+1)-1 I = LBND(K) IF (X(I) .GE. 0.5) THEN D = EXP(-80*((X(I)-R)**2+(Y(I)-S)**2+(Z(I)-S)**2)) EDKT = EXP(-D*K2*T) UI1 = D/(K1+K2) * + (K1*(1-C2)+(K1+K2)*C2*EDKT)/(1-C2+C2*EDKT) RES(I,1) = U(I,1) - UI1 RES(I,2) = U(I,2) - (D - UI1) ENDIF 50 CONTINUE ENDIF 10 CONTINUE RETURN END SHAR_EOF fi # end of overwriting check if test -f 'prtsol.f' then echo shar: will not over-write existing file "'prtsol.f'" else cat << \SHAR_EOF > 'prtsol.f' PROGRAM PRTSOL C C----------------------------------------------------------------------- C Ccc This program reads a file made by subroutine DUMP and prints the C solution on an output file. Both filenames are read from standard C input. C Ccc EXTERNALS USED: EXTERNAL PRSOL, RDDUMP C C Ccc INCLUDE 'CMNWRITEF' C C CMNWRITEF C C COMMON needed for continuation calls INTEGER MAXLVW, NPDEW, LRWKPS, LIWKPS, LRWKB, LIWKB LOGICAL FIRST, SECOND DOUBLE PRECISION T0,TW,TEW,DTW, XLW,YFW,ZDW, XRW,YBW,ZUW, DXB,DYB, + DZB, DTO COMMON /WRITIF/ MAXLVW, NPDEW, LRWKPS, LIWKPS, LRWKB, LIWKB COMMON /WRITLF/ FIRST, SECOND COMMON /WRITRF/ T0,TW,TEW,DTW, XLW,YFW,ZDW, XRW,YBW,ZUW, + DXB,DYB,DZB, DTO SAVE /WRITIF/, /WRITLF/, /WRITRF/ C C end INCLUDE 'CMNWRITEF' C C C----------------------------------------------------------------------- C INTEGER MXLEV, NPD, NPTS, LENIWK, LENRWK PARAMETER (MXLEV=3, NPD=1, NPTS=100000) PARAMETER (LENIWK=NPTS*(7*MXLEV+23), + LENRWK=5*NPTS*NPD*MXLEV) C CHARACTER FILE*128 INTEGER IWK(LENIWK), + LSGNM1, LSGN, LSGNP1, LSUNM1, LSSN, LSUN DOUBLE PRECISION RWK(LENRWK) PRINT *, 'DUMP file?' READ '(A)', FILE C OPEN(UNIT=62,FILE=FILE,FORM='UNFORMATTED') CALL RDDUMP (62, RWK, LENRWK, IWK, LENIWK) CLOSE(62) C C Setup work storage LSGNM1 = 1 LSGN = LSGNM1 + MAXLVW+1 LSGNP1 = LSGN + MAXLVW+1 LSUNM1 = LSGNP1 + MAXLVW+1 LSSN = LSUNM1 + MAXLVW LSUN = LSSN + MAXLVW C C call print routine PRINT *, 'output file?' READ '(A)', FILE C OPEN(UNIT=61,FILE=FILE) CALL PRSOL (61, TW, NPDEW, XLW, YFW, ZDW, DXB, DYB, DZB, + IWK(LSGN), IWK(LIWKPS), IWK(LSUN), RWK(LRWKPS)) CLOSE(61) END SUBROUTINE RDDUMP (LUNDMP, RWK, LENRWK, IWK, LENIWK) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER LENIWK INTEGER LUNDMP, LENRWK, IWK(LENIWK) DOUBLE PRECISION RWK(LENRWK) C Ccc PURPOSE: C Read all information necessary for a restart of VLUGR3 from file C Ccc PARAMETER DESCRIPTION: C LUNDMP : IN. Logical unit number of dumpfile. Should be opened as an C unformatted file. C RWK : OUT. Real workstorage intended to pass to VLUGR3 C LENRWK : IN. Dimension of RWK. C IWK : OUT. Integer workstorage intended to pass to VLUGR3 C LENIWK : IN. Dimension of IWK. C Ccc EXTERNALS USED: NONE C C Ccc INCLUDE 'CMNSTATS' C C CMNSTATS C C COMMON with integration statistics INTEGER MXCLEV, MXCNIT PARAMETER (MXCLEV = 10, MXCNIT = 20) INTEGER LUNPDS, LUNNLS, LUNLSS, LEVEL, NSTEPS, NREJS, + NJACS(MXCLEV), NRESID(MXCLEV), NNIT(MXCLEV), + NLSIT(MXCLEV,MXCNIT) COMMON /STATS/ LUNPDS, LUNNLS, LUNLSS, LEVEL, NSTEPS, NREJS, + NJACS, NRESID, NNIT, NLSIT SAVE /STATS/ C C end INCLUDE 'CMNSTATS' C C Ccc INCLUDE 'CMNWRITEF' C C CMNWRITEF C C COMMON needed for continuation calls INTEGER MAXLVW, NPDEW, LRWKPS, LIWKPS, LRWKB, LIWKB LOGICAL FIRST, SECOND DOUBLE PRECISION T0,TW,TEW,DTW, XLW,YFW,ZDW, XRW,YBW,ZUW, DXB,DYB, + DZB, DTO COMMON /WRITIF/ MAXLVW, NPDEW, LRWKPS, LIWKPS, LRWKB, LIWKB COMMON /WRITLF/ FIRST, SECOND COMMON /WRITRF/ T0,TW,TEW,DTW, XLW,YFW,ZDW, XRW,YBW,ZUW, + DXB,DYB,DZB, DTO SAVE /WRITIF/, /WRITLF/, /WRITRF/ C C end INCLUDE 'CMNWRITEF' C C C----------------------------------------------------------------------- C INTEGER I, J READ(LUNDMP) MAXLVW, NPDEW, LRWKPS, LIWKPS, LRWKB, LIWKB, + FIRST, SECOND, + T0,TW,TEW,DTW, XLW,YFW,ZDW, XRW,YBW,ZUW, DXB,DYB,DZB, DTO IF (LENRWK .LT. LRWKPS+LRWKB .OR. LENIWK .LT. LIWKPS+LIWKB) THEN PRINT *, LENRWK, LRWKPS+LRWKB, LENIWK, LIWKPS+LIWKB STOP 'work space too small' ENDIF READ(LUNDMP) LUNPDS, LUNNLS, LUNLSS, LEVEL, NSTEPS, NREJS, + (NJACS(I), I=1,MXCLEV), (NRESID(I), I=1,MXCLEV), + (NNIT(I), I=1,MXCLEV), ((NLSIT(I,J), I=1,MXCLEV), J=1,MXCNIT) READ(LUNDMP) (RWK(I), I=1,LRWKPS+LRWKB) READ(LUNDMP) (IWK(I), I=1,LIWKPS+LIWKB) C RETURN END SUBROUTINE PRSOL (LUN, T, NPDE, XL, YF, ZD, DXB, DYB, DZB, + LGRID, ISTRUC, LSOL, SOL) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER LUN, NPDE, LGRID(0:*), ISTRUC(*), LSOL(*) DOUBLE PRECISION T, XL, YF, ZD, DXB, DYB, DZB, SOL(*) C Ccc PURPOSE: C Print solution and coordinate values at all grid levels. C Ccc PARAMETER DESCRIPTION: C LUN : IN. Logical unit number of print file C T : IN. Current value of time variable C NPDE : IN. # PDE components C XL : IN. X-coordinate of left/front/down point of virtual box C YF : IN. Y-coordinate of left/front/down point of virtual box C ZD : IN. Z-coordinate of left/front/down point of virtual box C DXB : IN. Cell width in X-direction of base grid C DYB : IN. Cell width in Y-direction of base grid C DZB : IN. Cell width in Z-direction of base grid C LGRID : IN. (0:*) C LGRID(0) = max. grid level used at T C LGRID(1): pointer to base grid structure ISTRUC C LGRID(LEVEL): pointer to grid structure C (LPLN,IPLN,LROW,IROW,ICOL) C of refinement level LEVEL for time T C ISTRUC : IN. (*) C ISTRUC(LGRID(LEVEL):.) contains (LPLN,IPLN,LROW,IROW,ICOL) C of grid level LEVEL, C LPLN : (0:LPLN(0)+1) C LPLN(0) = NPLNS: Actual # planes in grid C LPLN(1:NPLNS): pointers to the start of a plane in LROW C LPLN(NPLNS+1) = NROWS+1: Actual # rows in grid + 1 C IPLN : (NPLNS) C IPLN(IP): plane number of plane IP in virtual box C LROW : (NROWS+1) C LROW(1:NROWS): pointers to the start of a row in the grid C LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 C IROW : (NROWS) C IROW(IR): row number of row IR in virtual box C ICOL : (NPTS) C ICOL(IPT): column number of grid point IPT in virtual box C LSOL : IN. (*) C LSOL(LEVEL): pointer to (injected) solution at grid C of refinement level LEVEL for time T C SOL : IN. (*) C SOL(LSOL(LEVEL)+1:LSOL(LEVEL)+NPTS(LEVEL)*NPDE) contains C U_LEVEL(NPTS,NPDE) C Ccc EXTERNALS USED: EXTERNAL PRSOLL C C----------------------------------------------------------------------- C INTEGER MAXLEV, LEVEL, LLPLN, LIPLN, LLROW, LIROW, LICOL, + NPLNS, NROWS, NPTS DOUBLE PRECISION DX, DY, DZ MAXLEV = LGRID(0) DX = DXB DY = DYB DZ = DZB DO 10 LEVEL = 1, MAXLEV LLPLN = LGRID(LEVEL) NPLNS = ISTRUC(LLPLN) NROWS = ISTRUC(LLPLN+NPLNS+1)-1 LIPLN = LLPLN+NPLNS+2 LLROW = LIPLN+NPLNS NPTS = ISTRUC(LLROW+NROWS)-1 LIROW = LLROW+NROWS+1 LICOL = LIROW+NROWS CALL PRSOLL (LUN, LEVEL, T, NPTS, NPDE, XL, YF, ZD, DX, DY, DZ, + ISTRUC(LLPLN), ISTRUC(LIPLN), ISTRUC(LLROW), ISTRUC(LIROW), + ISTRUC(LICOL), SOL(LSOL(LEVEL)+1)) DX = DX/2 DY = DY/2 DZ = DZ/2 10 CONTINUE RETURN END SUBROUTINE PRSOLL (LUN, LEVEL, T, NPTS, NPDE, XL, YF, ZD, + DX, DY, DZ, LPLN, IPLN, LROW, IROW, ICOL, U) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER LUN, LEVEL, NPTS, NPDE, LPLN(0:*), IPLN(*), + LROW(*), IROW(*), ICOL(*) DOUBLE PRECISION T, XL, YF, ZD, DX, DY, DZ, U(NPTS,NPDE) C Ccc PURPOSE: C Print solution and X-, Y- and Z-coordinates of gridlevel LEVEL. C Ccc PARAMETER DESCRIPTION: C LUN : IN. Logical unit number of print file C LEVEL : IN. Grid level corresponding with solution U. C T : IN. Current value of time variable C NPTS : IN. # grid points at this level C NPDE : IN. # PDE components C XL : IN. X-coordinate of left/front/down point of virtual box C YF : IN. Y-coordinate of left/front/down point of virtual box C ZD : IN. Z-coordinate of left/front/down point of virtual box C DX : IN. Grid width in X-direction C DY : IN. Grid width in Y-direction C DZ : IN. Grid width in Z-direction C LPLN : IN. (0:LPLN(0)+1) C LPLN(0) = NPLNS: Actual # planes in LROW C LPLN(1:NPLNS): pointers to the start of a plane in LROW C LPLN(NPLNS+1) = NROWS+1: Total # rows in grid + 1 C IPLN : IN. (NPLNS) C IPLN(IP): plane number of plane IP in virtual box C LROW : IN. (NROWS+1) C LROW(1:NROWS): pointers to the start of a row in the grid C LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 C IROW : IN. (NROWS) C IROW(IR): row number of row IR in virtual box C ICOL : IN. (NPTS) C ICOL(IPT): column number of grid point IPT in virtual box C U : IN. Solution on this grid level C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER IC, IP, IPT, IR, NPLNS DOUBLE PRECISION X, Y, Z C NPLNS = LPLN(0) WRITE(LUN,'(//// A,T14,A,T30,A,T46,A,T62,A,T71,A //)') + 'Lev', 't', 'Z', 'Y', 'X', 'Solution' IP = 1 Z = ZD + IPLN(IP)*DZ IR = LPLN(IP) Y = YF + IROW(IR)*DY IPT = LROW(IR) X = XL + ICOL(IPT)*DX WRITE(LUN, + '(I3,T5,E12.5,T21,E12.5,T37,E12.5,T53,E12.5,T69,E12.5)') + LEVEL, T, Z, Y, X, U(IPT,1) DO 10 IC = 2, NPDE WRITE(LUN,'(T69,E12.5)') U(IPT,IC) 10 CONTINUE DO 14 IPT = LROW(IR)+1, LROW(IR+1)-1 X = XL + ICOL(IPT)*DX WRITE(LUN, + '(T53,E12.5,T69,E12.5)') + X, U(IPT,1) DO 15 IC = 2, NPDE WRITE(LUN,'(T69,E12.5)') U(IPT,IC) 15 CONTINUE 14 CONTINUE DO 20 IR = LPLN(IP)+1, LPLN(IP+1)-1 Y = YF + IROW(IR)*DY IPT = LROW(IR) X = XL + ICOL(IPT)*DX WRITE(LUN, + '(T37,E12.5,T53,E12.5,T69,E12.5)') + Y, X, U(IPT,1) DO 30 IC = 2, NPDE WRITE(LUN,'(T69,E12.5)') U(IPT,IC) 30 CONTINUE DO 40 IPT = LROW(IR)+1, LROW(IR+1)-1 X = XL + ICOL(IPT)*DX WRITE(LUN, + '(T53,E12.5,T69,E12.5)') + X, U(IPT,1) DO 50 IC = 2, NPDE WRITE(LUN,'(T69,E12.5)') U(IPT,IC) 50 CONTINUE 40 CONTINUE 20 CONTINUE DO 100 IP = 2, NPLNS Z = ZD + IPLN(IP)*DZ IR = LPLN(IP) Y = YF + IROW(IR)*DY IPT = LROW(IR) X = XL + ICOL(IPT)*DX WRITE(LUN, + '(T21,E12.5,T37,E12.5,T53,E12.5,T69,E12.5)') + Z, Y, X, U(IPT,1) DO 110 IC = 2, NPDE WRITE(LUN,'(T69,E12.5)') U(IPT,IC) 110 CONTINUE DO 114 IPT = LROW(IR)+1, LROW(IR+1)-1 X = XL + ICOL(IPT)*DX WRITE(LUN, + '(T53,E12.5,T69,E12.5)') + X, U(IPT,1) DO 115 IC = 2, NPDE WRITE(LUN,'(T69,E12.5)') U(IPT,IC) 115 CONTINUE 114 CONTINUE DO 120 IR = LPLN(IP)+1, LPLN(IP+1)-1 Y = YF + IROW(IR)*DY IPT = LROW(IR) X = XL + ICOL(IPT)*DX WRITE(LUN, + '(T37,E12.5,T53,E12.5,T69,E12.5)') + Y, X, U(IPT,1) DO 130 IC = 2, NPDE WRITE(LUN,'(T69,E12.5)') U(IPT,IC) 130 CONTINUE DO 140 IPT = LROW(IR)+1, LROW(IR+1)-1 X = XL + ICOL(IPT)*DX WRITE(LUN, + '(T53,E12.5,T69,E12.5)') + X, U(IPT,1) DO 150 IC = 2, NPDE WRITE(LUN,'(T69,E12.5)') U(IPT,IC) 150 CONTINUE 140 CONTINUE 120 CONTINUE 100 CONTINUE RETURN END SHAR_EOF fi # end of overwriting check if test -f 'wrtuni.f' then echo shar: will not over-write existing file "'wrtuni.f'" else cat << \SHAR_EOF > 'wrtuni.f' PROGRAM WRTUNI C C !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! C !!! !!! C !!! In subroutine WRUNI the constant NONVAL should be adjusted to !!! C !!! the data (NONVAL = impossible value for the first componenent) !!! C !!! !!! C !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! C C----------------------------------------------------------------------- C Ccc This program reads a file made by subroutine DUMP and writes the C (interpolated) solution on a uniform grid of a specified grid level C to the output file sol.dat. The maximum grid level used in each point C is written to the file grid.dat. C NB. This program is not correct for a domain with holes in it with C a size of the width of the base grid. C Ccc EXTERNALS USED: EXTERNAL WRUNI, RDDUMP C C Ccc INCLUDE 'CMNWRITEF' C C CMNWRITEF C C COMMON needed for continuation calls INTEGER MAXLVW, NPDEW, LRWKPS, LIWKPS, LRWKB, LIWKB LOGICAL FIRST, SECOND DOUBLE PRECISION T0,TW,TEW,DTW, XLW,YFW,ZDW, XRW,YBW,ZUW, DXB,DYB, + DZB, DTO COMMON /WRITIF/ MAXLVW, NPDEW, LRWKPS, LIWKPS, LRWKB, LIWKB COMMON /WRITLF/ FIRST, SECOND COMMON /WRITRF/ T0,TW,TEW,DTW, XLW,YFW,ZDW, XRW,YBW,ZUW, + DXB,DYB,DZB, DTO SAVE /WRITIF/, /WRITLF/, /WRITRF/ C C end INCLUDE 'CMNWRITEF' C C C----------------------------------------------------------------------- C INTEGER MXLEV, NPD, NPTS, LENIWK, LENRWK PARAMETER (MXLEV=3, NPD=1, NPTS=100000) PARAMETER (LENIWK=NPTS*(7*MXLEV+23), + LENRWK=5*NPTS*NPD*MXLEV) C CHARACTER FILE*128 INTEGER IWK(LENIWK), + LSGNM1, LSGN, LSGNP1, LSUNM1, LSSN, LSUN, + LUNI, MAXLEV, NX, NXB, NY, NYB, NZ, NZB, UNILEV DOUBLE PRECISION RWK(LENRWK) PRINT *, 'DUMP file?' READ '(A)', FILE C OPEN(UNIT=62,FILE=FILE,FORM='UNFORMATTED') CALL RDDUMP (62, RWK, LENRWK, IWK, LENIWK) CLOSE(62) C C Setup work storage LSGNM1 = 1 LSGN = LSGNM1 + MAXLVW+1 LSGNP1 = LSGN + MAXLVW+1 LSUNM1 = LSGNP1 + MAXLVW+1 LSSN = LSUNM1 + MAXLVW LSUN = LSSN + MAXLVW C C Check workspace MAXLEV = IWK(LSGN) PRINT *, 'Max. grid level?' READ *, UNILEV UNILEV = MIN(UNILEV,MAXLEV) NXB = NINT((XRW - XLW)/DXB) NYB = NINT((YBW - YFW)/DYB) NZB = NINT((ZUW - ZDW)/DZB) NX = NXB * 2**(UNILEV-1) NY = NYB * 2**(UNILEV-1) NZ = NZB * 2**(UNILEV-1) LUNI = LENRWK - (NX+1)*(NY+1)*(NZ+1)*NPDEW IF (LUNI .LT. IWK(LSUN+MAXLVW)) STOP 'workspace' C C Write problem info to standard output and write the interpolated C solution and grid levels to the files PRINT *, 'T, NPDE, XL, YF, ZD, DXB, DYB, DZB, NXB, NYB, NZB' PRINT *, TW, NPDEW, XLW, YFW, ZDW, DXB, DYB, DZB, NXB, NYB, NZB FILE = 'sol.dat' OPEN(UNIT=61,FILE=FILE) FILE = 'grid.dat' OPEN(UNIT=63,FILE=FILE) CALL WRUNI (61, 63, UNILEV, + TW, NPDEW, XLW, YFW, ZDW, DXB, DYB, DZB, NXB, NYB, NZB, + IWK(LSGN), IWK(LIWKPS), IWK(LSUN), RWK(LRWKPS), + RWK(LUNI), NX, NY, NZ) CLOSE(61) CLOSE(63) END SUBROUTINE RDDUMP (LUNDMP, RWK, LENRWK, IWK, LENIWK) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER LENIWK INTEGER LUNDMP, LENRWK, IWK(LENIWK) DOUBLE PRECISION RWK(LENRWK) C Ccc PURPOSE: C Read all information necessary for a restart of VLUGR3 from file C Ccc PARAMETER DESCRIPTION: C LUNDMP : IN. Logical unit number of dumpfile. Should be opened as an C unformatted file. C RWK : OUT. Real workstorage intended to pass to VLUGR3 C LENRWK : IN. Dimension of RWK. C IWK : OUT. Integer workstorage intended to pass to VLUGR3 C LENIWK : IN. Dimension of IWK. C Ccc EXTERNALS USED: NONE C C Ccc INCLUDE 'CMNSTATS' C C CMNSTATS C C COMMON with integration statistics INTEGER MXCLEV, MXCNIT PARAMETER (MXCLEV = 10, MXCNIT = 20) INTEGER LUNPDS, LUNNLS, LUNLSS, LEVEL, NSTEPS, NREJS, + NJACS(MXCLEV), NRESID(MXCLEV), NNIT(MXCLEV), + NLSIT(MXCLEV,MXCNIT) COMMON /STATS/ LUNPDS, LUNNLS, LUNLSS, LEVEL, NSTEPS, NREJS, + NJACS, NRESID, NNIT, NLSIT SAVE /STATS/ C C end INCLUDE 'CMNSTATS' C C Ccc INCLUDE 'CMNWRITEF' C C CMNWRITEF C C COMMON needed for continuation calls INTEGER MAXLVW, NPDEW, LRWKPS, LIWKPS, LRWKB, LIWKB LOGICAL FIRST, SECOND DOUBLE PRECISION T0,TW,TEW,DTW, XLW,YFW,ZDW, XRW,YBW,ZUW, DXB,DYB, + DZB, DTO COMMON /WRITIF/ MAXLVW, NPDEW, LRWKPS, LIWKPS, LRWKB, LIWKB COMMON /WRITLF/ FIRST, SECOND COMMON /WRITRF/ T0,TW,TEW,DTW, XLW,YFW,ZDW, XRW,YBW,ZUW, + DXB,DYB,DZB, DTO SAVE /WRITIF/, /WRITLF/, /WRITRF/ C C end INCLUDE 'CMNWRITEF' C C C----------------------------------------------------------------------- C INTEGER I, J READ(LUNDMP) MAXLVW, NPDEW, LRWKPS, LIWKPS, LRWKB, LIWKB, + FIRST, SECOND, + T0,TW,TEW,DTW, XLW,YFW,ZDW, XRW,YBW,ZUW, DXB,DYB,DZB, DTO IF (LENRWK .LT. LRWKPS+LRWKB .OR. LENIWK .LT. LIWKPS+LIWKB) THEN PRINT *, LENRWK, LRWKPS+LRWKB, LENIWK, LIWKPS+LIWKB STOP 'work space too small' ENDIF READ(LUNDMP) LUNPDS, LUNNLS, LUNLSS, LEVEL, NSTEPS, NREJS, + (NJACS(I), I=1,MXCLEV), (NRESID(I), I=1,MXCLEV), + (NNIT(I), I=1,MXCLEV), ((NLSIT(I,J), I=1,MXCLEV), J=1,MXCNIT) READ(LUNDMP) (RWK(I), I=1,LRWKPS+LRWKB) READ(LUNDMP) (IWK(I), I=1,LIWKPS+LIWKB) C RETURN END SUBROUTINE WRUNI (LUNS, LUNG, UNILEV, + T, NPDE, XL, YF, ZD, DXB, DYB, DZB, NXB, NYB, NZB, + LGRID, ISTRUC, LSOL, SOL, UNIFRM, NX, NY, NZ) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER LUNS, LUNG, UNILEV, + NPDE, NXB, NYB, NZB, LGRID(0:*), ISTRUC(*), LSOL(*), NX, NY, NZ DOUBLE PRECISION T, XL, YF, ZD, DXB, DYB, DZB, SOL(*), + UNIFRM(0:NX,0:NY,0:NZ,NPDE) C Ccc PURPOSE: C Write (interpolated) solution values at grid level UNILEV to file C LUNS. C Write maximum gridlevel used in each point to file LUNG. C NB. The data will not be correct for a domain with holes in it with C a size of the width of the base grid. C Ccc PARAMETER DESCRIPTION: C LUNS : IN. Logical unit number of solution file C LUNG : IN. Logical unit number of grid level file C UNILEV : IN. Maximum grid level to be used to generate the data C T : IN. Value of time variable C NPDE : IN. # PDE components C XL : IN. X-coordinate of left/front/down point of virtual box C YF : IN. Y-coordinate of left/front/down point of virtual box C ZD : IN. Z-coordinate of left/front/down point of virtual box C DXB : IN. Cell width in X-direction of base grid C DYB : IN. Cell width in Y-direction of base grid C DZB : IN. Cell width in Z-direction of base grid C NXB,NYB,NZB: IN. # gridcells in X-, Y- and Z-direction, resp., on grid C of base level C LGRID : IN. (0:*) C LGRID(0) = max. grid level used at T C LGRID(1): pointer to base grid structure ISTRUC C LGRID(LEVEL): pointer to grid structure C (LPLN,IPLN,LROW,IROW,ICOL) C of refinement level LEVEL for time T C ISTRUC : IN. (*) C ISTRUC(LGRID(LEVEL):.) contains (LPLN,IPLN,LROW,IROW,ICOL) C of grid level LEVEL, C LPLN : (0:LPLN(0)+1) C LPLN(0) = NPLNS: Actual # planes in grid C LPLN(1:NPLNS): pointers to the start of a plane in LROW C LPLN(NPLNS+1) = NROWS+1: Actual # rows in grid + 1 C IPLN : (NPLNS) C IPLN(IP): plane number of plane IP in virtual box C LROW : (NROWS+1) C LROW(1:NROWS): pointers to the start of a row in the grid C LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 C IROW : (NROWS) C IROW(IR): row number of row IR in virtual box C ICOL : (NPTS) C ICOL(IPT): column number of grid point IPT in virtual box C LSOL : IN. (*) C LSOL(LEVEL): pointer to (injected) solution at grid C of refinement level LEVEL for time T C SOL : IN. (*) C SOL(LSOL(LEVEL)+1:LSOL(LEVEL)+NPTS(LEVEL)*NPDE) contains C U_LEVEL(NPTS,NPDE) C UNIFRM : WORK. (Interpolated) solution on level UNILEV / max. grid C level used. C NX,NY,NZ: IN. # gridcells in X-, Y- and Z-direction, resp., on grid C of level UNILEV C C----------------------------------------------------------------------- C C !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! C !!! !!! C !!! In subroutine WRUNI the constant NONVAL should be adjusted to !!! C !!! the data (NONVAL = impossible value for the first componenent) !!! C !!! !!! DOUBLE PRECISION NONVAL PARAMETER (NONVAL = -999.999) C !!! !!! C !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! C C----------------------------------------------------------------------- C INTEGER I, IC, ICOL, IMUL, IP, IPLN, IPT, IR, IROW, J, K, + LEVEL, LLPLN, LIPLN, LLROW, LIROW, LICOL, MAXLEV, + NPLNS, NROWS, NPTS DO 1 IC = 1, NPDE DO 1 IPLN = 0, NZ DO 1 IROW = 0, NY DO 1 ICOL = 0, NX UNIFRM(ICOL,IROW,IPLN,IC) = NONVAL 1 CONTINUE MAXLEV = LGRID(0) DO 10 LEVEL = 1, UNILEV IMUL = 2**(UNILEV-LEVEL) LLPLN = LGRID(LEVEL) NPLNS = ISTRUC(LLPLN) NROWS = ISTRUC(LLPLN+NPLNS+1)-1 LIPLN = LLPLN+NPLNS+2 LLROW = LIPLN+NPLNS NPTS = ISTRUC(LLROW+NROWS)-1 LIROW = LLROW+NROWS+1 LICOL = LIROW+NROWS DO 20 IP = 1, NPLNS IPLN = ISTRUC(LIPLN-1+IP)*IMUL DO 30 IR = ISTRUC(LLPLN+IP), ISTRUC(LLPLN+IP+1)-1 IROW = ISTRUC(LIROW-1+IR)*IMUL DO 40 IPT = ISTRUC(LLROW-1+IR), ISTRUC(LLROW+IR)-1 ICOL = ISTRUC(LICOL-1+IPT)*IMUL DO 50 IC = 1, NPDE UNIFRM(ICOL,IROW,IPLN,IC) = + SOL(LSOL(LEVEL)+(IC-1)*NPTS+IPT) 50 CONTINUE 40 CONTINUE 30 CONTINUE 20 CONTINUE 10 CONTINUE DO 100 LEVEL = 2, UNILEV IMUL = 2**(UNILEV-LEVEL) DO 110 K = IMUL, NZ, IMUL*2 DO 110 J = 0, NY, IMUL*2 DO 110 I = 0, NX, IMUL*2 IF (UNIFRM(I,J,K,1) .EQ. NONVAL) THEN DO 120 IC = 1, NPDE UNIFRM(I,J,K,IC) = + (UNIFRM(I,J,K-IMUL,IC)+UNIFRM(I,J,K+IMUL,IC))/2 120 CONTINUE ENDIF 110 CONTINUE DO 130 K = 0, NZ, IMUL DO 130 J = IMUL, NY, IMUL*2 DO 130 I = 0, NX, IMUL*2 IF (UNIFRM(I,J,K,1) .EQ. NONVAL) THEN DO 140 IC = 1, NPDE UNIFRM(I,J,K,IC) = + (UNIFRM(I,J-IMUL,K,IC)+UNIFRM(I,J+IMUL,K,IC))/2 140 CONTINUE ENDIF 130 CONTINUE DO 150 K = 0, NZ, IMUL DO 150 J = 0, NY, IMUL DO 150 I = IMUL, NX, IMUL*2 IF (UNIFRM(I,J,K,1) .EQ. NONVAL) THEN DO 160 IC = 1, NPDE UNIFRM(I,J,K,IC) = + (UNIFRM(I-IMUL,J,K,IC)+UNIFRM(I+IMUL,J,K,IC))/2 160 CONTINUE ENDIF 150 CONTINUE 100 CONTINUE DO 170 K = 0, NZ DO 170 J = 0, NY DO 170 I = 0, NX WRITE(LUNS,'(100E13.3)') (UNIFRM(I,J,K,IC), IC = 1, NPDE) 170 CONTINUE C C Grids DO 201 IPLN = 0, NZ DO 201 IROW = 0, NY DO 201 ICOL = 0, NX UNIFRM(ICOL,IROW,IPLN,1) = 0 201 CONTINUE DO 210 LEVEL = 1, UNILEV IMUL = 2**(UNILEV-LEVEL) LLPLN = LGRID(LEVEL) NPLNS = ISTRUC(LLPLN) NROWS = ISTRUC(LLPLN+NPLNS+1)-1 LIPLN = LLPLN+NPLNS+2 LLROW = LIPLN+NPLNS NPTS = ISTRUC(LLROW+NROWS)-1 LIROW = LLROW+NROWS+1 LICOL = LIROW+NROWS DO 220 IP = 1, NPLNS IPLN = ISTRUC(LIPLN-1+IP)*IMUL DO 230 IR = ISTRUC(LLPLN+IP), ISTRUC(LLPLN+IP+1)-1 IROW = ISTRUC(LIROW-1+IR)*IMUL DO 240 IPT = ISTRUC(LLROW-1+IR), ISTRUC(LLROW+IR)-1 ICOL = ISTRUC(LICOL-1+IPT)*IMUL UNIFRM(ICOL,IROW,IPLN,1) = LEVEL 240 CONTINUE 230 CONTINUE 220 CONTINUE 210 CONTINUE DO 300 LEVEL = 2, UNILEV IMUL = 2**(UNILEV-LEVEL) DO 310 K = IMUL, NZ, IMUL*2 DO 310 J = 0, NY, IMUL*2 DO 310 I = 0, NX, IMUL*2 IF (UNIFRM(I,J,K,1) .LT. LEVEL) THEN UNIFRM(I,J,K,1) = + MIN(UNIFRM(I,J,K-IMUL,1),UNIFRM(I,J,K+IMUL,1)) ENDIF 310 CONTINUE DO 320 K = 0, NZ, IMUL DO 320 J = IMUL, NY, IMUL*2 DO 320 I = 0, NX, IMUL*2 IF (UNIFRM(I,J,K,1) .LT. LEVEL) THEN UNIFRM(I,J,K,1) = + MIN(UNIFRM(I,J-IMUL,K,1),UNIFRM(I,J+IMUL,K,1)) ENDIF 320 CONTINUE DO 330 K = 0, NZ, IMUL DO 330 J = 0, NY, IMUL DO 330 I = IMUL, NX, IMUL*2 IF (UNIFRM(I,J,K,1) .LT. LEVEL) THEN UNIFRM(I,J,K,1) = + MIN(UNIFRM(I-IMUL,J,K,1),UNIFRM(I+IMUL,J,K,1)) ENDIF 330 CONTINUE 300 CONTINUE DO 350 K = 0, NZ DO 350 J = 0, NY DO 350 I = 0, NX WRITE(LUNG,'(I2)') NINT(UNIFRM(I,J,K,1)) 350 CONTINUE RETURN END SHAR_EOF fi # end of overwriting check cd .. if test ! -d 'Sp' then mkdir 'Sp' fi cd 'Sp' if test -f 'exmpl_28' then echo shar: will not over-write existing file "'exmpl_28'" else cat << \SHAR_EOF > 'exmpl_28' Error at T=0.100E-02, level=1 : 384 0.361E-03 0.361E-03 0.361E-03 Error at T=0.100E-02, level=2 : 2126 0.361E-03 0.361E-03 0.361E-03 Error at T=0.100E-02, level=3 : 9189 0.361E-03 0.361E-03 0.361E-03 Error at T=0.100E-02, level=4 : 43645 0.362E-03 0.362E-03 0.362E-03 Error at T=0.300E-02, level=1 : 384 0.102E-02 0.102E-02 0.102E-02 Error at T=0.300E-02, level=2 : 2126 0.102E-02 0.102E-02 0.102E-02 Error at T=0.300E-02, level=3 : 9697 0.103E-02 0.103E-02 0.103E-02 Error at T=0.300E-02, level=4 : 43645 0.104E-02 0.104E-02 0.104E-02 Error at T=0.699E-02, level=1 : 384 0.206E-02 0.206E-02 0.206E-02 Error at T=0.699E-02, level=2 : 2126 0.206E-02 0.206E-02 0.206E-02 Error at T=0.699E-02, level=3 : 9697 0.209E-02 0.209E-02 0.209E-02 Error at T=0.699E-02, level=4 : 43645 0.215E-02 0.215E-02 0.215E-02 Error at T=0.149E-01, level=1 : 384 0.293E-02 0.293E-02 0.293E-02 Error at T=0.149E-01, level=2 : 2126 0.293E-02 0.293E-02 0.293E-02 Error at T=0.149E-01, level=3 : 10139 0.314E-02 0.314E-02 0.314E-02 Error at T=0.149E-01, level=4 : 46261 0.478E-02 0.478E-02 0.478E-02 Error at T=0.308E-01, level=1 : 384 0.692E-03 0.692E-03 0.692E-03 Error at T=0.308E-01, level=2 : 2126 0.857E-03 0.857E-03 0.857E-03 Error at T=0.308E-01, level=3 : 10139 0.595E-02 0.595E-02 0.595E-02 Error at T=0.308E-01, level=4 : 45947 0.959E-02 0.959E-02 0.959E-02 Error at T=0.602E-01, level=1 : 384 0.882E-02 0.883E-02 0.883E-02 Error at T=0.602E-01, level=2 : 2126 0.884E-02 0.884E-02 0.884E-02 Error at T=0.602E-01, level=3 : 10197 0.182E-01 0.182E-01 0.182E-01 Error at T=0.602E-01, level=4 : 45921 0.192E-01 0.192E-01 0.192E-01 Error at T=0.896E-01, level=1 : 384 0.141E-01 0.141E-01 0.141E-01 Error at T=0.896E-01, level=2 : 2126 0.141E-01 0.141E-01 0.141E-01 Error at T=0.896E-01, level=3 : 10197 0.161E-01 0.161E-01 0.161E-01 Error at T=0.896E-01, level=4 : 48125 0.279E-01 0.279E-01 0.279E-01 Error at T=0.119E+00, level=1 : 384 0.117E-01 0.117E-01 0.117E-01 Error at T=0.119E+00, level=2 : 2198 0.302E-01 0.302E-01 0.302E-01 Error at T=0.119E+00, level=3 : 10825 0.302E-01 0.302E-01 0.302E-01 Error at T=0.119E+00, level=4 : 52205 0.339E-01 0.339E-01 0.339E-01 Error at T=0.149E+00, level=1 : 384 0.659E-02 0.659E-02 0.659E-02 Error at T=0.149E+00, level=2 : 2318 0.215E-01 0.215E-01 0.215E-01 Error at T=0.149E+00, level=3 : 11215 0.215E-01 0.215E-01 0.215E-01 Error at T=0.149E+00, level=4 : 49905 0.387E-01 0.387E-01 0.387E-01 Error at T=0.179E+00, level=1 : 384 0.278E-02 0.278E-02 0.278E-02 Error at T=0.179E+00, level=2 : 2318 0.119E-01 0.119E-01 0.119E-01 Error at T=0.179E+00, level=3 : 11047 0.362E-01 0.362E-01 0.362E-01 Error at T=0.179E+00, level=4 : 54293 0.416E-01 0.416E-01 0.416E-01 Error at T=0.208E+00, level=1 : 384 0.239E-01 0.239E-01 0.239E-01 Error at T=0.208E+00, level=2 : 2318 0.239E-01 0.239E-01 0.239E-01 Error at T=0.208E+00, level=3 : 11303 0.239E-01 0.239E-01 0.239E-01 Error at T=0.208E+00, level=4 : 51793 0.435E-01 0.435E-01 0.435E-01 Error at T=0.236E+00, level=1 : 384 0.384E-01 0.384E-01 0.384E-01 Error at T=0.236E+00, level=2 : 2318 0.384E-01 0.384E-01 0.384E-01 Error at T=0.236E+00, level=3 : 11635 0.388E-01 0.388E-01 0.388E-01 Error at T=0.236E+00, level=4 : 56249 0.446E-01 0.446E-01 0.446E-01 Error at T=0.266E+00, level=1 : 384 0.198E-01 0.198E-01 0.198E-01 Error at T=0.266E+00, level=2 : 2318 0.210E-01 0.210E-01 0.210E-01 Error at T=0.266E+00, level=3 : 11997 0.271E-01 0.271E-01 0.271E-01 Error at T=0.266E+00, level=4 : 53359 0.454E-01 0.454E-01 0.454E-01 Error at T=0.294E+00, level=1 : 384 0.143E-01 0.143E-01 0.143E-01 Error at T=0.294E+00, level=2 : 2310 0.172E-01 0.172E-01 0.172E-01 Error at T=0.294E+00, level=3 : 11789 0.406E-01 0.406E-01 0.406E-01 Error at T=0.294E+00, level=4 : 57831 0.458E-01 0.458E-01 0.458E-01 Error at T=0.323E+00, level=1 : 384 0.233E-01 0.233E-01 0.233E-01 Error at T=0.323E+00, level=2 : 2318 0.297E-01 0.297E-01 0.297E-01 Error at T=0.323E+00, level=3 : 12215 0.302E-01 0.302E-01 0.302E-01 Error at T=0.323E+00, level=4 : 54777 0.459E-01 0.459E-01 0.459E-01 Error at T=0.351E+00, level=1 : 384 0.170E-01 0.170E-01 0.170E-01 Error at T=0.351E+00, level=2 : 2334 0.396E-01 0.396E-01 0.396E-01 Error at T=0.351E+00, level=3 : 12515 0.414E-01 0.414E-01 0.414E-01 Error at T=0.351E+00, level=4 : 59145 0.459E-01 0.459E-01 0.459E-01 Error at T=0.381E+00, level=1 : 384 0.794E-02 0.794E-02 0.794E-02 Error at T=0.381E+00, level=2 : 2358 0.175E-01 0.175E-01 0.175E-01 Error at T=0.381E+00, level=3 : 12577 0.328E-01 0.328E-01 0.328E-01 Error at T=0.381E+00, level=4 : 56612 0.456E-01 0.456E-01 0.456E-01 Error at T=0.409E+00, level=1 : 384 0.897E-02 0.897E-02 0.897E-02 Error at T=0.409E+00, level=2 : 2358 0.209E-01 0.209E-01 0.209E-01 Error at T=0.409E+00, level=3 : 12101 0.416E-01 0.416E-01 0.416E-01 Error at T=0.409E+00, level=4 : 60640 0.453E-01 0.453E-01 0.453E-01 Error at T=0.439E+00, level=1 : 384 0.324E-01 0.324E-01 0.324E-01 Error at T=0.439E+00, level=2 : 2358 0.345E-01 0.345E-01 0.345E-01 Error at T=0.439E+00, level=3 : 12717 0.352E-01 0.352E-01 0.352E-01 Error at T=0.439E+00, level=4 : 58192 0.448E-01 0.448E-01 0.448E-01 Error at T=0.467E+00, level=1 : 384 0.386E-01 0.386E-01 0.386E-01 Error at T=0.467E+00, level=2 : 2358 0.390E-01 0.390E-01 0.390E-01 Error at T=0.467E+00, level=3 : 12953 0.413E-01 0.413E-01 0.413E-01 Error at T=0.467E+00, level=4 : 61382 0.457E-01 0.457E-01 0.457E-01 Error at T=0.496E+00, level=1 : 384 0.120E-01 0.120E-01 0.120E-01 Error at T=0.496E+00, level=2 : 2358 0.137E-01 0.137E-01 0.137E-01 Error at T=0.496E+00, level=3 : 12947 0.372E-01 0.372E-01 0.372E-01 Error at T=0.496E+00, level=4 : 58684 0.459E-01 0.459E-01 0.459E-01 Error at T=0.524E+00, level=1 : 384 0.215E-01 0.215E-01 0.215E-01 Error at T=0.524E+00, level=2 : 2342 0.229E-01 0.229E-01 0.229E-01 Error at T=0.524E+00, level=3 : 12607 0.407E-01 0.407E-01 0.407E-01 Error at T=0.524E+00, level=4 : 61690 0.464E-01 0.464E-01 0.464E-01 Error at T=0.554E+00, level=1 : 384 0.235E-01 0.235E-01 0.235E-01 Error at T=0.554E+00, level=2 : 2342 0.383E-01 0.383E-01 0.383E-01 Error at T=0.554E+00, level=3 : 12967 0.390E-01 0.390E-01 0.390E-01 Error at T=0.554E+00, level=4 : 58832 0.477E-01 0.477E-01 0.477E-01 Error at T=0.582E+00, level=1 : 384 0.145E-01 0.145E-01 0.145E-01 Error at T=0.582E+00, level=2 : 2374 0.369E-01 0.369E-01 0.369E-01 Error at T=0.582E+00, level=3 : 13185 0.396E-01 0.396E-01 0.396E-01 Error at T=0.582E+00, level=4 : 61722 0.479E-01 0.479E-01 0.479E-01 Error at T=0.612E+00, level=1 : 384 0.589E-02 0.589E-02 0.589E-02 Error at T=0.612E+00, level=2 : 2374 0.924E-02 0.924E-02 0.924E-02 Error at T=0.612E+00, level=3 : 13091 0.405E-01 0.405E-01 0.405E-01 Error at T=0.612E+00, level=4 : 58634 0.492E-01 0.492E-01 0.492E-01 Error at T=0.640E+00, level=1 : 384 0.159E-01 0.159E-01 0.159E-01 Error at T=0.640E+00, level=2 : 2374 0.232E-01 0.232E-01 0.232E-01 Error at T=0.640E+00, level=3 : 12699 0.379E-01 0.379E-01 0.379E-01 Error at T=0.640E+00, level=4 : 61502 0.491E-01 0.491E-01 0.491E-01 Error at T=0.670E+00, level=1 : 384 0.381E-01 0.381E-01 0.381E-01 Error at T=0.670E+00, level=2 : 2374 0.410E-01 0.410E-01 0.410E-01 Error at T=0.670E+00, level=3 : 13012 0.417E-01 0.417E-01 0.417E-01 Error at T=0.670E+00, level=4 : 59468 0.504E-01 0.504E-01 0.504E-01 Error at T=0.697E+00, level=1 : 384 0.337E-01 0.337E-01 0.337E-01 Error at T=0.697E+00, level=2 : 2374 0.339E-01 0.339E-01 0.339E-01 Error at T=0.697E+00, level=3 : 13039 0.359E-01 0.359E-01 0.359E-01 Error at T=0.697E+00, level=4 : 61022 0.502E-01 0.502E-01 0.502E-01 Error at T=0.727E+00, level=1 : 384 0.697E-02 0.697E-02 0.697E-02 Error at T=0.727E+00, level=2 : 2374 0.775E-02 0.775E-02 0.775E-02 Error at T=0.727E+00, level=3 : 12991 0.425E-01 0.425E-01 0.425E-01 Error at T=0.727E+00, level=4 : 59854 0.514E-01 0.514E-01 0.514E-01 Error at T=0.758E+00, level=1 : 384 0.241E-01 0.241E-01 0.241E-01 Error at T=0.758E+00, level=2 : 2374 0.245E-01 0.245E-01 0.245E-01 Error at T=0.758E+00, level=3 : 12607 0.317E-01 0.317E-01 0.317E-01 Error at T=0.758E+00, level=4 : 60058 0.525E-01 0.525E-01 0.525E-01 Error at T=0.788E+00, level=1 : 384 0.208E-01 0.208E-01 0.208E-01 Error at T=0.788E+00, level=2 : 2346 0.423E-01 0.423E-01 0.423E-01 Error at T=0.788E+00, level=3 : 12869 0.438E-01 0.438E-01 0.438E-01 Error at T=0.788E+00, level=4 : 59106 0.531E-01 0.531E-01 0.531E-01 Error at T=0.818E+00, level=1 : 384 0.109E-01 0.109E-01 0.109E-01 Error at T=0.818E+00, level=2 : 2370 0.256E-01 0.256E-01 0.256E-01 Error at T=0.818E+00, level=3 : 12701 0.282E-01 0.282E-01 0.282E-01 Error at T=0.818E+00, level=4 : 58920 0.535E-01 0.535E-01 0.535E-01 Error at T=0.849E+00, level=1 : 384 0.621E-02 0.621E-02 0.621E-02 Error at T=0.849E+00, level=2 : 2370 0.146E-01 0.146E-01 0.146E-01 Error at T=0.849E+00, level=3 : 12423 0.435E-01 0.435E-01 0.435E-01 Error at T=0.849E+00, level=4 : 58046 0.527E-01 0.527E-01 0.527E-01 Error at T=0.879E+00, level=1 : 384 0.301E-01 0.301E-01 0.301E-01 Error at T=0.879E+00, level=2 : 2370 0.301E-01 0.301E-01 0.301E-01 Error at T=0.879E+00, level=3 : 12333 0.321E-01 0.321E-01 0.321E-01 Error at T=0.879E+00, level=4 : 57256 0.596E-01 0.596E-01 0.596E-01 Error at T=0.909E+00, level=1 : 384 0.394E-01 0.394E-01 0.394E-01 Error at T=0.909E+00, level=2 : 2370 0.403E-01 0.403E-01 0.403E-01 Error at T=0.909E+00, level=3 : 12531 0.414E-01 0.414E-01 0.414E-01 Error at T=0.909E+00, level=4 : 56978 0.523E-01 0.523E-01 0.523E-01 Error at T=0.939E+00, level=1 : 384 0.129E-01 0.129E-01 0.129E-01 Error at T=0.939E+00, level=2 : 2370 0.133E-01 0.133E-01 0.133E-01 Error at T=0.939E+00, level=3 : 12261 0.344E-01 0.344E-01 0.344E-01 Error at T=0.939E+00, level=4 : 54706 0.526E-01 0.526E-01 0.526E-01 Error at T=0.970E+00, level=1 : 384 0.193E-01 0.193E-01 0.193E-01 Error at T=0.970E+00, level=2 : 2354 0.206E-01 0.206E-01 0.206E-01 Error at T=0.970E+00, level=3 : 11594 0.382E-01 0.382E-01 0.382E-01 Error at T=0.970E+00, level=4 : 55409 0.506E-01 0.506E-01 0.506E-01 Error at T=0.100E+01, level=1 : 384 0.230E-01 0.230E-01 0.230E-01 Error at T=0.100E+01, level=2 : 2314 0.376E-01 0.376E-01 0.376E-01 Error at T=0.100E+01, level=3 : 11918 0.379E-01 0.379E-01 0.379E-01 Error at T=0.100E+01, level=4 : 52925 0.470E-01 0.470E-01 0.470E-01 SHAR_EOF fi # end of overwriting check if test -f 'exmpl_output' then echo shar: will not over-write existing file "'exmpl_output'" else cat << \SHAR_EOF > 'exmpl_output' Input domain: Plane: 0 ca 26 26 26 26 26 da XX XX 12 2 2 2 2 2 23 XX XX 12 2 2 2 2 2 23 XX XX 12 2 2 2 2 2 23 XX XX 12 2 2 2 2 2 23 XX XX 12 2 2 2 2 2 23 XX XX aa 25 25 25 25 25 ba XX XX Plane: 1 16 6 6 6 6 6 36 XX XX 1 .. .. .. .. .. 3 XX XX 1 .. .. .. .. .. 3 XX XX 1 .. .. .. .. .. 3 XX XX 1 .. .. .. .. .. 3 XX XX 1 .. .. .. .. .. 3 XX XX 15 5 5 5 5 5 35 XX XX Plane: 2 16 6 6 6 6 6 36 XX XX 1 .. .. .. .. .. 3 XX XX 1 .. ga 45 ha .. 3 XX XX 1 .. 34 4 14 .. 3 XX XX 1 .. ea 46 fa .. 3 XX XX 1 .. .. .. .. .. 3 XX XX 15 5 5 5 5 5 35 XX XX Plane: 3 16 6 6 6 6 6 36 XX XX 1 .. .. .. .. .. 3 XX XX 1 .. 35 5 15 .. 3 XX XX 1 .. 3 XX 1 .. 3 XX XX 1 .. 36 6 16 .. 3 XX XX 1 .. .. .. .. .. 3 XX XX 15 5 5 5 5 5 35 XX XX Plane: 4 16 6 6 6 6 6 oa 26 pa 1 .. .. .. .. .. 32 2 23 1 .. ma 25 na .. 32 2 23 1 .. 23 2 12 .. 32 2 23 1 .. ka 26 la .. 32 2 23 1 .. .. .. .. .. 32 2 23 15 5 5 5 5 5 ia 25 ja Plane: 5 16 6 6 6 6 6 6 6 36 1 .. .. .. .. .. .. .. 3 1 .. .. .. .. .. .. .. 3 1 .. .. .. .. .. .. .. 3 1 .. .. .. .. .. .. .. 3 1 .. .. .. .. .. .. .. 3 15 5 5 5 5 5 5 5 35 Plane: 6 sa 46 46 46 46 46 46 46 ta 14 4 4 4 4 4 4 4 34 14 4 4 4 4 4 4 4 34 14 4 4 4 4 4 4 4 34 14 4 4 4 4 4 4 4 34 14 4 4 4 4 4 4 4 34 qa 45 45 45 45 45 45 45 ra Legenda corners: aa: 5 2 1 ba: 5 3 2 ca: 6 2 1 da: 6 3 2 ea: 6 4 3 fa: 6 4 1 ga: 5 4 3 ha: 5 4 1 ia: 5 2 3 ja: 5 3 2 ka: 6 3 2 la: 6 2 1 ma: 5 3 2 na: 5 2 1 oa: 6 2 3 pa: 6 3 2 qa: 5 4 1 ra: 5 4 3 sa: 6 4 1 ta: 6 4 3 Max. grid level exceeded at T= 0.1000000E-02 Max. grid level exceeded at T= 0.2998000E-02 Max. grid level exceeded at T= 0.6986008E-02 Max. grid level exceeded at T= 0.1493012E-01 Max. grid level exceeded at T= 0.3081834E-01 Max. grid level exceeded at T= 0.6018748E-01 Max. grid level exceeded at T= 0.8955663E-01 Max. grid level exceeded at T= 0.1189258E+00 Max. grid level exceeded at T= 0.1493076E+00 Max. grid level exceeded at T= 0.1786419E+00 Max. grid level exceeded at T= 0.2079761E+00 Max. grid level exceeded at T= 0.2362626E+00 Max. grid level exceeded at T= 0.2656372E+00 Max. grid level exceeded at T= 0.2938819E+00 Max. grid level exceeded at T= 0.3233035E+00 Max. grid level exceeded at T= 0.3514992E+00 Max. grid level exceeded at T= 0.3809765E+00 Max. grid level exceeded at T= 0.4091139E+00 Max. grid level exceeded at T= 0.4386582E+00 Max. grid level exceeded at T= 0.4667253E+00 Max. grid level exceeded at T= 0.4963517E+00 Max. grid level exceeded at T= 0.5243321E+00 Max. grid level exceeded at T= 0.5540614E+00 Max. grid level exceeded at T= 0.5819325E+00 Max. grid level exceeded at T= 0.6117945E+00 Max. grid level exceeded at T= 0.6395235E+00 Max. grid level exceeded at T= 0.6695632E+00 Max. grid level exceeded at T= 0.6970996E+00 Max. grid level exceeded at T= 0.7273896E+00 Max. grid level exceeded at T= 0.7576797E+00 Max. grid level exceeded at T= 0.7879697E+00 Max. grid level exceeded at T= 0.8182597E+00 Max. grid level exceeded at T= 0.8485498E+00 Max. grid level exceeded at T= 0.8788398E+00 Max. grid level exceeded at T= 0.9091299E+00 Max. grid level exceeded at T= 0.9394199E+00 Max. grid level exceeded at T= 0.9697100E+00 Max. grid level exceeded at T= 0.1000000E+01 VLUGR3 returned with MNTR=1 SHAR_EOF fi # end of overwriting check if test -f 'exmpl_runinfo' then echo shar: will not over-write existing file "'exmpl_runinfo'" else cat << \SHAR_EOF > 'exmpl_runinfo' Newton: MAXNIT, MAXJAC, TOLNEW:10, 2, 1. Lin. solver matrix-free GCRO + Diag:NRRMAX, MAXLR, MAXL, TOLLSC:1, 5, 20, 0.1 Time integration at T= 0.10E-02, Grid level= 1, NPTS= 384 Nonlinear system solver at T = 0.1000000E-02 Max. and WRMS norm residual= 0.1124459E+01 0.3149425E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.1541739E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1541739E+01 1 0.3214229E-02 0.2084808E-02 2 0.1519507E-04 0.9855801E-05 Result GMRES:2, 5.E-2, 1.5195070302249E-5, 0 1 2 0.1519507E-04 0.1541862E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1519507E-04 1 0.1108865E-06 0.7297533E-02 2 0.5265803E-09 0.3465468E-04 Result GMRES:2, 5.E-2, 5.2658026808317E-10, 0 2 4 0.5265803E-09 0.1524345E-04 NI: 1, NLI: 6, ERLI 0.5265803E-09, ERNI: 0.1541862E+01 Max. and WRMS norm residual= 0.3399470E-04 0.5746859E-02 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.5735699E-05 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.5735699E-05 1 0.2499724E-07 0.4358185E-02 2 0.1323890E-09 0.2308158E-04 Result GMRES:2, 2.5E-2, 1.323889991015E-10, 0 1 2 0.1323890E-09 0.5755760E-05 NI: 2, NLI: 3, ERLI 0.1323890E-09, ERNI: 0.5755760E-05 T= 0.10E-02, LEVEL= 1 ,TOLWGT=1.0, SPCMON= 0.76E+01 Time integration at T= 0.10E-02, Grid level= 2, NPTS= 2126 Nonlinear system solver at T = 0.1000000E-02 Max. and WRMS norm residual= 0.1498061E+03 0.4882716E+05 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 6378 # it. GCRO # it.GMRES Error Estimate 0 0 0.6044390E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.6044390E+02 1 0.3880998E+00 0.6420827E-02 2 0.3679684E-02 0.6087767E-04 Result GMRES:2, 5.E-2, 3.6796835414273E-3, 0 1 2 0.3679684E-02 0.6042077E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3679684E-02 1 0.6319284E-04 0.1717344E-01 2 0.7255687E-06 0.1971824E-03 Result GMRES:2, 5.E-2, 7.2556873256907E-7, 0 2 4 0.7255687E-06 0.3679168E-02 NI: 1, NLI: 6, ERLI 0.7255687E-06, ERNI: 0.6042078E+02 Max. and WRMS norm residual= 0.1797533E+00 0.6151018E+02 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 6378 # it. GCRO # it.GMRES Error Estimate 0 0 0.6155541E-01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.6155541E-01 1 0.5503188E-03 0.8940218E-02 2 0.7565403E-05 0.1229039E-03 Result GMRES:2, 2.5E-2, 7.5654026707891E-6, 0 1 2 0.7565403E-05 0.6129839E-01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.7565403E-05 1 0.1410900E-06 0.1864936E-01 2 0.1695511E-08 0.2241138E-03 Result GMRES:2, 2.5E-2, 1.6955114957167E-9, 0 2 4 0.1695511E-08 0.7553426E-05 NI: 2, NLI: 6, ERLI 0.1695511E-08, ERNI: 0.6129839E-01 T= 0.10E-02, LEVEL= 2 ,TOLWGT=1.0, SPCMON= 0.71E+01 Time integration at T= 0.10E-02, Grid level= 3, NPTS= 9189 Nonlinear system solver at T = 0.1000000E-02 Max. and WRMS norm residual= 0.1498061E+03 0.7984853E+05 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 27567 # it. GCRO # it.GMRES Error Estimate 0 0 0.8833126E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.8833126E+02 1 0.1216322E+01 0.1377000E-01 2 0.2268013E-01 0.2567622E-03 Result GMRES:2, 5.E-2, 2.2680127671997E-2, 0 1 2 0.2268013E-01 0.8859513E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2268013E-01 1 0.6987077E-03 0.3080705E-01 2 0.2058884E-04 0.9077922E-03 Result GMRES:2, 5.E-2, 2.0588842353698E-5, 0 2 4 0.2058884E-04 0.2260235E-01 NI: 1, NLI: 6, ERLI 0.2058884E-04, ERNI: 0.8859516E+02 Max. and WRMS norm residual= 0.7511225E+00 0.2641461E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 27567 # it. GCRO # it.GMRES Error Estimate 0 0 0.2630939E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2630939E+00 1 0.4953119E-02 0.1882643E-01 2 0.1041107E-03 0.3957168E-03 Result GMRES:2, 2.5E-2, 1.0411067471585E-4, 0 1 2 0.1041107E-03 0.2612005E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1041107E-03 1 0.3236160E-05 0.3108384E-01 2 0.1013492E-06 0.9734755E-03 Result GMRES:2, 2.5E-2, 1.0134919565893E-7, 0 2 4 0.1013492E-06 0.1033925E-03 NI: 2, NLI: 6, ERLI 0.1013492E-06, ERNI: 0.2612007E+00 T= 0.10E-02, LEVEL= 3 ,TOLWGT=1.0, SPCMON= 0.44E+01 Time integration at T= 0.10E-02, Grid level= 4, NPTS= 43645 Nonlinear system solver at T = 0.1000000E-02 Max. and WRMS norm residual= 0.1599005E+03 0.1075761E+06 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 130935 # it. GCRO # it.GMRES Error Estimate 0 0 0.1084637E+03 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1084637E+03 1 0.2638250E+01 0.2432381E-01 2 0.1016732E+00 0.9373943E-03 3 0.5842191E-02 0.5386310E-04 Result GMRES:3, 5.E-2, 5.8421909696837E-3, 0 1 3 0.5842191E-02 0.1133683E+03 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.5842191E-02 1 0.3991215E-03 0.6831709E-01 2 0.2949278E-04 0.5048240E-02 3 0.2217745E-05 0.3796084E-03 Result GMRES:3, 5.E-2, 2.2177450451754E-6, 0 2 6 0.2217745E-05 0.5803110E-02 NI: 1, NLI: 8, ERLI 0.2217745E-05, ERNI: 0.1133683E+03 Max. and WRMS norm residual= 0.1046012E+01 0.3986111E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 130935 # it. GCRO # it.GMRES Error Estimate 0 0 0.3777196E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3777196E+00 1 0.1179853E-01 0.3123621E-01 2 0.4220885E-03 0.1117465E-02 3 0.2398447E-04 0.6349809E-04 Result GMRES:3, 2.5E-2, 2.3984473578658E-5, 0 1 3 0.2398447E-04 0.3887819E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2398447E-04 1 0.1666918E-05 0.6949986E-01 2 0.1284546E-06 0.5355739E-02 3 0.9566611E-08 0.3988668E-03 Result GMRES:3, 2.5E-2, 9.5666114107964E-9, 0 2 6 0.9566611E-08 0.2402875E-04 NI: 2, NLI: 8, ERLI 0.9566611E-08, ERNI: 0.3887820E+00 T= 0.10E-02, LEVEL= 4 ,TOLWGT=1.0, SPCMON= 0.14E+01 TN= 0.00E+00, DT= 0.10E-02, DTNEW= 0.20E-02, TIMMON= 0.17E-01 Time integration at T= 0.30E-02, Grid level= 1, NPTS= 384 Nonlinear system solver at T = 0.2998000E-02 Max. and WRMS norm residual= 0.6679694E+01 0.1487095E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.3498169E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3498169E+01 1 0.7861158E-02 0.2247221E-02 2 0.3485402E-04 0.9963504E-05 Result GMRES:2, 5.E-2, 3.4854015717155E-5, 0 1 2 0.3485402E-04 0.3498127E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3485402E-04 1 0.2925203E-06 0.8392730E-02 2 0.1430356E-08 0.4103848E-04 Result GMRES:2, 5.E-2, 1.4303556827874E-9, 0 2 4 0.1430356E-08 0.3486013E-04 NI: 1, NLI: 6, ERLI 0.1430356E-08, ERNI: 0.3498127E+01 Max. and WRMS norm residual= 0.1772405E-04 0.3713206E-02 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.4463737E-05 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4463737E-05 1 0.2204970E-07 0.4939741E-02 2 0.1581496E-09 0.3542986E-04 Result GMRES:2, 2.5E-2, 1.5814957647085E-10, 0 1 2 0.1581496E-09 0.4461103E-05 NI: 2, NLI: 3, ERLI 0.1581496E-09, ERNI: 0.4461103E-05 T= 0.30E-02, LEVEL= 1 ,TOLWGT=0.9, SPCMON= 0.79E+01 Time integration at T= 0.30E-02, Grid level= 2, NPTS= 2126 Nonlinear system solver at T = 0.2998000E-02 Max. and WRMS norm residual= 0.6858036E+01 0.1607871E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 6378 # it. GCRO # it.GMRES Error Estimate 0 0 0.2642043E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2642043E+01 1 0.1723589E-01 0.6523700E-02 2 0.1529727E-03 0.5789939E-04 Result GMRES:2, 5.E-2, 1.5297265826504E-4, 0 1 2 0.1529727E-03 0.2642191E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1529727E-03 1 0.2307489E-05 0.1508432E-01 2 0.2077612E-07 0.1358159E-03 Result GMRES:2, 5.E-2, 2.0776123285195E-8, 0 2 4 0.2077612E-07 0.1529910E-03 NI: 1, NLI: 6, ERLI 0.2077612E-07, ERNI: 0.2642191E+01 Max. and WRMS norm residual= 0.1946703E-03 0.6244727E-01 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 6378 # it. GCRO # it.GMRES Error Estimate 0 0 0.7501308E-04 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.7501308E-04 1 0.6569082E-06 0.8757249E-02 2 0.7570696E-08 0.1009250E-03 Result GMRES:2, 2.5E-2, 7.5706957034262E-9, 0 1 2 0.7570696E-08 0.7490112E-04 NI: 2, NLI: 3, ERLI 0.7570696E-08, ERNI: 0.7490112E-04 T= 0.30E-02, LEVEL= 2 ,TOLWGT=0.9, SPCMON= 0.74E+01 Time integration at T= 0.30E-02, Grid level= 3, NPTS= 9697 Nonlinear system solver at T = 0.2998000E-02 Max. and WRMS norm residual= 0.7079486E+01 0.2059303E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 29091 # it. GCRO # it.GMRES Error Estimate 0 0 0.2822847E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2822847E+01 1 0.3751610E-01 0.1329016E-01 2 0.5773630E-03 0.2045322E-03 Result GMRES:2, 5.E-2, 5.7736302558844E-4, 0 1 2 0.5773630E-03 0.2843847E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.5773630E-03 1 0.1297426E-04 0.2247158E-01 2 0.2611908E-06 0.4523857E-03 Result GMRES:2, 5.E-2, 2.6119076327076E-7, 0 2 4 0.2611908E-06 0.5790741E-03 NI: 1, NLI: 6, ERLI 0.2611908E-06, ERNI: 0.2843848E+01 Max. and WRMS norm residual= 0.1631281E-02 0.5585823E+00 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 29091 # it. GCRO # it.GMRES Error Estimate 0 0 0.6641720E-03 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.6641720E-03 1 0.1208770E-04 0.1819966E-01 2 0.1683984E-06 0.2535464E-03 Result GMRES:2, 2.5E-2, 1.6839840934453E-7, 0 1 2 0.1683984E-06 0.6638743E-03 NI: 2, NLI: 3, ERLI 0.1683984E-06, ERNI: 0.6638743E-03 T= 0.30E-02, LEVEL= 3 ,TOLWGT=0.9, SPCMON= 0.45E+01 Time integration at T= 0.30E-02, Grid level= 4, NPTS= 43645 Nonlinear system solver at T = 0.2998000E-02 Max. and WRMS norm residual= 0.7220855E+01 0.2867534E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 130935 # it. GCRO # it.GMRES Error Estimate 0 0 0.3479204E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3479204E+01 1 0.1026604E+00 0.2950688E-01 2 0.3767904E-02 0.1082979E-02 3 0.1107885E-03 0.3184306E-04 Result GMRES:3, 5.E-2, 1.1078849145658E-4, 0 1 3 0.1107885E-03 0.3688133E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1107885E-03 1 0.4163355E-05 0.3757931E-01 2 0.2455216E-06 0.2216129E-02 3 0.1856550E-07 0.1675760E-03 Result GMRES:3, 5.E-2, 1.8565497623487E-8, 0 2 6 0.1856550E-07 0.1149539E-03 NI: 1, NLI: 8, ERLI 0.1856550E-07, ERNI: 0.3688134E+01 Max. and WRMS norm residual= 0.3465866E-02 0.1254077E+01 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 130935 # it. GCRO # it.GMRES Error Estimate 0 0 0.1408993E-02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1408993E-02 1 0.5298778E-04 0.3760683E-01 2 0.1557883E-05 0.1105671E-02 3 0.5995917E-07 0.4255462E-04 Result GMRES:3, 2.5E-2, 5.9959170658241E-8, 0 1 3 0.5995917E-07 0.1461930E-02 NI: 2, NLI: 4, ERLI 0.5995917E-07, ERNI: 0.1461930E-02 T= 0.30E-02, LEVEL= 4 ,TOLWGT=1.0, SPCMON= 0.14E+01 TN= 0.10E-02, DT= 0.20E-02, DTNEW= 0.40E-02, TIMMON= 0.34E-01 Time integration at T= 0.70E-02, Grid level= 1, NPTS= 384 Nonlinear system solver at T = 0.6986008E-02 Max. and WRMS norm residual= 0.5662287E+01 0.1259278E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.6664062E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.6664062E+01 1 0.2940373E-01 0.4412283E-02 2 0.2313807E-03 0.3472067E-04 Result GMRES:2, 5.E-2, 2.313806919189E-4, 0 1 2 0.2313807E-03 0.6663617E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2313807E-03 1 0.3587978E-05 0.1550682E-01 2 0.3560714E-07 0.1538898E-03 Result GMRES:2, 5.E-2, 3.5607138670423E-8, 0 2 4 0.3560714E-07 0.2313639E-03 NI: 1, NLI: 6, ERLI 0.3560714E-07, ERNI: 0.6663617E+01 Max. and WRMS norm residual= 0.1701966E-03 0.3401122E-01 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.8182457E-04 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.8182457E-04 1 0.8110194E-06 0.9911685E-02 2 0.1150152E-07 0.1405631E-03 Result GMRES:2, 2.5E-2, 1.1501516953759E-8, 0 1 2 0.1150152E-07 0.8171881E-04 NI: 2, NLI: 3, ERLI 0.1150152E-07, ERNI: 0.8171881E-04 T= 0.70E-02, LEVEL= 1 ,TOLWGT=0.9, SPCMON= 0.84E+01 Time integration at T= 0.70E-02, Grid level= 2, NPTS= 2126 Nonlinear system solver at T = 0.6986008E-02 Max. and WRMS norm residual= 0.6205785E+01 0.1471313E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 6378 # it. GCRO # it.GMRES Error Estimate 0 0 0.5023487E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.5023487E+01 1 0.6508874E-01 0.1295688E-01 2 0.1155929E-02 0.2301049E-03 Result GMRES:2, 5.E-2, 1.1559290773048E-3, 0 1 2 0.1155929E-02 0.5023574E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1155929E-02 1 0.3496303E-04 0.3024669E-01 2 0.6151537E-06 0.5321726E-03 Result GMRES:2, 5.E-2, 6.1515372938912E-7, 0 2 4 0.6151537E-06 0.1155504E-02 NI: 1, NLI: 6, ERLI 0.6151537E-06, ERNI: 0.5023573E+01 Max. and WRMS norm residual= 0.9415661E-03 0.2698732E+00 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 6378 # it. GCRO # it.GMRES Error Estimate 0 0 0.6485267E-03 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.6485267E-03 1 0.1202798E-04 0.1854662E-01 2 0.2672127E-06 0.4120304E-03 Result GMRES:2, 2.5E-2, 2.6721270083242E-7, 0 1 2 0.2672127E-06 0.6464911E-03 NI: 2, NLI: 3, ERLI 0.2672127E-06, ERNI: 0.6464911E-03 T= 0.70E-02, LEVEL= 2 ,TOLWGT=0.9, SPCMON= 0.78E+01 Time integration at T= 0.70E-02, Grid level= 3, NPTS= 9697 Nonlinear system solver at T = 0.6986008E-02 Max. and WRMS norm residual= 0.6873663E+01 0.2029074E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 29091 # it. GCRO # it.GMRES Error Estimate 0 0 0.5548970E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.5548970E+01 1 0.1474788E+00 0.2657768E-01 2 0.4622567E-02 0.8330496E-03 Result GMRES:2, 5.E-2, 4.6225673990929E-3, 0 1 2 0.4622567E-02 0.5631321E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4622567E-02 1 0.2082598E-03 0.4505284E-01 2 0.8115256E-05 0.1755573E-02 3 0.4677353E-06 0.1011852E-03 Result GMRES:3, 5.E-2, 4.677352797735E-7, 0 2 5 0.4677353E-06 0.4646127E-02 NI: 1, NLI: 7, ERLI 0.4677353E-06, ERNI: 0.5631338E+01 Max. and WRMS norm residual= 0.5604899E-02 0.1911946E+01 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 29091 # it. GCRO # it.GMRES Error Estimate 0 0 0.4501528E-02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4501528E-02 1 0.1661498E-03 0.3690964E-01 2 0.4548883E-05 0.1010520E-02 3 0.2356629E-06 0.5235176E-04 Result GMRES:3, 2.5E-2, 2.3566290094811E-7, 0 1 3 0.2356629E-06 0.4496861E-02 NI: 2, NLI: 4, ERLI 0.2356629E-06, ERNI: 0.4496861E-02 T= 0.70E-02, LEVEL= 3 ,TOLWGT=0.9, SPCMON= 0.46E+01 Time integration at T= 0.70E-02, Grid level= 4, NPTS= 43645 Nonlinear system solver at T = 0.6986008E-02 Max. and WRMS norm residual= 0.7292470E+01 0.2873697E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 130935 # it. GCRO # it.GMRES Error Estimate 0 0 0.6616769E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.6616769E+01 1 0.3980325E+00 0.6015512E-01 2 0.2742805E-01 0.4145233E-02 3 0.1556384E-02 0.2352181E-03 Result GMRES:3, 5.E-2, 1.5563838703258E-3, 0 1 3 0.1556384E-02 0.7399213E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1556384E-02 1 0.1151610E-03 0.7399269E-01 2 0.1326795E-04 0.8524858E-02 3 0.1898858E-05 0.1220045E-02 4 0.2846103E-06 0.1828664E-03 Result GMRES:4, 5.E-2, 2.8461026528327E-7, 0 2 7 0.2846103E-06 0.1670898E-02 NI: 1, NLI: 9, ERLI 0.2846103E-06, ERNI: 0.7399242E+01 Max. and WRMS norm residual= 0.1223316E-01 0.4540882E+01 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 130935 # it. GCRO # it.GMRES Error Estimate 0 0 0.9585554E-02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.9585554E-02 1 0.7159389E-03 0.7468936E-01 2 0.4123686E-04 0.4301979E-02 3 0.3032751E-05 0.3163877E-03 Result GMRES:3, 2.5E-2, 3.0327510797947E-6, 0 1 3 0.3032751E-05 0.1027034E-01 NI: 2, NLI: 4, ERLI 0.3032751E-05, ERNI: 0.1027034E-01 T= 0.70E-02, LEVEL= 4 ,TOLWGT=1.0, SPCMON= 0.15E+01 TN= 0.30E-02, DT= 0.40E-02, DTNEW= 0.80E-02, TIMMON= 0.69E-01 Time integration at T= 0.15E-01, Grid level= 1, NPTS= 384 Nonlinear system solver at T = 0.1493012E-01 Max. and WRMS norm residual= 0.5735827E+01 0.1268626E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.1290660E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1290660E+02 1 0.1159595E+00 0.8984510E-02 2 0.1902845E-02 0.1474319E-03 Result GMRES:2, 5.E-2, 1.9028449334073E-3, 0 1 2 0.1902845E-02 0.1290491E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1902845E-02 1 0.6179214E-04 0.3247355E-01 2 0.1221251E-05 0.6418028E-03 Result GMRES:2, 5.E-2, 1.2212512523794E-6, 0 2 4 0.1221251E-05 0.1902221E-02 NI: 1, NLI: 6, ERLI 0.1221251E-05, ERNI: 0.1290491E+02 Max. and WRMS norm residual= 0.5280950E-03 0.1057643E+00 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.5092399E-03 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.5092399E-03 1 0.9959420E-05 0.1955742E-01 2 0.2986594E-06 0.5864807E-03 Result GMRES:2, 2.5E-2, 2.9865938457211E-7, 0 1 2 0.2986594E-06 0.5075250E-03 NI: 2, NLI: 3, ERLI 0.2986594E-06, ERNI: 0.5075250E-03 T= 0.15E-01, LEVEL= 1 ,TOLWGT=0.9, SPCMON= 0.93E+01 Time integration at T= 0.15E-01, Grid level= 2, NPTS= 2126 Nonlinear system solver at T = 0.1493012E-01 Max. and WRMS norm residual= 0.6296362E+01 0.1482320E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 6378 # it. GCRO # it.GMRES Error Estimate 0 0 0.9918091E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.9918091E+01 1 0.2633275E+00 0.2655022E-01 2 0.9407153E-02 0.9484842E-03 Result GMRES:2, 5.E-2, 9.407152966707E-3, 0 1 2 0.9407153E-02 0.9917361E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.9407153E-02 1 0.5698427E-03 0.6057547E-01 2 0.2032764E-04 0.2160871E-02 3 0.1518844E-05 0.1614563E-03 Result GMRES:3, 5.E-2, 1.518844346436E-6, 0 2 5 0.1518844E-05 0.9396756E-02 NI: 1, NLI: 7, ERLI 0.1518844E-05, ERNI: 0.9917362E+01 Max. and WRMS norm residual= 0.2847621E-02 0.9615019E+00 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 6378 # it. GCRO # it.GMRES Error Estimate 0 0 0.4621523E-02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4621523E-02 1 0.1677089E-03 0.3628866E-01 2 0.7644033E-05 0.1654007E-02 3 0.3693382E-06 0.7991698E-04 Result GMRES:3, 2.5E-2, 3.6933820057979E-7, 0 1 3 0.3693382E-06 0.4592450E-02 NI: 2, NLI: 4, ERLI 0.3693382E-06, ERNI: 0.4592450E-02 T= 0.15E-01, LEVEL= 2 ,TOLWGT=0.9, SPCMON= 0.86E+01 Time integration at T= 0.15E-01, Grid level= 3, NPTS= 10139 Nonlinear system solver at T = 0.1493012E-01 Max. and WRMS norm residual= 0.6966540E+01 0.1995953E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 30417 # it. GCRO # it.GMRES Error Estimate 0 0 0.1077048E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1077048E+02 1 0.5724043E+00 0.5314566E-01 2 0.3554577E-01 0.3300296E-02 3 0.2639364E-02 0.2450553E-03 Result GMRES:3, 5.E-2, 2.639363744577E-3, 0 1 3 0.2639364E-02 0.1108037E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2639364E-02 1 0.2713265E-03 0.1028000E+00 2 0.2985620E-04 0.1131189E-01 3 0.3541169E-05 0.1341675E-02 4 0.4534846E-06 0.1718159E-03 Result GMRES:4, 5.E-2, 4.5348458936944E-7, 0 2 7 0.4534846E-06 0.2632020E-02 NI: 1, NLI: 9, ERLI 0.4534846E-06, ERNI: 0.1108043E+02 Max. and WRMS norm residual= 0.2207549E-01 0.7125741E+01 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 30417 # it. GCRO # it.GMRES Error Estimate 0 0 0.3294299E-01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3294299E-01 1 0.2402211E-02 0.7292026E-01 2 0.1274145E-03 0.3867728E-02 3 0.1283613E-04 0.3896467E-03 Result GMRES:3, 2.5E-2, 1.2836125066316E-5, 0 1 3 0.1283613E-04 0.3282515E-01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1283613E-04 1 0.1664932E-05 0.1297067E+00 2 0.1994751E-06 0.1554013E-01 3 0.2086637E-07 0.1625597E-02 4 0.2797383E-08 0.2179305E-03 Result GMRES:4, 2.5E-2, 2.7973825909329E-9, 0 2 7 0.2797383E-08 0.1270319E-04 NI: 2, NLI: 9, ERLI 0.2797383E-08, ERNI: 0.3282570E-01 T= 0.15E-01, LEVEL= 3 ,TOLWGT=0.9, SPCMON= 0.47E+01 Time integration at T= 0.15E-01, Grid level= 4, NPTS= 46261 Nonlinear system solver at T = 0.1493012E-01 Max. and WRMS norm residual= 0.7403778E+01 0.2804252E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 138783 # it. GCRO # it.GMRES Error Estimate 0 0 0.1175952E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1175952E+02 1 0.1446634E+01 0.1230182E+00 2 0.1773570E+00 0.1508200E-01 3 0.1894668E-01 0.1611179E-02 4 0.2685557E-02 0.2283731E-03 Result GMRES:4, 5.E-2, 2.6855574579229E-3, 0 1 4 0.2685557E-02 0.1445289E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2685557E-02 1 0.5930167E-03 0.2208170E+00 2 0.1527552E-03 0.5688027E-01 3 0.4060618E-04 0.1512020E-01 4 0.1100561E-04 0.4098073E-02 5 0.3106769E-05 0.1156843E-02 6 0.8704690E-06 0.3241297E-03 Result GMRES:6, 5.E-2, 8.7046901571721E-7, 0 2 10 0.8704690E-06 0.2917628E-02 NI: 1, NLI: 12, ERLI 0.8704690E-06, ERNI: 0.1445295E+02 Max. and WRMS norm residual= 0.4576897E-01 0.1695355E+02 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 138783 # it. GCRO # it.GMRES Error Estimate 0 0 0.6385998E-01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.6385998E-01 1 0.9315959E-02 0.1458810E+00 2 0.1021812E-02 0.1600082E-01 3 0.1375246E-03 0.2153534E-02 4 0.2479614E-04 0.3882893E-03 Result GMRES:4, 2.5E-2, 2.4796143398306E-5, 0 1 4 0.2479614E-04 0.7217828E-01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2479614E-04 1 0.5986901E-05 0.2414449E+00 2 0.1601885E-05 0.6460219E-01 3 0.4361369E-06 0.1758890E-01 4 0.1048182E-06 0.4227197E-02 5 0.3064172E-07 0.1235745E-02 6 0.7658931E-08 0.3088759E-03 Result GMRES:6, 2.5E-2, 7.6589313801354E-9, 0 2 10 0.7658931E-08 0.2601495E-04 NI: 2, NLI: 12, ERLI 0.7658931E-08, ERNI: 0.7217852E-01 T= 0.15E-01, LEVEL= 4 ,TOLWGT=1.0, SPCMON= 0.16E+01 TN= 0.70E-02, DT= 0.79E-02, DTNEW= 0.16E-01, TIMMON= 0.13E+00 Time integration at T= 0.31E-01, Grid level= 1, NPTS= 384 Nonlinear system solver at T = 0.3081834E-01 Max. and WRMS norm residual= 0.5764491E+01 0.1264748E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.2324619E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2324619E+02 1 0.4441912E+00 0.1910813E-01 2 0.1659881E-01 0.7140443E-03 Result GMRES:2, 5.E-2, 1.6598810665497E-2, 0 1 2 0.1659881E-01 0.2323663E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1659881E-01 1 0.1192257E-02 0.7182787E-01 2 0.4553130E-04 0.2743046E-02 3 0.2494706E-05 0.1502942E-03 Result GMRES:3, 5.E-2, 2.494705549279E-6, 0 2 5 0.2494706E-05 0.1656782E-01 NI: 1, NLI: 7, ERLI 0.2494706E-05, ERNI: 0.2323663E+02 Max. and WRMS norm residual= 0.1093260E-02 0.2875341E+00 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.2797114E-02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2797114E-02 1 0.9818527E-04 0.3510235E-01 2 0.6643859E-05 0.2375255E-02 3 0.2677258E-06 0.9571501E-04 Result GMRES:3, 2.5E-2, 2.6772577701967E-7, 0 1 3 0.2677258E-06 0.2786058E-02 NI: 2, NLI: 4, ERLI 0.2677258E-06, ERNI: 0.2786058E-02 T= 0.31E-01, LEVEL= 1 ,TOLWGT=0.9, SPCMON= 0.11E+02 Time integration at T= 0.31E-01, Grid level= 2, NPTS= 2126 Nonlinear system solver at T = 0.3081834E-01 Max. and WRMS norm residual= 0.6358529E+01 0.1486051E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 6378 # it. GCRO # it.GMRES Error Estimate 0 0 0.1901010E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1901010E+02 1 0.1072309E+01 0.5640735E-01 2 0.7818092E-01 0.4112600E-02 3 0.6895818E-02 0.3627450E-03 Result GMRES:3, 5.E-2, 6.8958178789433E-3, 0 1 3 0.6895818E-02 0.1898081E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.6895818E-02 1 0.8752862E-03 0.1269300E+00 2 0.1060300E-03 0.1537598E-01 3 0.1226654E-04 0.1778838E-02 4 0.1710818E-05 0.2480950E-03 Result GMRES:4, 5.E-2, 1.7108178509344E-6, 0 2 7 0.1710818E-05 0.6804531E-02 NI: 1, NLI: 9, ERLI 0.1710818E-05, ERNI: 0.1898089E+02 Max. and WRMS norm residual= 0.1221436E-01 0.4227724E+01 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 6378 # it. GCRO # it.GMRES Error Estimate 0 0 0.4134768E-01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4134768E-01 1 0.2821980E-02 0.6825002E-01 2 0.2307720E-03 0.5581256E-02 3 0.2340319E-04 0.5660097E-03 Result GMRES:3, 2.5E-2, 2.3403187526772E-5, 0 1 3 0.2340319E-04 0.4124103E-01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2340319E-04 1 0.3710110E-05 0.1585301E+00 2 0.4276349E-06 0.1827251E-01 3 0.4866180E-07 0.2079281E-02 4 0.7114685E-08 0.3040050E-03 Result GMRES:4, 2.5E-2, 7.1146851954198E-9, 0 2 7 0.7114685E-08 0.2310292E-04 NI: 2, NLI: 9, ERLI 0.7114685E-08, ERNI: 0.4124149E-01 T= 0.31E-01, LEVEL= 2 ,TOLWGT=0.9, SPCMON= 0.98E+01 Time integration at T= 0.31E-01, Grid level= 3, NPTS= 10139 Nonlinear system solver at T = 0.3081834E-01 Max. and WRMS norm residual= 0.7020894E+01 0.2018742E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 30417 # it. GCRO # it.GMRES Error Estimate 0 0 0.2142167E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2142167E+02 1 0.2273024E+01 0.1061087E+00 2 0.2816553E+00 0.1314815E-01 3 0.3957862E-01 0.1847598E-02 4 0.6753616E-02 0.3152703E-03 Result GMRES:4, 5.E-2, 6.7536161591097E-3, 0 1 4 0.6753616E-02 0.2256906E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.6753616E-02 1 0.1806652E-02 0.2675089E+00 2 0.3941858E-03 0.5836662E-01 3 0.7374272E-04 0.1091900E-01 4 0.2010492E-04 0.2976912E-02 5 0.4880640E-05 0.7226706E-03 Result GMRES:5, 5.E-2, 4.8806397820415E-6, 0 2 9 0.4880640E-05 0.6618193E-02 NI: 1, NLI: 11, ERLI 0.4880640E-05, ERNI: 0.2256928E+02 Max. and WRMS norm residual= 0.9319569E-01 0.3060590E+02 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 30417 # it. GCRO # it.GMRES Error Estimate 0 0 0.2775579E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2775579E+00 1 0.3849753E-01 0.1387009E+00 2 0.3603147E-02 0.1298160E-01 3 0.7045501E-03 0.2538389E-02 4 0.1458523E-03 0.5254841E-03 Result GMRES:4, 2.5E-2, 1.4585227793396E-4, 0 1 4 0.1458523E-03 0.2735942E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1458523E-03 1 0.4218889E-04 0.2892576E+00 2 0.9959502E-05 0.6828486E-01 3 0.1915965E-05 0.1313634E-01 4 0.5129139E-06 0.3516667E-02 5 0.1436538E-06 0.9849265E-03 Result GMRES:5, 2.5E-2, 1.436537737585E-7, 0 2 9 0.1436538E-06 0.1412912E-03 NI: 2, NLI: 11, ERLI 0.1436538E-06, ERNI: 0.2735971E+00 T= 0.31E-01, LEVEL= 3 ,TOLWGT=0.9, SPCMON= 0.43E+01 Time integration at T= 0.31E-01, Grid level= 4, NPTS= 45947 Nonlinear system solver at T = 0.3081834E-01 Max. and WRMS norm residual= 0.7434306E+01 0.2840474E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 137841 # it. GCRO # it.GMRES Error Estimate 0 0 0.2057532E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2057532E+02 1 0.5037380E+01 0.2448263E+00 2 0.1033589E+01 0.5023443E-01 3 0.2017325E+00 0.9804586E-02 4 0.5368528E-01 0.2609208E-02 5 0.2037261E-01 0.9901480E-03 Result GMRES:5, 5.E-2, 2.03726125955E-2, 0 1 5 0.2037261E-01 0.2943704E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2037261E-01 1 0.8921336E-02 0.4379083E+00 2 0.3668731E-02 0.1800815E+00 3 0.1583779E-02 0.7774060E-01 4 0.7079782E-03 0.3475147E-01 5 0.3185523E-03 0.1563630E-01 6 0.1385698E-03 0.6801768E-02 7 0.6245075E-04 0.3065427E-02 8 0.2771920E-04 0.1360611E-02 9 0.1259791E-04 0.6183748E-03 Result GMRES:9, 5.E-2, 1.2597911120737E-5, 0 2 14 0.1259791E-04 0.2338381E-01 NI: 1, NLI: 16, ERLI 0.1259791E-04, ERNI: 0.2943765E+02 Max. and WRMS norm residual= 0.1739682E+00 0.6780495E+02 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 137841 # it. GCRO # it.GMRES Error Estimate 0 0 0.4222300E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4222300E+00 1 0.1159593E+00 0.2746353E+00 2 0.2287891E-01 0.5418590E-01 3 0.5213941E-02 0.1234858E-01 4 0.1477110E-02 0.3498353E-02 5 0.5713683E-03 0.1353216E-02 6 0.2389513E-03 0.5659268E-03 Result GMRES:6, 2.5E-2, 2.3895128458059E-4, 0 1 6 0.2389513E-03 0.5167810E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2389513E-03 1 0.1083262E-03 0.4533399E+00 2 0.4769780E-04 0.1996131E+00 3 0.2023936E-04 0.8470078E-01 4 0.8469498E-05 0.3544445E-01 5 0.4010930E-05 0.1678555E-01 6 0.1572670E-05 0.6581552E-02 7 0.7149702E-06 0.2992117E-02 8 0.3151091E-06 0.1318717E-02 9 0.1403526E-06 0.5873692E-03 Result GMRES:9, 2.5E-2, 1.4035263271403E-7, 0 2 15 0.1403526E-06 0.2732245E-03 NI: 2, NLI: 17, ERLI 0.1403526E-06, ERNI: 0.5167889E+00 T= 0.31E-01, LEVEL= 4 ,TOLWGT=1.0, SPCMON= 0.15E+01 TN= 0.15E-01, DT= 0.16E-01, DTNEW= 0.29E-01, TIMMON= 0.27E+00 Time integration at T= 0.60E-01, Grid level= 1, NPTS= 384 Nonlinear system solver at T = 0.6018748E-01 Max. and WRMS norm residual= 0.5378858E+01 0.1176004E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.3209641E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3209641E+02 1 0.1429305E+01 0.4453161E-01 2 0.1265592E+00 0.3943095E-02 3 0.1457459E-01 0.4540879E-03 Result GMRES:3, 5.E-2, 1.4574593279158E-2, 0 1 3 0.1457459E-01 0.3197476E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1457459E-01 1 0.1659704E-02 0.1138765E+00 2 0.1675979E-03 0.1149932E-01 3 0.1204160E-04 0.8262050E-03 Result GMRES:3, 5.E-2, 1.2041602533659E-5, 0 2 6 0.1204160E-04 0.1429537E-01 NI: 1, NLI: 8, ERLI 0.1204160E-04, ERNI: 0.3197503E+02 Max. and WRMS norm residual= 0.4268505E-02 0.1135475E+01 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.2141427E-01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2141427E-01 1 0.1440168E-02 0.6725273E-01 2 0.1493205E-03 0.6972943E-02 3 0.1404596E-04 0.6559158E-03 Result GMRES:3, 2.5E-2, 1.4045959167007E-5, 0 1 3 0.1404596E-04 0.2144781E-01 NI: 2, NLI: 4, ERLI 0.1404596E-04, ERNI: 0.2144781E-01 T= 0.60E-01, LEVEL= 1 ,TOLWGT=0.9, SPCMON= 0.13E+02 Time integration at T= 0.60E-01, Grid level= 2, NPTS= 2126 Nonlinear system solver at T = 0.6018748E-01 Max. and WRMS norm residual= 0.5967104E+01 0.1416428E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 6378 # it. GCRO # it.GMRES Error Estimate 0 0 0.3240911E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3240911E+02 1 0.3690411E+01 0.1138696E+00 2 0.5321246E+00 0.1641898E-01 3 0.9174137E-01 0.2830728E-02 4 0.2004652E-01 0.6185457E-03 Result GMRES:4, 5.E-2, 2.0046515162702E-2, 0 1 4 0.2004652E-01 0.3182285E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2004652E-01 1 0.6333469E-02 0.3159386E+00 2 0.1271146E-02 0.6340983E-01 3 0.2717821E-03 0.1355757E-01 4 0.5716008E-04 0.2851372E-02 5 0.1476800E-04 0.7366865E-03 Result GMRES:5, 5.E-2, 1.4767997926773E-5, 0 2 9 0.1476800E-04 0.1899201E-01 NI: 1, NLI: 11, ERLI 0.1476800E-04, ERNI: 0.3182315E+02 Max. and WRMS norm residual= 0.7766468E-01 0.2274903E+02 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 6378 # it. GCRO # it.GMRES Error Estimate 0 0 0.4389497E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4389497E+00 1 0.5184035E-01 0.1181009E+00 2 0.7778408E-02 0.1772050E-01 3 0.1486727E-02 0.3387010E-02 4 0.3394593E-03 0.7733445E-03 Result GMRES:4, 2.5E-2, 3.3945934348859E-4, 0 1 4 0.3394593E-03 0.4360270E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3394593E-03 1 0.1087143E-03 0.3202571E+00 2 0.2376481E-04 0.7000783E-01 3 0.4564430E-05 0.1344617E-01 4 0.9569511E-06 0.2819045E-02 5 0.2462015E-06 0.7252754E-03 Result GMRES:5, 2.5E-2, 2.4620150414091E-7, 0 2 9 0.2462015E-06 0.3172190E-03 NI: 2, NLI: 11, ERLI 0.2462015E-06, ERNI: 0.4360269E+00 T= 0.60E-01, LEVEL= 2 ,TOLWGT=0.9, SPCMON= 0.12E+02 Time integration at T= 0.60E-01, Grid level= 3, NPTS= 10197 Nonlinear system solver at T = 0.6018748E-01 Max. and WRMS norm residual= 0.6489043E+01 0.2028012E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 30591 # it. GCRO # it.GMRES Error Estimate 0 0 0.3960499E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3960499E+02 1 0.7809390E+01 0.1971820E+00 2 0.1760918E+01 0.4446202E-01 3 0.4526357E+00 0.1142876E-01 4 0.1325172E+00 0.3345971E-02 5 0.5315464E-01 0.1342120E-02 6 0.1891556E-01 0.4776055E-03 Result GMRES:6, 5.E-2, 1.8915561510172E-2, 0 1 6 0.1891556E-01 0.4287451E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1891556E-01 1 0.8490069E-02 0.4488405E+00 2 0.3630531E-02 0.1919336E+00 3 0.1163380E-02 0.6150388E-01 4 0.4914608E-03 0.2598183E-01 5 0.2055754E-03 0.1086806E-01 6 0.8327926E-04 0.4402685E-02 7 0.3449667E-04 0.1823719E-02 8 0.1391211E-04 0.7354850E-03 Result GMRES:8, 5.E-2, 1.3912111010478E-5, 0 2 14 0.1391211E-04 0.1817698E-01 NI: 1, NLI: 16, ERLI 0.1391211E-04, ERNI: 0.4287552E+02 Max. and WRMS norm residual= 0.4150674E+00 0.1129826E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 30591 # it. GCRO # it.GMRES Error Estimate 0 0 0.1872420E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1872420E+01 1 0.4612003E+00 0.2463124E+00 2 0.6772357E-01 0.3616900E-01 3 0.2223670E-01 0.1187591E-01 4 0.8201534E-02 0.4380178E-02 5 0.3047100E-02 0.1627359E-02 6 0.1093114E-02 0.5837975E-03 Result GMRES:6, 2.5E-2, 1.0931142161291E-3, 0 1 6 0.1093114E-02 0.1702481E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1093114E-02 1 0.5154420E-03 0.4715353E+00 2 0.2134639E-03 0.1952805E+00 3 0.8026851E-04 0.7343104E-01 4 0.3226331E-04 0.2951504E-01 5 0.1216240E-04 0.1112637E-01 6 0.5461847E-05 0.4996593E-02 7 0.2089865E-05 0.1911845E-02 8 0.8797839E-06 0.8048417E-03 Result GMRES:8, 2.5E-2, 8.7978393274778E-7, 0 2 14 0.8797839E-06 0.1025539E-02 NI: 2, NLI: 16, ERLI 0.8797839E-06, ERNI: 0.1702525E+01 T= 0.60E-01, LEVEL= 3 ,TOLWGT=0.9, SPCMON= 0.62E+01 Time integration at T= 0.60E-01, Grid level= 4, NPTS= 45921 Nonlinear system solver at T = 0.6018748E-01 Max. and WRMS norm residual= 0.7698432E+01 0.2850879E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 137763 # it. GCRO # it.GMRES Error Estimate 0 0 0.3222994E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3222994E+02 1 0.1289702E+02 0.4001565E+00 2 0.4167932E+01 0.1293187E+00 3 0.1342410E+01 0.4165102E-01 4 0.5907831E+00 0.1833026E-01 5 0.3274091E+00 0.1015854E-01 6 0.1852641E+00 0.5748201E-02 7 0.1051653E+00 0.3262969E-02 8 0.6196250E-01 0.1922514E-02 9 0.3676024E-01 0.1140562E-02 10 0.2175574E-01 0.6750166E-03 Result GMRES:10, 5.E-2, 2.175574276941E-2, 0 1 10 0.2175574E-01 0.5535551E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2175574E-01 1 0.1362685E-01 0.6263566E+00 2 0.8103289E-02 0.3724667E+00 3 0.4941059E-02 0.2271152E+00 4 0.3058879E-02 0.1406010E+00 5 0.1889967E-02 0.8687212E-01 6 0.1154023E-02 0.5304453E-01 7 0.7162187E-03 0.3292090E-01 8 0.4321226E-03 0.1986246E-01 9 0.2684095E-03 0.1233741E-01 10 0.1627361E-03 0.7480143E-02 11 0.1011022E-03 0.4647149E-02 12 0.6192874E-04 0.2846547E-02 13 0.3847387E-04 0.1768447E-02 14 0.2377093E-04 0.1092628E-02 15 0.1478567E-04 0.6796214E-03 Result GMRES:15, 5.E-2, 1.478566809795E-5, 0 2 25 0.1478567E-04 0.3088503E-01 NI: 1, NLI: 27, ERLI 0.1478567E-04, ERNI: 0.5535622E+02 Max. and WRMS norm residual= 0.6325260E+00 0.2287117E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 137763 # it. GCRO # it.GMRES Error Estimate 0 0 0.2044927E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2044927E+01 1 0.9220082E+00 0.4508757E+00 2 0.2846200E+00 0.1391834E+00 3 0.9934659E-01 0.4858196E-01 4 0.3800168E-01 0.1858339E-01 5 0.2031796E-01 0.9935784E-02 6 0.1160583E-01 0.5675425E-02 7 0.6195433E-02 0.3029659E-02 8 0.3597076E-02 0.1759024E-02 9 0.2123484E-02 0.1038415E-02 10 0.1210657E-02 0.5920293E-03 Result GMRES:10, 2.5E-2, 1.2106568471142E-3, 0 1 10 0.1210657E-02 0.2741993E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1210657E-02 1 0.7537288E-03 0.6225784E+00 2 0.4500380E-03 0.3717304E+00 3 0.2697883E-03 0.2228446E+00 4 0.1659861E-03 0.1371042E+00 5 0.1021919E-03 0.8441033E-01 6 0.6090235E-04 0.5030521E-01 7 0.3803005E-04 0.3141274E-01 8 0.2291557E-04 0.1892821E-01 9 0.1431940E-04 0.1182780E-01 10 0.8789497E-05 0.7260106E-02 11 0.5495307E-05 0.4539112E-02 12 0.3423617E-05 0.2827901E-02 13 0.2147294E-05 0.1773660E-02 14 0.1350594E-05 0.1115587E-02 15 0.8520573E-06 0.7037976E-03 Result GMRES:15, 2.5E-2, 8.5205734823787E-7, 0 2 25 0.8520573E-06 0.1739394E-02 NI: 2, NLI: 27, ERLI 0.8520573E-06, ERNI: 0.2742110E+01 T= 0.60E-01, LEVEL= 4 ,TOLWGT=1.0, SPCMON= 0.17E+01 TN= 0.31E-01, DT= 0.29E-01, DTNEW= 0.29E-01, TIMMON= 0.50E+00 Time integration at T= 0.90E-01, Grid level= 1, NPTS= 384 Nonlinear system solver at T = 0.8955663E-01 Max. and WRMS norm residual= 0.3352644E+01 0.7634225E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.1926393E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1926393E+02 1 0.1229011E+01 0.6379857E-01 2 0.1340471E+00 0.6958448E-02 3 0.1774620E-01 0.9212135E-03 Result GMRES:3, 5.E-2, 1.7746195597951E-2, 0 1 3 0.1774620E-01 0.1884493E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1774620E-01 1 0.2227647E-02 0.1255281E+00 2 0.2864297E-03 0.1614034E-01 3 0.2375654E-04 0.1338683E-02 4 0.2382643E-05 0.1342622E-03 Result GMRES:4, 5.E-2, 2.3826432893059E-6, 0 2 7 0.2382643E-05 0.1734959E-01 NI: 1, NLI: 9, ERLI 0.2382643E-05, ERNI: 0.1884558E+02 Max. and WRMS norm residual= 0.4864519E-02 0.9774059E+00 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.2047901E-01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2047901E-01 1 0.1889793E-02 0.9227951E-01 2 0.2136946E-03 0.1043481E-01 3 0.2456507E-04 0.1199524E-02 4 0.2549053E-05 0.1244715E-03 Result GMRES:4, 2.5E-2, 2.5490529144496E-6, 0 1 4 0.2549053E-05 0.1999091E-01 NI: 2, NLI: 5, ERLI 0.2549053E-05, ERNI: 0.1999091E-01 T= 0.90E-01, LEVEL= 1 ,TOLWGT=0.9, SPCMON= 0.17E+02 Time integration at T= 0.90E-01, Grid level= 2, NPTS= 2126 Nonlinear system solver at T = 0.8955663E-01 Max. and WRMS norm residual= 0.3460483E+01 0.1095579E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 6378 # it. GCRO # it.GMRES Error Estimate 0 0 0.3247868E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3247868E+02 1 0.3949376E+01 0.1215990E+00 2 0.6281230E+00 0.1933955E-01 3 0.1317157E+00 0.4055452E-02 4 0.2827535E-01 0.8705818E-03 Result GMRES:4, 5.E-2, 2.827534873084E-2, 0 1 4 0.2827535E-01 0.3111160E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2827535E-01 1 0.9315084E-02 0.3294419E+00 2 0.2180649E-02 0.7712192E-01 3 0.5433915E-03 0.1921785E-01 4 0.1223302E-03 0.4326390E-02 5 0.3417275E-04 0.1208570E-02 6 0.7683044E-05 0.2717223E-03 Result GMRES:6, 5.E-2, 7.6830435429613E-6, 0 2 10 0.7683044E-05 0.2552616E-01 NI: 1, NLI: 12, ERLI 0.7683044E-05, ERNI: 0.3111289E+02 Max. and WRMS norm residual= 0.9230198E-01 0.2469442E+02 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 6378 # it. GCRO # it.GMRES Error Estimate 0 0 0.5483972E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.5483972E+00 1 0.7146314E-01 0.1303127E+00 2 0.1196892E-01 0.2182527E-01 3 0.2516140E-02 0.4588171E-02 4 0.6630769E-03 0.1209118E-02 5 0.1749414E-03 0.3190048E-03 Result GMRES:5, 2.5E-2, 1.7494135193127E-4, 0 1 5 0.1749414E-03 0.5212012E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1749414E-03 1 0.5834314E-04 0.3335011E+00 2 0.1569013E-04 0.8968796E-01 3 0.3405294E-05 0.1946535E-01 4 0.7596115E-06 0.4342092E-02 5 0.1714091E-06 0.9798088E-03 Result GMRES:5, 2.5E-2, 1.714090771864E-7, 0 2 10 0.1714091E-06 0.1643683E-03 NI: 2, NLI: 12, ERLI 0.1714091E-06, ERNI: 0.5212063E+00 T= 0.90E-01, LEVEL= 2 ,TOLWGT=0.9, SPCMON= 0.15E+02 Time integration at T= 0.90E-01, Grid level= 3, NPTS= 10197 Nonlinear system solver at T = 0.8955663E-01 Max. and WRMS norm residual= 0.6805786E+01 0.1919140E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 30591 # it. GCRO # it.GMRES Error Estimate 0 0 0.4057420E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4057420E+02 1 0.9622232E+01 0.2371515E+00 2 0.2158013E+01 0.5318683E-01 3 0.6299890E+00 0.1552684E-01 4 0.2033626E+00 0.5012115E-02 5 0.8491779E-01 0.2092901E-02 6 0.3517086E-01 0.8668282E-03 Result GMRES:6, 5.E-2, 3.5170862886021E-2, 0 1 6 0.3517086E-01 0.4415708E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3517086E-01 1 0.1730518E-01 0.4920318E+00 2 0.7657447E-02 0.2177213E+00 3 0.2773279E-02 0.7885160E-01 4 0.1207777E-02 0.3434027E-01 5 0.5394351E-03 0.1533756E-01 6 0.2373596E-03 0.6748758E-02 7 0.9719047E-04 0.2763380E-02 8 0.4491581E-04 0.1277074E-02 9 0.1922506E-04 0.5466190E-03 Result GMRES:9, 5.E-2, 1.9225061289657E-5, 0 2 15 0.1922506E-04 0.3307245E-01 NI: 1, NLI: 17, ERLI 0.1922506E-04, ERNI: 0.4415937E+02 Max. and WRMS norm residual= 0.3101784E+00 0.1024552E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 30591 # it. GCRO # it.GMRES Error Estimate 0 0 0.1779770E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1779770E+01 1 0.5288687E+00 0.2971557E+00 2 0.8641394E-01 0.4855343E-01 3 0.3063543E-01 0.1721314E-01 4 0.1126268E-01 0.6328165E-02 5 0.5017070E-02 0.2818943E-02 6 0.1859158E-02 0.1044606E-02 7 0.7841045E-03 0.4405651E-03 Result GMRES:7, 2.5E-2, 7.8410446924283E-4, 0 1 7 0.7841045E-03 0.1726652E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.7841045E-03 1 0.4032777E-03 0.5143163E+00 2 0.1728871E-03 0.2204899E+00 3 0.6846096E-04 0.8731102E-01 4 0.3144939E-04 0.4010867E-01 5 0.1267189E-04 0.1616097E-01 6 0.6013067E-05 0.7668706E-02 7 0.2564138E-05 0.3270149E-02 8 0.1197481E-05 0.1527196E-02 9 0.5278434E-06 0.6731799E-03 Result GMRES:9, 2.5E-2, 5.2784339391671E-7, 0 2 16 0.5278434E-06 0.7338152E-03 NI: 2, NLI: 18, ERLI 0.5278434E-06, ERNI: 0.1726693E+01 T= 0.90E-01, LEVEL= 3 ,TOLWGT=0.9, SPCMON= 0.45E+01 Time integration at T= 0.90E-01, Grid level= 4, NPTS= 48125 Nonlinear system solver at T = 0.8955663E-01 Max. and WRMS norm residual= 0.7067417E+01 0.2588655E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 144375 # it. GCRO # it.GMRES Error Estimate 0 0 0.3107398E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3107398E+02 1 0.1323329E+02 0.4258641E+00 2 0.4777901E+01 0.1537589E+00 3 0.1707807E+01 0.5495938E-01 4 0.7992632E+00 0.2572130E-01 5 0.4719711E+00 0.1518862E-01 6 0.2764752E+00 0.8897320E-02 7 0.1637255E+00 0.5268895E-02 8 0.1011142E+00 0.3253983E-02 9 0.6232357E-01 0.2005651E-02 10 0.3839448E-01 0.1235583E-02 11 0.2424833E-01 0.7803417E-03 Result GMRES:11, 5.E-2, 2.4248326068424E-2, 0 1 11 0.2424833E-01 0.5488843E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2424833E-01 1 0.1583856E-01 0.6531817E+00 2 0.9826183E-02 0.4052314E+00 3 0.6245703E-02 0.2575725E+00 4 0.4034136E-02 0.1663676E+00 5 0.2588591E-02 0.1067534E+00 6 0.1655840E-02 0.6828678E-01 7 0.1072106E-02 0.4421359E-01 8 0.6691504E-03 0.2759573E-01 9 0.4339353E-03 0.1789547E-01 10 0.2721147E-03 0.1122200E-01 11 0.1762656E-03 0.7269186E-02 12 0.1119514E-03 0.4616871E-02 13 0.7241488E-04 0.2986387E-02 14 0.4636593E-04 0.1912129E-02 15 0.3000821E-04 0.1237537E-02 16 0.1931400E-04 0.7965087E-03 Result GMRES:16, 5.E-2, 1.9314003129202E-5, 0 2 27 0.1931400E-04 0.3605488E-01 NI: 1, NLI: 29, ERLI 0.1931400E-04, ERNI: 0.5488905E+02 Max. and WRMS norm residual= 0.6682876E+00 0.2253317E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 144375 # it. GCRO # it.GMRES Error Estimate 0 0 0.2112362E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2112362E+01 1 0.1018012E+01 0.4819306E+00 2 0.3390127E+00 0.1604899E+00 3 0.1278505E+00 0.6052490E-01 4 0.5247875E-01 0.2484364E-01 5 0.2993688E-01 0.1417223E-01 6 0.1764738E-01 0.8354337E-02 7 0.9779868E-02 0.4629826E-02 8 0.5981741E-02 0.2831778E-02 9 0.3604892E-02 0.1706569E-02 10 0.2141994E-02 0.1014028E-02 11 0.1342701E-02 0.6356394E-03 Result GMRES:11, 2.5E-2, 1.3427005131495E-3, 0 1 11 0.1342701E-02 0.2874301E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1342701E-02 1 0.8723872E-03 0.6497259E+00 2 0.5355828E-03 0.3988847E+00 3 0.3338665E-03 0.2486530E+00 4 0.2155814E-03 0.1605581E+00 5 0.1353647E-03 0.1008153E+00 6 0.8501558E-04 0.6331686E-01 7 0.5468613E-04 0.4072846E-01 8 0.3399924E-04 0.2532154E-01 9 0.2207190E-04 0.1643844E-01 10 0.1403787E-04 0.1045495E-01 11 0.9132101E-05 0.6801294E-02 12 0.5886924E-05 0.4384391E-02 13 0.3841207E-05 0.2860807E-02 14 0.2504377E-05 0.1865179E-02 15 0.1640743E-05 0.1221973E-02 16 0.1078820E-05 0.8034702E-03 Result GMRES:16, 2.5E-2, 1.0788198842708E-6, 0 2 27 0.1078820E-05 0.2000066E-02 NI: 2, NLI: 29, ERLI 0.1078820E-05, ERNI: 0.2874463E+01 T= 0.90E-01, LEVEL= 4 ,TOLWGT=1.0, SPCMON= 0.18E+01 TN= 0.60E-01, DT= 0.29E-01, DTNEW= 0.30E-01, TIMMON= 0.49E+00 Time integration at T= 0.12E+00, Grid level= 1, NPTS= 384 Nonlinear system solver at T = 0.1189258E+00 Max. and WRMS norm residual= 0.1044796E+01 0.2625846E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.7460691E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.7460691E+01 1 0.4894829E+00 0.6560825E-01 2 0.4739003E-01 0.6351962E-02 3 0.6987218E-02 0.9365376E-03 Result GMRES:3, 5.E-2, 6.9872177170494E-3, 0 1 3 0.6987218E-02 0.7168691E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.6987218E-02 1 0.9664696E-03 0.1383197E+00 2 0.1191791E-03 0.1705673E-01 3 0.9635367E-05 0.1378999E-02 4 0.1295722E-05 0.1854418E-03 Result GMRES:4, 5.E-2, 1.2957219981156E-6, 0 2 7 0.1295722E-05 0.6922419E-02 NI: 1, NLI: 9, ERLI 0.1295722E-05, ERNI: 0.7168895E+01 Max. and WRMS norm residual= 0.1434148E-02 0.4027488E+00 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.8773307E-02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.8773307E-02 1 0.6706276E-03 0.7643954E-01 2 0.8556887E-04 0.9753320E-02 3 0.1043109E-04 0.1188957E-02 4 0.1204059E-05 0.1372412E-03 Result GMRES:4, 2.5E-2, 1.2040592344261E-6, 0 1 4 0.1204059E-05 0.8581578E-02 NI: 2, NLI: 5, ERLI 0.1204059E-05, ERNI: 0.8581578E-02 T= 0.12E+00, LEVEL= 1 ,TOLWGT=0.9, SPCMON= 0.18E+02 Time integration at T= 0.12E+00, Grid level= 2, NPTS= 2198 Nonlinear system solver at T = 0.1189258E+00 Max. and WRMS norm residual= 0.4651150E+01 0.1277483E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 6594 # it. GCRO # it.GMRES Error Estimate 0 0 0.3931465E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3931465E+02 1 0.5178930E+01 0.1317303E+00 2 0.6049031E+00 0.1538620E-01 3 0.1321836E+00 0.3362196E-02 4 0.2394168E-01 0.6089760E-03 Result GMRES:4, 5.E-2, 2.3941676583017E-2, 0 1 4 0.2394168E-01 0.3875213E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2394168E-01 1 0.7715192E-02 0.3222494E+00 2 0.1798459E-02 0.7511835E-01 3 0.5163758E-03 0.2156807E-01 4 0.1111374E-03 0.4642006E-02 5 0.3154229E-04 0.1317464E-02 6 0.7034840E-05 0.2938324E-03 Result GMRES:6, 5.E-2, 7.0348398956304E-6, 0 2 10 0.7034840E-05 0.2235258E-01 NI: 1, NLI: 12, ERLI 0.7034840E-05, ERNI: 0.3875271E+02 Max. and WRMS norm residual= 0.2168374E-01 0.6251970E+01 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 6594 # it. GCRO # it.GMRES Error Estimate 0 0 0.1242148E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1242148E+00 1 0.1834267E-01 0.1476690E+00 2 0.2924404E-02 0.2354312E-01 3 0.7005060E-03 0.5639473E-02 4 0.1839897E-03 0.1481222E-02 5 0.5180975E-04 0.4170980E-03 Result GMRES:5, 2.5E-2, 5.1809745230747E-5, 0 1 5 0.5180975E-04 0.1211544E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.5180975E-04 1 0.1707549E-04 0.3295806E+00 2 0.4566562E-05 0.8814099E-01 3 0.9243720E-06 0.1784166E-01 4 0.2201233E-06 0.4248685E-02 5 0.5184242E-07 0.1000631E-02 6 0.1456183E-07 0.2810636E-03 Result GMRES:6, 2.5E-2, 1.456183208993E-8, 0 2 11 0.1456183E-07 0.4839637E-04 NI: 2, NLI: 13, ERLI 0.1456183E-07, ERNI: 0.1211552E+00 T= 0.12E+00, LEVEL= 2 ,TOLWGT=0.9, SPCMON= 0.12E+02 Time integration at T= 0.12E+00, Grid level= 3, NPTS= 10825 Nonlinear system solver at T = 0.1189258E+00 Max. and WRMS norm residual= 0.6593129E+01 0.1922828E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 32475 # it. GCRO # it.GMRES Error Estimate 0 0 0.4068907E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4068907E+02 1 0.9642571E+01 0.2369819E+00 2 0.2412914E+01 0.5930128E-01 3 0.6441990E+00 0.1583224E-01 4 0.2134404E+00 0.5245645E-02 5 0.9381987E-01 0.2305776E-02 6 0.3600935E-01 0.8849883E-03 Result GMRES:6, 5.E-2, 3.6009351453564E-2, 0 1 6 0.3600935E-01 0.4389389E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3600935E-01 1 0.1758472E-01 0.4883375E+00 2 0.7926016E-02 0.2201099E+00 3 0.2797530E-02 0.7768899E-01 4 0.1265264E-02 0.3513708E-01 5 0.5547687E-03 0.1540624E-01 6 0.2468953E-03 0.6856422E-02 7 0.1074606E-03 0.2984241E-02 8 0.4799165E-04 0.1332755E-02 9 0.2170086E-04 0.6026451E-03 Result GMRES:9, 5.E-2, 2.1700858940803E-5, 0 2 15 0.2170086E-04 0.3433218E-01 NI: 1, NLI: 17, ERLI 0.2170086E-04, ERNI: 0.4389640E+02 Max. and WRMS norm residual= 0.5052000E+00 0.1285439E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 32475 # it. GCRO # it.GMRES Error Estimate 0 0 0.2343386E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2343386E+01 1 0.6058871E+00 0.2585520E+00 2 0.9496543E-01 0.4052487E-01 3 0.3397755E-01 0.1449934E-01 4 0.1349324E-01 0.5758010E-02 5 0.5617836E-02 0.2397316E-02 6 0.2248064E-02 0.9593230E-03 Result GMRES:6, 2.5E-2, 2.2480642618831E-3, 0 1 6 0.2248064E-02 0.2050677E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2248064E-02 1 0.1131729E-02 0.5034237E+00 2 0.4986616E-03 0.2218182E+00 3 0.2008836E-03 0.8935846E-01 4 0.8880466E-04 0.3950272E-01 5 0.3622440E-04 0.1611360E-01 6 0.1719589E-04 0.7649197E-02 7 0.7118404E-05 0.3166460E-02 8 0.3281959E-05 0.1459905E-02 9 0.1470098E-05 0.6539396E-03 Result GMRES:9, 2.5E-2, 1.4700983395841E-6, 0 2 15 0.1470098E-05 0.2114113E-02 NI: 2, NLI: 17, ERLI 0.1470098E-05, ERNI: 0.2050824E+01 T= 0.12E+00, LEVEL= 3 ,TOLWGT=0.9, SPCMON= 0.60E+01 Time integration at T= 0.12E+00, Grid level= 4, NPTS= 52205 Nonlinear system solver at T = 0.1189258E+00 Max. and WRMS norm residual= 0.7110130E+01 0.2540332E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 156615 # it. GCRO # it.GMRES Error Estimate 0 0 0.3031679E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3031679E+02 1 0.1298650E+02 0.4283600E+00 2 0.4844217E+01 0.1597866E+00 3 0.1800863E+01 0.5940151E-01 4 0.8481896E+00 0.2797755E-01 5 0.5053879E+00 0.1667023E-01 6 0.2958910E+00 0.9759971E-02 7 0.1749512E+00 0.5770769E-02 8 0.1084277E+00 0.3576489E-02 9 0.6688088E-01 0.2206067E-02 10 0.4136920E-01 0.1364564E-02 11 0.2625377E-01 0.8659811E-03 Result GMRES:11, 5.E-2, 2.6253771298488E-2, 0 1 11 0.2625377E-01 0.5352171E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2625377E-01 1 0.1719437E-01 0.6549295E+00 2 0.1070688E-01 0.4078225E+00 3 0.6823183E-02 0.2598935E+00 4 0.4418577E-02 0.1683026E+00 5 0.2844528E-02 0.1083474E+00 6 0.1820045E-02 0.6932507E-01 7 0.1184421E-02 0.4511432E-01 8 0.7340785E-03 0.2796088E-01 9 0.4792591E-03 0.1825487E-01 10 0.2991267E-03 0.1139367E-01 11 0.1944879E-03 0.7407998E-02 12 0.1234547E-03 0.4702363E-02 13 0.8003354E-04 0.3048459E-02 14 0.5129596E-04 0.1953851E-02 15 0.3325052E-04 0.1266504E-02 16 0.2143665E-04 0.8165171E-03 Result GMRES:16, 5.E-2, 2.1436652702483E-5, 0 2 27 0.2143665E-04 0.3901091E-01 NI: 1, NLI: 29, ERLI 0.2143665E-04, ERNI: 0.5352237E+02 Max. and WRMS norm residual= 0.6813853E+00 0.2184944E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 156615 # it. GCRO # it.GMRES Error Estimate 0 0 0.2047283E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2047283E+01 1 0.9992581E+00 0.4880899E+00 2 0.3378865E+00 0.1650414E+00 3 0.1302535E+00 0.6362261E-01 4 0.5530861E-01 0.2701561E-01 5 0.3242645E-01 0.1583877E-01 6 0.1891324E-01 0.9238214E-02 7 0.1055062E-01 0.5153472E-02 8 0.6522542E-02 0.3185950E-02 9 0.3886812E-02 0.1898522E-02 10 0.2330682E-02 0.1138427E-02 11 0.1458599E-02 0.7124559E-03 Result GMRES:11, 2.5E-2, 1.4585987322926E-3, 0 1 11 0.1458599E-02 0.2792293E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1458599E-02 1 0.9453282E-03 0.6481071E+00 2 0.5809619E-03 0.3983014E+00 3 0.3616708E-03 0.2479577E+00 4 0.2338513E-03 0.1603260E+00 5 0.1463216E-03 0.1003166E+00 6 0.9208468E-04 0.6313229E-01 7 0.5892251E-04 0.4039666E-01 8 0.3636471E-04 0.2493126E-01 9 0.2356544E-04 0.1615622E-01 10 0.1493837E-04 0.1024159E-01 11 0.9705178E-05 0.6653768E-02 12 0.6256799E-05 0.4289595E-02 13 0.4083862E-05 0.2799853E-02 14 0.2660942E-05 0.1824314E-02 15 0.1744750E-05 0.1196183E-02 16 0.1147394E-05 0.7866415E-03 Result GMRES:16, 2.5E-2, 1.1473943124331E-6, 0 2 27 0.1147394E-05 0.2162013E-02 NI: 2, NLI: 29, ERLI 0.1147394E-05, ERNI: 0.2792455E+01 T= 0.12E+00, LEVEL= 4 ,TOLWGT=1.0, SPCMON= 0.18E+01 TN= 0.90E-01, DT= 0.29E-01, DTNEW= 0.30E-01, TIMMON= 0.48E+00 Time integration at T= 0.15E+00, Grid level= 1, NPTS= 384 Nonlinear system solver at T = 0.1493076E+00 Max. and WRMS norm residual= 0.5367454E+00 0.1694001E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.9543468E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.9543468E+01 1 0.4212018E+00 0.4413509E-01 2 0.3087214E-01 0.3234897E-02 3 0.3636518E-02 0.3810479E-03 Result GMRES:3, 5.E-2, 3.6365180925244E-3, 0 1 3 0.3636518E-02 0.9512504E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3636518E-02 1 0.4510664E-03 0.1240380E+00 2 0.6138337E-04 0.1687971E-01 3 0.6708514E-05 0.1844763E-02 4 0.8459797E-06 0.2326345E-03 Result GMRES:4, 5.E-2, 8.4597966098841E-7, 0 2 7 0.8459797E-06 0.3370352E-02 NI: 1, NLI: 9, ERLI 0.8459797E-06, ERNI: 0.9512515E+01 Max. and WRMS norm residual= 0.2923529E-03 0.5742447E-01 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.1267933E-02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1267933E-02 1 0.9890399E-04 0.7800412E-01 2 0.1194256E-04 0.9418920E-02 3 0.1319817E-05 0.1040921E-02 4 0.1382266E-06 0.1090173E-03 Result GMRES:4, 2.5E-2, 1.3822655836428E-7, 0 1 4 0.1382266E-06 0.1236286E-02 NI: 2, NLI: 5, ERLI 0.1382266E-06, ERNI: 0.1236286E-02 T= 0.15E+00, LEVEL= 1 ,TOLWGT=0.9, SPCMON= 0.17E+02 Time integration at T= 0.15E+00, Grid level= 2, NPTS= 2318 Nonlinear system solver at T = 0.1493076E+00 Max. and WRMS norm residual= 0.6708945E+01 0.1604279E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 6954 # it. GCRO # it.GMRES Error Estimate 0 0 0.4235101E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4235101E+02 1 0.6403540E+01 0.1512016E+00 2 0.8408866E+00 0.1985517E-01 3 0.1744163E+00 0.4118350E-02 4 0.3734035E-01 0.8816873E-03 Result GMRES:4, 5.E-2, 3.7340345359773E-2, 0 1 4 0.3734035E-01 0.4225187E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3734035E-01 1 0.1371195E-01 0.3672154E+00 2 0.3028401E-02 0.8110264E-01 3 0.8986134E-03 0.2406548E-01 4 0.1792527E-03 0.4800509E-02 5 0.5102287E-04 0.1366427E-02 6 0.1133880E-04 0.3036607E-03 Result GMRES:6, 5.E-2, 1.1338795607085E-5, 0 2 10 0.1133880E-04 0.3554289E-01 NI: 1, NLI: 12, ERLI 0.1133880E-04, ERNI: 0.4225229E+02 Max. and WRMS norm residual= 0.1104424E+00 0.2979047E+02 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 6954 # it. GCRO # it.GMRES Error Estimate 0 0 0.6524912E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.6524912E+00 1 0.7721201E-01 0.1183342E+00 2 0.1430968E-01 0.2193083E-01 3 0.2292532E-02 0.3513506E-02 4 0.6052378E-03 0.9275799E-03 Result GMRES:4, 2.5E-2, 6.0523777822531E-4, 0 1 4 0.6052378E-03 0.6258040E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.6052378E-03 1 0.2019221E-03 0.3336243E+00 2 0.4735263E-04 0.7823806E-01 3 0.1183634E-04 0.1955651E-01 4 0.3082287E-05 0.5092688E-02 5 0.8155354E-06 0.1347463E-02 6 0.1898663E-06 0.3137054E-03 Result GMRES:6, 2.5E-2, 1.8986633915636E-7, 0 2 10 0.1898663E-06 0.5675546E-03 NI: 2, NLI: 12, ERLI 0.1898663E-06, ERNI: 0.6258175E+00 T= 0.15E+00, LEVEL= 2 ,TOLWGT=0.9, SPCMON= 0.97E+01 Time integration at T= 0.15E+00, Grid level= 3, NPTS= 11215 Nonlinear system solver at T = 0.1493076E+00 Max. and WRMS norm residual= 0.6932015E+01 0.1918560E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 33645 # it. GCRO # it.GMRES Error Estimate 0 0 0.4131855E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4131855E+02 1 0.1071324E+02 0.2592840E+00 2 0.2597841E+01 0.6287347E-01 3 0.7660707E+00 0.1854060E-01 4 0.2606611E+00 0.6308573E-02 5 0.1153078E+00 0.2790702E-02 6 0.4846515E-01 0.1172963E-02 7 0.1899683E-01 0.4597651E-03 Result GMRES:7, 5.E-2, 1.8996827605844E-2, 0 1 7 0.1899683E-01 0.4488427E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1899683E-01 1 0.9633882E-02 0.5071311E+00 2 0.4236280E-02 0.2229994E+00 3 0.1719448E-02 0.9051240E-01 4 0.8197963E-03 0.4315438E-01 5 0.3451257E-03 0.1816754E-01 6 0.1655679E-03 0.8715556E-02 7 0.7203414E-04 0.3791904E-02 8 0.3365348E-04 0.1771531E-02 9 0.1507736E-04 0.7936776E-03 Result GMRES:9, 5.E-2, 1.5077356468956E-5, 0 2 16 0.1507736E-04 0.1778996E-01 NI: 1, NLI: 18, ERLI 0.1507736E-04, ERNI: 0.4488429E+02 Max. and WRMS norm residual= 0.3501101E+00 0.1099180E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 33645 # it. GCRO # it.GMRES Error Estimate 0 0 0.1961119E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1961119E+01 1 0.6344962E+00 0.3235379E+00 2 0.1033062E+00 0.5267716E-01 3 0.3829906E-01 0.1952919E-01 4 0.1463409E-01 0.7462113E-02 5 0.6684506E-02 0.3408517E-02 6 0.2577361E-02 0.1314230E-02 7 0.1120640E-02 0.5714291E-03 Result GMRES:7, 2.5E-2, 1.1206403039915E-3, 0 1 7 0.1120640E-02 0.1883314E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1120640E-02 1 0.5836485E-03 0.5208170E+00 2 0.2545952E-03 0.2271872E+00 3 0.1028873E-03 0.9181121E-01 4 0.4930816E-04 0.4399998E-01 5 0.2042289E-04 0.1822431E-01 6 0.9904715E-05 0.8838443E-02 7 0.4317311E-05 0.3852539E-02 8 0.2039927E-05 0.1820323E-02 9 0.9214720E-06 0.8222728E-03 Result GMRES:9, 2.5E-2, 9.2147200909859E-7, 0 2 16 0.9214720E-06 0.1045368E-02 NI: 2, NLI: 18, ERLI 0.9214720E-06, ERNI: 0.1883372E+01 T= 0.15E+00, LEVEL= 3 ,TOLWGT=0.9, SPCMON= 0.45E+01 Time integration at T= 0.15E+00, Grid level= 4, NPTS= 49905 Nonlinear system solver at T = 0.1493076E+00 Max. and WRMS norm residual= 0.7182913E+01 0.2657505E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 149715 # it. GCRO # it.GMRES Error Estimate 0 0 0.3219987E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3219987E+02 1 0.1403678E+02 0.4359267E+00 2 0.5442692E+01 0.1690284E+00 3 0.2118273E+01 0.6578516E-01 4 0.1035060E+01 0.3214485E-01 5 0.6292879E+00 0.1954318E-01 6 0.3717975E+00 0.1154655E-01 7 0.2227604E+00 0.6918055E-02 8 0.1395927E+00 0.4335194E-02 9 0.8673792E-01 0.2693735E-02 10 0.5437879E-01 0.1688789E-02 11 0.3485605E-01 0.1082491E-02 12 0.2201740E-01 0.6837730E-03 Result GMRES:12, 5.E-2, 2.2017398625352E-2, 0 1 12 0.2201740E-01 0.5736586E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2201740E-01 1 0.1457017E-01 0.6617570E+00 2 0.9227660E-02 0.4191076E+00 3 0.5963239E-02 0.2708421E+00 4 0.3899529E-02 0.1771113E+00 5 0.2538779E-02 0.1153078E+00 6 0.1653154E-02 0.7508396E-01 7 0.1082214E-02 0.4915269E-01 8 0.6902958E-03 0.3135229E-01 9 0.4547180E-03 0.2065267E-01 10 0.2881781E-03 0.1308865E-01 11 0.1892936E-03 0.8597456E-02 12 0.1218812E-03 0.5535677E-02 13 0.7984372E-04 0.3626392E-02 14 0.5201499E-04 0.2362449E-02 15 0.3411163E-04 0.1549304E-02 16 0.2229031E-04 0.1012395E-02 17 0.1462533E-04 0.6642623E-03 Result GMRES:17, 5.E-2, 1.4625327398456E-5, 0 2 29 0.1462533E-04 0.3338948E-01 NI: 1, NLI: 31, ERLI 0.1462533E-04, ERNI: 0.5736648E+02 Max. and WRMS norm residual= 0.7105129E+00 0.2391808E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 149715 # it. GCRO # it.GMRES Error Estimate 0 0 0.2269186E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2269186E+01 1 0.1135708E+01 0.5004911E+00 2 0.3923751E+00 0.1729144E+00 3 0.1568209E+00 0.6910886E-01 4 0.6981135E-01 0.3076493E-01 5 0.4222088E-01 0.1860617E-01 6 0.2456885E-01 0.1082716E-01 7 0.1400344E-01 0.6171127E-02 8 0.8777024E-02 0.3867917E-02 9 0.5242331E-02 0.2310225E-02 10 0.3198924E-02 0.1409723E-02 11 0.2012751E-02 0.8869924E-03 Result GMRES:11, 2.5E-2, 2.0127509905615E-3, 0 1 11 0.2012751E-02 0.3120958E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2012751E-02 1 0.1313252E-02 0.6524660E+00 2 0.8161570E-03 0.4054933E+00 3 0.5125048E-03 0.2546290E+00 4 0.3344946E-03 0.1661878E+00 5 0.2114555E-03 0.1050579E+00 6 0.1342851E-03 0.6671719E-01 7 0.8672610E-04 0.4308834E-01 8 0.5380995E-04 0.2673453E-01 9 0.3519962E-04 0.1748831E-01 10 0.2243457E-04 0.1114622E-01 11 0.1471124E-04 0.7309023E-02 12 0.9564436E-05 0.4751922E-02 13 0.6301279E-05 0.3130680E-02 14 0.4144108E-05 0.2058927E-02 15 0.2744303E-05 0.1363459E-02 16 0.1821858E-05 0.9051580E-03 Result GMRES:16, 2.5E-2, 1.821857711108E-6, 0 2 27 0.1821858E-05 0.3009251E-02 NI: 2, NLI: 29, ERLI 0.1821858E-05, ERNI: 0.3121173E+01 T= 0.15E+00, LEVEL= 4 ,TOLWGT=1.0, SPCMON= 0.18E+01 TN= 0.12E+00, DT= 0.30E-01, DTNEW= 0.29E-01, TIMMON= 0.52E+00 Time integration at T= 0.18E+00, Grid level= 1, NPTS= 384 Nonlinear system solver at T = 0.1786419E+00 Max. and WRMS norm residual= 0.1275396E+01 0.4030709E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.2289279E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2289279E+02 1 0.8859326E+00 0.3869920E-01 2 0.6688531E-01 0.2921676E-02 3 0.6617875E-02 0.2890812E-03 Result GMRES:3, 5.E-2, 6.6178747152648E-3, 0 1 3 0.6617875E-02 0.2288861E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.6617875E-02 1 0.9281915E-03 0.1402552E+00 2 0.1057016E-03 0.1597214E-01 3 0.1200267E-04 0.1813675E-02 4 0.1415568E-05 0.2139007E-03 Result GMRES:4, 5.E-2, 1.4155680642368E-6, 0 2 7 0.1415568E-05 0.6266619E-02 NI: 1, NLI: 9, ERLI 0.1415568E-05, ERNI: 0.2288863E+02 Max. and WRMS norm residual= 0.3257697E-02 0.8205186E+00 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.1807404E-01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1807404E-01 1 0.1339373E-02 0.7410480E-01 2 0.1649333E-03 0.9125426E-02 3 0.1972178E-04 0.1091166E-02 4 0.2411745E-05 0.1334370E-03 Result GMRES:4, 2.5E-2, 2.4117451367619E-6, 0 1 4 0.2411745E-05 0.1743886E-01 NI: 2, NLI: 5, ERLI 0.2411745E-05, ERNI: 0.1743886E-01 T= 0.18E+00, LEVEL= 1 ,TOLWGT=0.9, SPCMON= 0.16E+02 Time integration at T= 0.18E+00, Grid level= 2, NPTS= 2318 Nonlinear system solver at T = 0.1786419E+00 Max. and WRMS norm residual= 0.6510384E+01 0.1538800E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 6954 # it. GCRO # it.GMRES Error Estimate 0 0 0.3734966E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3734966E+02 1 0.5398955E+01 0.1445516E+00 2 0.8252349E+00 0.2209484E-01 3 0.1589912E+00 0.4256831E-02 4 0.3905556E-01 0.1045674E-02 5 0.1033128E-01 0.2766096E-03 Result GMRES:5, 5.E-2, 1.0331277431699E-2, 0 1 5 0.1033128E-01 0.3651209E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1033128E-01 1 0.3257792E-02 0.3153329E+00 2 0.8934564E-03 0.8648073E-01 3 0.1910655E-03 0.1849389E-01 4 0.4100905E-04 0.3969408E-02 5 0.9417001E-05 0.9115040E-03 Result GMRES:5, 5.E-2, 9.4170008286448E-6, 0 2 10 0.9417001E-05 0.9601869E-02 NI: 1, NLI: 12, ERLI 0.9417001E-05, ERNI: 0.3651221E+02 Max. and WRMS norm residual= 0.1597302E+00 0.3896400E+02 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 6954 # it. GCRO # it.GMRES Error Estimate 0 0 0.8331771E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.8331771E+00 1 0.1073074E+00 0.1287930E+00 2 0.1842556E-01 0.2211482E-01 3 0.3546234E-02 0.4256279E-02 4 0.9131795E-03 0.1096021E-02 5 0.2395346E-03 0.2874954E-03 Result GMRES:5, 2.5E-2, 2.3953458915022E-4, 0 1 5 0.2395346E-03 0.8029952E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2395346E-03 1 0.7839584E-04 0.3272840E+00 2 0.2092541E-04 0.8735860E-01 3 0.4598983E-05 0.1919966E-01 4 0.1019398E-05 0.4255745E-02 5 0.2126631E-06 0.8878178E-03 Result GMRES:5, 2.5E-2, 2.1266306258317E-7, 0 2 10 0.2126631E-06 0.2224705E-03 NI: 2, NLI: 12, ERLI 0.2126631E-06, ERNI: 0.8030039E+00 T= 0.18E+00, LEVEL= 2 ,TOLWGT=0.9, SPCMON= 0.12E+02 Time integration at T= 0.18E+00, Grid level= 3, NPTS= 11047 Nonlinear system solver at T = 0.1786419E+00 Max. and WRMS norm residual= 0.6521806E+01 0.1954158E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 33141 # it. GCRO # it.GMRES Error Estimate 0 0 0.4130335E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4130335E+02 1 0.1021823E+02 0.2473947E+00 2 0.2637631E+01 0.6385997E-01 3 0.7140047E+00 0.1728685E-01 4 0.2435950E+00 0.5897707E-02 5 0.1099522E+00 0.2662065E-02 6 0.4278721E-01 0.1035926E-02 7 0.1745004E-01 0.4224849E-03 Result GMRES:7, 5.E-2, 1.7450039677665E-2, 0 1 7 0.1745004E-01 0.4449021E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1745004E-01 1 0.8904881E-02 0.5103072E+00 2 0.3749821E-02 0.2148890E+00 3 0.1534497E-02 0.8793659E-01 4 0.7339898E-03 0.4206236E-01 5 0.2938959E-03 0.1684213E-01 6 0.1433679E-03 0.8215905E-02 7 0.5964080E-04 0.3417803E-02 8 0.2829382E-04 0.1621419E-02 9 0.1237032E-04 0.7088991E-03 Result GMRES:9, 5.E-2, 1.2370317284468E-5, 0 2 16 0.1237032E-04 0.1624295E-01 NI: 1, NLI: 18, ERLI 0.1237032E-04, ERNI: 0.4449017E+02 Max. and WRMS norm residual= 0.5101696E+00 0.1297232E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 33141 # it. GCRO # it.GMRES Error Estimate 0 0 0.2370642E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2370642E+01 1 0.6346103E+00 0.2676956E+00 2 0.1003456E+00 0.4232847E-01 3 0.3663968E-01 0.1545559E-01 4 0.1504139E-01 0.6344860E-02 5 0.6295656E-02 0.2655676E-02 6 0.2593567E-02 0.1094036E-02 7 0.1091390E-02 0.4603772E-03 Result GMRES:7, 2.5E-2, 1.0913895586577E-3, 0 1 7 0.1091390E-02 0.2061274E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1091390E-02 1 0.5713771E-03 0.5235318E+00 2 0.2393392E-03 0.2192976E+00 3 0.9641266E-04 0.8833936E-01 4 0.4588504E-04 0.4204277E-01 5 0.1943462E-04 0.1780723E-01 6 0.8886020E-05 0.8141933E-02 7 0.4017654E-05 0.3681228E-02 8 0.1789753E-05 0.1639885E-02 9 0.8170966E-06 0.7486755E-03 Result GMRES:9, 2.5E-2, 8.1709660370113E-7, 0 2 16 0.8170966E-06 0.1007177E-02 NI: 2, NLI: 18, ERLI 0.8170966E-06, ERNI: 0.2061373E+01 T= 0.18E+00, LEVEL= 3 ,TOLWGT=0.9, SPCMON= 0.59E+01 Time integration at T= 0.18E+00, Grid level= 4, NPTS= 54293 Nonlinear system solver at T = 0.1786419E+00 Max. and WRMS norm residual= 0.7192561E+01 0.2556204E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 162879 # it. GCRO # it.GMRES Error Estimate 0 0 0.3038765E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3038765E+02 1 0.1311035E+02 0.4314367E+00 2 0.5070171E+01 0.1668497E+00 3 0.1984755E+01 0.6531452E-01 4 0.9769625E+00 0.3214999E-01 5 0.5932192E+00 0.1952172E-01 6 0.3470402E+00 0.1142044E-01 7 0.2071423E+00 0.6816660E-02 8 0.1288186E+00 0.4239177E-02 9 0.7940264E-01 0.2612991E-02 10 0.4948268E-01 0.1628381E-02 11 0.3146328E-01 0.1035397E-02 12 0.1973375E-01 0.6494003E-03 Result GMRES:12, 5.E-2, 1.9733748540868E-2, 0 1 12 0.1973375E-01 0.5374036E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1973375E-01 1 0.1296658E-01 0.6570766E+00 2 0.8147499E-02 0.4128713E+00 3 0.5225885E-02 0.2648197E+00 4 0.3391525E-02 0.1718642E+00 5 0.2191716E-02 0.1110643E+00 6 0.1416715E-02 0.7179150E-01 7 0.9203193E-03 0.4663682E-01 8 0.5833432E-03 0.2956069E-01 9 0.3814008E-03 0.1932733E-01 10 0.2399834E-03 0.1216107E-01 11 0.1565313E-03 0.7932165E-02 12 0.1000488E-03 0.5069932E-02 13 0.6510526E-04 0.3299183E-02 14 0.4211517E-04 0.2134170E-02 15 0.2744022E-04 0.1390522E-02 16 0.1780255E-04 0.9021372E-03 Result GMRES:16, 5.E-2, 1.7802549529563E-5, 0 2 28 0.1780255E-04 0.2959406E-01 NI: 1, NLI: 30, ERLI 0.1780255E-04, ERNI: 0.5374091E+02 Max. and WRMS norm residual= 0.6629800E+00 0.2157016E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 162879 # it. GCRO # it.GMRES Error Estimate 0 0 0.2022807E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2022807E+01 1 0.1000008E+01 0.4943662E+00 2 0.3413673E+00 0.1687592E+00 3 0.1371672E+00 0.6781030E-01 4 0.6276631E-01 0.3102930E-01 5 0.3818234E-01 0.1887591E-01 6 0.2184012E-01 0.1079693E-01 7 0.1251088E-01 0.6184908E-02 8 0.7784955E-02 0.3848589E-02 9 0.4605077E-02 0.2276577E-02 10 0.2802700E-02 0.1385550E-02 11 0.1745652E-02 0.8629848E-03 Result GMRES:11, 2.5E-2, 1.7456521880733E-3, 0 1 11 0.1745652E-02 0.2778628E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1745652E-02 1 0.1128856E-02 0.6466670E+00 2 0.6964267E-03 0.3989493E+00 3 0.4339823E-03 0.2486076E+00 4 0.2804957E-03 0.1606824E+00 5 0.1767647E-03 0.1012600E+00 6 0.1108343E-03 0.6349165E-01 7 0.7132287E-04 0.4085744E-01 8 0.4361670E-04 0.2498591E-01 9 0.2832007E-04 0.1622320E-01 10 0.1784574E-04 0.1022296E-01 11 0.1160168E-04 0.6646044E-02 12 0.7473343E-05 0.4281118E-02 13 0.4880045E-05 0.2795543E-02 14 0.3184323E-05 0.1824145E-02 15 0.2090795E-05 0.1197716E-02 16 0.1377132E-05 0.7888926E-03 Result GMRES:16, 2.5E-2, 1.3771320410806E-6, 0 2 27 0.1377132E-05 0.2572886E-02 NI: 2, NLI: 29, ERLI 0.1377132E-05, ERNI: 0.2778801E+01 T= 0.18E+00, LEVEL= 4 ,TOLWGT=1.0, SPCMON= 0.18E+01 TN= 0.15E+00, DT= 0.29E-01, DTNEW= 0.30E-01, TIMMON= 0.49E+00 Time integration at T= 0.21E+00, Grid level= 1, NPTS= 384 Nonlinear system solver at T = 0.2079761E+00 Max. and WRMS norm residual= 0.2717184E+01 0.8115279E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.4345470E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4345470E+02 1 0.1814484E+01 0.4175577E-01 2 0.1189995E+00 0.2738473E-02 3 0.1214991E-01 0.2795995E-03 Result GMRES:3, 5.E-2, 1.2149913960028E-2, 0 1 3 0.1214991E-01 0.4340892E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1214991E-01 1 0.1511690E-02 0.1244198E+00 2 0.1744079E-03 0.1435466E-01 3 0.1918055E-04 0.1578657E-02 4 0.2248431E-05 0.1850574E-03 Result GMRES:4, 5.E-2, 2.2484312570891E-6, 0 2 7 0.2248431E-05 0.1151523E-01 NI: 1, NLI: 9, ERLI 0.2248431E-05, ERNI: 0.4340899E+02 Max. and WRMS norm residual= 0.7510860E-02 0.1892953E+01 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.4075987E-01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4075987E-01 1 0.2870125E-02 0.7041546E-01 2 0.3262541E-03 0.8004297E-02 3 0.3899879E-04 0.9567938E-03 Result GMRES:3, 2.5E-2, 3.8998789695618E-5, 0 1 3 0.3899879E-04 0.3946639E-01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3899879E-04 1 0.5348029E-05 0.1371332E+00 2 0.6394548E-06 0.1639679E-01 3 0.6226056E-07 0.1596474E-02 4 0.6003151E-08 0.1539317E-03 Result GMRES:4, 2.5E-2, 6.0031512034383E-9, 0 2 7 0.6003151E-08 0.3824692E-04 NI: 2, NLI: 9, ERLI 0.6003151E-08, ERNI: 0.3946817E-01 T= 0.21E+00, LEVEL= 1 ,TOLWGT=0.9, SPCMON= 0.14E+02 Time integration at T= 0.21E+00, Grid level= 2, NPTS= 2318 Nonlinear system solver at T = 0.2079761E+00 Max. and WRMS norm residual= 0.3700244E+01 0.1197751E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 6954 # it. GCRO # it.GMRES Error Estimate 0 0 0.3537853E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3537853E+02 1 0.4560819E+01 0.1289149E+00 2 0.7210063E+00 0.2037977E-01 3 0.1477987E+00 0.4177639E-02 4 0.3215196E-01 0.9087988E-03 Result GMRES:4, 5.E-2, 3.2151962438494E-2, 0 1 4 0.3215196E-01 0.3382062E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3215196E-01 1 0.1066661E-01 0.3317562E+00 2 0.2539311E-02 0.7897842E-01 3 0.6345109E-03 0.1973475E-01 4 0.1419900E-03 0.4416214E-02 5 0.3900234E-04 0.1213062E-02 6 0.8775076E-05 0.2729250E-03 Result GMRES:6, 5.E-2, 8.7750756836821E-6, 0 2 10 0.8775076E-05 0.2903244E-01 NI: 1, NLI: 12, ERLI 0.8775076E-05, ERNI: 0.3382217E+02 Max. and WRMS norm residual= 0.1122610E+00 0.2939054E+02 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 6954 # it. GCRO # it.GMRES Error Estimate 0 0 0.6502356E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.6502356E+00 1 0.8440952E-01 0.1298137E+00 2 0.1400078E-01 0.2153186E-01 3 0.2967917E-02 0.4564372E-02 4 0.7995367E-03 0.1229611E-02 5 0.2131364E-03 0.3277833E-03 Result GMRES:5, 2.5E-2, 2.1313639470416E-4, 0 1 5 0.2131364E-03 0.6117532E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2131364E-03 1 0.7203144E-04 0.3379594E+00 2 0.1912936E-04 0.8975172E-01 3 0.4298986E-05 0.2017012E-01 4 0.9634434E-06 0.4520314E-02 5 0.2106548E-06 0.9883566E-03 Result GMRES:5, 2.5E-2, 2.106547525223E-7, 0 2 10 0.2106548E-06 0.2000931E-03 NI: 2, NLI: 12, ERLI 0.2106548E-06, ERNI: 0.6117581E+00 T= 0.21E+00, LEVEL= 2 ,TOLWGT=0.9, SPCMON= 0.14E+02 Time integration at T= 0.21E+00, Grid level= 3, NPTS= 11303 Nonlinear system solver at T = 0.2079761E+00 Max. and WRMS norm residual= 0.7075005E+01 0.1958427E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 33909 # it. GCRO # it.GMRES Error Estimate 0 0 0.4081998E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4081998E+02 1 0.1055789E+02 0.2586452E+00 2 0.2576217E+01 0.6311167E-01 3 0.7330578E+00 0.1795831E-01 4 0.2519639E+00 0.6172561E-02 5 0.1126141E+00 0.2758798E-02 6 0.4622833E-01 0.1132493E-02 7 0.1824346E-01 0.4469246E-03 Result GMRES:7, 5.E-2, 1.8243455564962E-2, 0 1 7 0.1824346E-01 0.4420837E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1824346E-01 1 0.9155421E-02 0.5018468E+00 2 0.3909871E-02 0.2143163E+00 3 0.1573947E-02 0.8627461E-01 4 0.7507315E-03 0.4115073E-01 5 0.3087002E-03 0.1692115E-01 6 0.1472644E-03 0.8072177E-02 7 0.6267571E-04 0.3435517E-02 8 0.2885796E-04 0.1581826E-02 9 0.1265980E-04 0.6939364E-03 Result GMRES:9, 5.E-2, 1.2659797099098E-5, 0 2 16 0.1265980E-04 0.1697199E-01 NI: 1, NLI: 18, ERLI 0.1265980E-04, ERNI: 0.4420849E+02 Max. and WRMS norm residual= 0.3459817E+00 0.1077873E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 33909 # it. GCRO # it.GMRES Error Estimate 0 0 0.1881383E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1881383E+01 1 0.5859879E+00 0.3114666E+00 2 0.9366364E-01 0.4978447E-01 3 0.3502033E-01 0.1861415E-01 4 0.1340397E-01 0.7124533E-02 5 0.6134361E-02 0.3260560E-02 6 0.2313609E-02 0.1229739E-02 7 0.1015659E-02 0.5398472E-03 Result GMRES:7, 2.5E-2, 1.0156592103193E-3, 0 1 7 0.1015659E-02 0.1801902E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1015659E-02 1 0.5220177E-03 0.5139693E+00 2 0.2215777E-03 0.2181615E+00 3 0.8774108E-04 0.8638831E-01 4 0.4222940E-04 0.4157831E-01 5 0.1705988E-04 0.1679686E-01 6 0.8159309E-05 0.8033511E-02 7 0.3484441E-05 0.3430719E-02 8 0.1620481E-05 0.1595497E-02 9 0.7217737E-06 0.7106456E-03 Result GMRES:9, 2.5E-2, 7.2177369960449E-7, 0 2 16 0.7217737E-06 0.9435444E-03 NI: 2, NLI: 18, ERLI 0.7217737E-06, ERNI: 0.1801960E+01 T= 0.21E+00, LEVEL= 3 ,TOLWGT=0.9, SPCMON= 0.45E+01 Time integration at T= 0.21E+00, Grid level= 4, NPTS= 51793 Nonlinear system solver at T = 0.2079761E+00 Max. and WRMS norm residual= 0.7307037E+01 0.2667220E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 155379 # it. GCRO # it.GMRES Error Estimate 0 0 0.3151451E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3151451E+02 1 0.1355996E+02 0.4302766E+00 2 0.5262541E+01 0.1669879E+00 3 0.2082930E+01 0.6609432E-01 4 0.1042451E+01 0.3307844E-01 5 0.6354589E+00 0.2016401E-01 6 0.3701452E+00 0.1174523E-01 7 0.2216717E+00 0.7033956E-02 8 0.1376120E+00 0.4366625E-02 9 0.8465637E-01 0.2686266E-02 10 0.5277647E-01 0.1674672E-02 11 0.3347811E-01 0.1062308E-02 12 0.2097296E-01 0.6655017E-03 Result GMRES:12, 5.E-2, 2.0972957815334E-2, 0 1 12 0.2097296E-01 0.5563133E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2097296E-01 1 0.1376341E-01 0.6562455E+00 2 0.8630765E-02 0.4115187E+00 3 0.5527836E-02 0.2635697E+00 4 0.3581358E-02 0.1707608E+00 5 0.2310850E-02 0.1101824E+00 6 0.1491706E-02 0.7112521E-01 7 0.9672563E-03 0.4611921E-01 8 0.6127184E-03 0.2921469E-01 9 0.4000980E-03 0.1907685E-01 10 0.2513169E-03 0.1198290E-01 11 0.1637393E-03 0.7807162E-02 12 0.1044957E-03 0.4982400E-02 13 0.6792182E-04 0.3238543E-02 14 0.4388901E-04 0.2092647E-02 15 0.2856279E-04 0.1361887E-02 16 0.1850860E-04 0.8824981E-03 Result GMRES:16, 5.E-2, 1.850859518654E-5, 0 2 28 0.1850860E-04 0.3135294E-01 NI: 1, NLI: 30, ERLI 0.1850860E-04, ERNI: 0.5563193E+02 Max. and WRMS norm residual= 0.6624783E+00 0.2228775E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 155379 # it. GCRO # it.GMRES Error Estimate 0 0 0.2083742E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2083742E+01 1 0.1029837E+01 0.4942248E+00 2 0.3510544E+00 0.1684731E+00 3 0.1425910E+00 0.6843028E-01 4 0.6683958E-01 0.3207671E-01 5 0.4093563E-01 0.1964525E-01 6 0.2322608E-01 0.1114633E-01 7 0.1340342E-01 0.6432381E-02 8 0.8320133E-02 0.3992881E-02 9 0.4908010E-02 0.2355383E-02 10 0.2991770E-02 0.1435768E-02 11 0.1856326E-02 0.8908618E-03 Result GMRES:11, 2.5E-2, 1.856325888649E-3, 0 1 11 0.1856326E-02 0.2861503E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1856326E-02 1 0.1196952E-02 0.6447961E+00 2 0.7373479E-03 0.3972082E+00 3 0.4585656E-03 0.2470286E+00 4 0.2954048E-03 0.1591341E+00 5 0.1862797E-03 0.1003486E+00 6 0.1162836E-03 0.6264181E-01 7 0.7482791E-04 0.4030968E-01 8 0.4555262E-04 0.2453913E-01 9 0.2952494E-04 0.1590504E-01 10 0.1853522E-04 0.9984893E-02 11 0.1202510E-04 0.6477903E-02 12 0.7725738E-05 0.4161843E-02 13 0.5034262E-05 0.2711950E-02 14 0.3277712E-05 0.1765699E-02 15 0.2147720E-05 0.1156974E-02 16 0.1411479E-05 0.7603616E-03 Result GMRES:16, 2.5E-2, 1.4114789340018E-6, 0 2 27 0.1411479E-05 0.2721787E-02 NI: 2, NLI: 29, ERLI 0.1411479E-05, ERNI: 0.2861679E+01 T= 0.21E+00, LEVEL= 4 ,TOLWGT=1.0, SPCMON= 0.18E+01 TN= 0.18E+00, DT= 0.29E-01, DTNEW= 0.29E-01, TIMMON= 0.50E+00 Time integration at T= 0.24E+00, Grid level= 1, NPTS= 384 Nonlinear system solver at T = 0.2362626E+00 Max. and WRMS norm residual= 0.5019212E+01 0.1390858E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.5346755E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.5346755E+02 1 0.2407245E+01 0.4502253E-01 2 0.1516764E+00 0.2836794E-02 3 0.1999356E-01 0.3739382E-03 Result GMRES:3, 5.E-2, 1.999355841997E-2, 0 1 3 0.1999356E-01 0.5339690E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1999356E-01 1 0.2603717E-02 0.1302278E+00 2 0.2380115E-03 0.1190441E-01 3 0.1856090E-04 0.9283438E-03 Result GMRES:3, 5.E-2, 1.8560896156287E-5, 0 2 6 0.1856090E-04 0.1912823E-01 NI: 1, NLI: 8, ERLI 0.1856090E-04, ERNI: 0.5339729E+02 Max. and WRMS norm residual= 0.1228683E-01 0.3408581E+01 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.6983944E-01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.6983944E-01 1 0.4557384E-02 0.6525517E-01 2 0.5598173E-03 0.8015776E-02 3 0.6150527E-04 0.8806668E-03 Result GMRES:3, 2.5E-2, 6.1505271497511E-5, 0 1 3 0.6150527E-04 0.6787778E-01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.6150527E-04 1 0.8010278E-05 0.1302373E+00 2 0.8691571E-06 0.1413142E-01 3 0.7871433E-07 0.1279798E-02 4 0.6530636E-08 0.1061801E-03 Result GMRES:4, 2.5E-2, 6.530636499751E-9, 0 2 7 0.6530636E-08 0.6055028E-04 NI: 2, NLI: 9, ERLI 0.6530636E-08, ERNI: 0.6788002E-01 T= 0.24E+00, LEVEL= 1 ,TOLWGT=0.9, SPCMON= 0.10E+02 Time integration at T= 0.24E+00, Grid level= 2, NPTS= 2318 Nonlinear system solver at T = 0.2362626E+00 Max. and WRMS norm residual= 0.5073006E+01 0.1346895E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 6954 # it. GCRO # it.GMRES Error Estimate 0 0 0.3886253E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3886253E+02 1 0.5291694E+01 0.1361644E+00 2 0.6006856E+00 0.1545668E-01 3 0.1255967E+00 0.3231821E-02 4 0.2245132E-01 0.5777114E-03 Result GMRES:4, 5.E-2, 2.2451324211758E-2, 0 1 4 0.2245132E-01 0.3841862E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2245132E-01 1 0.7238334E-02 0.3224012E+00 2 0.1643782E-02 0.7321537E-01 3 0.4723491E-03 0.2103881E-01 4 0.9686801E-04 0.4314579E-02 5 0.2601242E-04 0.1158614E-02 6 0.5634228E-05 0.2509530E-03 Result GMRES:6, 5.E-2, 5.6342277849503E-6, 0 2 10 0.5634228E-05 0.2101892E-01 NI: 1, NLI: 12, ERLI 0.5634228E-05, ERNI: 0.3841910E+02 Max. and WRMS norm residual= 0.2338351E-01 0.7164486E+01 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 6954 # it. GCRO # it.GMRES Error Estimate 0 0 0.1389521E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1389521E+00 1 0.1797891E-01 0.1293892E+00 2 0.2316623E-02 0.1667209E-01 3 0.5272385E-03 0.3794389E-02 4 0.1183856E-03 0.8519883E-03 Result GMRES:4, 2.5E-2, 1.1838560684137E-4, 0 1 4 0.1183856E-03 0.1387228E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1183856E-03 1 0.4043256E-04 0.3415328E+00 2 0.9180002E-05 0.7754322E-01 3 0.2575004E-05 0.2175099E-01 4 0.4923799E-06 0.4159120E-02 5 0.1468576E-06 0.1240502E-02 6 0.3450788E-07 0.2914871E-03 Result GMRES:6, 2.5E-2, 3.4507879201442E-8, 0 2 10 0.3450788E-07 0.1086385E-03 NI: 2, NLI: 12, ERLI 0.3450788E-07, ERNI: 0.1387245E+00 T= 0.24E+00, LEVEL= 2 ,TOLWGT=0.9, SPCMON= 0.11E+02 Time integration at T= 0.24E+00, Grid level= 3, NPTS= 11635 Nonlinear system solver at T = 0.2362626E+00 Max. and WRMS norm residual= 0.6416281E+01 0.1951541E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 34905 # it. GCRO # it.GMRES Error Estimate 0 0 0.3971875E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3971875E+02 1 0.9689343E+01 0.2439489E+00 2 0.2459030E+01 0.6191108E-01 3 0.6602573E+00 0.1662332E-01 4 0.2228969E+00 0.5611882E-02 5 0.9999824E-01 0.2517659E-02 6 0.3834705E-01 0.9654648E-03 Result GMRES:6, 5.E-2, 3.8347051204736E-2, 0 1 6 0.3834705E-01 0.4262517E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3834705E-01 1 0.1866090E-01 0.4866319E+00 2 0.8214170E-02 0.2142060E+00 3 0.2927768E-02 0.7634925E-01 4 0.1321739E-02 0.3446781E-01 5 0.5676456E-03 0.1480285E-01 6 0.2501741E-03 0.6523945E-02 7 0.1104153E-03 0.2879368E-02 8 0.4783909E-04 0.1247530E-02 9 0.2144048E-04 0.5591167E-03 Result GMRES:9, 5.E-2, 2.1440478229099E-5, 0 2 15 0.2144048E-04 0.3638858E-01 NI: 1, NLI: 17, ERLI 0.2144048E-04, ERNI: 0.4262802E+02 Max. and WRMS norm residual= 0.4704726E+00 0.1193384E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 34905 # it. GCRO # it.GMRES Error Estimate 0 0 0.2105933E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2105933E+01 1 0.5599264E+00 0.2658804E+00 2 0.8783296E-01 0.4170738E-01 3 0.3158212E-01 0.1499673E-01 4 0.1289348E-01 0.6122453E-02 5 0.5306432E-02 0.2519753E-02 6 0.2153549E-02 0.1022610E-02 7 0.8945517E-03 0.4247768E-03 Result GMRES:7, 2.5E-2, 8.9455168153328E-4, 0 1 7 0.8945517E-03 0.1837816E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.8945517E-03 1 0.4619678E-03 0.5164239E+00 2 0.1875012E-03 0.2096035E+00 3 0.7474020E-04 0.8355045E-01 4 0.3517016E-04 0.3931597E-01 5 0.1462935E-04 0.1635383E-01 6 0.6593698E-05 0.7370953E-02 7 0.2929229E-05 0.3274522E-02 8 0.1281931E-05 0.1433043E-02 9 0.5752047E-06 0.6430089E-03 Result GMRES:9, 2.5E-2, 5.7520471207302E-7, 0 2 16 0.5752047E-06 0.8258276E-03 NI: 2, NLI: 18, ERLI 0.5752047E-06, ERNI: 0.1837893E+01 T= 0.24E+00, LEVEL= 3 ,TOLWGT=0.9, SPCMON= 0.58E+01 Time integration at T= 0.24E+00, Grid level= 4, NPTS= 56249 Nonlinear system solver at T = 0.2362626E+00 Max. and WRMS norm residual= 0.7331978E+01 0.2573781E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 168747 # it. GCRO # it.GMRES Error Estimate 0 0 0.2974949E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2974949E+02 1 0.1259311E+02 0.4233050E+00 2 0.4814660E+01 0.1618401E+00 3 0.1890038E+01 0.6353179E-01 4 0.9455307E+00 0.3178309E-01 5 0.5726144E+00 0.1924787E-01 6 0.3292086E+00 0.1106603E-01 7 0.1958520E+00 0.6583375E-02 8 0.1203234E+00 0.4044552E-02 9 0.7328029E-01 0.2463245E-02 10 0.4527133E-01 0.1521751E-02 11 0.2841642E-01 0.9551902E-03 Result GMRES:11, 5.E-2, 2.841642009727E-2, 0 1 11 0.2841642E-01 0.5200027E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2841642E-01 1 0.1840116E-01 0.6475538E+00 2 0.1138694E-01 0.4007170E+00 3 0.7184110E-02 0.2528155E+00 4 0.4608525E-02 0.1621783E+00 5 0.2943122E-02 0.1035712E+00 6 0.1864870E-02 0.6562648E-01 7 0.1203063E-02 0.4233690E-01 8 0.7403021E-03 0.2605191E-01 9 0.4793222E-03 0.1686779E-01 10 0.2973750E-03 0.1046490E-01 11 0.1917617E-03 0.6748272E-02 12 0.1210093E-03 0.4258430E-02 13 0.7780814E-04 0.2738140E-02 14 0.4964258E-04 0.1746968E-02 15 0.3192356E-04 0.1123420E-02 16 0.2047576E-04 0.7205608E-03 Result GMRES:16, 5.E-2, 2.04757596316E-5, 0 2 27 0.2047576E-04 0.4159721E-01 NI: 1, NLI: 29, ERLI 0.2047576E-04, ERNI: 0.5200103E+02 Max. and WRMS norm residual= 0.6191019E+00 0.2018565E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 168747 # it. GCRO # it.GMRES Error Estimate 0 0 0.1860146E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1860146E+01 1 0.9028949E+00 0.4853892E+00 2 0.3025166E+00 0.1626305E+00 3 0.1222497E+00 0.6572048E-01 4 0.5803784E-01 0.3120069E-01 5 0.3537493E-01 0.1901728E-01 6 0.1977493E-01 0.1063084E-01 7 0.1138979E-01 0.6123061E-02 8 0.6991857E-02 0.3758767E-02 9 0.4084111E-02 0.2195586E-02 10 0.2470773E-02 0.1328268E-02 11 0.1516139E-02 0.8150643E-03 Result GMRES:11, 2.5E-2, 1.5161388343606E-3, 0 1 11 0.1516139E-02 0.2540869E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1516139E-02 1 0.9673375E-03 0.6380270E+00 2 0.5899365E-03 0.3891045E+00 3 0.3631788E-03 0.2395419E+00 4 0.2312191E-03 0.1525052E+00 5 0.1447011E-03 0.9544055E-01 6 0.8913643E-04 0.5879173E-01 7 0.5688895E-04 0.3752226E-01 8 0.3417019E-04 0.2253764E-01 9 0.2192821E-04 0.1446319E-01 10 0.1360067E-04 0.8970595E-02 11 0.8731894E-05 0.5759297E-02 12 0.5549374E-05 0.3660202E-02 13 0.3578033E-05 0.2359964E-02 14 0.2305703E-05 0.1520773E-02 15 0.1495219E-05 0.9862019E-03 Result GMRES:15, 2.5E-2, 1.4952189344021E-6, 0 2 26 0.1495219E-05 0.2189975E-02 NI: 2, NLI: 28, ERLI 0.1495219E-05, ERNI: 0.2541005E+01 T= 0.24E+00, LEVEL= 4 ,TOLWGT=1.0, SPCMON= 0.18E+01 TN= 0.21E+00, DT= 0.28E-01, DTNEW= 0.30E-01, TIMMON= 0.47E+00 Time integration at T= 0.27E+00, Grid level= 1, NPTS= 384 Nonlinear system solver at T = 0.2656372E+00 Max. and WRMS norm residual= 0.6823408E+01 0.1729673E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.4973830E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4973830E+02 1 0.2733041E+01 0.5494842E-01 2 0.2382794E+00 0.4790662E-02 3 0.3343459E-01 0.6722102E-03 Result GMRES:3, 5.E-2, 3.343458909038E-2, 0 1 3 0.3343459E-01 0.4971490E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3343459E-01 1 0.4496954E-02 0.1345000E+00 2 0.4548499E-03 0.1360417E-01 3 0.2582760E-04 0.7724815E-03 Result GMRES:3, 5.E-2, 2.5827602625825E-5, 0 2 6 0.2582760E-04 0.3246530E-01 NI: 1, NLI: 8, ERLI 0.2582760E-04, ERNI: 0.4971569E+02 Max. and WRMS norm residual= 0.1436638E-01 0.3994966E+01 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.8240776E-01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.8240776E-01 1 0.5999432E-02 0.7280179E-01 2 0.8403946E-03 0.1019800E-01 3 0.7643012E-04 0.9274626E-03 Result GMRES:3, 2.5E-2, 7.6430115469735E-5, 0 1 3 0.7643012E-04 0.8033490E-01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.7643012E-04 1 0.9713309E-05 0.1270875E+00 2 0.1072293E-05 0.1402972E-01 3 0.8015300E-07 0.1048710E-02 4 0.7105795E-08 0.9297114E-04 Result GMRES:4, 2.5E-2, 7.1057952693052E-9, 0 2 7 0.7105795E-08 0.7581713E-04 NI: 2, NLI: 9, ERLI 0.7105795E-08, ERNI: 0.8033576E-01 T= 0.27E+00, LEVEL= 1 ,TOLWGT=0.9, SPCMON= 0.12E+02 Time integration at T= 0.27E+00, Grid level= 2, NPTS= 2318 Nonlinear system solver at T = 0.2656372E+00 Max. and WRMS norm residual= 0.6984121E+01 0.1683221E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 6954 # it. GCRO # it.GMRES Error Estimate 0 0 0.4175286E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4175286E+02 1 0.6354376E+01 0.1521902E+00 2 0.8155737E+00 0.1953336E-01 3 0.1612196E+00 0.3861282E-02 4 0.3500233E-01 0.8383217E-03 Result GMRES:4, 5.E-2, 3.5002329480901E-2, 0 1 4 0.3500233E-01 0.4167821E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3500233E-01 1 0.1288636E-01 0.3681572E+00 2 0.2757140E-02 0.7877020E-01 3 0.7700247E-03 0.2199924E-01 4 0.1492403E-03 0.4263724E-02 5 0.4198698E-04 0.1199548E-02 6 0.8740291E-05 0.2497060E-03 Result GMRES:6, 5.E-2, 8.7402908520163E-6, 0 2 10 0.8740291E-05 0.3356335E-01 NI: 1, NLI: 12, ERLI 0.8740291E-05, ERNI: 0.4167850E+02 Max. and WRMS norm residual= 0.1298325E+00 0.3391999E+02 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 6954 # it. GCRO # it.GMRES Error Estimate 0 0 0.7156280E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.7156280E+00 1 0.8579884E-01 0.1198931E+00 2 0.1521458E-01 0.2126046E-01 3 0.2547462E-02 0.3559757E-02 4 0.6756445E-03 0.9441280E-03 Result GMRES:4, 2.5E-2, 6.7564445182957E-4, 0 1 4 0.6756445E-03 0.6854019E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.6756445E-03 1 0.2367087E-03 0.3503450E+00 2 0.5294081E-04 0.7835602E-01 3 0.1230522E-04 0.1821257E-01 4 0.3000465E-05 0.4440893E-02 5 0.7922322E-06 0.1172558E-02 6 0.1783345E-06 0.2639473E-03 Result GMRES:6, 2.5E-2, 1.783345396825E-7, 0 2 10 0.1783345E-06 0.6388069E-03 NI: 2, NLI: 12, ERLI 0.1783345E-06, ERNI: 0.6854147E+00 T= 0.27E+00, LEVEL= 2 ,TOLWGT=0.9, SPCMON= 0.99E+01 Time integration at T= 0.27E+00, Grid level= 3, NPTS= 11997 Nonlinear system solver at T = 0.2656372E+00 Max. and WRMS norm residual= 0.7235618E+01 0.1952566E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 35991 # it. GCRO # it.GMRES Error Estimate 0 0 0.4046381E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4046381E+02 1 0.1050479E+02 0.2596094E+00 2 0.2592631E+01 0.6407283E-01 3 0.7400669E+00 0.1828960E-01 4 0.2599870E+00 0.6425172E-02 5 0.1181762E+00 0.2920540E-02 6 0.4799736E-01 0.1186180E-02 7 0.1922875E-01 0.4752085E-03 Result GMRES:7, 5.E-2, 1.9228747145018E-2, 0 1 7 0.1922875E-01 0.4375459E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1922875E-01 1 0.9665049E-02 0.5026354E+00 2 0.4075985E-02 0.2119735E+00 3 0.1643516E-02 0.8547183E-01 4 0.7949120E-03 0.4133977E-01 5 0.3245188E-03 0.1687675E-01 6 0.1553966E-03 0.8081472E-02 7 0.6601929E-04 0.3433364E-02 8 0.3023622E-04 0.1572449E-02 9 0.1328356E-04 0.6908176E-03 Result GMRES:9, 5.E-2, 1.3283557239841E-5, 0 2 16 0.1328356E-04 0.1780471E-01 NI: 1, NLI: 18, ERLI 0.1328356E-04, ERNI: 0.4375480E+02 Max. and WRMS norm residual= 0.3582758E+00 0.1087215E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 35991 # it. GCRO # it.GMRES Error Estimate 0 0 0.1895261E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1895261E+01 1 0.5818930E+00 0.3070253E+00 2 0.9330555E-01 0.4923098E-01 3 0.3584925E-01 0.1891521E-01 4 0.1391998E-01 0.7344624E-02 5 0.6434481E-02 0.3395037E-02 6 0.2419684E-02 0.1276702E-02 7 0.1075686E-02 0.5675663E-03 Result GMRES:7, 2.5E-2, 1.0756861374462E-3, 0 1 7 0.1075686E-02 0.1810368E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1075686E-02 1 0.5529010E-03 0.5139984E+00 2 0.2322439E-03 0.2159030E+00 3 0.9131277E-04 0.8488793E-01 4 0.4473474E-04 0.4158716E-01 5 0.1794411E-04 0.1668155E-01 6 0.8579579E-05 0.7975913E-02 7 0.3652356E-05 0.3395373E-02 8 0.1702829E-05 0.1583017E-02 9 0.7580968E-06 0.7047565E-03 Result GMRES:9, 2.5E-2, 7.5809684597827E-7, 0 2 16 0.7580968E-06 0.9966937E-03 NI: 2, NLI: 18, ERLI 0.7580968E-06, ERNI: 0.1810436E+01 T= 0.27E+00, LEVEL= 3 ,TOLWGT=0.9, SPCMON= 0.45E+01 Time integration at T= 0.27E+00, Grid level= 4, NPTS= 53359 Nonlinear system solver at T = 0.2656372E+00 Max. and WRMS norm residual= 0.7460963E+01 0.2702163E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 160077 # it. GCRO # it.GMRES Error Estimate 0 0 0.3175160E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3175160E+02 1 0.1361566E+02 0.4288181E+00 2 0.5311904E+01 0.1672956E+00 3 0.2139639E+01 0.6738682E-01 4 0.1103745E+01 0.3476186E-01 5 0.6772749E+00 0.2133042E-01 6 0.3923921E+00 0.1235818E-01 7 0.2369497E+00 0.7462607E-02 8 0.1468984E+00 0.4626488E-02 9 0.9031995E-01 0.2844580E-02 10 0.5644563E-01 0.1777726E-02 11 0.3573199E-01 0.1125360E-02 12 0.2237869E-01 0.7048052E-03 Result GMRES:12, 5.E-2, 2.2378691378907E-2, 0 1 12 0.2237869E-01 0.5591765E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2237869E-01 1 0.1467840E-01 0.6559095E+00 2 0.9188518E-02 0.4105923E+00 3 0.5879981E-02 0.2627491E+00 4 0.3804498E-02 0.1700054E+00 5 0.2452442E-02 0.1095882E+00 6 0.1582223E-02 0.7070222E-01 7 0.1024351E-02 0.4577349E-01 8 0.6495658E-03 0.2902609E-01 9 0.4238820E-03 0.1894132E-01 10 0.2661395E-03 0.1189254E-01 11 0.1733583E-03 0.7746578E-02 12 0.1105692E-03 0.4940826E-02 13 0.7186643E-04 0.3211378E-02 14 0.4644257E-04 0.2075303E-02 15 0.3022746E-04 0.1350725E-02 16 0.1958642E-04 0.8752265E-03 Result GMRES:16, 5.E-2, 1.958642458855E-5, 0 2 28 0.1958642E-04 0.3335795E-01 NI: 1, NLI: 30, ERLI 0.1958642E-04, ERNI: 0.5591834E+02 Max. and WRMS norm residual= 0.6640374E+00 0.2250351E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 160077 # it. GCRO # it.GMRES Error Estimate 0 0 0.2099421E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2099421E+01 1 0.1038742E+01 0.4947756E+00 2 0.3540483E+00 0.1686409E+00 3 0.1463467E+00 0.6970812E-01 4 0.7108282E-01 0.3385829E-01 5 0.4389693E-01 0.2090906E-01 6 0.2471141E-01 0.1177058E-01 7 0.1442896E-01 0.6872825E-02 8 0.8928795E-02 0.4252979E-02 9 0.5259120E-02 0.2505033E-02 10 0.3216416E-02 0.1532049E-02 11 0.1987664E-02 0.9467676E-03 Result GMRES:11, 2.5E-2, 1.9876640937328E-3, 0 1 11 0.1987664E-02 0.2876259E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1987664E-02 1 0.1278093E-02 0.6430126E+00 2 0.7868044E-03 0.3958438E+00 3 0.4885419E-03 0.2457869E+00 4 0.3136785E-03 0.1578126E+00 5 0.1980698E-03 0.9964956E-01 6 0.1231890E-03 0.6197678E-01 7 0.7930078E-04 0.3989647E-01 8 0.4811054E-04 0.2420456E-01 9 0.3115498E-04 0.1567417E-01 10 0.1949381E-04 0.9807395E-02 11 0.1263489E-04 0.6356653E-02 12 0.8103300E-05 0.4076795E-02 13 0.5274924E-05 0.2653831E-02 14 0.3430599E-05 0.1725945E-02 15 0.2246046E-05 0.1129993E-02 16 0.1474383E-05 0.7417668E-03 Result GMRES:16, 2.5E-2, 1.4743833211636E-6, 0 2 27 0.1474383E-05 0.2898766E-02 NI: 2, NLI: 29, ERLI 0.1474383E-05, ERNI: 0.2876440E+01 T= 0.27E+00, LEVEL= 4 ,TOLWGT=1.0, SPCMON= 0.18E+01 TN= 0.24E+00, DT= 0.29E-01, DTNEW= 0.29E-01, TIMMON= 0.51E+00 Time integration at T= 0.29E+00, Grid level= 1, NPTS= 384 Nonlinear system solver at T = 0.2938819E+00 Max. and WRMS norm residual= 0.6350022E+01 0.1556477E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.3589759E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3589759E+02 1 0.2304931E+01 0.6420851E-01 2 0.2423077E+00 0.6749971E-02 3 0.2948777E-01 0.8214416E-03 Result GMRES:3, 5.E-2, 2.9487770022212E-2, 0 1 3 0.2948777E-01 0.3570781E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2948777E-01 1 0.3673996E-02 0.1245939E+00 2 0.4306840E-03 0.1460551E-01 3 0.2986247E-04 0.1012707E-02 4 0.2431874E-05 0.8247061E-04 Result GMRES:4, 5.E-2, 2.4318744501627E-6, 0 2 7 0.2431874E-05 0.2885807E-01 NI: 1, NLI: 9, ERLI 0.2431874E-05, ERNI: 0.3570843E+02 Max. and WRMS norm residual= 0.1490079E-01 0.3042755E+01 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.6039841E-01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.6039841E-01 1 0.5393057E-02 0.8929139E-01 2 0.6560189E-03 0.1086153E-01 3 0.5921951E-04 0.9804814E-03 Result GMRES:3, 2.5E-2, 5.9219510984317E-5, 0 1 3 0.5921951E-04 0.5899949E-01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.5921951E-04 1 0.7687330E-05 0.1298108E+00 2 0.8496341E-06 0.1434720E-01 3 0.6596104E-07 0.1113840E-02 4 0.5943104E-08 0.1003572E-03 Result GMRES:4, 2.5E-2, 5.9431035264916E-9, 0 2 7 0.5943104E-08 0.5809907E-04 NI: 2, NLI: 9, ERLI 0.5943104E-08, ERNI: 0.5899991E-01 T= 0.29E+00, LEVEL= 1 ,TOLWGT=0.9, SPCMON= 0.14E+02 Time integration at T= 0.29E+00, Grid level= 2, NPTS= 2310 Nonlinear system solver at T = 0.2938819E+00 Max. and WRMS norm residual= 0.6338079E+01 0.1573382E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 6930 # it. GCRO # it.GMRES Error Estimate 0 0 0.3701947E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3701947E+02 1 0.5201405E+01 0.1405046E+00 2 0.7775115E+00 0.2100277E-01 3 0.1425496E+00 0.3850667E-02 4 0.3452950E-01 0.9327391E-03 Result GMRES:4, 5.E-2, 3.4529504443028E-2, 0 1 4 0.3452950E-01 0.3597270E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3452950E-01 1 0.1210914E-01 0.3506897E+00 2 0.2628947E-02 0.7613626E-01 3 0.5806391E-03 0.1681574E-01 4 0.1303329E-03 0.3774538E-02 5 0.3473642E-04 0.1005993E-02 6 0.6835653E-05 0.1979656E-03 Result GMRES:6, 5.E-2, 6.8356533282873E-6, 0 2 10 0.6835653E-05 0.3276657E-01 NI: 1, NLI: 12, ERLI 0.6835653E-05, ERNI: 0.3597320E+02 Max. and WRMS norm residual= 0.1581272E+00 0.3953960E+02 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 6930 # it. GCRO # it.GMRES Error Estimate 0 0 0.8155879E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.8155879E+00 1 0.1042934E+00 0.1278752E+00 2 0.1675403E-01 0.2054227E-01 3 0.3264780E-02 0.4002978E-02 4 0.8285882E-03 0.1015940E-02 5 0.2146461E-03 0.2631795E-03 Result GMRES:5, 2.5E-2, 2.1464605002092E-4, 0 1 5 0.2146461E-03 0.7826771E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2146461E-03 1 0.6872815E-04 0.3201930E+00 2 0.1753864E-04 0.8170958E-01 3 0.3792886E-05 0.1767042E-01 4 0.8351759E-06 0.3890945E-02 5 0.1703466E-06 0.7936163E-03 Result GMRES:5, 2.5E-2, 1.7034661347457E-7, 0 2 10 0.1703466E-06 0.1994808E-03 NI: 2, NLI: 12, ERLI 0.1703466E-06, ERNI: 0.7826852E+00 T= 0.29E+00, LEVEL= 2 ,TOLWGT=0.9, SPCMON= 0.13E+02 Time integration at T= 0.29E+00, Grid level= 3, NPTS= 11789 Nonlinear system solver at T = 0.2938819E+00 Max. and WRMS norm residual= 0.6343551E+01 0.1974426E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 35367 # it. GCRO # it.GMRES Error Estimate 0 0 0.4011147E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4011147E+02 1 0.9879186E+01 0.2462933E+00 2 0.2516954E+01 0.6274899E-01 3 0.6890210E+00 0.1717765E-01 4 0.2367905E+00 0.5903312E-02 5 0.1072896E+00 0.2674786E-02 6 0.4133927E-01 0.1030609E-02 7 0.1688429E-01 0.4209342E-03 Result GMRES:7, 5.E-2, 1.6884292107853E-2, 0 1 7 0.1688429E-01 0.4295158E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1688429E-01 1 0.8490761E-02 0.5028793E+00 2 0.3450345E-02 0.2043524E+00 3 0.1395864E-02 0.8267236E-01 4 0.6700019E-03 0.3968197E-01 5 0.2609276E-03 0.1545387E-01 6 0.1263295E-03 0.7482074E-02 7 0.5129300E-04 0.3037913E-02 8 0.2376860E-04 0.1407734E-02 9 0.1019874E-04 0.6040370E-03 Result GMRES:9, 5.E-2, 1.0198737807942E-5, 0 2 16 0.1019874E-04 0.1563513E-01 NI: 1, NLI: 18, ERLI 0.1019874E-04, ERNI: 0.4295167E+02 Max. and WRMS norm residual= 0.4637464E+00 0.1192833E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 35367 # it. GCRO # it.GMRES Error Estimate 0 0 0.2101909E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2101909E+01 1 0.5677735E+00 0.2701228E+00 2 0.9050685E-01 0.4305936E-01 3 0.3285199E-01 0.1562960E-01 4 0.1356668E-01 0.6454459E-02 5 0.5596668E-02 0.2662660E-02 6 0.2296750E-02 0.1092697E-02 7 0.9529045E-03 0.4533520E-03 Result GMRES:7, 2.5E-2, 9.5290447926922E-4, 0 1 7 0.9529045E-03 0.1828208E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.9529045E-03 1 0.4939704E-03 0.5183840E+00 2 0.1996366E-03 0.2095033E+00 3 0.8002970E-04 0.8398502E-01 4 0.3793634E-04 0.3981128E-01 5 0.1578171E-04 0.1656169E-01 6 0.7153942E-05 0.7507512E-02 7 0.3177719E-05 0.3334771E-02 8 0.1401811E-05 0.1471093E-02 9 0.6268794E-06 0.6578618E-03 Result GMRES:9, 2.5E-2, 6.2687942969368E-7, 0 2 16 0.6268794E-06 0.8806063E-03 NI: 2, NLI: 18, ERLI 0.6268794E-06, ERNI: 0.1828289E+01 T= 0.29E+00, LEVEL= 3 ,TOLWGT=0.9, SPCMON= 0.58E+01 Time integration at T= 0.29E+00, Grid level= 4, NPTS= 57831 Nonlinear system solver at T = 0.2938819E+00 Max. and WRMS norm residual= 0.7413801E+01 0.2585218E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 173493 # it. GCRO # it.GMRES Error Estimate 0 0 0.2982880E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2982880E+02 1 0.1260504E+02 0.4225796E+00 2 0.4853060E+01 0.1626971E+00 3 0.1940282E+01 0.6504729E-01 4 0.9980732E+00 0.3346006E-01 5 0.6080503E+00 0.2038467E-01 6 0.3486184E+00 0.1168731E-01 7 0.2091292E+00 0.7010985E-02 8 0.1284747E+00 0.4307069E-02 9 0.7833006E-01 0.2625988E-02 10 0.4854117E-01 0.1627326E-02 11 0.3045340E-01 0.1020940E-02 12 0.1890050E-01 0.6336328E-03 Result GMRES:12, 5.E-2, 1.8900503806476E-2, 0 1 12 0.1890050E-01 0.5204757E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1890050E-01 1 0.1228887E-01 0.6501877E+00 2 0.7620693E-02 0.4032005E+00 3 0.4831006E-02 0.2556020E+00 4 0.3097277E-02 0.1638727E+00 5 0.1978596E-02 0.1046848E+00 6 0.1264813E-02 0.6691954E-01 7 0.8113519E-03 0.4292753E-01 8 0.5100872E-03 0.2698802E-01 9 0.3299643E-03 0.1745796E-01 10 0.2054389E-03 0.1086949E-01 11 0.1326803E-03 0.7019932E-02 12 0.8390604E-04 0.4439355E-02 13 0.5407335E-04 0.2860947E-02 14 0.3465477E-04 0.1833537E-02 15 0.2236774E-04 0.1183447E-02 16 0.1437589E-04 0.7606087E-03 Result GMRES:16, 5.E-2, 1.4375887243557E-5, 0 2 28 0.1437589E-04 0.2785404E-01 NI: 1, NLI: 30, ERLI 0.1437589E-04, ERNI: 0.5204812E+02 Max. and WRMS norm residual= 0.6111423E+00 0.2025400E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 173493 # it. GCRO # it.GMRES Error Estimate 0 0 0.1866282E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1866282E+01 1 0.9077375E+00 0.4863881E+00 2 0.3046218E+00 0.1632239E+00 3 0.1252775E+00 0.6712679E-01 4 0.6132033E-01 0.3285694E-01 5 0.3762054E-01 0.2015801E-01 6 0.2096121E-01 0.1123153E-01 7 0.1219301E-01 0.6533316E-02 8 0.7472249E-02 0.4003814E-02 9 0.4367790E-02 0.2340369E-02 10 0.2650827E-02 0.1420378E-02 11 0.1623729E-02 0.8700337E-03 Result GMRES:11, 2.5E-2, 1.6237285919436E-3, 0 1 11 0.1623729E-02 0.2543531E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1623729E-02 1 0.1035055E-02 0.6374558E+00 2 0.6314628E-03 0.3888968E+00 3 0.3886651E-03 0.2393658E+00 4 0.2470907E-03 0.1521749E+00 5 0.1548900E-03 0.9539157E-01 6 0.9530711E-04 0.5869645E-01 7 0.6088386E-04 0.3749633E-01 8 0.3653652E-04 0.2250162E-01 9 0.2345594E-04 0.1444573E-01 10 0.1452885E-04 0.8947832E-02 11 0.9331959E-05 0.5747241E-02 12 0.5929325E-05 0.3651672E-02 13 0.3824612E-05 0.2355451E-02 14 0.2464982E-05 0.1518099E-02 15 0.1599379E-05 0.9850041E-03 Result GMRES:15, 2.5E-2, 1.5993792740714E-6, 0 2 26 0.1599379E-05 0.2338625E-02 NI: 2, NLI: 28, ERLI 0.1599379E-05, ERNI: 0.2543673E+01 T= 0.29E+00, LEVEL= 4 ,TOLWGT=1.0, SPCMON= 0.18E+01 TN= 0.27E+00, DT= 0.28E-01, DTNEW= 0.30E-01, TIMMON= 0.47E+00 Time integration at T= 0.32E+00, Grid level= 1, NPTS= 384 Nonlinear system solver at T = 0.3233035E+00 Max. and WRMS norm residual= 0.3529960E+01 0.9010830E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.2072388E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2072388E+02 1 0.1451187E+01 0.7002488E-01 2 0.1727003E+00 0.8333395E-02 3 0.2265270E-01 0.1093072E-02 4 0.2315001E-02 0.1117069E-03 Result GMRES:4, 5.E-2, 2.3150009252378E-3, 0 1 4 0.2315001E-02 0.2008225E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2315001E-02 1 0.3116081E-03 0.1346039E+00 2 0.4179272E-04 0.1805300E-01 3 0.3804317E-05 0.1643333E-02 4 0.3989441E-06 0.1723300E-03 Result GMRES:4, 5.E-2, 3.989440706097E-7, 0 2 8 0.3989441E-06 0.2210632E-02 NI: 1, NLI: 10, ERLI 0.3989441E-06, ERNI: 0.2008222E+02 Max. and WRMS norm residual= 0.6165169E-02 0.1309466E+01 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.2753804E-01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2753804E-01 1 0.2586282E-02 0.9391670E-01 2 0.3173199E-03 0.1152297E-01 3 0.3573333E-04 0.1297599E-02 4 0.3861973E-05 0.1402414E-03 Result GMRES:4, 2.5E-2, 3.8619733611282E-6, 0 1 4 0.3861973E-05 0.2679034E-01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3861973E-05 1 0.5310951E-06 0.1375191E+00 2 0.7023535E-07 0.1818639E-01 3 0.5885285E-08 0.1523906E-02 4 0.6343582E-09 0.1642575E-03 Result GMRES:4, 2.5E-2, 6.3435822988085E-10, 0 2 8 0.6343582E-09 0.3716276E-05 NI: 2, NLI: 10, ERLI 0.6343582E-09, ERNI: 0.2679032E-01 T= 0.32E+00, LEVEL= 1 ,TOLWGT=0.9, SPCMON= 0.18E+02 Time integration at T= 0.32E+00, Grid level= 2, NPTS= 2318 Nonlinear system solver at T = 0.3233035E+00 Max. and WRMS norm residual= 0.3559650E+01 0.1237366E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 6954 # it. GCRO # it.GMRES Error Estimate 0 0 0.3729382E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3729382E+02 1 0.4942939E+01 0.1325404E+00 2 0.7467873E+00 0.2002442E-01 3 0.1505946E+00 0.4038057E-02 4 0.3203312E-01 0.8589389E-03 Result GMRES:4, 5.E-2, 3.2033115705157E-2, 0 1 4 0.3203312E-01 0.3565584E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3203312E-01 1 0.1044965E-01 0.3262139E+00 2 0.2556255E-02 0.7980040E-01 3 0.6442599E-03 0.2011231E-01 4 0.1479870E-03 0.4619814E-02 5 0.3944021E-04 0.1231232E-02 6 0.9112787E-05 0.2844802E-03 Result GMRES:6, 5.E-2, 9.1127871180151E-6, 0 2 10 0.9112787E-05 0.2883276E-01 NI: 1, NLI: 12, ERLI 0.9112787E-05, ERNI: 0.3565748E+02 Max. and WRMS norm residual= 0.1098222E+00 0.2951975E+02 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 6954 # it. GCRO # it.GMRES Error Estimate 0 0 0.6520652E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.6520652E+00 1 0.8484210E-01 0.1301129E+00 2 0.1365033E-01 0.2093399E-01 3 0.2933134E-02 0.4498222E-02 4 0.8046730E-03 0.1234038E-02 5 0.2160135E-03 0.3312759E-03 Result GMRES:5, 2.5E-2, 2.1601349788285E-4, 0 1 5 0.2160135E-03 0.6085025E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2160135E-03 1 0.7335697E-04 0.3395944E+00 2 0.1940381E-04 0.8982683E-01 3 0.4376526E-05 0.2026043E-01 4 0.9757792E-06 0.4517214E-02 5 0.2245087E-06 0.1039327E-02 6 0.5720282E-07 0.2648113E-03 Result GMRES:6, 2.5E-2, 5.720282497941E-8, 0 2 11 0.5720282E-07 0.2026368E-03 NI: 2, NLI: 13, ERLI 0.5720282E-07, ERNI: 0.6085074E+00 T= 0.32E+00, LEVEL= 2 ,TOLWGT=0.9, SPCMON= 0.14E+02 Time integration at T= 0.32E+00, Grid level= 3, NPTS= 12215 Nonlinear system solver at T = 0.3233035E+00 Max. and WRMS norm residual= 0.7341150E+01 0.1967129E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 36645 # it. GCRO # it.GMRES Error Estimate 0 0 0.4083078E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4083078E+02 1 0.1065058E+02 0.2608468E+00 2 0.2658050E+01 0.6509917E-01 3 0.7630785E+00 0.1868881E-01 4 0.2746635E+00 0.6726873E-02 5 0.1265060E+00 0.3098300E-02 6 0.5104997E-01 0.1250281E-02 7 0.2080944E-01 0.5096507E-03 Result GMRES:7, 5.E-2, 2.0809437369025E-2, 0 1 7 0.2080944E-01 0.4409148E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2080944E-01 1 0.1048855E-01 0.5040285E+00 2 0.4401113E-02 0.2114960E+00 3 0.1778784E-02 0.8547966E-01 4 0.8686604E-03 0.4174358E-01 5 0.3543094E-03 0.1702638E-01 6 0.1700741E-03 0.8172934E-02 7 0.7242931E-04 0.3480599E-02 8 0.3315131E-04 0.1593090E-02 9 0.1463185E-04 0.7031351E-03 Result GMRES:9, 5.E-2, 1.463184644491E-5, 0 2 16 0.1463185E-04 0.1919810E-01 NI: 1, NLI: 18, ERLI 0.1463185E-04, ERNI: 0.4409178E+02 Max. and WRMS norm residual= 0.3723000E+00 0.1122836E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 36645 # it. GCRO # it.GMRES Error Estimate 0 0 0.1967993E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1967993E+01 1 0.5892974E+00 0.2994408E+00 2 0.9537830E-01 0.4846476E-01 3 0.3795750E-01 0.1928741E-01 4 0.1500702E-01 0.7625545E-02 5 0.6978474E-02 0.3545985E-02 6 0.2630376E-02 0.1336578E-02 7 0.1188692E-02 0.6040122E-03 Result GMRES:7, 2.5E-2, 1.1886917605298E-3, 0 1 7 0.1188692E-02 0.1871195E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1188692E-02 1 0.6118390E-03 0.5147163E+00 2 0.2565213E-03 0.2158013E+00 3 0.1000250E-03 0.8414715E-01 4 0.4987030E-04 0.4195394E-01 5 0.1991996E-04 0.1675789E-01 6 0.9510748E-05 0.8001021E-02 7 0.4060465E-05 0.3415910E-02 8 0.1892866E-05 0.1592394E-02 9 0.8448878E-06 0.7107711E-03 Result GMRES:9, 2.5E-2, 8.4488777699866E-7, 0 2 16 0.8448878E-06 0.1098640E-02 NI: 2, NLI: 18, ERLI 0.8448878E-06, ERNI: 0.1871279E+01 T= 0.32E+00, LEVEL= 3 ,TOLWGT=0.9, SPCMON= 0.45E+01 Time integration at T= 0.32E+00, Grid level= 4, NPTS= 54777 Nonlinear system solver at T = 0.3233035E+00 Max. and WRMS norm residual= 0.7534041E+01 0.2711909E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 164331 # it. GCRO # it.GMRES Error Estimate 0 0 0.3188138E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3188138E+02 1 0.1365910E+02 0.4284348E+00 2 0.5370341E+01 0.1684476E+00 3 0.2204467E+01 0.6914591E-01 4 0.1165244E+01 0.3654936E-01 5 0.7180032E+00 0.2252108E-01 6 0.4157999E+00 0.1304209E-01 7 0.2529786E+00 0.7934995E-02 8 0.1568988E+00 0.4921330E-02 9 0.9668927E-01 0.3032781E-02 10 0.6061210E-01 0.1901175E-02 11 0.3838530E-01 0.1204004E-02 12 0.2408151E-01 0.7553471E-03 Result GMRES:12, 5.E-2, 2.4081511607423E-2, 0 1 12 0.2408151E-01 0.5605748E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2408151E-01 1 0.1581289E-01 0.6566402E+00 2 0.9905165E-02 0.4113183E+00 3 0.6344300E-02 0.2634511E+00 4 0.4107810E-02 0.1705794E+00 5 0.2650609E-02 0.1100682E+00 6 0.1712124E-02 0.7109704E-01 7 0.1109120E-02 0.4605693E-01 8 0.7050872E-03 0.2927919E-01 9 0.4606752E-03 0.1912983E-01 10 0.2897735E-03 0.1203303E-01 11 0.1890494E-03 0.7850397E-02 12 0.1207449E-03 0.5014009E-02 13 0.7861254E-04 0.3264436E-02 14 0.5089204E-04 0.2113324E-02 15 0.3318159E-04 0.1377887E-02 16 0.2153838E-04 0.8943947E-03 Result GMRES:16, 5.E-2, 2.1538376119751E-5, 0 2 28 0.2153838E-04 0.3590476E-01 NI: 1, NLI: 30, ERLI 0.2153838E-04, ERNI: 0.5605829E+02 Max. and WRMS norm residual= 0.6546586E+00 0.2267508E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 164331 # it. GCRO # it.GMRES Error Estimate 0 0 0.2117391E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2117391E+01 1 0.1050828E+01 0.4962843E+00 2 0.3590752E+00 0.1695838E+00 3 0.1509267E+00 0.7127958E-01 4 0.7525794E-01 0.3554278E-01 5 0.4674043E-01 0.2207454E-01 6 0.2628082E-01 0.1241189E-01 7 0.1547638E-01 0.7309177E-02 8 0.9568811E-02 0.4519152E-02 9 0.5646729E-02 0.2666834E-02 10 0.3463488E-02 0.1635734E-02 11 0.2139474E-02 0.1010429E-02 12 0.1298834E-02 0.6134126E-03 Result GMRES:12, 2.5E-2, 1.2988342429429E-3, 0 1 12 0.1298834E-02 0.2895002E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1298834E-02 1 0.8393317E-03 0.6462193E+00 2 0.5169262E-03 0.3979924E+00 3 0.3234389E-03 0.2490225E+00 4 0.2080255E-03 0.1601632E+00 5 0.1315021E-03 0.1012462E+00 6 0.8355199E-04 0.6432845E-01 7 0.5355134E-04 0.4123031E-01 8 0.3356867E-04 0.2584523E-01 9 0.2180240E-04 0.1678613E-01 10 0.1365864E-04 0.1051607E-01 11 0.8921936E-05 0.6869188E-02 12 0.5735709E-05 0.4416044E-02 13 0.3755806E-05 0.2891674E-02 14 0.2451502E-05 0.1887463E-02 15 0.1614512E-05 0.1243047E-02 16 0.1060954E-05 0.8168511E-03 Result GMRES:16, 2.5E-2, 1.06095415931E-6, 0 2 28 0.1060954E-05 0.1905899E-02 NI: 2, NLI: 30, ERLI 0.1060954E-05, ERNI: 0.2895096E+01 T= 0.32E+00, LEVEL= 4 ,TOLWGT=1.0, SPCMON= 0.18E+01 TN= 0.29E+00, DT= 0.29E-01, DTNEW= 0.29E-01, TIMMON= 0.51E+00 Time integration at T= 0.35E+00, Grid level= 1, NPTS= 384 Nonlinear system solver at T = 0.3514992E+00 Max. and WRMS norm residual= 0.7274623E+00 0.2102162E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.6733877E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.6733877E+01 1 0.4407737E+00 0.6545616E-01 2 0.3308893E-01 0.4913801E-02 3 0.5245833E-02 0.7790212E-03 Result GMRES:3, 5.E-2, 5.2458328350106E-3, 0 1 3 0.5245833E-02 0.6494769E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.5245833E-02 1 0.7132755E-03 0.1359699E+00 2 0.8411158E-04 0.1603398E-01 3 0.7230834E-05 0.1378396E-02 4 0.9400320E-06 0.1791959E-03 Result GMRES:4, 5.E-2, 9.4003196691699E-7, 0 2 7 0.9400320E-06 0.5197173E-02 NI: 1, NLI: 9, ERLI 0.9400320E-06, ERNI: 0.6494884E+01 Max. and WRMS norm residual= 0.1132246E-02 0.3644528E+00 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.7711200E-02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.7711200E-02 1 0.5253246E-03 0.6812489E-01 2 0.6890030E-04 0.8935096E-02 3 0.8455615E-05 0.1096537E-02 4 0.9333436E-06 0.1210374E-03 Result GMRES:4, 2.5E-2, 9.3334362327945E-7, 0 1 4 0.9333436E-06 0.7520278E-02 NI: 2, NLI: 5, ERLI 0.9333436E-06, ERNI: 0.7520278E-02 T= 0.35E+00, LEVEL= 1 ,TOLWGT=0.9, SPCMON= 0.18E+02 Time integration at T= 0.35E+00, Grid level= 2, NPTS= 2334 Nonlinear system solver at T = 0.3514992E+00 Max. and WRMS norm residual= 0.5494498E+01 0.1425643E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 7002 # it. GCRO # it.GMRES Error Estimate 0 0 0.4012761E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4012761E+02 1 0.5638433E+01 0.1405125E+00 2 0.6436427E+00 0.1603989E-01 3 0.1314143E+00 0.3274909E-02 4 0.2385624E-01 0.5945093E-03 Result GMRES:4, 5.E-2, 2.3856241364451E-2, 0 1 4 0.2385624E-01 0.3976664E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2385624E-01 1 0.7971842E-02 0.3341617E+00 2 0.1796736E-02 0.7531513E-01 3 0.5279695E-03 0.2213129E-01 4 0.1072961E-03 0.4497612E-02 5 0.2785312E-04 0.1167540E-02 6 0.6290603E-05 0.2636880E-03 Result GMRES:6, 5.E-2, 6.2906033819164E-6, 0 2 10 0.6290603E-05 0.2236812E-01 NI: 1, NLI: 12, ERLI 0.6290603E-05, ERNI: 0.3976715E+02 Max. and WRMS norm residual= 0.3746957E-01 0.1016125E+02 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 7002 # it. GCRO # it.GMRES Error Estimate 0 0 0.2044765E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2044765E+00 1 0.2365004E-01 0.1156614E+00 2 0.3667442E-02 0.1793576E-01 3 0.6727509E-03 0.3290113E-02 4 0.1550867E-03 0.7584572E-03 Result GMRES:4, 2.5E-2, 1.5508668673583E-4, 0 1 4 0.1550867E-03 0.2015507E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1550867E-03 1 0.5245412E-04 0.3382245E+00 2 0.1145432E-04 0.7385751E-01 3 0.3071633E-05 0.1980591E-01 4 0.7043496E-06 0.4541651E-02 5 0.2113929E-06 0.1363063E-02 6 0.4590403E-07 0.2959895E-03 Result GMRES:6, 2.5E-2, 4.5904033631465E-8, 0 2 10 0.4590403E-07 0.1475762E-03 NI: 2, NLI: 12, ERLI 0.4590403E-07, ERNI: 0.2015515E+00 T= 0.35E+00, LEVEL= 2 ,TOLWGT=0.9, SPCMON= 0.11E+02 Time integration at T= 0.35E+00, Grid level= 3, NPTS= 12515 Nonlinear system solver at T = 0.3514992E+00 Max. and WRMS norm residual= 0.6232552E+01 0.1941244E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 37545 # it. GCRO # it.GMRES Error Estimate 0 0 0.3940032E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3940032E+02 1 0.9769046E+01 0.2479433E+00 2 0.2487735E+01 0.6313998E-01 3 0.6936753E+00 0.1760583E-01 4 0.2419215E+00 0.6140089E-02 5 0.1103798E+00 0.2801496E-02 6 0.4272858E-01 0.1084473E-02 7 0.1759087E-01 0.4464651E-03 Result GMRES:7, 5.E-2, 1.759086576203E-2, 0 1 7 0.1759087E-01 0.4209705E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1759087E-01 1 0.8846729E-02 0.5029160E+00 2 0.3587113E-02 0.2039191E+00 3 0.1451445E-02 0.8251131E-01 4 0.6995724E-03 0.3976907E-01 5 0.2722879E-03 0.1547894E-01 6 0.1320281E-03 0.7505491E-02 7 0.5356604E-04 0.3045105E-02 8 0.2484942E-04 0.1412632E-02 9 0.1064660E-04 0.6052348E-03 Result GMRES:9, 5.E-2, 1.0646604561728E-5, 0 2 16 0.1064660E-04 0.1628008E-01 NI: 1, NLI: 18, ERLI 0.1064660E-04, ERNI: 0.4209719E+02 Max. and WRMS norm residual= 0.4526926E+00 0.1153975E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 37545 # it. GCRO # it.GMRES Error Estimate 0 0 0.2028667E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2028667E+01 1 0.5580062E+00 0.2750605E+00 2 0.9020050E-01 0.4446294E-01 3 0.3280778E-01 0.1617209E-01 4 0.1368627E-01 0.6746438E-02 5 0.5653046E-02 0.2786582E-02 6 0.2340989E-02 0.1153954E-02 7 0.9700591E-03 0.4781756E-03 Result GMRES:7, 2.5E-2, 9.7005911784481E-4, 0 1 7 0.9700591E-03 0.1760667E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.9700591E-03 1 0.5041030E-03 0.5196622E+00 2 0.2033959E-03 0.2096737E+00 3 0.8177433E-04 0.8429830E-01 4 0.3884362E-04 0.4004252E-01 5 0.1616421E-04 0.1666312E-01 6 0.7318977E-05 0.7544878E-02 7 0.3261358E-05 0.3362019E-02 8 0.1438031E-05 0.1482416E-02 9 0.6436972E-06 0.6635649E-03 Result GMRES:9, 2.5E-2, 6.4369718808155E-7, 0 2 16 0.6436972E-06 0.8984423E-03 NI: 2, NLI: 18, ERLI 0.6436972E-06, ERNI: 0.1760747E+01 T= 0.35E+00, LEVEL= 3 ,TOLWGT=0.9, SPCMON= 0.58E+01 Time integration at T= 0.35E+00, Grid level= 4, NPTS= 59145 Nonlinear system solver at T = 0.3514992E+00 Max. and WRMS norm residual= 0.7456965E+01 0.2589681E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 177435 # it. GCRO # it.GMRES Error Estimate 0 0 0.2987422E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2987422E+02 1 0.1259339E+02 0.4215470E+00 2 0.4875154E+01 0.1631893E+00 3 0.1981626E+01 0.6633230E-01 4 0.1040537E+01 0.3483060E-01 5 0.6352841E+00 0.2126530E-01 6 0.3639421E+00 0.1218248E-01 7 0.2195890E+00 0.7350450E-02 8 0.1348212E+00 0.4512961E-02 9 0.8232466E-01 0.2755710E-02 10 0.5111102E-01 0.1710874E-02 11 0.3205448E-01 0.1072981E-02 12 0.1991164E-01 0.6665159E-03 Result GMRES:12, 5.E-2, 1.9911640513021E-2, 0 1 12 0.1991164E-01 0.5198786E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1991164E-01 1 0.1294989E-01 0.6503679E+00 2 0.8029607E-02 0.4032620E+00 3 0.5090326E-02 0.2556457E+00 4 0.3263199E-02 0.1638840E+00 5 0.2084951E-02 0.1047102E+00 6 0.1333231E-02 0.6695735E-01 7 0.8551099E-03 0.4294522E-01 8 0.5383398E-03 0.2703643E-01 9 0.3484251E-03 0.1749856E-01 10 0.2170825E-03 0.1090229E-01 11 0.1403125E-03 0.7046756E-02 12 0.8877231E-04 0.4458312E-02 13 0.5725390E-04 0.2875398E-02 14 0.3672178E-04 0.1844237E-02 15 0.2372129E-04 0.1191328E-02 16 0.1525762E-04 0.7662662E-03 Result GMRES:16, 5.E-2, 1.5257616763048E-5, 0 2 28 0.1525762E-04 0.2932939E-01 NI: 1, NLI: 30, ERLI 0.1525762E-04, ERNI: 0.5198848E+02 Max. and WRMS norm residual= 0.5952574E+00 0.2025832E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 177435 # it. GCRO # it.GMRES Error Estimate 0 0 0.1866291E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1866291E+01 1 0.9087347E+00 0.4869202E+00 2 0.3051537E+00 0.1635082E+00 3 0.1273597E+00 0.6824216E-01 4 0.6380397E-01 0.3418759E-01 5 0.3928715E-01 0.2105093E-01 6 0.2186021E-01 0.1171319E-01 7 0.1280123E-01 0.6859186E-02 8 0.7832558E-02 0.4196858E-02 9 0.4583133E-02 0.2455744E-02 10 0.2786527E-02 0.1493083E-02 11 0.1704770E-02 0.9134535E-03 Result GMRES:11, 2.5E-2, 1.7047697781345E-3, 0 1 11 0.1704770E-02 0.2537916E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1704770E-02 1 0.1086073E-02 0.6370788E+00 2 0.6624817E-03 0.3886048E+00 3 0.4075967E-03 0.2390920E+00 4 0.2588660E-03 0.1518480E+00 5 0.1623746E-03 0.9524723E-01 6 0.9990066E-04 0.5860068E-01 7 0.6383837E-04 0.3744691E-01 8 0.3829832E-04 0.2246539E-01 9 0.2459393E-04 0.1442654E-01 10 0.1521773E-04 0.8926560E-02 11 0.9775862E-05 0.5734418E-02 12 0.6210271E-05 0.3642880E-02 13 0.4005986E-05 0.2349869E-02 14 0.2582205E-05 0.1514694E-02 15 0.1675558E-05 0.9828647E-03 Result GMRES:15, 2.5E-2, 1.6755580329291E-6, 0 2 26 0.1675558E-05 0.2449517E-02 NI: 2, NLI: 28, ERLI 0.1675558E-05, ERNI: 0.2538061E+01 T= 0.35E+00, LEVEL= 4 ,TOLWGT=1.0, SPCMON= 0.18E+01 TN= 0.32E+00, DT= 0.28E-01, DTNEW= 0.30E-01, TIMMON= 0.47E+00 Time integration at T= 0.38E+00, Grid level= 1, NPTS= 384 Nonlinear system solver at T = 0.3809765E+00 Max. and WRMS norm residual= 0.7102820E+00 0.2375933E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.1338265E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1338265E+02 1 0.5434861E+00 0.4061123E-01 2 0.4625213E-01 0.3456126E-02 3 0.5437407E-02 0.4063026E-03 Result GMRES:3, 5.E-2, 5.4374068479523E-3, 0 1 3 0.5437407E-02 0.1340687E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.5437407E-02 1 0.8954332E-03 0.1646802E+00 2 0.9990425E-04 0.1837351E-01 3 0.8893805E-05 0.1635670E-02 4 0.1050285E-05 0.1931592E-03 Result GMRES:4, 5.E-2, 1.0502850886842E-6, 0 2 7 0.1050285E-05 0.5198091E-02 NI: 1, NLI: 9, ERLI 0.1050285E-05, ERNI: 0.1340692E+02 Max. and WRMS norm residual= 0.1604595E-02 0.4555823E+00 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.1003816E-01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1003816E-01 1 0.7607110E-03 0.7578190E-01 2 0.1072077E-03 0.1068002E-01 3 0.1303874E-04 0.1298917E-02 4 0.1446933E-05 0.1441432E-03 Result GMRES:4, 2.5E-2, 1.4469326873182E-6, 0 1 4 0.1446933E-05 0.9628068E-02 NI: 2, NLI: 5, ERLI 0.1446933E-05, ERNI: 0.9628068E-02 T= 0.38E+00, LEVEL= 1 ,TOLWGT=0.9, SPCMON= 0.17E+02 Time integration at T= 0.38E+00, Grid level= 2, NPTS= 2358 Nonlinear system solver at T = 0.3809765E+00 Max. and WRMS norm residual= 0.7185003E+01 0.1724780E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 7074 # it. GCRO # it.GMRES Error Estimate 0 0 0.4227993E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4227993E+02 1 0.6555440E+01 0.1550485E+00 2 0.8608496E+00 0.2036071E-01 3 0.1639535E+00 0.3877808E-02 4 0.3774527E-01 0.8927466E-03 Result GMRES:4, 5.E-2, 3.7745265387005E-2, 0 1 4 0.3774527E-01 0.4215848E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3774527E-01 1 0.1437383E-01 0.3808114E+00 2 0.2981012E-02 0.7897710E-01 3 0.8353156E-03 0.2213034E-01 4 0.1621218E-03 0.4295155E-02 5 0.4694213E-04 0.1243656E-02 6 0.9848574E-05 0.2609221E-03 Result GMRES:6, 5.E-2, 9.8485739465719E-6, 0 2 10 0.9848574E-05 0.3618033E-01 NI: 1, NLI: 12, ERLI 0.9848574E-05, ERNI: 0.4215888E+02 Max. and WRMS norm residual= 0.1501706E+00 0.3812499E+02 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 7074 # it. GCRO # it.GMRES Error Estimate 0 0 0.8055543E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.8055543E+00 1 0.1002871E+00 0.1244945E+00 2 0.1762588E-01 0.2188043E-01 3 0.3138886E-02 0.3896555E-02 4 0.8706445E-03 0.1080802E-02 5 0.2177617E-03 0.2703253E-03 Result GMRES:5, 2.5E-2, 2.177616897089E-4, 0 1 5 0.2177617E-03 0.7699723E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2177617E-03 1 0.7367234E-04 0.3383164E+00 2 0.1875796E-04 0.8613986E-01 3 0.4405502E-05 0.2023084E-01 4 0.9260019E-06 0.4252364E-02 5 0.2229139E-06 0.1023660E-02 6 0.5443830E-07 0.2499903E-03 Result GMRES:6, 2.5E-2, 5.4438303897822E-8, 0 2 11 0.5443830E-07 0.1996474E-03 NI: 2, NLI: 13, ERLI 0.5443830E-07, ERNI: 0.7699806E+00 T= 0.38E+00, LEVEL= 2 ,TOLWGT=0.9, SPCMON= 0.10E+02 Time integration at T= 0.38E+00, Grid level= 3, NPTS= 12577 Nonlinear system solver at T = 0.3809765E+00 Max. and WRMS norm residual= 0.7410877E+01 0.1960346E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 37731 # it. GCRO # it.GMRES Error Estimate 0 0 0.4081387E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4081387E+02 1 0.1065202E+02 0.2609902E+00 2 0.2688645E+01 0.6587577E-01 3 0.7744250E+00 0.1897455E-01 4 0.2853810E+00 0.6992255E-02 5 0.1325628E+00 0.3247984E-02 6 0.5317197E-01 0.1302792E-02 7 0.2202007E-01 0.5395241E-03 Result GMRES:7, 5.E-2, 2.2020067173424E-2, 0 1 7 0.2202007E-01 0.4401662E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2202007E-01 1 0.1113729E-01 0.5057791E+00 2 0.4652182E-02 0.2112701E+00 3 0.1885175E-02 0.8561167E-01 4 0.9263393E-03 0.4206796E-01 5 0.3770688E-03 0.1712387E-01 6 0.1814195E-03 0.8238827E-02 7 0.7727849E-04 0.3509457E-02 8 0.3540500E-04 0.1607852E-02 9 0.1566925E-04 0.7115896E-03 Result GMRES:9, 5.E-2, 1.5669250720065E-5, 0 2 16 0.1566925E-04 0.2025536E-01 NI: 1, NLI: 18, ERLI 0.1566925E-04, ERNI: 0.4401701E+02 Max. and WRMS norm residual= 0.4108071E+00 0.1151346E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 37731 # it. GCRO # it.GMRES Error Estimate 0 0 0.2030528E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2030528E+01 1 0.5907030E+00 0.2909111E+00 2 0.9683692E-01 0.4769052E-01 3 0.3982003E-01 0.1961068E-01 4 0.1597082E-01 0.7865355E-02 5 0.7416770E-02 0.3652632E-02 6 0.2814669E-02 0.1386176E-02 7 0.1290180E-02 0.6353914E-03 Result GMRES:7, 2.5E-2, 1.2901798757929E-3, 0 1 7 0.1290180E-02 0.1917958E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1290180E-02 1 0.6650550E-03 0.5154747E+00 2 0.2790596E-03 0.2162951E+00 3 0.1082444E-03 0.8389869E-01 4 0.5458985E-04 0.4231182E-01 5 0.2180159E-04 0.1689810E-01 6 0.1037700E-04 0.8043061E-02 7 0.4450695E-05 0.3449670E-02 8 0.2076113E-05 0.1609165E-02 9 0.9263955E-06 0.7180359E-03 Result GMRES:9, 2.5E-2, 9.2639550231837E-7, 0 2 16 0.9263955E-06 0.1190116E-02 NI: 2, NLI: 18, ERLI 0.9263955E-06, ERNI: 0.1918060E+01 T= 0.38E+00, LEVEL= 3 ,TOLWGT=0.9, SPCMON= 0.47E+01 Time integration at T= 0.38E+00, Grid level= 4, NPTS= 56612 Nonlinear system solver at T = 0.3809765E+00 Max. and WRMS norm residual= 0.7574811E+01 0.2698738E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 169836 # it. GCRO # it.GMRES Error Estimate 0 0 0.3179873E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3179873E+02 1 0.1360252E+02 0.4277693E+00 2 0.5382684E+01 0.1692736E+00 3 0.2248826E+01 0.7072063E-01 4 0.1212226E+01 0.3812185E-01 5 0.7481629E+00 0.2352808E-01 6 0.4337537E+00 0.1364060E-01 7 0.2655037E+00 0.8349505E-02 8 0.1646991E+00 0.5179423E-02 9 0.1017721E+00 0.3200508E-02 10 0.6395337E-01 0.2011193E-02 11 0.4052529E-01 0.1274431E-02 12 0.2547235E-01 0.8010492E-03 Result GMRES:12, 5.E-2, 2.5472348669994E-2, 0 1 12 0.2547235E-01 0.5578362E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2547235E-01 1 0.1674267E-01 0.6572880E+00 2 0.1049717E-01 0.4121008E+00 3 0.6729508E-02 0.2641887E+00 4 0.4360525E-02 0.1711866E+00 5 0.2816780E-02 0.1105819E+00 6 0.1821583E-02 0.7151218E-01 7 0.1180978E-02 0.4636314E-01 8 0.7523597E-03 0.2953633E-01 9 0.4921948E-03 0.1932271E-01 10 0.3101365E-03 0.1217542E-01 11 0.2026149E-03 0.7954306E-02 12 0.1295853E-03 0.5087291E-02 13 0.8449219E-04 0.3317016E-02 14 0.5478238E-04 0.2150661E-02 15 0.3577110E-04 0.1404311E-02 16 0.2325284E-04 0.9128658E-03 Result GMRES:16, 5.E-2, 2.3252835757567E-5, 0 2 28 0.2325284E-04 0.3800272E-01 NI: 1, NLI: 30, ERLI 0.2325284E-04, ERNI: 0.5578454E+02 Max. and WRMS norm residual= 0.6387294E+00 0.2265403E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 169836 # it. GCRO # it.GMRES Error Estimate 0 0 0.2117406E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2117406E+01 1 0.1053396E+01 0.4974936E+00 2 0.3605697E+00 0.1702884E+00 3 0.1538473E+00 0.7265840E-01 4 0.7841763E-01 0.3703477E-01 5 0.4888904E-01 0.2308913E-01 6 0.2748817E-01 0.1298200E-01 7 0.1629789E-01 0.7697104E-02 8 0.1006841E-01 0.4755069E-02 9 0.5952638E-02 0.2811289E-02 10 0.3659369E-02 0.1728232E-02 11 0.2259581E-02 0.1067146E-02 12 0.1373869E-02 0.6488454E-03 Result GMRES:12, 2.5E-2, 1.3738688242735E-3, 0 1 12 0.1373869E-02 0.2890038E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1373869E-02 1 0.8882114E-03 0.6465038E+00 2 0.5470124E-03 0.3981547E+00 3 0.3423474E-03 0.2491849E+00 4 0.2202596E-03 0.1603207E+00 5 0.1393708E-03 0.1014440E+00 6 0.8863939E-04 0.6451809E-01 7 0.5687189E-04 0.4139543E-01 8 0.3567446E-04 0.2596642E-01 9 0.2320877E-04 0.1689301E-01 10 0.1452089E-04 0.1056935E-01 11 0.9498750E-05 0.6913870E-02 12 0.6106517E-05 0.4444760E-02 13 0.4003354E-05 0.2913928E-02 14 0.2614908E-05 0.1903317E-02 15 0.1724158E-05 0.1254965E-02 16 0.1133775E-05 0.8252426E-03 Result GMRES:16, 2.5E-2, 1.1337751154207E-6, 0 2 28 0.1133775E-05 0.2011878E-02 NI: 2, NLI: 30, ERLI 0.1133775E-05, ERNI: 0.2890133E+01 T= 0.38E+00, LEVEL= 4 ,TOLWGT=1.0, SPCMON= 0.18E+01 TN= 0.35E+00, DT= 0.29E-01, DTNEW= 0.29E-01, TIMMON= 0.51E+00 Time integration at T= 0.41E+00, Grid level= 1, NPTS= 384 Nonlinear system solver at T = 0.4091139E+00 Max. and WRMS norm residual= 0.1611333E+01 0.5159055E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.2901767E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2901767E+02 1 0.1174300E+01 0.4046844E-01 2 0.8431996E-01 0.2905815E-02 3 0.8768256E-02 0.3021696E-03 Result GMRES:3, 5.E-2, 8.7682555851464E-3, 0 1 3 0.8768256E-02 0.2906315E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.8768256E-02 1 0.1333065E-02 0.1520331E+00 2 0.1471597E-03 0.1678323E-01 3 0.1384388E-04 0.1578863E-02 4 0.1614395E-05 0.1841182E-03 Result GMRES:4, 5.E-2, 1.6143951624714E-6, 0 2 7 0.1614395E-05 0.8356027E-02 NI: 1, NLI: 9, ERLI 0.1614395E-05, ERNI: 0.2906318E+02 Max. and WRMS norm residual= 0.5982424E-02 0.1804509E+01 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.3801610E-01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3801610E-01 1 0.2608157E-02 0.6860664E-01 2 0.3456424E-03 0.9091999E-02 3 0.4107998E-04 0.1080594E-02 4 0.4367252E-05 0.1148790E-03 Result GMRES:4, 2.5E-2, 4.3672522795418E-6, 0 1 4 0.4367252E-05 0.3662759E-01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4367252E-05 1 0.5777972E-06 0.1323022E+00 2 0.8017115E-07 0.1835734E-01 3 0.6390172E-08 0.1463202E-02 4 0.6319262E-09 0.1446965E-03 Result GMRES:4, 2.5E-2, 6.3192620539516E-10, 0 2 8 0.6319262E-09 0.4185013E-05 NI: 2, NLI: 10, ERLI 0.6319262E-09, ERNI: 0.3662750E-01 T= 0.41E+00, LEVEL= 1 ,TOLWGT=0.9, SPCMON= 0.15E+02 Time integration at T= 0.41E+00, Grid level= 2, NPTS= 2358 Nonlinear system solver at T = 0.4091139E+00 Max. and WRMS norm residual= 0.6112798E+01 0.1542993E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 7074 # it. GCRO # it.GMRES Error Estimate 0 0 0.3690211E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3690211E+02 1 0.5100493E+01 0.1382168E+00 2 0.7888739E+00 0.2137747E-01 3 0.1391193E+00 0.3769955E-02 4 0.3427192E-01 0.9287251E-03 Result GMRES:4, 5.E-2, 3.4271915301103E-2, 0 1 4 0.3427192E-01 0.3561714E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3427192E-01 1 0.1206914E-01 0.3521582E+00 2 0.2624159E-02 0.7656880E-01 3 0.5932369E-03 0.1730971E-01 4 0.1347052E-03 0.3930484E-02 5 0.3586521E-04 0.1046490E-02 6 0.7379318E-05 0.2153168E-03 Result GMRES:6, 5.E-2, 7.3793183435557E-6, 0 2 10 0.7379318E-05 0.3230426E-01 NI: 1, NLI: 12, ERLI 0.7379318E-05, ERNI: 0.3561791E+02 Max. and WRMS norm residual= 0.1565045E+00 0.3987798E+02 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 7074 # it. GCRO # it.GMRES Error Estimate 0 0 0.8246771E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.8246771E+00 1 0.1073237E+00 0.1301403E+00 2 0.1706056E-01 0.2068757E-01 3 0.3398660E-02 0.4121201E-02 4 0.8988968E-03 0.1089999E-02 5 0.2271175E-03 0.2754017E-03 Result GMRES:5, 2.5E-2, 2.2711748937098E-4, 0 1 5 0.2271175E-03 0.7882083E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2271175E-03 1 0.7203394E-04 0.3171660E+00 2 0.1873872E-04 0.8250671E-01 3 0.4094394E-05 0.1802765E-01 4 0.9463308E-06 0.4166702E-02 5 0.1937147E-06 0.8529273E-03 Result GMRES:5, 2.5E-2, 1.9371469770695E-7, 0 2 10 0.1937147E-06 0.2116438E-03 NI: 2, NLI: 12, ERLI 0.1937147E-06, ERNI: 0.7882172E+00 T= 0.41E+00, LEVEL= 2 ,TOLWGT=0.9, SPCMON= 0.13E+02 Time integration at T= 0.41E+00, Grid level= 3, NPTS= 12101 Nonlinear system solver at T = 0.4091139E+00 Max. and WRMS norm residual= 0.6083708E+01 0.1989204E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 36303 # it. GCRO # it.GMRES Error Estimate 0 0 0.4036201E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4036201E+02 1 0.1005370E+02 0.2490883E+00 2 0.2555289E+01 0.6330927E-01 3 0.7255200E+00 0.1797532E-01 4 0.2564660E+00 0.6354142E-02 5 0.1176242E+00 0.2914231E-02 6 0.4571486E-01 0.1132621E-02 7 0.1891834E-01 0.4687165E-03 Result GMRES:7, 5.E-2, 1.8918338447033E-2, 0 1 7 0.1891834E-01 0.4304258E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1891834E-01 1 0.9519340E-02 0.5031806E+00 2 0.3852571E-02 0.2036421E+00 3 0.1558088E-02 0.8235858E-01 4 0.7521980E-03 0.3976026E-01 5 0.2924977E-03 0.1546107E-01 6 0.1419094E-03 0.7501153E-02 7 0.5745690E-04 0.3037101E-02 8 0.2666228E-04 0.1409335E-02 9 0.1140487E-04 0.6028474E-03 Result GMRES:9, 5.E-2, 1.1404871796157E-5, 0 2 16 0.1140487E-04 0.1750889E-01 NI: 1, NLI: 18, ERLI 0.1140487E-04, ERNI: 0.4304278E+02 Max. and WRMS norm residual= 0.4405789E+00 0.1155342E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 36303 # it. GCRO # it.GMRES Error Estimate 0 0 0.2023694E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2023694E+01 1 0.5687637E+00 0.2810522E+00 2 0.9321096E-01 0.4605981E-01 3 0.3384300E-01 0.1672338E-01 4 0.1422652E-01 0.7029977E-02 5 0.5886432E-02 0.2908756E-02 6 0.2452365E-02 0.1211826E-02 7 0.1014483E-02 0.5013024E-03 Result GMRES:7, 2.5E-2, 1.0144827775855E-3, 0 1 7 0.1014483E-02 0.1756571E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1014483E-02 1 0.5287110E-03 0.5211631E+00 2 0.2127622E-03 0.2097248E+00 3 0.8584108E-04 0.8461561E-01 4 0.4077343E-04 0.4019134E-01 5 0.1697490E-04 0.1673256E-01 6 0.7685778E-05 0.7576055E-02 7 0.3427622E-05 0.3378689E-02 8 0.1514967E-05 0.1493340E-02 9 0.6786410E-06 0.6689527E-03 Result GMRES:9, 2.5E-2, 6.7864098411073E-7, 0 2 16 0.6786410E-06 0.9419600E-03 NI: 2, NLI: 18, ERLI 0.6786410E-06, ERNI: 0.1756653E+01 T= 0.41E+00, LEVEL= 3 ,TOLWGT=0.9, SPCMON= 0.58E+01 Time integration at T= 0.41E+00, Grid level= 4, NPTS= 60640 Nonlinear system solver at T = 0.4091139E+00 Max. and WRMS norm residual= 0.7469804E+01 0.2577846E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 181920 # it. GCRO # it.GMRES Error Estimate 0 0 0.2977004E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2977004E+02 1 0.1250987E+02 0.4202166E+00 2 0.4865069E+01 0.1634216E+00 3 0.2010424E+01 0.6753180E-01 4 0.1074361E+01 0.3608866E-01 5 0.6555754E+00 0.2202131E-01 6 0.3760838E+00 0.1263296E-01 7 0.2278432E+00 0.7653440E-02 8 0.1398009E+00 0.4696027E-02 9 0.8549373E-01 0.2871804E-02 10 0.5312380E-01 0.1784472E-02 11 0.3328728E-01 0.1118147E-02 12 0.2070164E-01 0.6953849E-03 Result GMRES:12, 5.E-2, 2.0701635923195E-2, 0 1 12 0.2070164E-01 0.5163188E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2070164E-01 1 0.1345842E-01 0.6501140E+00 2 0.8342828E-02 0.4030033E+00 3 0.5287275E-02 0.2554037E+00 4 0.3387618E-02 0.1636401E+00 5 0.2164306E-02 0.1045476E+00 6 0.1384162E-02 0.6686244E-01 7 0.8875622E-03 0.4287401E-01 8 0.5596087E-03 0.2703210E-01 9 0.3620120E-03 0.1748712E-01 10 0.2259823E-03 0.1091616E-01 11 0.1459697E-03 0.7051117E-02 12 0.9244154E-04 0.4465422E-02 13 0.5962218E-04 0.2880071E-02 14 0.3825770E-04 0.1848052E-02 15 0.2471658E-04 0.1193943E-02 16 0.1590334E-04 0.7682165E-03 Result GMRES:16, 5.E-2, 1.5903337301711E-5, 0 2 28 0.1590334E-04 0.3047392E-01 NI: 1, NLI: 30, ERLI 0.1590334E-04, ERNI: 0.5163255E+02 Max. and WRMS norm residual= 0.5787067E+00 0.2011304E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 181920 # it. GCRO # it.GMRES Error Estimate 0 0 0.1852147E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1852147E+01 1 0.9021725E+00 0.4870955E+00 2 0.3029238E+00 0.1635528E+00 3 0.1281259E+00 0.6917697E-01 4 0.6550354E-01 0.3536628E-01 5 0.4041465E-01 0.2182043E-01 6 0.2246043E-01 0.1212670E-01 7 0.1322681E-01 0.7141339E-02 8 0.8076043E-02 0.4360368E-02 9 0.4727991E-02 0.2552708E-02 10 0.2878588E-02 0.1554190E-02 11 0.1757830E-02 0.9490770E-03 Result GMRES:11, 2.5E-2, 1.7578301098653E-3, 0 1 11 0.1757830E-02 0.2513994E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1757830E-02 1 0.1118842E-02 0.6364903E+00 2 0.6820747E-03 0.3880208E+00 3 0.4193789E-03 0.2385776E+00 4 0.2660929E-03 0.1513758E+00 5 0.1669033E-03 0.9494849E-01 6 0.1027364E-03 0.5844501E-01 7 0.6562814E-04 0.3733474E-01 8 0.3936531E-04 0.2239426E-01 9 0.2527639E-04 0.1437932E-01 10 0.1561338E-04 0.8882191E-02 11 0.1002578E-04 0.5703500E-02 12 0.6365578E-05 0.3621270E-02 13 0.4103773E-05 0.2334568E-02 14 0.2645067E-05 0.1504734E-02 15 0.1715535E-05 0.9759390E-03 Result GMRES:15, 2.5E-2, 1.7155350357822E-6, 0 2 26 0.1715535E-05 0.2519225E-02 NI: 2, NLI: 28, ERLI 0.1715535E-05, ERNI: 0.2514141E+01 T= 0.41E+00, LEVEL= 4 ,TOLWGT=1.0, SPCMON= 0.18E+01 TN= 0.38E+00, DT= 0.28E-01, DTNEW= 0.30E-01, TIMMON= 0.47E+00 Time integration at T= 0.44E+00, Grid level= 1, NPTS= 384 Nonlinear system solver at T = 0.4386582E+00 Max. and WRMS norm residual= 0.3227726E+01 0.9377991E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.5100912E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.5100912E+02 1 0.2390890E+01 0.4687183E-01 2 0.1478757E+00 0.2899005E-02 3 0.1700796E-01 0.3334299E-03 Result GMRES:3, 5.E-2, 1.7007963270755E-2, 0 1 3 0.1700796E-01 0.5099144E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1700796E-01 1 0.2299472E-02 0.1351997E+00 2 0.2565647E-03 0.1508497E-01 3 0.2578336E-04 0.1515958E-02 4 0.3233729E-05 0.1901303E-03 Result GMRES:4, 5.E-2, 3.2337285899983E-6, 0 2 7 0.3233729E-05 0.1609735E-01 NI: 1, NLI: 9, ERLI 0.3233729E-05, ERNI: 0.5099153E+02 Max. and WRMS norm residual= 0.9659105E-02 0.2872406E+01 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.6154568E-01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.6154568E-01 1 0.4111865E-02 0.6680997E-01 2 0.5238472E-03 0.8511519E-02 3 0.6464845E-04 0.1050414E-02 4 0.6922380E-05 0.1124755E-03 Result GMRES:4, 2.5E-2, 6.9223801374562E-6, 0 1 4 0.6922380E-05 0.5952033E-01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.6922380E-05 1 0.9036183E-06 0.1305358E+00 2 0.1309526E-06 0.1891728E-01 3 0.1132227E-07 0.1635604E-02 4 0.1053450E-08 0.1521803E-03 Result GMRES:4, 2.5E-2, 1.0534501690852E-9, 0 2 8 0.1053450E-08 0.6647935E-05 NI: 2, NLI: 10, ERLI 0.1053450E-08, ERNI: 0.5952011E-01 T= 0.44E+00, LEVEL= 1 ,TOLWGT=0.9, SPCMON= 0.12E+02 Time integration at T= 0.44E+00, Grid level= 2, NPTS= 2358 Nonlinear system solver at T = 0.4386582E+00 Max. and WRMS norm residual= 0.3375988E+01 0.1225495E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 7074 # it. GCRO # it.GMRES Error Estimate 0 0 0.3835237E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3835237E+02 1 0.5207635E+01 0.1357839E+00 2 0.7508751E+00 0.1957832E-01 3 0.1527570E+00 0.3982989E-02 4 0.3112580E-01 0.8115744E-03 Result GMRES:4, 5.E-2, 3.1125799816806E-2, 0 1 4 0.3112580E-01 0.3677360E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3112580E-01 1 0.9947249E-02 0.3195821E+00 2 0.2494148E-02 0.8013122E-01 3 0.6432469E-03 0.2066604E-01 4 0.1548529E-03 0.4975067E-02 5 0.4083977E-04 0.1312087E-02 6 0.9799696E-05 0.3148416E-03 Result GMRES:6, 5.E-2, 9.7996955534006E-6, 0 2 10 0.9799696E-05 0.2794598E-01 NI: 1, NLI: 12, ERLI 0.9799696E-05, ERNI: 0.3677527E+02 Max. and WRMS norm residual= 0.9881134E-01 0.2686422E+02 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 7074 # it. GCRO # it.GMRES Error Estimate 0 0 0.5970525E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.5970525E+00 1 0.7822015E-01 0.1310105E+00 2 0.1290318E-01 0.2161147E-01 3 0.2733738E-02 0.4578723E-02 4 0.7826172E-03 0.1310801E-02 5 0.2085025E-03 0.3492197E-03 Result GMRES:5, 2.5E-2, 2.0850251159718E-4, 0 1 5 0.2085025E-03 0.5526192E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2085025E-03 1 0.7170424E-04 0.3439011E+00 2 0.1915201E-04 0.9185508E-01 3 0.4405785E-05 0.2113061E-01 4 0.1016495E-05 0.4875218E-02 5 0.2343317E-06 0.1123879E-02 6 0.6202598E-07 0.2974831E-03 Result GMRES:6, 2.5E-2, 6.2025980666907E-8, 0 2 11 0.6202598E-07 0.1952815E-03 NI: 2, NLI: 13, ERLI 0.6202598E-07, ERNI: 0.5526241E+00 T= 0.44E+00, LEVEL= 2 ,TOLWGT=0.9, SPCMON= 0.14E+02 Time integration at T= 0.44E+00, Grid level= 3, NPTS= 12717 Nonlinear system solver at T = 0.4386582E+00 Max. and WRMS norm residual= 0.7453152E+01 0.1962205E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 38151 # it. GCRO # it.GMRES Error Estimate 0 0 0.4102339E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4102339E+02 1 0.1068316E+02 0.2604164E+00 2 0.2733188E+01 0.6662511E-01 3 0.7900487E+00 0.1925849E-01 4 0.2977724E+00 0.7258602E-02 5 0.1387899E+00 0.3383190E-02 6 0.5529016E-01 0.1347772E-02 7 0.2322528E-01 0.5661473E-03 Result GMRES:7, 5.E-2, 2.3225280203205E-2, 0 1 7 0.2322528E-01 0.4418886E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2322528E-01 1 0.1180889E-01 0.5084498E+00 2 0.4906539E-02 0.2112585E+00 3 0.1993918E-02 0.8585118E-01 4 0.9839925E-03 0.4236730E-01 5 0.3996643E-03 0.1720816E-01 6 0.1928654E-03 0.8304117E-02 7 0.8209061E-04 0.3534537E-02 8 0.3768204E-04 0.1622458E-02 9 0.1670256E-04 0.7191544E-03 Result GMRES:9, 5.E-2, 1.67025622494E-5, 0 2 16 0.1670256E-04 0.2131886E-01 NI: 1, NLI: 18, ERLI 0.1670256E-04, ERNI: 0.4418934E+02 Max. and WRMS norm residual= 0.4462814E+00 0.1188746E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 38151 # it. GCRO # it.GMRES Error Estimate 0 0 0.2110497E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2110497E+01 1 0.5967688E+00 0.2827622E+00 2 0.9947490E-01 0.4713340E-01 3 0.4206352E-01 0.1993062E-01 4 0.1702471E-01 0.8066683E-02 5 0.7849077E-02 0.3719066E-02 6 0.3014093E-02 0.1428144E-02 7 0.1394731E-02 0.6608543E-03 Result GMRES:7, 2.5E-2, 1.3947311281629E-3, 0 1 7 0.1394731E-02 0.1977035E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1394731E-02 1 0.7197148E-03 0.5160241E+00 2 0.3028983E-03 0.2171733E+00 3 0.1171327E-03 0.8398226E-01 4 0.5947794E-04 0.4264473E-01 5 0.2384846E-04 0.1709896E-01 6 0.1129835E-04 0.8100739E-02 7 0.4869159E-05 0.3491110E-02 8 0.2271392E-05 0.1628552E-02 9 0.1011853E-05 0.7254823E-03 Result GMRES:9, 2.5E-2, 1.0118527485839E-6, 0 2 16 0.1011853E-05 0.1284732E-02 NI: 2, NLI: 18, ERLI 0.1011853E-05, ERNI: 0.1977158E+01 T= 0.44E+00, LEVEL= 3 ,TOLWGT=0.9, SPCMON= 0.49E+01 Time integration at T= 0.44E+00, Grid level= 4, NPTS= 58192 Nonlinear system solver at T = 0.4386582E+00 Max. and WRMS norm residual= 0.7589450E+01 0.2680770E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 174576 # it. GCRO # it.GMRES Error Estimate 0 0 0.3169293E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3169293E+02 1 0.1353449E+02 0.4270508E+00 2 0.5396462E+01 0.1702734E+00 3 0.2301929E+01 0.7263226E-01 4 0.1265435E+01 0.3992798E-01 5 0.7800727E+00 0.2461346E-01 6 0.4539757E+00 0.1432419E-01 7 0.2791401E+00 0.8807644E-02 8 0.1731417E+00 0.5463100E-02 9 0.1073461E+00 0.3387068E-02 10 0.6749882E-01 0.2129775E-02 11 0.4277861E-01 0.1349784E-02 12 0.2695605E-01 0.8505383E-03 Result GMRES:12, 5.E-2, 2.6956052876701E-2, 0 1 12 0.2695605E-01 0.5545886E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2695605E-01 1 0.1771508E-01 0.6571838E+00 2 0.1111819E-01 0.4124562E+00 3 0.7132174E-02 0.2645853E+00 4 0.4622396E-02 0.1714790E+00 5 0.2988329E-02 0.1108593E+00 6 0.1934710E-02 0.7177273E-01 7 0.1255344E-02 0.4657004E-01 8 0.8026111E-03 0.2977480E-01 9 0.5244434E-03 0.1945550E-01 10 0.3322454E-03 0.1232545E-01 11 0.2167532E-03 0.8040984E-02 12 0.1390400E-03 0.5158027E-02 13 0.9069746E-04 0.3364642E-02 14 0.5888498E-04 0.2184481E-02 15 0.3847766E-04 0.1427422E-02 16 0.2503671E-04 0.9287972E-03 Result GMRES:16, 5.E-2, 2.5036705096762E-5, 0 2 28 0.2503671E-04 0.4023009E-01 NI: 1, NLI: 30, ERLI 0.2503671E-04, ERNI: 0.5545987E+02 Max. and WRMS norm residual= 0.6372472E+00 0.2259591E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 174576 # it. GCRO # it.GMRES Error Estimate 0 0 0.2113987E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2113987E+01 1 0.1054106E+01 0.4986342E+00 2 0.3614785E+00 0.1709937E+00 3 0.1563310E+00 0.7395081E-01 4 0.8125988E-01 0.3843917E-01 5 0.5078103E-01 0.2402146E-01 6 0.2852657E-01 0.1349421E-01 7 0.1701341E-01 0.8048024E-02 8 0.1049444E-01 0.4964290E-02 9 0.6210715E-02 0.2937916E-02 10 0.3824908E-02 0.1809334E-02 11 0.2358745E-02 0.1115780E-02 12 0.1435357E-02 0.6789812E-03 Result GMRES:12, 2.5E-2, 1.4353572249015E-3, 0 1 12 0.1435357E-02 0.2882300E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1435357E-02 1 0.9282842E-03 0.6467269E+00 2 0.5711120E-03 0.3978884E+00 3 0.3574612E-03 0.2490399E+00 4 0.2299801E-03 0.1602250E+00 5 0.1455222E-03 0.1013840E+00 6 0.9256732E-04 0.6449079E-01 7 0.5938961E-04 0.4137619E-01 8 0.3720205E-04 0.2591832E-01 9 0.2421550E-04 0.1687071E-01 10 0.1509801E-04 0.1051865E-01 11 0.9880250E-05 0.6883478E-02 12 0.6345657E-05 0.4420960E-02 13 0.4161935E-05 0.2899582E-02 14 0.2719522E-05 0.1894666E-02 15 0.1794369E-05 0.1250120E-02 16 0.1180650E-05 0.8225478E-03 Result GMRES:16, 2.5E-2, 1.1806499751381E-6, 0 2 28 0.1180650E-05 0.2096482E-02 NI: 2, NLI: 30, ERLI 0.1180650E-05, ERNI: 0.2882396E+01 T= 0.44E+00, LEVEL= 4 ,TOLWGT=1.0, SPCMON= 0.18E+01 TN= 0.41E+00, DT= 0.30E-01, DTNEW= 0.29E-01, TIMMON= 0.50E+00 Time integration at T= 0.47E+00, Grid level= 1, NPTS= 384 Nonlinear system solver at T = 0.4667253E+00 Max. and WRMS norm residual= 0.5770397E+01 0.1540572E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.5508905E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.5508905E+02 1 0.2786518E+01 0.5058207E-01 2 0.1807535E+00 0.3281115E-02 3 0.2706093E-01 0.4912216E-03 Result GMRES:3, 5.E-2, 2.706093131559E-2, 0 1 3 0.2706093E-01 0.5504427E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2706093E-01 1 0.3769765E-02 0.1393066E+00 2 0.3317389E-03 0.1225896E-01 3 0.2306672E-04 0.8523993E-03 Result GMRES:3, 5.E-2, 2.3066718742108E-5, 0 2 6 0.2306672E-04 0.2598296E-01 NI: 1, NLI: 8, ERLI 0.2306672E-04, ERNI: 0.5504482E+02 Max. and WRMS norm residual= 0.1323377E-01 0.4272412E+01 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.8647336E-01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.8647336E-01 1 0.5635124E-02 0.6516601E-01 2 0.7722419E-03 0.8930402E-02 3 0.8068908E-04 0.9331090E-03 Result GMRES:3, 2.5E-2, 8.0689076622161E-5, 0 1 3 0.8068908E-04 0.8402294E-01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.8068908E-04 1 0.1047278E-04 0.1297918E+00 2 0.1233098E-05 0.1528209E-01 3 0.1020229E-06 0.1264395E-02 4 0.7523506E-08 0.9324070E-04 Result GMRES:4, 2.5E-2, 7.5235056378152E-9, 0 2 7 0.7523506E-08 0.7940984E-04 NI: 2, NLI: 9, ERLI 0.7523506E-08, ERNI: 0.8402546E-01 T= 0.47E+00, LEVEL= 1 ,TOLWGT=0.9, SPCMON= 0.94E+01 Time integration at T= 0.47E+00, Grid level= 2, NPTS= 2358 Nonlinear system solver at T = 0.4667253E+00 Max. and WRMS norm residual= 0.5844129E+01 0.1486555E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 7074 # it. GCRO # it.GMRES Error Estimate 0 0 0.4083537E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4083537E+02 1 0.5833842E+01 0.1428625E+00 2 0.6739128E+00 0.1650316E-01 3 0.1370608E+00 0.3356425E-02 4 0.2481963E-01 0.6077974E-03 Result GMRES:4, 5.E-2, 2.4819632215669E-2, 0 1 4 0.2481963E-01 0.4059448E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2481963E-01 1 0.8485363E-02 0.3418811E+00 2 0.1905193E-02 0.7676153E-01 3 0.5586202E-03 0.2250719E-01 4 0.1141569E-03 0.4599460E-02 5 0.3027656E-04 0.1219864E-02 6 0.6856329E-05 0.2762462E-03 Result GMRES:6, 5.E-2, 6.8563292673652E-6, 0 2 10 0.6856329E-05 0.2342411E-01 NI: 1, NLI: 12, ERLI 0.6856329E-05, ERNI: 0.4059493E+02 Max. and WRMS norm residual= 0.5809846E-01 0.1503005E+02 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 7074 # it. GCRO # it.GMRES Error Estimate 0 0 0.3085532E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3085532E+00 1 0.3559936E-01 0.1153751E+00 2 0.6097958E-02 0.1976307E-01 3 0.1111563E-02 0.3602499E-02 4 0.2970923E-03 0.9628558E-03 Result GMRES:4, 2.5E-2, 2.970922816424E-4, 0 1 4 0.2970923E-03 0.2984177E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2970923E-03 1 0.1009736E-03 0.3398727E+00 2 0.2232225E-04 0.7513576E-01 3 0.5134161E-05 0.1728137E-01 4 0.1265694E-05 0.4260273E-02 5 0.3381171E-06 0.1138088E-02 6 0.7532141E-07 0.2535287E-03 Result GMRES:6, 2.5E-2, 7.532141384466E-8, 0 2 10 0.7532141E-07 0.2798109E-03 NI: 2, NLI: 12, ERLI 0.7532141E-07, ERNI: 0.2984209E+00 T= 0.47E+00, LEVEL= 2 ,TOLWGT=0.9, SPCMON= 0.10E+02 Time integration at T= 0.47E+00, Grid level= 3, NPTS= 12953 Nonlinear system solver at T = 0.4667253E+00 Max. and WRMS norm residual= 0.6020247E+01 0.1928224E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 38859 # it. GCRO # it.GMRES Error Estimate 0 0 0.3908782E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3908782E+02 1 0.9777996E+01 0.2501545E+00 2 0.2472203E+01 0.6324739E-01 3 0.7126332E+00 0.1823159E-01 4 0.2523896E+00 0.6456989E-02 5 0.1159001E+00 0.2965121E-02 6 0.4526013E-01 0.1157909E-02 7 0.1874909E-01 0.4796657E-03 Result GMRES:7, 5.E-2, 1.8749086902232E-2, 0 1 7 0.1874909E-01 0.4163007E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1874909E-01 1 0.9427429E-02 0.5028207E+00 2 0.3811832E-02 0.2033076E+00 3 0.1538433E-02 0.8205375E-01 4 0.7430974E-03 0.3963379E-01 5 0.2890472E-03 0.1541660E-01 6 0.1403239E-03 0.7484308E-02 7 0.5683389E-04 0.3031288E-02 8 0.2633510E-04 0.1404607E-02 9 0.1124299E-04 0.5996554E-03 Result GMRES:9, 5.E-2, 1.1242991187637E-5, 0 2 16 0.1124299E-04 0.1736039E-01 NI: 1, NLI: 18, ERLI 0.1124299E-04, ERNI: 0.4163030E+02 Max. and WRMS norm residual= 0.4271319E+00 0.1091443E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 38859 # it. GCRO # it.GMRES Error Estimate 0 0 0.1902101E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1902101E+01 1 0.5472667E+00 0.2877170E+00 2 0.9057719E-01 0.4761955E-01 3 0.3265368E-01 0.1716716E-01 4 0.1375495E-01 0.7231453E-02 5 0.5701709E-02 0.2997585E-02 6 0.2383652E-02 0.1253168E-02 7 0.9845993E-03 0.5176377E-03 Result GMRES:7, 2.5E-2, 9.845993158767E-4, 0 1 7 0.9845993E-03 0.1656433E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.9845993E-03 1 0.5141078E-03 0.5221493E+00 2 0.2064360E-03 0.2096650E+00 3 0.8344903E-04 0.8475430E-01 4 0.3964432E-04 0.4026442E-01 5 0.1645892E-04 0.1671636E-01 6 0.7459116E-05 0.7575788E-02 7 0.3322412E-05 0.3374380E-02 8 0.1463015E-05 0.1485899E-02 9 0.6548809E-06 0.6651242E-03 Result GMRES:9, 2.5E-2, 6.548808638617E-7, 0 2 16 0.6548809E-06 0.9168681E-03 NI: 2, NLI: 18, ERLI 0.6548809E-06, ERNI: 0.1656510E+01 T= 0.47E+00, LEVEL= 3 ,TOLWGT=0.9, SPCMON= 0.58E+01 Time integration at T= 0.47E+00, Grid level= 4, NPTS= 61382 Nonlinear system solver at T = 0.4667253E+00 Max. and WRMS norm residual= 0.7455692E+01 0.2571177E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 184146 # it. GCRO # it.GMRES Error Estimate 0 0 0.2970114E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2970114E+02 1 0.1244608E+02 0.4190440E+00 2 0.4867284E+01 0.1638754E+00 3 0.2045587E+01 0.6887234E-01 4 0.1108765E+01 0.3733072E-01 5 0.6754057E+00 0.2274006E-01 6 0.3871867E+00 0.1303609E-01 7 0.2351851E+00 0.7918388E-02 8 0.1438175E+00 0.4842154E-02 9 0.8791883E-01 0.2960117E-02 10 0.5463433E-01 0.1839469E-02 11 0.3416892E-01 0.1150425E-02 12 0.2125857E-01 0.7157495E-03 Result GMRES:12, 5.E-2, 2.1258571848749E-2, 0 1 12 0.2125857E-01 0.5137315E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2125857E-01 1 0.1381221E-01 0.6497243E+00 2 0.8556452E-02 0.4024942E+00 3 0.5419412E-02 0.2549283E+00 4 0.3470221E-02 0.1632387E+00 5 0.2216880E-02 0.1042817E+00 6 0.1416917E-02 0.6665158E-01 7 0.9083962E-03 0.4273082E-01 8 0.5724443E-03 0.2692769E-01 9 0.3705258E-03 0.1742948E-01 10 0.2309850E-03 0.1086550E-01 11 0.1493130E-03 0.7023661E-02 12 0.9447191E-04 0.4443944E-02 13 0.6094852E-04 0.2867009E-02 14 0.3909077E-04 0.1838824E-02 15 0.2525819E-04 0.1188141E-02 16 0.1624826E-04 0.7643156E-03 Result GMRES:16, 5.E-2, 1.6248257922821E-5, 0 2 28 0.1624826E-04 0.3125664E-01 NI: 1, NLI: 30, ERLI 0.1624826E-04, ERNI: 0.5137388E+02 Max. and WRMS norm residual= 0.5840666E+00 0.1999468E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 184146 # it. GCRO # it.GMRES Error Estimate 0 0 0.1840019E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1840019E+01 1 0.8959945E+00 0.4869486E+00 2 0.3006399E+00 0.1633896E+00 3 0.1282408E+00 0.6969537E-01 4 0.6649154E-01 0.3613634E-01 5 0.4103216E-01 0.2229986E-01 6 0.2275230E-01 0.1236525E-01 7 0.1344818E-01 0.7308718E-02 8 0.8187543E-02 0.4449707E-02 9 0.4789995E-02 0.2603232E-02 10 0.2916497E-02 0.1585037E-02 11 0.1775762E-02 0.9650783E-03 Result GMRES:11, 2.5E-2, 1.7757619382075E-3, 0 1 11 0.1775762E-02 0.2494737E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1775762E-02 1 0.1128406E-02 0.6354491E+00 2 0.6867787E-03 0.3867516E+00 3 0.4215779E-03 0.2374068E+00 4 0.2671772E-03 0.1504578E+00 5 0.1672613E-03 0.9419131E-01 6 0.1026544E-03 0.5780865E-01 7 0.6542689E-04 0.3684440E-01 8 0.3900084E-04 0.2196288E-01 9 0.2494930E-04 0.1404991E-01 10 0.1533040E-04 0.8633141E-02 11 0.9803039E-05 0.5520469E-02 12 0.6209954E-05 0.3497065E-02 13 0.3990998E-05 0.2247485E-02 14 0.2569508E-05 0.1446989E-02 15 0.1663591E-05 0.9368324E-03 Result GMRES:15, 2.5E-2, 1.6635913820683E-6, 0 2 26 0.1663591E-05 0.2536520E-02 NI: 2, NLI: 28, ERLI 0.1663591E-05, ERNI: 0.2494888E+01 T= 0.47E+00, LEVEL= 4 ,TOLWGT=1.0, SPCMON= 0.18E+01 TN= 0.44E+00, DT= 0.28E-01, DTNEW= 0.30E-01, TIMMON= 0.47E+00 Time integration at T= 0.50E+00, Grid level= 1, NPTS= 384 Nonlinear system solver at T = 0.4963517E+00 Max. and WRMS norm residual= 0.7110092E+01 0.1750983E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.4806708E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4806708E+02 1 0.2997148E+01 0.6235344E-01 2 0.2690464E+00 0.5597311E-02 3 0.3983701E-01 0.8287795E-03 Result GMRES:3, 5.E-2, 3.9837007146259E-2, 0 1 3 0.3983701E-01 0.4803940E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3983701E-01 1 0.5650603E-02 0.1418431E+00 2 0.6058376E-03 0.1520791E-01 3 0.3296252E-04 0.8274347E-03 Result GMRES:3, 5.E-2, 3.2962522616612E-5, 0 2 6 0.3296252E-04 0.3880685E-01 NI: 1, NLI: 8, ERLI 0.3296252E-04, ERNI: 0.4804018E+02 Max. and WRMS norm residual= 0.1619311E-01 0.4051935E+01 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.8358384E-01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.8358384E-01 1 0.6746039E-02 0.8070985E-01 2 0.9378944E-03 0.1122100E-01 3 0.8885922E-04 0.1063115E-02 4 0.8086729E-05 0.9674990E-04 Result GMRES:4, 2.5E-2, 8.0867287728234E-6, 0 1 4 0.8086729E-05 0.8164012E-01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.8086729E-05 1 0.1117328E-05 0.1381681E+00 2 0.1100701E-06 0.1361120E-01 3 0.1368148E-07 0.1691843E-02 4 0.1256702E-08 0.1554030E-03 Result GMRES:4, 2.5E-2, 1.2567017916171E-9, 0 2 8 0.1256702E-08 0.7981672E-05 NI: 2, NLI: 10, ERLI 0.1256702E-08, ERNI: 0.8164010E-01 T= 0.50E+00, LEVEL= 1 ,TOLWGT=0.9, SPCMON= 0.12E+02 Time integration at T= 0.50E+00, Grid level= 2, NPTS= 2358 Nonlinear system solver at T = 0.4963517E+00 Max. and WRMS norm residual= 0.7264532E+01 0.1738264E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 7074 # it. GCRO # it.GMRES Error Estimate 0 0 0.4238565E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4238565E+02 1 0.6628618E+01 0.1563883E+00 2 0.8990187E+00 0.2121045E-01 3 0.1745523E+00 0.4118194E-02 4 0.4112965E-01 0.9703675E-03 Result GMRES:4, 5.E-2, 4.1129652998585E-2, 0 1 4 0.4112965E-01 0.4217726E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4112965E-01 1 0.1598162E-01 0.3885670E+00 2 0.3295138E-02 0.8011588E-01 3 0.8679097E-03 0.2110180E-01 4 0.1795365E-03 0.4365136E-02 5 0.5272294E-04 0.1281872E-02 6 0.1131819E-04 0.2751832E-03 Result GMRES:6, 5.E-2, 1.1318190706042E-5, 0 2 10 0.1131819E-04 0.3939618E-01 NI: 1, NLI: 12, ERLI 0.1131819E-04, ERNI: 0.4217766E+02 Max. and WRMS norm residual= 0.1630085E+00 0.4121586E+02 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 7074 # it. GCRO # it.GMRES Error Estimate 0 0 0.8725682E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.8725682E+00 1 0.1125276E+00 0.1289614E+00 2 0.2009815E-01 0.2303333E-01 3 0.3859518E-02 0.4423170E-02 4 0.1079993E-02 0.1237718E-02 5 0.2781228E-03 0.3187404E-03 Result GMRES:5, 2.5E-2, 2.7812279051573E-4, 0 1 5 0.2781228E-03 0.8338217E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2781228E-03 1 0.9109226E-04 0.3275253E+00 2 0.2408294E-04 0.8659103E-01 3 0.5771833E-05 0.2075282E-01 4 0.1238998E-05 0.4454859E-02 5 0.2875740E-06 0.1033982E-02 6 0.7249129E-07 0.2606449E-03 Result GMRES:6, 2.5E-2, 7.2491285480901E-8, 0 2 11 0.7249129E-07 0.2554871E-03 NI: 2, NLI: 13, ERLI 0.7249129E-07, ERNI: 0.8338320E+00 T= 0.50E+00, LEVEL= 2 ,TOLWGT=0.9, SPCMON= 0.10E+02 Time integration at T= 0.50E+00, Grid level= 3, NPTS= 12947 Nonlinear system solver at T = 0.4963517E+00 Max. and WRMS norm residual= 0.7471783E+01 0.1950413E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 38841 # it. GCRO # it.GMRES Error Estimate 0 0 0.4087771E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4087771E+02 1 0.1063321E+02 0.2601225E+00 2 0.2748161E+01 0.6722883E-01 3 0.7920683E+00 0.1937653E-01 4 0.3022447E+00 0.7393876E-02 5 0.1410076E+00 0.3449498E-02 6 0.5593827E-01 0.1368429E-02 7 0.2374970E-01 0.5809938E-03 Result GMRES:7, 5.E-2, 2.3749697181938E-2, 0 1 7 0.2374970E-01 0.4400581E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2374970E-01 1 0.1211355E-01 0.5100508E+00 2 0.5023551E-02 0.2115206E+00 3 0.2049395E-02 0.8629140E-01 4 0.1015012E-02 0.4273790E-01 5 0.4114829E-03 0.1732582E-01 6 0.1992539E-03 0.8389744E-02 7 0.8479946E-04 0.3570549E-02 8 0.3896874E-04 0.1640810E-02 9 0.1731153E-04 0.7289156E-03 Result GMRES:9, 5.E-2, 1.7311525691579E-5, 0 2 16 0.1731153E-04 0.2175655E-01 NI: 1, NLI: 18, ERLI 0.1731153E-04, ERNI: 0.4400634E+02 Max. and WRMS norm residual= 0.4776244E+00 0.1219614E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 38841 # it. GCRO # it.GMRES Error Estimate 0 0 0.2180109E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2180109E+01 1 0.6006023E+00 0.2754919E+00 2 0.1015301E+00 0.4657113E-01 3 0.4373735E-01 0.2006200E-01 4 0.1783225E-01 0.8179522E-02 5 0.8166807E-02 0.3746055E-02 6 0.3186727E-02 0.1461728E-02 7 0.1479689E-02 0.6787226E-03 Result GMRES:7, 2.5E-2, 1.4796891140865E-3, 0 1 7 0.1479689E-02 0.2023193E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1479689E-02 1 0.7640473E-03 0.5163566E+00 2 0.3227395E-03 0.2181130E+00 3 0.1251138E-03 0.8455411E-01 4 0.6362173E-04 0.4299669E-01 5 0.2571764E-04 0.1738043E-01 6 0.1212900E-04 0.8196989E-02 7 0.5253449E-05 0.3550373E-02 8 0.2441573E-05 0.1650058E-02 9 0.1082800E-05 0.7317751E-03 Result GMRES:9, 2.5E-2, 1.0827996203711E-6, 0 2 16 0.1082800E-05 0.1360806E-02 NI: 2, NLI: 18, ERLI 0.1082800E-05, ERNI: 0.2023337E+01 T= 0.50E+00, LEVEL= 3 ,TOLWGT=0.9, SPCMON= 0.51E+01 Time integration at T= 0.50E+00, Grid level= 4, NPTS= 58684 Nonlinear system solver at T = 0.4963517E+00 Max. and WRMS norm residual= 0.7595910E+01 0.2678833E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 176052 # it. GCRO # it.GMRES Error Estimate 0 0 0.3170409E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3170409E+02 1 0.1353903E+02 0.4270438E+00 2 0.5426904E+01 0.1711736E+00 3 0.2336417E+01 0.7369449E-01 4 0.1290531E+01 0.4070552E-01 5 0.7955799E+00 0.2509392E-01 6 0.4625319E+00 0.1458903E-01 7 0.2847802E+00 0.8982443E-02 8 0.1763510E+00 0.5562406E-02 9 0.1092748E+00 0.3446710E-02 10 0.6880951E-01 0.2170367E-02 11 0.4360587E-01 0.1375402E-02 12 0.2748864E-01 0.8670377E-03 Result GMRES:12, 5.E-2, 2.7488638294885E-2, 0 1 12 0.2748864E-01 0.5546418E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2748864E-01 1 0.1808485E-01 0.6579026E+00 2 0.1135537E-01 0.4130934E+00 3 0.7287936E-02 0.2651254E+00 4 0.4727810E-02 0.1719914E+00 5 0.3059651E-02 0.1113060E+00 6 0.1981044E-02 0.7206773E-01 7 0.1286591E-02 0.4680447E-01 8 0.8213399E-03 0.2987925E-01 9 0.5386565E-03 0.1959560E-01 10 0.3399976E-03 0.1236866E-01 11 0.2227263E-03 0.8102485E-02 12 0.1426408E-03 0.5189083E-02 13 0.9323154E-04 0.3391639E-02 14 0.6054662E-04 0.2202605E-02 15 0.3962491E-04 0.1441502E-02 16 0.2580721E-04 0.9388319E-03 Result GMRES:16, 5.E-2, 2.5807210564301E-5, 0 2 28 0.2580721E-04 0.4105084E-01 NI: 1, NLI: 30, ERLI 0.2580721E-04, ERNI: 0.5546526E+02 Max. and WRMS norm residual= 0.6668014E+00 0.2269141E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 176052 # it. GCRO # it.GMRES Error Estimate 0 0 0.2125071E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2125071E+01 1 0.1061533E+01 0.4995285E+00 2 0.3642067E+00 0.1713857E+00 3 0.1585655E+00 0.7461657E-01 4 0.8331778E-01 0.3920706E-01 5 0.5216661E-01 0.2454817E-01 6 0.2930613E-01 0.1379066E-01 7 0.1754853E-01 0.8257854E-02 8 0.1081775E-01 0.5090538E-02 9 0.6409193E-02 0.3015990E-02 10 0.3952662E-02 0.1860014E-02 11 0.2435779E-02 0.1146211E-02 12 0.1483194E-02 0.6979503E-03 Result GMRES:12, 2.5E-2, 1.4831938598738E-3, 0 1 12 0.1483194E-02 0.2896550E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1483194E-02 1 0.9599727E-03 0.6472334E+00 2 0.5898895E-03 0.3977157E+00 3 0.3694956E-03 0.2491216E+00 4 0.2377709E-03 0.1603101E+00 5 0.1503589E-03 0.1013751E+00 6 0.9558754E-04 0.6444710E-01 7 0.6126048E-04 0.4130308E-01 8 0.3817464E-04 0.2573813E-01 9 0.2481169E-04 0.1672856E-01 10 0.1537101E-04 0.1036345E-01 11 0.1003872E-04 0.6768310E-02 12 0.6433424E-05 0.4337548E-02 13 0.4213024E-05 0.2840508E-02 14 0.2750752E-05 0.1854614E-02 15 0.1813987E-05 0.1223028E-02 16 0.1193455E-05 0.8046521E-03 Result GMRES:16, 2.5E-2, 1.19345512506E-6, 0 2 28 0.1193455E-05 0.2161927E-02 NI: 2, NLI: 30, ERLI 0.1193455E-05, ERNI: 0.2896650E+01 T= 0.50E+00, LEVEL= 4 ,TOLWGT=1.0, SPCMON= 0.19E+01 TN= 0.47E+00, DT= 0.30E-01, DTNEW= 0.29E-01, TIMMON= 0.50E+00 Time integration at T= 0.52E+00, Grid level= 1, NPTS= 384 Nonlinear system solver at T = 0.5243321E+00 Max. and WRMS norm residual= 0.5746101E+01 0.1411883E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.3187952E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3187952E+02 1 0.2206411E+01 0.6921092E-01 2 0.2211079E+00 0.6935733E-02 3 0.2965661E-01 0.9302714E-03 Result GMRES:3, 5.E-2, 2.96566081747E-2, 0 1 3 0.2965661E-01 0.3154830E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2965661E-01 1 0.3963225E-02 0.1336372E+00 2 0.4638527E-03 0.1564079E-01 3 0.3199073E-04 0.1078705E-02 4 0.2709701E-05 0.9136921E-04 Result GMRES:4, 5.E-2, 2.7097008613949E-6, 0 2 7 0.2709701E-05 0.2907646E-01 NI: 1, NLI: 9, ERLI 0.2709701E-05, ERNI: 0.3154898E+02 Max. and WRMS norm residual= 0.1212670E-01 0.2362643E+01 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.4677036E-01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4677036E-01 1 0.4446249E-02 0.9506553E-01 2 0.5246954E-03 0.1121855E-01 3 0.5342162E-04 0.1142211E-02 4 0.5056006E-05 0.1081028E-03 Result GMRES:4, 2.5E-2, 5.0560055563927E-6, 0 1 4 0.5056006E-05 0.4571498E-01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.5056006E-05 1 0.6827601E-06 0.1350394E+00 2 0.7399229E-07 0.1463453E-01 3 0.8039985E-08 0.1590185E-02 4 0.8347694E-09 0.1651045E-03 Result GMRES:4, 2.5E-2, 8.3476943533954E-10, 0 2 8 0.8347694E-09 0.4948961E-05 NI: 2, NLI: 10, ERLI 0.8347694E-09, ERNI: 0.4571498E-01 T= 0.52E+00, LEVEL= 1 ,TOLWGT=0.9, SPCMON= 0.15E+02 Time integration at T= 0.52E+00, Grid level= 2, NPTS= 2342 Nonlinear system solver at T = 0.5243321E+00 Max. and WRMS norm residual= 0.5786543E+01 0.1490703E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 7026 # it. GCRO # it.GMRES Error Estimate 0 0 0.3635964E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3635964E+02 1 0.4922490E+01 0.1353834E+00 2 0.7880120E+00 0.2167271E-01 3 0.1433806E+00 0.3943400E-02 4 0.3481501E-01 0.9575181E-03 Result GMRES:4, 5.E-2, 3.4815011388775E-2, 0 1 4 0.3481501E-01 0.3487921E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3481501E-01 1 0.1223788E-01 0.3515116E+00 2 0.2712428E-02 0.7790971E-01 3 0.5997113E-03 0.1722565E-01 4 0.1380409E-03 0.3964982E-02 5 0.3698870E-04 0.1062435E-02 6 0.7943609E-05 0.2281662E-03 Result GMRES:6, 5.E-2, 7.9436090443581E-6, 0 2 10 0.7943609E-05 0.3260044E-01 NI: 1, NLI: 12, ERLI 0.7943609E-05, ERNI: 0.3488015E+02 Max. and WRMS norm residual= 0.1487155E+00 0.3872585E+02 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 7026 # it. GCRO # it.GMRES Error Estimate 0 0 0.8024894E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.8024894E+00 1 0.1049328E+00 0.1307591E+00 2 0.1686463E-01 0.2101539E-01 3 0.3512088E-02 0.4376491E-02 4 0.9273028E-03 0.1155533E-02 5 0.2395878E-03 0.2985557E-03 Result GMRES:5, 2.5E-2, 2.3958779280387E-4, 0 1 5 0.2395878E-03 0.7649769E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2395878E-03 1 0.7542507E-04 0.3148118E+00 2 0.1965767E-04 0.8204787E-01 3 0.4290597E-05 0.1790825E-01 4 0.1011123E-05 0.4220262E-02 5 0.2081318E-06 0.8687079E-03 Result GMRES:5, 2.5E-2, 2.0813179772454E-7, 0 2 10 0.2081318E-06 0.2235970E-03 NI: 2, NLI: 12, ERLI 0.2081318E-06, ERNI: 0.7649862E+00 T= 0.52E+00, LEVEL= 2 ,TOLWGT=0.9, SPCMON= 0.14E+02 Time integration at T= 0.52E+00, Grid level= 3, NPTS= 12607 Nonlinear system solver at T = 0.5243321E+00 Max. and WRMS norm residual= 0.6183445E+01 0.1954542E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 37821 # it. GCRO # it.GMRES Error Estimate 0 0 0.3947126E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3947126E+02 1 0.9931635E+01 0.2516169E+00 2 0.2489686E+01 0.6307594E-01 3 0.7280090E+00 0.1844403E-01 4 0.2589204E+00 0.6559722E-02 5 0.1192877E+00 0.3022141E-02 6 0.4664406E-01 0.1181722E-02 7 0.1932384E-01 0.4895675E-03 Result GMRES:7, 5.E-2, 1.9323842345173E-2, 0 1 7 0.1932384E-01 0.4202811E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1932384E-01 1 0.9707979E-02 0.5023835E+00 2 0.3923111E-02 0.2030192E+00 3 0.1579309E-02 0.8172853E-01 4 0.7632512E-03 0.3949790E-01 5 0.2970398E-03 0.1537167E-01 6 0.1443458E-03 0.7469830E-02 7 0.5847157E-04 0.3025877E-02 8 0.2704884E-04 0.1399765E-02 9 0.1153608E-04 0.5969868E-03 Result GMRES:9, 5.E-2, 1.1536077887678E-5, 0 2 16 0.1153608E-04 0.1789746E-01 NI: 1, NLI: 18, ERLI 0.1153608E-04, ERNI: 0.4202836E+02 Max. and WRMS norm residual= 0.3984501E+00 0.1071146E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 37821 # it. GCRO # it.GMRES Error Estimate 0 0 0.1854709E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1854709E+01 1 0.5477951E+00 0.2953537E+00 2 0.9103832E-01 0.4908497E-01 3 0.3276681E-01 0.1766682E-01 4 0.1380757E-01 0.7444605E-02 5 0.5753329E-02 0.3102012E-02 6 0.2402062E-02 0.1295115E-02 7 0.9936305E-03 0.5357340E-03 Result GMRES:7, 2.5E-2, 9.936305240511E-4, 0 1 7 0.9936305E-03 0.1625734E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.9936305E-03 1 0.5190157E-03 0.5223428E+00 2 0.2081455E-03 0.2094798E+00 3 0.8418785E-04 0.8472752E-01 4 0.3998225E-04 0.4023855E-01 5 0.1655518E-04 0.1666130E-01 6 0.7533633E-05 0.7581926E-02 7 0.3344987E-05 0.3366430E-02 8 0.1473660E-05 0.1483107E-02 9 0.6585506E-06 0.6627721E-03 Result GMRES:9, 2.5E-2, 6.5855057514487E-7, 0 2 16 0.6585506E-06 0.9284991E-03 NI: 2, NLI: 18, ERLI 0.6585506E-06, ERNI: 0.1625807E+01 T= 0.52E+00, LEVEL= 3 ,TOLWGT=0.9, SPCMON= 0.57E+01 Time integration at T= 0.52E+00, Grid level= 4, NPTS= 61690 Nonlinear system solver at T = 0.5243321E+00 Max. and WRMS norm residual= 0.7381716E+01 0.2565509E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 185070 # it. GCRO # it.GMRES Error Estimate 0 0 0.2955424E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2955424E+02 1 0.1236712E+02 0.4184551E+00 2 0.4835466E+01 0.1636133E+00 3 0.2030320E+01 0.6869811E-01 4 0.1097345E+01 0.3712988E-01 5 0.6679385E+00 0.2260043E-01 6 0.3821443E+00 0.1293027E-01 7 0.2317097E+00 0.7840149E-02 8 0.1414890E+00 0.4787433E-02 9 0.8638469E-01 0.2922921E-02 10 0.5361712E-01 0.1814194E-02 11 0.3351071E-01 0.1133872E-02 12 0.2083089E-01 0.7048361E-03 Result GMRES:12, 5.E-2, 2.0830894245324E-2, 0 1 12 0.2083089E-01 0.5109311E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2083089E-01 1 0.1351968E-01 0.6490208E+00 2 0.8371876E-02 0.4018971E+00 3 0.5297250E-02 0.2542978E+00 4 0.3390039E-02 0.1627409E+00 5 0.2164166E-02 0.1038921E+00 6 0.1381625E-02 0.6632576E-01 7 0.8854208E-03 0.4250517E-01 8 0.5574225E-03 0.2675941E-01 9 0.3607025E-03 0.1731575E-01 10 0.2247988E-03 0.1079161E-01 11 0.1452981E-03 0.6975127E-02 12 0.9186930E-04 0.4410243E-02 13 0.5924684E-04 0.2844181E-02 14 0.3796918E-04 0.1822734E-02 15 0.2452192E-04 0.1177190E-02 16 0.1576370E-04 0.7567460E-03 Result GMRES:16, 5.E-2, 1.5763695858E-5, 0 2 28 0.1576370E-04 0.3059987E-01 NI: 1, NLI: 30, ERLI 0.1576370E-04, ERNI: 0.5109380E+02 Max. and WRMS norm residual= 0.6179940E+00 0.1986084E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 185070 # it. GCRO # it.GMRES Error Estimate 0 0 0.1826027E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1826027E+01 1 0.8881693E+00 0.4863944E+00 2 0.2971511E+00 0.1627310E+00 3 0.1268762E+00 0.6948212E-01 4 0.6615687E-01 0.3622995E-01 5 0.4084131E-01 0.2236621E-01 6 0.2263020E-01 0.1239314E-01 7 0.1341254E-01 0.7345204E-02 8 0.8156055E-02 0.4466558E-02 9 0.4775720E-02 0.2615361E-02 10 0.2910570E-02 0.1593936E-02 11 0.1770687E-02 0.9696936E-03 Result GMRES:11, 2.5E-2, 1.7706866906026E-3, 0 1 11 0.1770687E-02 0.2473833E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1770687E-02 1 0.1124989E-02 0.6353407E+00 2 0.6844827E-03 0.3865634E+00 3 0.4203921E-03 0.2374176E+00 4 0.2664141E-03 0.1504581E+00 5 0.1667787E-03 0.9418870E-01 6 0.1025566E-03 0.5791910E-01 7 0.6533083E-04 0.3689576E-01 8 0.3891187E-04 0.2197558E-01 9 0.2487108E-04 0.1404601E-01 10 0.1522832E-04 0.8600232E-02 11 0.9717795E-05 0.5488150E-02 12 0.6140031E-05 0.3467599E-02 13 0.3935366E-05 0.2222508E-02 14 0.2528790E-05 0.1428141E-02 15 0.1632975E-05 0.9222270E-03 Result GMRES:15, 2.5E-2, 1.6329750380123E-6, 0 2 26 0.1632975E-05 0.2526075E-02 NI: 2, NLI: 28, ERLI 0.1632975E-05, ERNI: 0.2473985E+01 T= 0.52E+00, LEVEL= 4 ,TOLWGT=1.0, SPCMON= 0.19E+01 TN= 0.50E+00, DT= 0.28E-01, DTNEW= 0.30E-01, TIMMON= 0.46E+00 Time integration at T= 0.55E+00, Grid level= 1, NPTS= 384 Nonlinear system solver at T = 0.5540614E+00 Max. and WRMS norm residual= 0.2707711E+01 0.7002348E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.1650725E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1650725E+02 1 0.1207075E+01 0.7312395E-01 2 0.1348723E+00 0.8170489E-02 3 0.1900015E-01 0.1151019E-02 4 0.2154114E-02 0.1304951E-03 Result GMRES:4, 5.E-2, 2.154114154987E-3, 0 1 4 0.2154114E-02 0.1583481E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2154114E-02 1 0.3170701E-03 0.1471928E+00 2 0.4369270E-04 0.2028337E-01 3 0.4003594E-05 0.1858580E-02 4 0.3989224E-06 0.1851909E-03 Result GMRES:4, 5.E-2, 3.9892237496201E-7, 0 2 8 0.3989224E-06 0.2041850E-02 NI: 1, NLI: 10, ERLI 0.3989224E-06, ERNI: 0.1583477E+02 Max. and WRMS norm residual= 0.4142780E-02 0.1003605E+01 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.2163689E-01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2163689E-01 1 0.1927984E-02 0.8910633E-01 2 0.2381991E-03 0.1100893E-01 3 0.3085785E-04 0.1426168E-02 4 0.3427039E-05 0.1583887E-03 Result GMRES:4, 2.5E-2, 3.4270391042373E-6, 0 1 4 0.3427039E-05 0.2104897E-01 NI: 2, NLI: 5, ERLI 0.3427039E-05, ERNI: 0.2104897E-01 T= 0.55E+00, LEVEL= 1 ,TOLWGT=0.9, SPCMON= 0.18E+02 Time integration at T= 0.55E+00, Grid level= 2, NPTS= 2342 Nonlinear system solver at T = 0.5540614E+00 Max. and WRMS norm residual= 0.3699322E+01 0.1227583E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 7026 # it. GCRO # it.GMRES Error Estimate 0 0 0.3912267E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3912267E+02 1 0.5448868E+01 0.1392765E+00 2 0.7487559E+00 0.1913867E-01 3 0.1594626E+00 0.4075965E-02 4 0.3186527E-01 0.8144964E-03 Result GMRES:4, 5.E-2, 3.186527157038E-2, 0 1 4 0.3186527E-01 0.3768268E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3186527E-01 1 0.1040734E-01 0.3266044E+00 2 0.2628436E-02 0.8248591E-01 3 0.7065962E-03 0.2217449E-01 4 0.1693681E-03 0.5315132E-02 5 0.4583986E-04 0.1438552E-02 6 0.1106724E-04 0.3473135E-03 Result GMRES:6, 5.E-2, 1.1067238596928E-5, 0 2 10 0.1106724E-04 0.2867827E-01 NI: 1, NLI: 12, ERLI 0.1106724E-04, ERNI: 0.3768426E+02 Max. and WRMS norm residual= 0.8063288E-01 0.2308853E+02 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 7026 # it. GCRO # it.GMRES Error Estimate 0 0 0.5161073E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.5161073E+00 1 0.6789921E-01 0.1315602E+00 2 0.1162926E-01 0.2253263E-01 3 0.2492631E-02 0.4829676E-02 4 0.7202305E-03 0.1395505E-02 5 0.1940956E-03 0.3760760E-03 Result GMRES:5, 2.5E-2, 1.9409556302536E-4, 0 1 5 0.1940956E-03 0.4745949E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1940956E-03 1 0.6769328E-04 0.3487626E+00 2 0.1774290E-04 0.9141323E-01 3 0.4080616E-05 0.2102375E-01 4 0.9669030E-06 0.4981582E-02 5 0.2322511E-06 0.1196581E-02 6 0.6227865E-07 0.3208659E-03 Result GMRES:6, 2.5E-2, 6.2278651865139E-8, 0 2 11 0.6227865E-07 0.1828090E-03 NI: 2, NLI: 13, ERLI 0.6227865E-07, ERNI: 0.4745990E+00 T= 0.55E+00, LEVEL= 2 ,TOLWGT=0.9, SPCMON= 0.14E+02 Time integration at T= 0.55E+00, Grid level= 3, NPTS= 12967 Nonlinear system solver at T = 0.5540614E+00 Max. and WRMS norm residual= 0.7333771E+01 0.1952295E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 38901 # it. GCRO # it.GMRES Error Estimate 0 0 0.4099909E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4099909E+02 1 0.1064591E+02 0.2596622E+00 2 0.2775611E+01 0.6769933E-01 3 0.7944291E+00 0.1937675E-01 4 0.3061819E+00 0.7468018E-02 5 0.1428777E+00 0.3484900E-02 6 0.5654597E-01 0.1379201E-02 7 0.2419011E-01 0.5900158E-03 Result GMRES:7, 5.E-2, 2.419011029232E-2, 0 1 7 0.2419011E-01 0.4411434E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2419011E-01 1 0.1240194E-01 0.5126864E+00 2 0.5130669E-02 0.2120978E+00 3 0.2105832E-02 0.8705342E-01 4 0.1044840E-02 0.4319286E-01 5 0.4231338E-03 0.1749202E-01 6 0.2059811E-03 0.8515094E-02 7 0.8751865E-04 0.3617951E-02 8 0.4046614E-04 0.1672838E-02 9 0.1799755E-04 0.7440046E-03 Result GMRES:9, 5.E-2, 1.799755321705E-5, 0 2 16 0.1799755E-04 0.2216368E-01 NI: 1, NLI: 18, ERLI 0.1799755E-04, ERNI: 0.4411490E+02 Max. and WRMS norm residual= 0.5017423E+00 0.1259504E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 38901 # it. GCRO # it.GMRES Error Estimate 0 0 0.2267169E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2267169E+01 1 0.6109823E+00 0.2694913E+00 2 0.1036944E+00 0.4573739E-01 3 0.4481838E-01 0.1976844E-01 4 0.1836515E-01 0.8100479E-02 5 0.8349247E-02 0.3682676E-02 6 0.3303762E-02 0.1457219E-02 7 0.1527167E-02 0.6736010E-03 Result GMRES:7, 2.5E-2, 1.5271671384219E-3, 0 1 7 0.1527167E-02 0.2082259E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1527167E-02 1 0.7905767E-03 0.5176753E+00 2 0.3341436E-03 0.2187996E+00 3 0.1304778E-03 0.8543781E-01 4 0.6602629E-04 0.4323449E-01 5 0.2701645E-04 0.1769056E-01 6 0.1264919E-04 0.8282781E-02 7 0.5519973E-05 0.3614518E-02 8 0.2554872E-05 0.1672949E-02 9 0.1134677E-05 0.7429947E-03 Result GMRES:9, 2.5E-2, 1.1346771024387E-6, 0 2 16 0.1134677E-05 0.1403477E-02 NI: 2, NLI: 18, ERLI 0.1134677E-05, ERNI: 0.2082416E+01 T= 0.55E+00, LEVEL= 3 ,TOLWGT=0.9, SPCMON= 0.53E+01 Time integration at T= 0.55E+00, Grid level= 4, NPTS= 58832 Nonlinear system solver at T = 0.5540614E+00 Max. and WRMS norm residual= 0.7532045E+01 0.2679269E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 176496 # it. GCRO # it.GMRES Error Estimate 0 0 0.3170947E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3170947E+02 1 0.1355782E+02 0.4275638E+00 2 0.5444398E+01 0.1716963E+00 3 0.2345969E+01 0.7398322E-01 4 0.1296442E+01 0.4088501E-01 5 0.8003365E+00 0.2523967E-01 6 0.4651786E+00 0.1467002E-01 7 0.2865301E+00 0.9036105E-02 8 0.1774558E+00 0.5596301E-02 9 0.1099692E+00 0.3468025E-02 10 0.6927172E-01 0.2184575E-02 11 0.4391632E-01 0.1384959E-02 12 0.2770916E-01 0.8738449E-03 Result GMRES:12, 5.E-2, 2.7709159223366E-2, 0 1 12 0.2770916E-01 0.5554085E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2770916E-01 1 0.1823876E-01 0.6582215E+00 2 0.1146446E-01 0.4137427E+00 3 0.7363445E-02 0.2657405E+00 4 0.4781711E-02 0.1725679E+00 5 0.3097711E-02 0.1117938E+00 6 0.2007430E-02 0.7244646E-01 7 0.1305527E-02 0.4711535E-01 8 0.8342447E-03 0.3010718E-01 9 0.5477240E-03 0.1976689E-01 10 0.3462756E-03 0.1249679E-01 11 0.2270503E-03 0.8194053E-02 12 0.1456270E-03 0.5255553E-02 13 0.9527995E-04 0.3438572E-02 14 0.6193606E-04 0.2235220E-02 15 0.4057410E-04 0.1464285E-02 16 0.2644910E-04 0.9545257E-03 Result GMRES:16, 5.E-2, 2.6449103846655E-5, 0 2 28 0.2644910E-04 0.4142193E-01 NI: 1, NLI: 30, ERLI 0.2644910E-04, ERNI: 0.5554191E+02 Max. and WRMS norm residual= 0.7088717E+00 0.2282851E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 176496 # it. GCRO # it.GMRES Error Estimate 0 0 0.2140551E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2140551E+01 1 0.1071225E+01 0.5004436E+00 2 0.3671794E+00 0.1715350E+00 3 0.1597444E+00 0.7462770E-01 4 0.8405001E-01 0.3926560E-01 5 0.5271867E-01 0.2462855E-01 6 0.2965118E-01 0.1385212E-01 7 0.1779538E-01 0.8313459E-02 8 0.1097859E-01 0.5128863E-02 9 0.6517446E-02 0.3044752E-02 10 0.4025686E-02 0.1880677E-02 11 0.2483487E-02 0.1160209E-02 12 0.1515369E-02 0.7079339E-03 Result GMRES:12, 2.5E-2, 1.5153685712121E-3, 0 1 12 0.1515369E-02 0.2917388E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1515369E-02 1 0.9823101E-03 0.6482318E+00 2 0.6041094E-03 0.3986551E+00 3 0.3791119E-03 0.2501780E+00 4 0.2440408E-03 0.1610438E+00 5 0.1546333E-03 0.1020434E+00 6 0.9846839E-04 0.6497983E-01 7 0.6320555E-04 0.4170969E-01 8 0.3948751E-04 0.2605803E-01 9 0.2571671E-04 0.1697059E-01 10 0.1593473E-04 0.1051541E-01 11 0.1042675E-04 0.6880668E-02 12 0.6676190E-05 0.4405655E-02 13 0.4376639E-05 0.2888168E-02 14 0.2856385E-05 0.1884944E-02 15 0.1884595E-05 0.1243655E-02 16 0.1240177E-05 0.8183995E-03 Result GMRES:16, 2.5E-2, 1.2401769135338E-6, 0 2 28 0.1240177E-05 0.2211672E-02 NI: 2, NLI: 30, ERLI 0.1240177E-05, ERNI: 0.2917489E+01 T= 0.55E+00, LEVEL= 4 ,TOLWGT=1.0, SPCMON= 0.19E+01 TN= 0.52E+00, DT= 0.30E-01, DTNEW= 0.30E-01, TIMMON= 0.50E+00 Time integration at T= 0.58E+00, Grid level= 1, NPTS= 384 Nonlinear system solver at T = 0.5819325E+00 Max. and WRMS norm residual= 0.4021008E+00 0.1300684E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.6593651E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.6593651E+01 1 0.3351009E+00 0.5082175E-01 2 0.2156885E-01 0.3271155E-02 3 0.2674963E-02 0.4056876E-03 Result GMRES:3, 5.E-2, 2.6749626182341E-3, 0 1 3 0.2674963E-02 0.6548904E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2674963E-02 1 0.3472320E-03 0.1298082E+00 2 0.4573749E-04 0.1709837E-01 3 0.4773672E-05 0.1784575E-02 4 0.5600313E-06 0.2093604E-03 Result GMRES:4, 5.E-2, 5.6003130770289E-7, 0 2 7 0.5600313E-06 0.2484251E-02 NI: 1, NLI: 9, ERLI 0.5600313E-06, ERNI: 0.6548916E+01 Max. and WRMS norm residual= 0.3707105E-03 0.9696720E-01 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.2025586E-02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2025586E-02 1 0.1311127E-03 0.6472829E-01 2 0.1413619E-04 0.6978814E-02 3 0.1556244E-05 0.7682929E-03 Result GMRES:3, 2.5E-2, 1.5562435778041E-6, 0 1 3 0.1556244E-05 0.1985415E-02 NI: 2, NLI: 4, ERLI 0.1556244E-05, ERNI: 0.1985415E-02 T= 0.58E+00, LEVEL= 1 ,TOLWGT=0.9, SPCMON= 0.18E+02 Time integration at T= 0.58E+00, Grid level= 2, NPTS= 2374 Nonlinear system solver at T = 0.5819325E+00 Max. and WRMS norm residual= 0.6180349E+01 0.1550718E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 7122 # it. GCRO # it.GMRES Error Estimate 0 0 0.4083989E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4083989E+02 1 0.5888673E+01 0.1441892E+00 2 0.6948342E+00 0.1701361E-01 3 0.1417842E+00 0.3471708E-02 4 0.2715917E-01 0.6650156E-03 Result GMRES:4, 5.E-2, 2.7159167210635E-2, 0 1 4 0.2715917E-01 0.4070463E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2715917E-01 1 0.9647308E-02 0.3552137E+00 2 0.2123698E-02 0.7819452E-01 3 0.6204005E-03 0.2284313E-01 4 0.1207383E-03 0.4445581E-02 5 0.3334403E-04 0.1227726E-02 6 0.7428517E-05 0.2735179E-03 Result GMRES:6, 5.E-2, 7.4285171819394E-6, 0 2 10 0.7428517E-05 0.2586158E-01 NI: 1, NLI: 12, ERLI 0.7428517E-05, ERNI: 0.4070498E+02 Max. and WRMS norm residual= 0.7720748E-01 0.2018478E+02 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 7122 # it. GCRO # it.GMRES Error Estimate 0 0 0.4149975E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4149975E+00 1 0.4852658E-01 0.1169322E+00 2 0.8532884E-02 0.2056129E-01 3 0.1529676E-02 0.3685988E-02 4 0.4218016E-03 0.1016395E-02 5 0.1020622E-03 0.2459345E-03 Result GMRES:5, 2.5E-2, 1.0206219446385E-4, 0 1 5 0.1020622E-03 0.3974503E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1020622E-03 1 0.3489754E-04 0.3419243E+00 2 0.8421750E-05 0.8251586E-01 3 0.1919082E-05 0.1880307E-01 4 0.4178343E-06 0.4093918E-02 5 0.1001493E-06 0.9812580E-03 Result GMRES:5, 2.5E-2, 1.0014934481559E-7, 0 2 10 0.1001493E-06 0.9424431E-04 NI: 2, NLI: 12, ERLI 0.1001493E-06, ERNI: 0.3974544E+00 T= 0.58E+00, LEVEL= 2 ,TOLWGT=0.9, SPCMON= 0.93E+01 Time integration at T= 0.58E+00, Grid level= 3, NPTS= 13185 Nonlinear system solver at T = 0.5819325E+00 Max. and WRMS norm residual= 0.6274056E+01 0.1908024E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 39555 # it. GCRO # it.GMRES Error Estimate 0 0 0.3836268E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3836268E+02 1 0.9695584E+01 0.2527348E+00 2 0.2400118E+01 0.6256389E-01 3 0.7034291E+00 0.1833629E-01 4 0.2473753E+00 0.6448333E-02 5 0.1137095E+00 0.2964065E-02 6 0.4469692E-01 0.1165115E-02 7 0.1839568E-01 0.4795202E-03 Result GMRES:7, 5.E-2, 1.8395680650084E-2, 0 1 7 0.1839568E-01 0.4084709E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1839568E-01 1 0.9207300E-02 0.5005142E+00 2 0.3726126E-02 0.2025544E+00 3 0.1495599E-02 0.8130165E-01 4 0.7208627E-03 0.3918652E-01 5 0.2815817E-03 0.1530695E-01 6 0.1362967E-03 0.7409170E-02 7 0.5533689E-04 0.3008146E-02 8 0.2550597E-04 0.1386519E-02 9 0.1087192E-04 0.5910042E-03 Result GMRES:9, 5.E-2, 1.0871923649829E-5, 0 2 16 0.1087192E-04 0.1705605E-01 NI: 1, NLI: 18, ERLI 0.1087192E-04, ERNI: 0.4084731E+02 Max. and WRMS norm residual= 0.3806759E+00 0.1011576E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 39555 # it. GCRO # it.GMRES Error Estimate 0 0 0.1738061E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1738061E+01 1 0.5262573E+00 0.3027841E+00 2 0.8656103E-01 0.4980322E-01 3 0.3074342E-01 0.1768834E-01 4 0.1279169E-01 0.7359746E-02 5 0.5362347E-02 0.3085247E-02 6 0.2223489E-02 0.1279293E-02 7 0.9175784E-03 0.5279322E-03 Result GMRES:7, 2.5E-2, 9.1757836978068E-4, 0 1 7 0.9175784E-03 0.1537905E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.9175784E-03 1 0.4778421E-03 0.5207644E+00 2 0.1917655E-03 0.2089909E+00 3 0.7736094E-04 0.8430990E-01 4 0.3668359E-04 0.3997870E-01 5 0.1511560E-04 0.1647336E-01 6 0.6881774E-05 0.7499930E-02 7 0.3046422E-05 0.3320068E-02 8 0.1339233E-05 0.1459529E-02 9 0.5987119E-06 0.6524913E-03 Result GMRES:9, 2.5E-2, 5.9871186988257E-7, 0 2 16 0.5987119E-06 0.8596118E-03 NI: 2, NLI: 18, ERLI 0.5987119E-06, ERNI: 0.1537966E+01 T= 0.58E+00, LEVEL= 3 ,TOLWGT=0.9, SPCMON= 0.56E+01 Time integration at T= 0.58E+00, Grid level= 4, NPTS= 61722 Nonlinear system solver at T = 0.5819325E+00 Max. and WRMS norm residual= 0.7380744E+01 0.2560351E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 185166 # it. GCRO # it.GMRES Error Estimate 0 0 0.2940026E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2940026E+02 1 0.1228332E+02 0.4177965E+00 2 0.4795275E+01 0.1631031E+00 3 0.2009459E+01 0.6834835E-01 4 0.1083855E+01 0.3686550E-01 5 0.6593854E+00 0.2242788E-01 6 0.3764697E+00 0.1280498E-01 7 0.2279746E+00 0.7754170E-02 8 0.1389563E+00 0.4726362E-02 9 0.8467486E-01 0.2880072E-02 10 0.5249446E-01 0.1785510E-02 11 0.3275669E-01 0.1114163E-02 12 0.2035210E-01 0.6922422E-03 Result GMRES:12, 5.E-2, 2.0352100601767E-2, 0 1 12 0.2035210E-01 0.5080389E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2035210E-01 1 0.1319467E-01 0.6483196E+00 2 0.8164890E-02 0.4011817E+00 3 0.5161465E-02 0.2536085E+00 4 0.3300563E-02 0.1621731E+00 5 0.2105530E-02 0.1034552E+00 6 0.1343202E-02 0.6599819E-01 7 0.8602775E-03 0.4226972E-01 8 0.5413017E-03 0.2659685E-01 9 0.3499932E-03 0.1719691E-01 10 0.2180339E-03 0.1071309E-01 11 0.1407673E-03 0.6916597E-02 12 0.8896781E-04 0.4371431E-02 13 0.5731692E-04 0.2816266E-02 14 0.3670594E-04 0.1803545E-02 15 0.2368204E-04 0.1163616E-02 16 0.1521348E-04 0.7475139E-03 Result GMRES:16, 5.E-2, 1.521347869265E-5, 0 2 28 0.1521348E-04 0.2986410E-01 NI: 1, NLI: 30, ERLI 0.1521348E-04, ERNI: 0.5080454E+02 Max. and WRMS norm residual= 0.6419266E+00 0.1970344E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 185166 # it. GCRO # it.GMRES Error Estimate 0 0 0.1809399E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1809399E+01 1 0.8784961E+00 0.4855182E+00 2 0.2927487E+00 0.1617934E+00 3 0.1244537E+00 0.6878178E-01 4 0.6489437E-01 0.3586516E-01 5 0.4006187E-01 0.2214099E-01 6 0.2213908E-01 0.1223560E-01 7 0.1313412E-01 0.7258831E-02 8 0.7972293E-02 0.4406045E-02 9 0.4665079E-02 0.2578248E-02 10 0.2842233E-02 0.1570816E-02 11 0.1726256E-02 0.9540494E-03 Result GMRES:11, 2.5E-2, 1.7262559016055E-3, 0 1 11 0.1726256E-02 0.2449342E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1726256E-02 1 0.1095386E-02 0.6345446E+00 2 0.6659147E-03 0.3857566E+00 3 0.4085659E-03 0.2366775E+00 4 0.2586432E-03 0.1498290E+00 5 0.1617468E-03 0.9369807E-01 6 0.9940104E-04 0.5758187E-01 7 0.6323338E-04 0.3663036E-01 8 0.3769930E-04 0.2183877E-01 9 0.2407453E-04 0.1394609E-01 10 0.1474295E-04 0.8540420E-02 11 0.9403026E-05 0.5447064E-02 12 0.5935939E-05 0.3438621E-02 13 0.3801512E-05 0.2202172E-02 14 0.2440558E-05 0.1413787E-02 15 0.1573396E-05 0.9114500E-03 Result GMRES:15, 2.5E-2, 1.5733959060923E-6, 0 2 26 0.1573396E-05 0.2460654E-02 NI: 2, NLI: 28, ERLI 0.1573396E-05, ERNI: 0.2449490E+01 T= 0.58E+00, LEVEL= 4 ,TOLWGT=1.0, SPCMON= 0.19E+01 TN= 0.55E+00, DT= 0.28E-01, DTNEW= 0.30E-01, TIMMON= 0.46E+00 Time integration at T= 0.61E+00, Grid level= 1, NPTS= 384 Nonlinear system solver at T = 0.6117945E+00 Max. and WRMS norm residual= 0.9075081E+00 0.2984951E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.1728756E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1728756E+02 1 0.7238177E+00 0.4186928E-01 2 0.6103137E-01 0.3530364E-02 3 0.7427255E-02 0.4296301E-03 Result GMRES:3, 5.E-2, 7.4272547540329E-3, 0 1 3 0.7427255E-02 0.1732148E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.7427255E-02 1 0.1234288E-02 0.1661836E+00 2 0.1399015E-03 0.1883623E-01 3 0.1246565E-04 0.1678366E-02 4 0.1609004E-05 0.2166351E-03 Result GMRES:4, 5.E-2, 1.609003963478E-6, 0 2 7 0.1609004E-05 0.7096585E-02 NI: 1, NLI: 9, ERLI 0.1609004E-05, ERNI: 0.1732155E+02 Max. and WRMS norm residual= 0.2675497E-02 0.7710255E+00 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.1712706E-01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1712706E-01 1 0.1340832E-02 0.7828738E-01 2 0.1837300E-03 0.1072747E-01 3 0.2343628E-04 0.1368378E-02 4 0.2724128E-05 0.1590541E-03 Result GMRES:4, 2.5E-2, 2.7241277334242E-6, 0 1 4 0.2724128E-05 0.1642313E-01 NI: 2, NLI: 5, ERLI 0.2724128E-05, ERNI: 0.1642313E-01 T= 0.61E+00, LEVEL= 1 ,TOLWGT=0.9, SPCMON= 0.17E+02 Time integration at T= 0.61E+00, Grid level= 2, NPTS= 2374 Nonlinear system solver at T = 0.6117945E+00 Max. and WRMS norm residual= 0.7167170E+01 0.1730932E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 7122 # it. GCRO # it.GMRES Error Estimate 0 0 0.4198353E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4198353E+02 1 0.6569848E+01 0.1564863E+00 2 0.9203533E+00 0.2192177E-01 3 0.1804463E+00 0.4298025E-02 4 0.4368147E-01 0.1040443E-02 5 0.1266570E-01 0.3016825E-03 Result GMRES:5, 5.E-2, 1.266569719832E-2, 0 1 5 0.1266570E-01 0.4162890E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1266570E-01 1 0.4124227E-02 0.3256218E+00 2 0.1084190E-02 0.8560051E-01 3 0.2388839E-03 0.1886070E-01 4 0.5336054E-04 0.4212996E-02 5 0.1277772E-04 0.1008845E-02 6 0.3520949E-05 0.2779909E-03 Result GMRES:6, 5.E-2, 3.5209490844285E-6, 0 2 11 0.3520949E-05 0.1157622E-01 NI: 1, NLI: 13, ERLI 0.3520949E-05, ERNI: 0.4162904E+02 Max. and WRMS norm residual= 0.1690708E+00 0.4335563E+02 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 7122 # it. GCRO # it.GMRES Error Estimate 0 0 0.9225125E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.9225125E+00 1 0.1210987E+00 0.1312705E+00 2 0.2183547E-01 0.2366956E-01 3 0.4271457E-02 0.4630243E-02 4 0.1180928E-02 0.1280122E-02 5 0.3086762E-03 0.3346038E-03 Result GMRES:5, 2.5E-2, 3.0867618363053E-4, 0 1 5 0.3086762E-03 0.8819225E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3086762E-03 1 0.1013866E-03 0.3284562E+00 2 0.2630795E-04 0.8522830E-01 3 0.6391835E-05 0.2070725E-01 4 0.1403792E-05 0.4547783E-02 5 0.3147821E-06 0.1019781E-02 6 0.8449609E-07 0.2737370E-03 Result GMRES:6, 2.5E-2, 8.4496086309528E-8, 0 2 11 0.8449609E-07 0.2837263E-03 NI: 2, NLI: 13, ERLI 0.8449609E-07, ERNI: 0.8819336E+00 T= 0.61E+00, LEVEL= 2 ,TOLWGT=0.9, SPCMON= 0.10E+02 Time integration at T= 0.61E+00, Grid level= 3, NPTS= 13091 Nonlinear system solver at T = 0.6117945E+00 Max. and WRMS norm residual= 0.7269634E+01 0.1943964E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 39273 # it. GCRO # it.GMRES Error Estimate 0 0 0.4094563E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4094563E+02 1 0.1061206E+02 0.2591744E+00 2 0.2789774E+01 0.6813361E-01 3 0.7906267E+00 0.1930918E-01 4 0.3061444E+00 0.7476850E-02 5 0.1429647E+00 0.3491575E-02 6 0.5639268E-01 0.1377257E-02 7 0.2426070E-01 0.5925102E-03 Result GMRES:7, 5.E-2, 2.4260703514419E-2, 0 1 7 0.2426070E-01 0.4402693E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2426070E-01 1 0.1248413E-01 0.5145825E+00 2 0.5156167E-02 0.2125316E+00 3 0.2128184E-02 0.8772143E-01 4 0.1057642E-02 0.4359485E-01 5 0.4271429E-03 0.1760637E-01 6 0.2091021E-03 0.8618962E-02 7 0.8845213E-04 0.3645901E-02 8 0.4122456E-04 0.1699232E-02 9 0.1831688E-04 0.7550019E-03 Result GMRES:9, 5.E-2, 1.8316876628369E-5, 0 2 16 0.1831688E-04 0.2222243E-01 NI: 1, NLI: 18, ERLI 0.1831688E-04, ERNI: 0.4402749E+02 Max. and WRMS norm residual= 0.5183953E+00 0.1291819E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 39273 # it. GCRO # it.GMRES Error Estimate 0 0 0.2341855E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2341855E+01 1 0.6211072E+00 0.2652202E+00 2 0.1054839E+00 0.4504288E-01 3 0.4559236E-01 0.1946848E-01 4 0.1886274E-01 0.8054616E-02 5 0.8515141E-02 0.3636067E-02 6 0.3413710E-02 0.1457695E-02 7 0.1568447E-02 0.6697458E-03 Result GMRES:7, 2.5E-2, 1.5684472269316E-3, 0 1 7 0.1568447E-02 0.2127857E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1568447E-02 1 0.8146592E-03 0.5194049E+00 2 0.3443592E-03 0.2195542E+00 3 0.1354316E-03 0.8634759E-01 4 0.6825991E-04 0.4352070E-01 5 0.2825868E-04 0.1801698E-01 6 0.1314536E-04 0.8381127E-02 7 0.5789026E-05 0.3690928E-02 8 0.2668656E-05 0.1701464E-02 9 0.1189676E-05 0.7585057E-03 Result GMRES:9, 2.5E-2, 1.1896762021682E-6, 0 2 16 0.1189676E-05 0.1439625E-02 NI: 2, NLI: 18, ERLI 0.1189676E-05, ERNI: 0.2128026E+01 T= 0.61E+00, LEVEL= 3 ,TOLWGT=0.9, SPCMON= 0.55E+01 Time integration at T= 0.61E+00, Grid level= 4, NPTS= 58634 Nonlinear system solver at T = 0.6117945E+00 Max. and WRMS norm residual= 0.7547101E+01 0.2684099E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 175902 # it. GCRO # it.GMRES Error Estimate 0 0 0.3179458E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3179458E+02 1 0.1361272E+02 0.4281459E+00 2 0.5478051E+01 0.1722951E+00 3 0.2365401E+01 0.7439634E-01 4 0.1309051E+01 0.4117212E-01 5 0.8091787E+00 0.2545021E-01 6 0.4704768E+00 0.1479739E-01 7 0.2901352E+00 0.9125304E-02 8 0.1797120E+00 0.5652284E-02 9 0.1114114E+00 0.3504099E-02 10 0.7025598E-01 0.2209684E-02 11 0.4455805E-01 0.1401435E-02 12 0.2816476E-01 0.8858352E-03 Result GMRES:12, 5.E-2, 2.8164761330745E-2, 0 1 12 0.2816476E-01 0.5575925E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2816476E-01 1 0.1855701E-01 0.6588733E+00 2 0.1168043E-01 0.4147178E+00 3 0.7511259E-02 0.2666900E+00 4 0.4883370E-02 0.1733858E+00 5 0.3167523E-02 0.1124641E+00 6 0.2055502E-02 0.7298134E-01 7 0.1338371E-02 0.4751933E-01 8 0.8567821E-03 0.3042036E-01 9 0.5630893E-03 0.1999269E-01 10 0.3565831E-03 0.1266061E-01 11 0.2339925E-03 0.8307988E-02 12 0.1502868E-03 0.5335988E-02 13 0.9841967E-04 0.3494426E-02 14 0.6405245E-04 0.2274205E-02 15 0.4199899E-04 0.1491189E-02 16 0.2741218E-04 0.9732793E-03 Result GMRES:16, 5.E-2, 2.7412179816362E-5, 0 2 28 0.2741218E-04 0.4216612E-01 NI: 1, NLI: 30, ERLI 0.2741218E-04, ERNI: 0.5576032E+02 Max. and WRMS norm residual= 0.7426053E+00 0.2303470E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 175902 # it. GCRO # it.GMRES Error Estimate 0 0 0.2163236E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2163236E+01 1 0.1084933E+01 0.5015326E+00 2 0.3719249E+00 0.1719299E+00 3 0.1615810E+00 0.7469413E-01 4 0.8519125E-01 0.3938140E-01 5 0.5355059E-01 0.2475486E-01 6 0.3009035E-01 0.1390988E-01 7 0.1811586E-01 0.8374430E-02 8 0.1117716E-01 0.5166873E-02 9 0.6642189E-02 0.3070488E-02 10 0.4109908E-02 0.1899889E-02 11 0.2535494E-02 0.1172084E-02 12 0.1549521E-02 0.7162979E-03 Result GMRES:12, 2.5E-2, 1.5495211708929E-3, 0 1 12 0.1549521E-02 0.2948586E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1549521E-02 1 0.1005896E-02 0.6491655E+00 2 0.6187267E-03 0.3993019E+00 3 0.3888578E-03 0.2509535E+00 4 0.2504891E-03 0.1616558E+00 5 0.1588422E-03 0.1025105E+00 6 0.1012557E-03 0.6534643E-01 7 0.6504920E-04 0.4198020E-01 8 0.4067562E-04 0.2625044E-01 9 0.2652588E-04 0.1711876E-01 10 0.1645104E-04 0.1061685E-01 11 0.1078299E-04 0.6958919E-02 12 0.6913701E-05 0.4461831E-02 13 0.4538990E-05 0.2929286E-02 14 0.2965033E-05 0.1913516E-02 15 0.1959191E-05 0.1264385E-02 16 0.1290468E-05 0.8328170E-03 Result GMRES:16, 2.5E-2, 1.2904675308444E-6, 0 2 28 0.1290468E-05 0.2263598E-02 NI: 2, NLI: 30, ERLI 0.1290468E-05, ERNI: 0.2948689E+01 T= 0.61E+00, LEVEL= 4 ,TOLWGT=1.0, SPCMON= 0.20E+01 TN= 0.58E+00, DT= 0.30E-01, DTNEW= 0.30E-01, TIMMON= 0.51E+00 Time integration at T= 0.64E+00, Grid level= 1, NPTS= 384 Nonlinear system solver at T = 0.6395235E+00 Max. and WRMS norm residual= 0.2056644E+01 0.6352214E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.3411344E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3411344E+02 1 0.1431370E+01 0.4195912E-01 2 0.9878622E-01 0.2895816E-02 3 0.1070488E-01 0.3138023E-03 Result GMRES:3, 5.E-2, 1.0704875036505E-2, 0 1 3 0.1070488E-01 0.3415357E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1070488E-01 1 0.1590801E-02 0.1486053E+00 2 0.1739110E-03 0.1624596E-01 3 0.1621230E-04 0.1514479E-02 4 0.1917020E-05 0.1790792E-03 Result GMRES:4, 5.E-2, 1.9170200169481E-6, 0 2 7 0.1917020E-05 0.1017971E-01 NI: 1, NLI: 9, ERLI 0.1917020E-05, ERNI: 0.3415363E+02 Max. and WRMS norm residual= 0.7776894E-02 0.2325447E+01 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.4825329E-01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4825329E-01 1 0.3356615E-02 0.6956240E-01 2 0.4185264E-03 0.8673530E-02 3 0.5115048E-04 0.1060041E-02 4 0.5510304E-05 0.1141954E-03 Result GMRES:4, 2.5E-2, 5.5103039108843E-6, 0 1 4 0.5510304E-05 0.4653088E-01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.5510304E-05 1 0.7459681E-06 0.1353770E+00 2 0.1015246E-06 0.1842450E-01 3 0.7750672E-08 0.1406578E-02 4 0.6926264E-09 0.1256966E-03 Result GMRES:4, 2.5E-2, 6.9262635681191E-10, 0 2 8 0.6926264E-09 0.5292510E-05 NI: 2, NLI: 10, ERLI 0.6926264E-09, ERNI: 0.4653072E-01 T= 0.64E+00, LEVEL= 1 ,TOLWGT=0.9, SPCMON= 0.14E+02 Time integration at T= 0.64E+00, Grid level= 2, NPTS= 2374 Nonlinear system solver at T = 0.6395235E+00 Max. and WRMS norm residual= 0.5375662E+01 0.1411908E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 7122 # it. GCRO # it.GMRES Error Estimate 0 0 0.3520479E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3520479E+02 1 0.4637942E+01 0.1317418E+00 2 0.7520002E+00 0.2136074E-01 3 0.1379031E+00 0.3917168E-02 4 0.3202430E-01 0.9096575E-03 Result GMRES:4, 5.E-2, 3.2024300091866E-2, 0 1 4 0.3202430E-01 0.3358735E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3202430E-01 1 0.1085036E-01 0.3388164E+00 2 0.2478046E-02 0.7738017E-01 3 0.5531947E-03 0.1727422E-01 4 0.1249659E-03 0.3902222E-02 5 0.3363111E-04 0.1050175E-02 6 0.7423150E-05 0.2317974E-03 Result GMRES:6, 5.E-2, 7.4231504080674E-6, 0 2 10 0.7423150E-05 0.2979277E-01 NI: 1, NLI: 12, ERLI 0.7423150E-05, ERNI: 0.3358842E+02 Max. and WRMS norm residual= 0.1329156E+00 0.3629132E+02 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 7122 # it. GCRO # it.GMRES Error Estimate 0 0 0.7519204E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.7519204E+00 1 0.9717836E-01 0.1292402E+00 2 0.1547369E-01 0.2057889E-01 3 0.3208923E-02 0.4267636E-02 4 0.8333856E-03 0.1108343E-02 5 0.2173022E-03 0.2889962E-03 Result GMRES:5, 2.5E-2, 2.1730217570149E-4, 0 1 5 0.2173022E-03 0.7147867E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2173022E-03 1 0.6891400E-04 0.3171344E+00 2 0.1747351E-04 0.8041110E-01 3 0.3782139E-05 0.1740497E-01 4 0.8886526E-06 0.4089479E-02 5 0.1880799E-06 0.8655223E-03 Result GMRES:5, 2.5E-2, 1.8807987109474E-7, 0 2 10 0.1880799E-06 0.2031052E-03 NI: 2, NLI: 12, ERLI 0.1880799E-06, ERNI: 0.7147947E+00 T= 0.64E+00, LEVEL= 2 ,TOLWGT=0.9, SPCMON= 0.14E+02 Time integration at T= 0.64E+00, Grid level= 3, NPTS= 12699 Nonlinear system solver at T = 0.6395235E+00 Max. and WRMS norm residual= 0.6399182E+01 0.1936992E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 38097 # it. GCRO # it.GMRES Error Estimate 0 0 0.3875789E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3875789E+02 1 0.9824855E+01 0.2534931E+00 2 0.2401182E+01 0.6195337E-01 3 0.7043799E+00 0.1817385E-01 4 0.2461178E+00 0.6350136E-02 5 0.1131019E+00 0.2918164E-02 6 0.4462011E-01 0.1151252E-02 7 0.1823033E-01 0.4703645E-03 Result GMRES:7, 5.E-2, 1.8230332757644E-2, 0 1 7 0.1823033E-01 0.4127519E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1823033E-01 1 0.9092007E-02 0.4987296E+00 2 0.3678254E-02 0.2017656E+00 3 0.1470260E-02 0.8064911E-01 4 0.7059371E-03 0.3872321E-01 5 0.2763929E-03 0.1516115E-01 6 0.1330255E-03 0.7296931E-02 7 0.5409326E-04 0.2967212E-02 8 0.2479180E-04 0.1359921E-02 9 0.1055548E-04 0.5790065E-03 Result GMRES:9, 5.E-2, 1.0555480784059E-5, 0 2 16 0.1055548E-04 0.1691006E-01 NI: 1, NLI: 18, ERLI 0.1055548E-04, ERNI: 0.4127541E+02 Max. and WRMS norm residual= 0.3597708E+00 0.9917307E+02 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 38097 # it. GCRO # it.GMRES Error Estimate 0 0 0.1688745E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1688745E+01 1 0.5228244E+00 0.3095935E+00 2 0.8499766E-01 0.5033185E-01 3 0.2999740E-01 0.1776313E-01 4 0.1235697E-01 0.7317251E-02 5 0.5231155E-02 0.3097659E-02 6 0.2146763E-02 0.1271218E-02 7 0.8860788E-03 0.5246967E-03 Result GMRES:7, 2.5E-2, 8.8607878971438E-4, 0 1 7 0.8860788E-03 0.1512836E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.8860788E-03 1 0.4596807E-03 0.5187808E+00 2 0.1846494E-03 0.2083893E+00 3 0.7407681E-04 0.8360071E-01 4 0.3512584E-04 0.3964189E-01 5 0.1438197E-04 0.1623103E-01 6 0.6554815E-05 0.7397554E-02 7 0.2891171E-05 0.3262882E-02 8 0.1269271E-05 0.1432458E-02 9 0.5669773E-06 0.6398724E-03 Result GMRES:9, 2.5E-2, 5.6697731889425E-7, 0 2 16 0.5669773E-06 0.8317560E-03 NI: 2, NLI: 18, ERLI 0.5669773E-06, ERNI: 0.1512890E+01 T= 0.64E+00, LEVEL= 3 ,TOLWGT=0.9, SPCMON= 0.55E+01 Time integration at T= 0.64E+00, Grid level= 4, NPTS= 61502 Nonlinear system solver at T = 0.6395235E+00 Max. and WRMS norm residual= 0.7383417E+01 0.2555554E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 184506 # it. GCRO # it.GMRES Error Estimate 0 0 0.2924910E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2924910E+02 1 0.1219209E+02 0.4168362E+00 2 0.4749041E+01 0.1623654E+00 3 0.1986716E+01 0.6792401E-01 4 0.1069628E+01 0.3656960E-01 5 0.6501253E+00 0.2222719E-01 6 0.3703337E+00 0.1266137E-01 7 0.2239503E+00 0.7656654E-02 8 0.1361922E+00 0.4656288E-02 9 0.8278454E-01 0.2830327E-02 10 0.5126107E-01 0.1752569E-02 11 0.3190746E-01 0.1090887E-02 12 0.1981761E-01 0.6775460E-03 Result GMRES:12, 5.E-2, 1.9817612772876E-2, 0 1 12 0.1981761E-01 0.5049298E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1981761E-01 1 0.1283251E-01 0.6475307E+00 2 0.7930362E-02 0.4001674E+00 3 0.5007039E-02 0.2526560E+00 4 0.3197798E-02 0.1613614E+00 5 0.2037084E-02 0.1027916E+00 6 0.1298466E-02 0.6552083E-01 7 0.8304451E-03 0.4190440E-01 8 0.5226174E-03 0.2637136E-01 9 0.3372734E-03 0.1701887E-01 10 0.2101652E-03 0.1060497E-01 11 0.1354171E-03 0.6833168E-02 12 0.8555125E-04 0.4316930E-02 13 0.5502693E-04 0.2776668E-02 14 0.3520651E-04 0.1776526E-02 15 0.2267907E-04 0.1144389E-02 16 0.1455514E-04 0.7344548E-03 Result GMRES:16, 5.E-2, 1.4555141726728E-5, 0 2 28 0.1455514E-04 0.2904147E-01 NI: 1, NLI: 30, ERLI 0.1455514E-04, ERNI: 0.5049358E+02 Max. and WRMS norm residual= 0.6556209E+00 0.1950783E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 184506 # it. GCRO # it.GMRES Error Estimate 0 0 0.1788570E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1788570E+01 1 0.8662909E+00 0.4843484E+00 2 0.2876876E+00 0.1608478E+00 3 0.1217066E+00 0.6804688E-01 4 0.6351941E-01 0.3551408E-01 5 0.3919964E-01 0.2191675E-01 6 0.2156424E-01 0.1205670E-01 7 0.1282272E-01 0.7169256E-02 8 0.7758960E-02 0.4338081E-02 9 0.4535683E-02 0.2535927E-02 10 0.2764193E-02 0.1545477E-02 11 0.1674076E-02 0.9359856E-03 Result GMRES:11, 2.5E-2, 1.6740755355368E-3, 0 1 11 0.1674076E-02 0.2419039E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1674076E-02 1 0.1060412E-02 0.6334312E+00 2 0.6441188E-03 0.3847609E+00 3 0.3948167E-03 0.2358416E+00 4 0.2496212E-03 0.1491099E+00 5 0.1559542E-03 0.9315839E-01 6 0.9578377E-04 0.5721592E-01 7 0.6084146E-04 0.3634332E-01 8 0.3625536E-04 0.2165695E-01 9 0.2312106E-04 0.1381124E-01 10 0.1413137E-04 0.8441296E-02 11 0.9000509E-05 0.5376405E-02 12 0.5673391E-05 0.3388970E-02 13 0.3627893E-05 0.2167102E-02 14 0.2326113E-05 0.1389491E-02 15 0.1497531E-05 0.8945423E-03 Result GMRES:15, 2.5E-2, 1.4975313340796E-6, 0 2 26 0.1497531E-05 0.2382606E-02 NI: 2, NLI: 28, ERLI 0.1497531E-05, ERNI: 0.2419180E+01 T= 0.64E+00, LEVEL= 4 ,TOLWGT=1.0, SPCMON= 0.20E+01 TN= 0.61E+00, DT= 0.28E-01, DTNEW= 0.30E-01, TIMMON= 0.46E+00 Time integration at T= 0.67E+00, Grid level= 1, NPTS= 384 Nonlinear system solver at T = 0.6695632E+00 Max. and WRMS norm residual= 0.3867804E+01 0.1095308E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.5495771E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.5495771E+02 1 0.2720912E+01 0.4950920E-01 2 0.1729405E+00 0.3146793E-02 3 0.2216908E-01 0.4033845E-03 Result GMRES:3, 5.E-2, 2.2169084844194E-2, 0 1 3 0.2216908E-01 0.5491825E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2216908E-01 1 0.3196404E-02 0.1441829E+00 2 0.3443239E-03 0.1553171E-01 3 0.3222844E-04 0.1453756E-02 4 0.4145036E-05 0.1869737E-03 Result GMRES:4, 5.E-2, 4.1450362577884E-6, 0 2 7 0.4145036E-05 0.2106610E-01 NI: 1, NLI: 9, ERLI 0.4145036E-05, ERNI: 0.5491851E+02 Max. and WRMS norm residual= 0.1071407E-01 0.3209130E+01 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.6916330E-01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.6916330E-01 1 0.4695560E-02 0.6789092E-01 2 0.5818896E-03 0.8413271E-02 3 0.7591634E-04 0.1097639E-02 4 0.8138703E-05 0.1176737E-03 Result GMRES:4, 2.5E-2, 8.1387027361249E-6, 0 1 4 0.8138703E-05 0.6700062E-01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.8138703E-05 1 0.1090167E-05 0.1339485E+00 2 0.1572129E-06 0.1931670E-01 3 0.1349542E-07 0.1658178E-02 4 0.1199693E-08 0.1474059E-03 Result GMRES:4, 2.5E-2, 1.1996925758419E-9, 0 2 8 0.1199693E-08 0.7825949E-05 NI: 2, NLI: 10, ERLI 0.1199693E-08, ERNI: 0.6700033E-01 T= 0.67E+00, LEVEL= 1 ,TOLWGT=0.9, SPCMON= 0.11E+02 Time integration at T= 0.67E+00, Grid level= 2, NPTS= 2374 Nonlinear system solver at T = 0.6695632E+00 Max. and WRMS norm residual= 0.4049366E+01 0.1227943E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 7122 # it. GCRO # it.GMRES Error Estimate 0 0 0.3960179E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3960179E+02 1 0.5683092E+01 0.1435059E+00 2 0.7455235E+00 0.1882550E-01 3 0.1629458E+00 0.4114606E-02 4 0.3127716E-01 0.7897915E-03 Result GMRES:4, 5.E-2, 3.1277159468162E-2, 0 1 4 0.3127716E-01 0.3833014E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3127716E-01 1 0.1002062E-01 0.3203815E+00 2 0.2528547E-02 0.8084326E-01 3 0.7003540E-03 0.2239187E-01 4 0.1682034E-03 0.5377833E-02 5 0.4588696E-04 0.1467108E-02 6 0.1112750E-04 0.3557708E-03 Result GMRES:6, 5.E-2, 1.1127499300098E-5, 0 2 10 0.1112750E-04 0.2832076E-01 NI: 1, NLI: 12, ERLI 0.1112750E-04, ERNI: 0.3833156E+02 Max. and WRMS norm residual= 0.6804162E-01 0.1876150E+02 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 7122 # it. GCRO # it.GMRES Error Estimate 0 0 0.4217759E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4217759E+00 1 0.5592558E-01 0.1325955E+00 2 0.9695144E-02 0.2298648E-01 3 0.2068506E-02 0.4904278E-02 4 0.6024986E-03 0.1428480E-02 5 0.1633405E-03 0.3872683E-03 Result GMRES:5, 2.5E-2, 1.6334045105246E-4, 0 1 5 0.1633405E-03 0.3849212E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1633405E-03 1 0.5780353E-04 0.3538838E+00 2 0.1494609E-04 0.9150268E-01 3 0.3476658E-05 0.2128473E-01 4 0.8153359E-06 0.4991635E-02 5 0.2046144E-06 0.1252687E-02 6 0.5549948E-07 0.3397780E-03 Result GMRES:6, 2.5E-2, 5.5499484292036E-8, 0 2 11 0.5549948E-07 0.1544219E-03 NI: 2, NLI: 13, ERLI 0.5549948E-07, ERNI: 0.3849242E+00 T= 0.67E+00, LEVEL= 2 ,TOLWGT=0.9, SPCMON= 0.14E+02 Time integration at T= 0.67E+00, Grid level= 3, NPTS= 13012 Nonlinear system solver at T = 0.6695632E+00 Max. and WRMS norm residual= 0.7223705E+01 0.1948625E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 39036 # it. GCRO # it.GMRES Error Estimate 0 0 0.4121992E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4121992E+02 1 0.1067069E+02 0.2588723E+00 2 0.2830036E+01 0.6865702E-01 3 0.7975335E+00 0.1934826E-01 4 0.3102485E+00 0.7526666E-02 5 0.1453251E+00 0.3525604E-02 6 0.5717830E-01 0.1387152E-02 7 0.2477285E-01 0.6009923E-03 Result GMRES:7, 5.E-2, 2.4772853135654E-2, 0 1 7 0.2477285E-01 0.4428405E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2477285E-01 1 0.1281700E-01 0.5173810E+00 2 0.5286355E-02 0.2133931E+00 3 0.2196432E-02 0.8866286E-01 4 0.1094598E-02 0.4418538E-01 5 0.4405625E-03 0.1778408E-01 6 0.2173582E-03 0.8774047E-02 7 0.9140583E-04 0.3689758E-02 8 0.4301903E-04 0.1736539E-02 9 0.1906598E-04 0.7696319E-03 Result GMRES:9, 5.E-2, 1.9065978550479E-5, 0 2 16 0.1906598E-04 0.2269105E-01 NI: 1, NLI: 18, ERLI 0.1906598E-04, ERNI: 0.4428464E+02 Max. and WRMS norm residual= 0.5333381E+00 0.1331366E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 39036 # it. GCRO # it.GMRES Error Estimate 0 0 0.2431539E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2431539E+01 1 0.6390320E+00 0.2628097E+00 2 0.1088374E+00 0.4476069E-01 3 0.4692887E-01 0.1930007E-01 4 0.1961984E-01 0.8068900E-02 5 0.8791506E-02 0.3615614E-02 6 0.3570907E-02 0.1468579E-02 7 0.1632264E-02 0.6712884E-03 Result GMRES:7, 2.5E-2, 1.632263811778E-3, 0 1 7 0.1632264E-02 0.2185390E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1632264E-02 1 0.8520881E-03 0.5220284E+00 2 0.3602611E-03 0.2207125E+00 3 0.1429549E-03 0.8758075E-01 4 0.7190440E-04 0.4405195E-01 5 0.3006065E-04 0.1841654E-01 6 0.1395669E-04 0.8550509E-02 7 0.6197010E-05 0.3796574E-02 8 0.2852207E-05 0.1747394E-02 9 0.1276966E-05 0.7823280E-03 Result GMRES:9, 2.5E-2, 1.2769656463337E-6, 0 2 16 0.1276966E-05 0.1497638E-02 NI: 2, NLI: 18, ERLI 0.1276966E-05, ERNI: 0.2185570E+01 T= 0.67E+00, LEVEL= 3 ,TOLWGT=0.9, SPCMON= 0.57E+01 Time integration at T= 0.67E+00, Grid level= 4, NPTS= 59468 Nonlinear system solver at T = 0.6695632E+00 Max. and WRMS norm residual= 0.7580218E+01 0.2662747E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 178404 # it. GCRO # it.GMRES Error Estimate 0 0 0.3160738E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3160738E+02 1 0.1355424E+02 0.4288316E+00 2 0.5468958E+01 0.1730279E+00 3 0.2369640E+01 0.7497111E-01 4 0.1314894E+01 0.4160086E-01 5 0.8141149E+00 0.2575712E-01 6 0.4737379E+00 0.1498821E-01 7 0.2926438E+00 0.9258719E-02 8 0.1813306E+00 0.5736971E-02 9 0.1124660E+00 0.3558221E-02 10 0.7102594E-01 0.2247132E-02 11 0.4505219E-01 0.1425369E-02 12 0.2854348E-01 0.9030640E-03 Result GMRES:12, 5.E-2, 2.8543484401599E-2, 0 1 12 0.2854348E-01 0.5550174E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2854348E-01 1 0.1883264E-01 0.6597876E+00 2 0.1186903E-01 0.4158226E+00 3 0.7643672E-02 0.2677904E+00 4 0.4976202E-02 0.1743376E+00 5 0.3231434E-02 0.1132109E+00 6 0.2100944E-02 0.7360503E-01 7 0.1369638E-02 0.4798425E-01 8 0.8794332E-03 0.3081030E-01 9 0.5783375E-03 0.2026163E-01 10 0.3674032E-03 0.1287170E-01 11 0.2412506E-03 0.8452039E-02 12 0.1553257E-03 0.5441721E-02 13 0.1018368E-03 0.3567777E-02 14 0.6639848E-04 0.2326222E-02 15 0.4359358E-04 0.1527269E-02 16 0.2850613E-04 0.9986914E-03 Result GMRES:16, 5.E-2, 2.8506131047821E-5, 0 2 28 0.2850613E-04 0.4281446E-01 NI: 1, NLI: 30, ERLI 0.2850613E-04, ERNI: 0.5550282E+02 Max. and WRMS norm residual= 0.7731056E+00 0.2306738E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 178404 # it. GCRO # it.GMRES Error Estimate 0 0 0.2170715E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2170715E+01 1 0.1091820E+01 0.5029770E+00 2 0.3749649E+00 0.1727380E+00 3 0.1627067E+00 0.7495537E-01 4 0.8602564E-01 0.3963010E-01 5 0.5421999E-01 0.2497795E-01 6 0.3041605E-01 0.1401200E-01 7 0.1839856E-01 0.8475806E-02 8 0.1134733E-01 0.5227465E-02 9 0.6753665E-02 0.3111264E-02 10 0.4191019E-02 0.1930709E-02 11 0.2584633E-02 0.1190683E-02 12 0.1583763E-02 0.7296043E-03 Result GMRES:12, 2.5E-2, 1.583762813088E-3, 0 1 12 0.1583763E-02 0.2959727E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1583763E-02 1 0.1030362E-02 0.6505785E+00 2 0.6339974E-03 0.4003108E+00 3 0.3993275E-03 0.2521384E+00 4 0.2575548E-03 0.1626221E+00 5 0.1634946E-03 0.1032318E+00 6 0.1044646E-03 0.6595974E-01 7 0.6716420E-04 0.4240799E-01 8 0.4209860E-04 0.2658138E-01 9 0.2748848E-04 0.1735644E-01 10 0.1705231E-04 0.1076696E-01 11 0.1120120E-04 0.7072523E-02 12 0.7185432E-05 0.4536937E-02 13 0.4726296E-05 0.2984219E-02 14 0.3091121E-05 0.1951758E-02 15 0.2046550E-05 0.1292207E-02 16 0.1349845E-05 0.8523027E-03 Result GMRES:16, 2.5E-2, 1.349845325439E-6, 0 2 28 0.1349845E-05 0.2316067E-02 NI: 2, NLI: 30, ERLI 0.1349845E-05, ERNI: 0.2959832E+01 T= 0.67E+00, LEVEL= 4 ,TOLWGT=1.0, SPCMON= 0.20E+01 TN= 0.64E+00, DT= 0.30E-01, DTNEW= 0.30E-01, TIMMON= 0.50E+00 Time integration at T= 0.70E+00, Grid level= 1, NPTS= 384 Nonlinear system solver at T = 0.6970996E+00 Max. and WRMS norm residual= 0.6481095E+01 0.1693877E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.5245508E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.5245508E+02 1 0.2778996E+01 0.5297858E-01 2 0.2056265E+00 0.3920049E-02 3 0.2800240E-01 0.5338358E-03 Result GMRES:3, 5.E-2, 2.8002402320104E-2, 0 1 3 0.2800240E-01 0.5242140E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2800240E-01 1 0.3856767E-02 0.1377299E+00 2 0.3747963E-03 0.1338443E-01 3 0.2868613E-04 0.1024417E-02 4 0.3394981E-05 0.1212389E-03 Result GMRES:4, 5.E-2, 3.39498088686E-6, 0 2 7 0.3394981E-05 0.2706131E-01 NI: 1, NLI: 9, ERLI 0.3394981E-05, ERNI: 0.5242207E+02 Max. and WRMS norm residual= 0.1455288E-01 0.4440449E+01 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.8805678E-01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.8805678E-01 1 0.6099461E-02 0.6926736E-01 2 0.7793411E-03 0.8850438E-02 3 0.8033322E-04 0.9122888E-03 Result GMRES:3, 2.5E-2, 8.0333215062522E-5, 0 1 3 0.8033322E-04 0.8566661E-01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.8033322E-04 1 0.1117138E-04 0.1390630E+00 2 0.1238898E-05 0.1542198E-01 3 0.8705023E-07 0.1083614E-02 4 0.7354260E-08 0.9154694E-04 Result GMRES:4, 2.5E-2, 7.3542602330386E-9, 0 2 7 0.7354260E-08 0.7946411E-04 NI: 2, NLI: 9, ERLI 0.7354260E-08, ERNI: 0.8566820E-01 T= 0.70E+00, LEVEL= 1 ,TOLWGT=0.9, SPCMON= 0.10E+02 Time integration at T= 0.70E+00, Grid level= 2, NPTS= 2374 Nonlinear system solver at T = 0.6970996E+00 Max. and WRMS norm residual= 0.6460179E+01 0.1607183E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 7122 # it. GCRO # it.GMRES Error Estimate 0 0 0.4057279E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4057279E+02 1 0.5882883E+01 0.1449958E+00 2 0.7015593E+00 0.1729137E-01 3 0.1384498E+00 0.3412380E-02 4 0.2703212E-01 0.6662623E-03 Result GMRES:4, 5.E-2, 2.7032120263531E-2, 0 1 4 0.2703212E-01 0.4052537E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2703212E-01 1 0.9633946E-02 0.3563888E+00 2 0.2067925E-02 0.7649879E-01 3 0.5969135E-03 0.2208164E-01 4 0.1115715E-03 0.4127369E-02 5 0.3074723E-04 0.1137433E-02 6 0.6821909E-05 0.2523631E-03 Result GMRES:6, 5.E-2, 6.8219090208401E-6, 0 2 10 0.6821909E-05 0.2587189E-01 NI: 1, NLI: 12, ERLI 0.6821909E-05, ERNI: 0.4052561E+02 Max. and WRMS norm residual= 0.9171082E-01 0.2505158E+02 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 7122 # it. GCRO # it.GMRES Error Estimate 0 0 0.5105765E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.5105765E+00 1 0.5991511E-01 0.1173480E+00 2 0.1036899E-01 0.2030840E-01 3 0.1816927E-02 0.3558580E-02 4 0.4972830E-03 0.9739639E-03 Result GMRES:4, 2.5E-2, 4.9728304618369E-4, 0 1 4 0.4972830E-03 0.4868365E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4972830E-03 1 0.1661402E-03 0.3340958E+00 2 0.3627384E-04 0.7294404E-01 3 0.7826087E-05 0.1573769E-01 4 0.1914624E-05 0.3850169E-02 5 0.5001456E-06 0.1005756E-02 6 0.1102833E-06 0.2217718E-03 Result GMRES:6, 2.5E-2, 1.102833422149E-7, 0 2 10 0.1102833E-06 0.4696145E-03 NI: 2, NLI: 12, ERLI 0.1102833E-06, ERNI: 0.4868433E+00 T= 0.70E+00, LEVEL= 2 ,TOLWGT=0.9, SPCMON= 0.89E+01 Time integration at T= 0.70E+00, Grid level= 3, NPTS= 13039 Nonlinear system solver at T = 0.6970996E+00 Max. and WRMS norm residual= 0.6532586E+01 0.1900579E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 39117 # it. GCRO # it.GMRES Error Estimate 0 0 0.3781432E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3781432E+02 1 0.9592075E+01 0.2536625E+00 2 0.2314349E+01 0.6120298E-01 3 0.6780933E+00 0.1793218E-01 4 0.2356399E+00 0.6231499E-02 5 0.1081012E+00 0.2858737E-02 6 0.4266436E-01 0.1128259E-02 7 0.1730267E-01 0.4575691E-03 Result GMRES:7, 5.E-2, 1.7302666060476E-2, 0 1 7 0.1730267E-01 0.4028134E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1730267E-01 1 0.8587436E-02 0.4963071E+00 2 0.3469818E-02 0.2005366E+00 3 0.1380847E-02 0.7980545E-01 4 0.6604095E-03 0.3816808E-01 5 0.2590181E-03 0.1496984E-01 6 0.1238014E-03 0.7155050E-02 7 0.5042883E-04 0.2914512E-02 8 0.2293554E-04 0.1325550E-02 9 0.9754096E-05 0.5637337E-03 Result GMRES:9, 5.E-2, 9.754095586552E-6, 0 2 16 0.9754096E-05 0.1604973E-01 NI: 1, NLI: 18, ERLI 0.9754096E-05, ERNI: 0.4028155E+02 Max. and WRMS norm residual= 0.3358229E+00 0.9412860E+02 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 39117 # it. GCRO # it.GMRES Error Estimate 0 0 0.1586915E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1586915E+01 1 0.4991076E+00 0.3145144E+00 2 0.8016543E-01 0.5051652E-01 3 0.2828514E-01 0.1782398E-01 4 0.1152504E-01 0.7262541E-02 5 0.4932176E-02 0.3108027E-02 6 0.1992414E-02 0.1255527E-02 7 0.8245644E-03 0.5196021E-03 Result GMRES:7, 2.5E-2, 8.2456440855621E-4, 0 1 7 0.8245644E-03 0.1442097E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.8245644E-03 1 0.4253086E-03 0.5157979E+00 2 0.1709424E-03 0.2073124E+00 3 0.6805563E-04 0.8253525E-01 4 0.3229725E-04 0.3916886E-01 5 0.1311654E-04 0.1590724E-01 6 0.5988633E-05 0.7262783E-02 7 0.2625586E-05 0.3184210E-02 8 0.1150815E-05 0.1395664E-02 9 0.5135544E-06 0.6228190E-03 Result GMRES:9, 2.5E-2, 5.1355439195563E-7, 0 2 16 0.5135544E-06 0.7752798E-03 NI: 2, NLI: 18, ERLI 0.5135544E-06, ERNI: 0.1442144E+01 T= 0.70E+00, LEVEL= 3 ,TOLWGT=0.9, SPCMON= 0.53E+01 Time integration at T= 0.70E+00, Grid level= 4, NPTS= 61022 Nonlinear system solver at T = 0.6970996E+00 Max. and WRMS norm residual= 0.7335437E+01 0.2551078E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 183066 # it. GCRO # it.GMRES Error Estimate 0 0 0.2909076E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2909076E+02 1 0.1208661E+02 0.4154792E+00 2 0.4692616E+01 0.1613095E+00 3 0.1959099E+01 0.6734437E-01 4 0.1052636E+01 0.3618455E-01 5 0.6388986E+00 0.2196225E-01 6 0.3629736E+00 0.1247728E-01 7 0.2190875E+00 0.7531170E-02 8 0.1328695E+00 0.4567412E-02 9 0.8049380E-01 0.2766988E-02 10 0.4975351E-01 0.1710286E-02 11 0.3085407E-01 0.1060614E-02 12 0.1914340E-01 0.6580578E-03 Result GMRES:12, 5.E-2, 1.9143401668245E-2, 0 1 12 0.1914340E-01 0.5013546E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1914340E-01 1 0.1237779E-01 0.6465828E+00 2 0.7628741E-02 0.3985050E+00 3 0.4807752E-02 0.2511441E+00 4 0.3064904E-02 0.1601024E+00 5 0.1947273E-02 0.1017203E+00 6 0.1240118E-02 0.6478042E-01 7 0.7912190E-03 0.4133116E-01 8 0.4984415E-03 0.2603725E-01 9 0.3205276E-03 0.1674350E-01 10 0.1999840E-03 0.1044663E-01 11 0.1284295E-03 0.6708811E-02 12 0.8112112E-04 0.4237550E-02 13 0.5205381E-04 0.2719151E-02 14 0.3326443E-04 0.1737645E-02 15 0.2138103E-04 0.1116888E-02 16 0.1370295E-04 0.7158056E-03 Result GMRES:16, 5.E-2, 1.3702954561797E-5, 0 2 28 0.1370295E-04 0.2799674E-01 NI: 1, NLI: 30, ERLI 0.1370295E-04, ERNI: 0.5013601E+02 Max. and WRMS norm residual= 0.6653940E+00 0.1925564E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 183066 # it. GCRO # it.GMRES Error Estimate 0 0 0.1761509E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1761509E+01 1 0.8503443E+00 0.4827362E+00 2 0.2814772E+00 0.1597932E+00 3 0.1184220E+00 0.6722757E-01 4 0.6184225E-01 0.3510754E-01 5 0.3813023E-01 0.2164635E-01 6 0.2084987E-01 0.1183637E-01 7 0.1242897E-01 0.7055867E-02 8 0.7486326E-02 0.4249950E-02 9 0.4370606E-02 0.2481172E-02 10 0.2664573E-02 0.1512665E-02 11 0.1607277E-02 0.9124432E-03 Result GMRES:11, 2.5E-2, 1.6072769777895E-3, 0 1 11 0.1607277E-02 0.2379985E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1607277E-02 1 0.1015773E-02 0.6319840E+00 2 0.6162544E-03 0.3834152E+00 3 0.3772926E-03 0.2347403E+00 4 0.2380929E-03 0.1481343E+00 5 0.1485581E-03 0.9242846E-01 6 0.9117560E-04 0.5672675E-01 7 0.5778290E-04 0.3595080E-01 8 0.3445016E-04 0.2143387E-01 9 0.2192624E-04 0.1364185E-01 10 0.1337024E-04 0.8318564E-02 11 0.8503195E-05 0.5290435E-02 12 0.5346170E-05 0.3326228E-02 13 0.3412943E-05 0.2123432E-02 14 0.2183702E-05 0.1358635E-02 15 0.1403563E-05 0.8732553E-03 Result GMRES:15, 2.5E-2, 1.4035631553438E-6, 0 2 26 0.1403563E-05 0.2282342E-02 NI: 2, NLI: 28, ERLI 0.1403563E-05, ERNI: 0.2380113E+01 T= 0.70E+00, LEVEL= 4 ,TOLWGT=1.0, SPCMON= 0.20E+01 TN= 0.67E+00, DT= 0.28E-01, DTNEW= 0.30E-01, TIMMON= 0.46E+00 Time integration at T= 0.73E+00, Grid level= 1, NPTS= 384 Nonlinear system solver at T = 0.7273896E+00 Max. and WRMS norm residual= 0.6953947E+01 0.1705939E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.4454481E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4454481E+02 1 0.2957181E+01 0.6638665E-01 2 0.2922489E+00 0.6560784E-02 3 0.3706284E-01 0.8320350E-03 Result GMRES:3, 5.E-2, 3.7062839476581E-2, 0 1 3 0.3706284E-01 0.4447440E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3706284E-01 1 0.5258756E-02 0.1418876E+00 2 0.6096581E-03 0.1644931E-01 3 0.4750013E-04 0.1281611E-02 4 0.5338824E-05 0.1440479E-03 Result GMRES:4, 5.E-2, 5.3388235563931E-6, 0 2 7 0.5338824E-05 0.3627415E-01 NI: 1, NLI: 9, ERLI 0.5338824E-05, ERNI: 0.4447515E+02 Max. and WRMS norm residual= 0.1672249E-01 0.3716984E+01 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.7768928E-01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.7768928E-01 1 0.6878532E-02 0.8853901E-01 2 0.8542239E-03 0.1099539E-01 3 0.8798381E-04 0.1132509E-02 4 0.1003484E-04 0.1291663E-03 Result GMRES:4, 2.5E-2, 1.0034837478713E-5, 0 1 4 0.1003484E-04 0.7596123E-01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1003484E-04 1 0.1465058E-05 0.1459972E+00 2 0.1650608E-06 0.1644877E-01 3 0.1592300E-07 0.1586772E-02 4 0.1505612E-08 0.1500385E-03 Result GMRES:4, 2.5E-2, 1.5056116385747E-9, 0 2 8 0.1505612E-08 0.9857783E-05 NI: 2, NLI: 10, ERLI 0.1505612E-08, ERNI: 0.7596124E-01 T= 0.73E+00, LEVEL= 1 ,TOLWGT=0.9, SPCMON= 0.13E+02 Time integration at T= 0.73E+00, Grid level= 2, NPTS= 2374 Nonlinear system solver at T = 0.7273896E+00 Max. and WRMS norm residual= 0.7077656E+01 0.1705374E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 7122 # it. GCRO # it.GMRES Error Estimate 0 0 0.4162174E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4162174E+02 1 0.6508364E+01 0.1563693E+00 2 0.9368969E+00 0.2250979E-01 3 0.1831061E+00 0.4399291E-02 4 0.4576506E-01 0.1099547E-02 5 0.1326375E-01 0.3186736E-03 Result GMRES:5, 5.E-2, 1.3263752252897E-2, 0 1 5 0.1326375E-01 0.4107063E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1326375E-01 1 0.4365164E-02 0.3291048E+00 2 0.1155184E-02 0.8709331E-01 3 0.2541047E-03 0.1915783E-01 4 0.5737283E-04 0.4325535E-02 5 0.1362885E-04 0.1027526E-02 6 0.3760513E-05 0.2835181E-03 Result GMRES:6, 5.E-2, 3.7605132417041E-6, 0 2 11 0.3760513E-05 0.1219553E-01 NI: 1, NLI: 13, ERLI 0.3760513E-05, ERNI: 0.4107078E+02 Max. and WRMS norm residual= 0.1751951E+00 0.4517605E+02 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 7122 # it. GCRO # it.GMRES Error Estimate 0 0 0.9721986E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.9721986E+00 1 0.1292011E+00 0.1328958E+00 2 0.2318226E-01 0.2384519E-01 3 0.4637006E-02 0.4769608E-02 4 0.1291400E-02 0.1328329E-02 5 0.3430344E-03 0.3528440E-03 Result GMRES:5, 2.5E-2, 3.4303443184209E-4, 0 1 5 0.3430344E-03 0.9296632E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3430344E-03 1 0.1123873E-03 0.3276270E+00 2 0.2968780E-04 0.8654465E-01 3 0.7126763E-05 0.2077565E-01 4 0.1622081E-05 0.4728623E-02 5 0.3513418E-06 0.1024217E-02 6 0.9596590E-07 0.2797559E-03 Result GMRES:6, 2.5E-2, 9.5965898218966E-8, 0 2 11 0.9596590E-07 0.3160253E-03 NI: 2, NLI: 13, ERLI 0.9596590E-07, ERNI: 0.9296760E+00 T= 0.73E+00, LEVEL= 2 ,TOLWGT=0.9, SPCMON= 0.11E+02 Time integration at T= 0.73E+00, Grid level= 3, NPTS= 12991 Nonlinear system solver at T = 0.7273896E+00 Max. and WRMS norm residual= 0.7210917E+01 0.1947271E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 38973 # it. GCRO # it.GMRES Error Estimate 0 0 0.4144507E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4144507E+02 1 0.1073264E+02 0.2589605E+00 2 0.2873988E+01 0.6934450E-01 3 0.8098580E+00 0.1954051E-01 4 0.3167830E+00 0.7643442E-02 5 0.1492030E+00 0.3600019E-02 6 0.5859919E-01 0.1413900E-02 7 0.2560733E-01 0.6178619E-03 Result GMRES:7, 5.E-2, 2.5607331652547E-2, 0 1 7 0.2560733E-01 0.4448284E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2560733E-01 1 0.1332480E-01 0.5203511E+00 2 0.5495231E-02 0.2145960E+00 3 0.2299040E-02 0.8978053E-01 4 0.1150782E-02 0.4493956E-01 5 0.4620660E-03 0.1804428E-01 6 0.2302181E-03 0.8990318E-02 7 0.9628904E-04 0.3760214E-02 8 0.4583063E-04 0.1789746E-02 9 0.2029000E-04 0.7923510E-03 Result GMRES:9, 5.E-2, 2.0289995538183E-5, 0 2 16 0.2029000E-04 0.2345502E-01 NI: 1, NLI: 18, ERLI 0.2029000E-04, ERNI: 0.4448347E+02 Max. and WRMS norm residual= 0.5505705E+00 0.1366617E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 38973 # it. GCRO # it.GMRES Error Estimate 0 0 0.2516762E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2516762E+01 1 0.6600732E+00 0.2622708E+00 2 0.1129741E+00 0.4488866E-01 3 0.4850360E-01 0.1927223E-01 4 0.2053442E-01 0.8159065E-02 5 0.9147020E-02 0.3634440E-02 6 0.3770394E-02 0.1498113E-02 7 0.1715040E-02 0.6814470E-03 Result GMRES:7, 2.5E-2, 1.7150396214736E-3, 0 1 7 0.1715040E-02 0.2237543E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1715040E-02 1 0.9010109E-03 0.5253586E+00 2 0.3809664E-03 0.2221327E+00 3 0.1530275E-03 0.8922678E-01 4 0.7676097E-04 0.4475755E-01 5 0.3251646E-04 0.1895960E-01 6 0.1508401E-04 0.8795139E-02 7 0.6760042E-05 0.3941625E-02 8 0.3111776E-05 0.1814405E-02 9 0.1400940E-05 0.8168559E-03 Result GMRES:9, 2.5E-2, 1.4009403096534E-6, 0 2 16 0.1400940E-05 0.1573098E-02 NI: 2, NLI: 18, ERLI 0.1400940E-05, ERNI: 0.2237736E+01 T= 0.73E+00, LEVEL= 3 ,TOLWGT=0.9, SPCMON= 0.58E+01 Time integration at T= 0.73E+00, Grid level= 4, NPTS= 59854 Nonlinear system solver at T = 0.7273896E+00 Max. and WRMS norm residual= 0.7551642E+01 0.2649769E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 179562 # it. GCRO # it.GMRES Error Estimate 0 0 0.3156963E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3156963E+02 1 0.1356755E+02 0.4297658E+00 2 0.5493977E+01 0.1740273E+00 3 0.2392130E+01 0.7577315E-01 4 0.1332595E+01 0.4221130E-01 5 0.8268108E+00 0.2619007E-01 6 0.4819284E+00 0.1526557E-01 7 0.2983916E+00 0.9451855E-02 8 0.1850807E+00 0.5862619E-02 9 0.1148880E+00 0.3639195E-02 10 0.7269927E-01 0.2302823E-02 11 0.4611898E-01 0.1460865E-02 12 0.2929746E-01 0.9280267E-03 Result GMRES:12, 5.E-2, 2.9297461008854E-2, 0 1 12 0.2929746E-01 0.5551807E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2929746E-01 1 0.1937206E-01 0.6612197E+00 2 0.1222173E-01 0.4171600E+00 3 0.7886331E-02 0.2691814E+00 4 0.5143650E-02 0.1755664E+00 5 0.3343668E-02 0.1141282E+00 6 0.2180133E-02 0.7441372E-01 7 0.1423015E-02 0.4857128E-01 8 0.9181375E-03 0.3133847E-01 9 0.6037652E-03 0.2060811E-01 10 0.3854720E-03 0.1315718E-01 11 0.2531848E-03 0.8641870E-02 12 0.1635726E-03 0.5583165E-02 13 0.1073928E-03 0.3665602E-02 14 0.7020248E-04 0.2396197E-02 15 0.4616965E-04 0.1575893E-02 16 0.3026700E-04 0.1033093E-02 17 0.1991398E-04 0.6797170E-03 Result GMRES:17, 5.E-2, 1.9913982147558E-5, 0 2 29 0.1991398E-04 0.4405514E-01 NI: 1, NLI: 31, ERLI 0.1991398E-04, ERNI: 0.5551918E+02 Max. and WRMS norm residual= 0.8014531E+00 0.2325527E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 179562 # it. GCRO # it.GMRES Error Estimate 0 0 0.2194569E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2194569E+01 1 0.1108194E+01 0.5049710E+00 2 0.3820317E+00 0.1740805E+00 3 0.1657091E+00 0.7550873E-01 4 0.8786971E-01 0.4003962E-01 5 0.5556549E-01 0.2531955E-01 6 0.3111547E-01 0.1417840E-01 7 0.1892622E-01 0.8624119E-02 8 0.1166697E-01 0.5316292E-02 9 0.6958535E-02 0.3170798E-02 10 0.4334578E-02 0.1975139E-02 11 0.2672253E-02 0.1217666E-02 12 0.1643971E-02 0.7491089E-03 Result GMRES:12, 2.5E-2, 1.6439710504992E-3, 0 1 12 0.1643971E-02 0.2994020E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1643971E-02 1 0.1072553E-02 0.6524159E+00 2 0.6606133E-03 0.4018400E+00 3 0.4172226E-03 0.2537895E+00 4 0.2696186E-03 0.1640045E+00 5 0.1713786E-03 0.1042467E+00 6 0.1098385E-03 0.6681291E-01 7 0.7068515E-04 0.4299659E-01 8 0.4446324E-04 0.2704624E-01 9 0.2906625E-04 0.1768051E-01 10 0.1806530E-04 0.1098882E-01 11 0.1189714E-04 0.7236832E-02 12 0.7644443E-05 0.4649986E-02 13 0.5042502E-05 0.3067270E-02 14 0.3304132E-05 0.2009848E-02 15 0.2193728E-05 0.1334408E-02 16 0.1449396E-05 0.8816431E-03 Result GMRES:16, 2.5E-2, 1.4493957902647E-6, 0 2 28 0.1449396E-05 0.2408006E-02 NI: 2, NLI: 30, ERLI 0.1449396E-05, ERNI: 0.2994131E+01 T= 0.73E+00, LEVEL= 4 ,TOLWGT=1.0, SPCMON= 0.20E+01 TN= 0.70E+00, DT= 0.30E-01, DTNEW= 0.30E-01, TIMMON= 0.50E+00 Time integration at T= 0.76E+00, Grid level= 1, NPTS= 384 Nonlinear system solver at T = 0.7576797E+00 Max. and WRMS norm residual= 0.4834134E+01 0.1193446E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.2854985E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2854985E+02 1 0.2130118E+01 0.7461047E-01 2 0.2408019E+00 0.8434436E-02 3 0.3082129E-01 0.1079561E-02 4 0.3431594E-02 0.1201966E-03 Result GMRES:4, 5.E-2, 3.4315943886913E-3, 0 1 4 0.3431594E-02 0.2797981E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3431594E-02 1 0.5333347E-03 0.1554189E+00 2 0.7201076E-04 0.2098464E-01 3 0.7202650E-05 0.2098922E-02 4 0.7523941E-06 0.2192550E-03 Result GMRES:4, 5.E-2, 7.523940646056E-7, 0 2 8 0.7523941E-06 0.3286778E-02 NI: 1, NLI: 10, ERLI 0.7523941E-06, ERNI: 0.2797977E+02 Max. and WRMS norm residual= 0.1067891E-01 0.2031174E+01 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.4371994E-01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4371994E-01 1 0.4516452E-02 0.1033042E+00 2 0.5212763E-03 0.1192308E-01 3 0.5888224E-04 0.1346805E-02 4 0.7098703E-05 0.1623676E-03 Result GMRES:4, 2.5E-2, 7.0987030119156E-6, 0 1 4 0.7098703E-05 0.4255125E-01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.7098703E-05 1 0.1099496E-05 0.1548869E+00 2 0.1425469E-06 0.2008069E-01 3 0.1425146E-07 0.2007614E-02 4 0.1555829E-08 0.2191709E-03 Result GMRES:4, 2.5E-2, 1.555829180286E-9, 0 2 8 0.1555829E-08 0.6914927E-05 NI: 2, NLI: 10, ERLI 0.1555829E-08, ERNI: 0.4255125E-01 T= 0.76E+00, LEVEL= 1 ,TOLWGT=0.9, SPCMON= 0.17E+02 Time integration at T= 0.76E+00, Grid level= 2, NPTS= 2374 Nonlinear system solver at T = 0.7576797E+00 Max. and WRMS norm residual= 0.4959439E+01 0.1347498E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 7122 # it. GCRO # it.GMRES Error Estimate 0 0 0.3824951E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3824951E+02 1 0.5327855E+01 0.1392921E+00 2 0.9253124E+00 0.2419148E-01 3 0.1853299E+00 0.4845287E-02 4 0.4475489E-01 0.1170077E-02 5 0.1368141E-01 0.3576885E-03 Result GMRES:5, 5.E-2, 1.3681410628848E-2, 0 1 5 0.1368141E-01 0.3618352E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1368141E-01 1 0.4789168E-02 0.3500493E+00 2 0.1233191E-02 0.9013625E-01 3 0.2377748E-03 0.1737941E-01 4 0.6374913E-04 0.4659544E-02 5 0.1670367E-04 0.1220903E-02 6 0.4577386E-05 0.3345697E-03 Result GMRES:6, 5.E-2, 4.5773857588778E-6, 0 2 11 0.4577386E-05 0.1263459E-01 NI: 1, NLI: 13, ERLI 0.4577386E-05, ERNI: 0.3618388E+02 Max. and WRMS norm residual= 0.1485049E+00 0.4043636E+02 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 7122 # it. GCRO # it.GMRES Error Estimate 0 0 0.9188289E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.9188289E+00 1 0.1260156E+00 0.1371481E+00 2 0.2148035E-01 0.2337796E-01 3 0.4842319E-02 0.5270098E-02 4 0.1379786E-02 0.1501679E-02 5 0.3838861E-03 0.4177994E-03 Result GMRES:5, 2.5E-2, 3.8388613716551E-4, 0 1 5 0.3838861E-03 0.8628675E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3838861E-03 1 0.1305683E-03 0.3401225E+00 2 0.3545634E-04 0.9236161E-01 3 0.8182010E-05 0.2131364E-01 4 0.2040322E-05 0.5314915E-02 5 0.4623281E-06 0.1204336E-02 6 0.1259933E-06 0.3282050E-03 Result GMRES:6, 2.5E-2, 1.2599333183068E-7, 0 2 11 0.1259933E-06 0.3569091E-03 NI: 2, NLI: 13, ERLI 0.1259933E-06, ERNI: 0.8628822E+00 T= 0.76E+00, LEVEL= 2 ,TOLWGT=0.9, SPCMON= 0.15E+02 Time integration at T= 0.76E+00, Grid level= 3, NPTS= 12607 Nonlinear system solver at T = 0.7576797E+00 Max. and WRMS norm residual= 0.6699374E+01 0.1943076E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 37821 # it. GCRO # it.GMRES Error Estimate 0 0 0.4176680E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4176680E+02 1 0.1140904E+02 0.2731605E+00 2 0.2933790E+01 0.7024215E-01 3 0.9201547E+00 0.2203077E-01 4 0.3413653E+00 0.8173124E-02 5 0.1649031E+00 0.3948185E-02 6 0.6809399E-01 0.1630337E-02 7 0.2914851E-01 0.6978871E-03 Result GMRES:7, 5.E-2, 2.9148513360942E-2, 0 1 7 0.2914851E-01 0.4469796E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2914851E-01 1 0.1519644E-01 0.5213453E+00 2 0.6434618E-02 0.2207529E+00 3 0.2696185E-02 0.9249820E-01 4 0.1357059E-02 0.4655672E-01 5 0.5595874E-03 0.1919780E-01 6 0.2815256E-03 0.9658319E-02 7 0.1200872E-03 0.4119841E-02 8 0.5760225E-04 0.1976164E-02 9 0.2563187E-04 0.8793542E-03 Result GMRES:9, 5.E-2, 2.5631866624664E-5, 0 2 16 0.2563187E-04 0.2701445E-01 NI: 1, NLI: 18, ERLI 0.2563187E-04, ERNI: 0.4469858E+02 Max. and WRMS norm residual= 0.3661344E+00 0.1115518E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 37821 # it. GCRO # it.GMRES Error Estimate 0 0 0.2010024E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2010024E+01 1 0.6958337E+00 0.3461818E+00 2 0.1168940E+00 0.5815555E-01 3 0.4440336E-01 0.2209096E-01 4 0.1881897E-01 0.9362564E-02 5 0.8637034E-02 0.4296981E-02 6 0.3600668E-02 0.1791356E-02 7 0.1583069E-02 0.7875871E-03 Result GMRES:7, 2.5E-2, 1.583068708844E-3, 0 1 7 0.1583069E-02 0.1847837E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1583069E-02 1 0.8492038E-03 0.5364289E+00 2 0.3621772E-03 0.2287817E+00 3 0.1505724E-03 0.9511424E-01 4 0.7551298E-04 0.4770038E-01 5 0.3201168E-04 0.2022128E-01 6 0.1544734E-04 0.9757846E-02 7 0.7061446E-05 0.4460606E-02 8 0.3273755E-05 0.2067981E-02 9 0.1533239E-05 0.9685233E-03 Result GMRES:9, 2.5E-2, 1.5332389410071E-6, 0 2 16 0.1533239E-05 0.1489818E-02 NI: 2, NLI: 18, ERLI 0.1533239E-05, ERNI: 0.1847932E+01 T= 0.76E+00, LEVEL= 3 ,TOLWGT=0.9, SPCMON= 0.51E+01 Time integration at T= 0.76E+00, Grid level= 4, NPTS= 60058 Nonlinear system solver at T = 0.7576797E+00 Max. and WRMS norm residual= 0.7342968E+01 0.2594061E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 180174 # it. GCRO # it.GMRES Error Estimate 0 0 0.3124420E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3124420E+02 1 0.1353374E+02 0.4331600E+00 2 0.5550476E+01 0.1776482E+00 3 0.2446804E+01 0.7831226E-01 4 0.1375533E+01 0.4402523E-01 5 0.8583910E+00 0.2747361E-01 6 0.5031131E+00 0.1610261E-01 7 0.3134588E+00 0.1003254E-01 8 0.1953439E+00 0.6252164E-02 9 0.1218055E+00 0.3898499E-02 10 0.7750283E-01 0.2480551E-02 11 0.4932856E-01 0.1578807E-02 12 0.3151892E-01 0.1008793E-02 13 0.2033476E-01 0.6508330E-03 Result GMRES:13, 5.E-2, 2.0334757764334E-2, 0 1 13 0.2033476E-01 0.5518662E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2033476E-01 1 0.1351389E-01 0.6645707E+00 2 0.8596267E-02 0.4227376E+00 3 0.5585892E-02 0.2746968E+00 4 0.3662028E-02 0.1800871E+00 5 0.2397575E-02 0.1179053E+00 6 0.1573515E-02 0.7738054E-01 7 0.1031730E-02 0.5073725E-01 8 0.6739976E-03 0.3314510E-01 9 0.4449116E-03 0.2187937E-01 10 0.2878373E-03 0.1415494E-01 11 0.1897544E-03 0.9331531E-02 12 0.1235780E-03 0.6077182E-02 13 0.8155711E-04 0.4010724E-02 14 0.5374604E-04 0.2643063E-02 15 0.3556760E-04 0.1749104E-02 16 0.2350011E-04 0.1155662E-02 17 0.1556845E-04 0.7656076E-03 Result GMRES:17, 5.E-2, 1.5568445036744E-5, 0 2 30 0.1556845E-04 0.3097704E-01 NI: 1, NLI: 32, ERLI 0.1556845E-04, ERNI: 0.5518714E+02 Max. and WRMS norm residual= 0.7998039E+00 0.2300275E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 180174 # it. GCRO # it.GMRES Error Estimate 0 0 0.2186882E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2186882E+01 1 0.1112637E+01 0.5087778E+00 2 0.3871140E+00 0.1770164E+00 3 0.1690310E+00 0.7729316E-01 4 0.9029252E-01 0.4128825E-01 5 0.5742640E-01 0.2625949E-01 6 0.3221363E-01 0.1473040E-01 7 0.1977299E-01 0.9041635E-02 8 0.1221097E-01 0.5583737E-02 9 0.7323396E-02 0.3348785E-02 10 0.4595814E-02 0.2101538E-02 11 0.2838824E-02 0.1298115E-02 12 0.1761713E-02 0.8055824E-03 Result GMRES:12, 2.5E-2, 1.7617133431909E-3, 0 1 12 0.1761713E-02 0.2994520E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1761713E-02 1 0.1156543E-02 0.6564876E+00 2 0.7156280E-03 0.4062114E+00 3 0.4547378E-03 0.2581225E+00 4 0.2955247E-03 0.1677484E+00 5 0.1886380E-03 0.1070764E+00 6 0.1217704E-03 0.6912045E-01 7 0.7864638E-04 0.4464198E-01 8 0.4987651E-04 0.2831136E-01 9 0.3271328E-04 0.1856902E-01 10 0.2046631E-04 0.1161728E-01 11 0.1354496E-04 0.7688514E-02 12 0.8749629E-05 0.4966545E-02 13 0.5803618E-05 0.3294303E-02 14 0.3821261E-05 0.2169060E-02 15 0.2550357E-05 0.1447657E-02 16 0.1692513E-05 0.9607199E-03 Result GMRES:16, 2.5E-2, 1.6925131231071E-6, 0 2 28 0.1692513E-05 0.2595329E-02 NI: 2, NLI: 30, ERLI 0.1692513E-05, ERNI: 0.2994647E+01 T= 0.76E+00, LEVEL= 4 ,TOLWGT=1.0, SPCMON= 0.20E+01 TN= 0.73E+00, DT= 0.30E-01, DTNEW= 0.30E-01, TIMMON= 0.50E+00 Time integration at T= 0.79E+00, Grid level= 1, NPTS= 384 Nonlinear system solver at T = 0.7879697E+00 Max. and WRMS norm residual= 0.1645565E+01 0.4228431E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.1091786E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1091786E+02 1 0.8003059E+00 0.7330248E-01 2 0.8865136E-01 0.8119851E-02 3 0.1255804E-01 0.1150229E-02 4 0.1464192E-02 0.1341098E-03 Result GMRES:4, 5.E-2, 1.4641915554493E-3, 0 1 4 0.1464192E-02 0.1032940E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1464192E-02 1 0.2382892E-03 0.1627445E+00 2 0.3185364E-04 0.2175511E-01 3 0.3965944E-05 0.2708624E-02 4 0.4493585E-06 0.3068987E-03 Result GMRES:4, 5.E-2, 4.4935846565924E-7, 0 2 8 0.4493585E-06 0.1378006E-02 NI: 1, NLI: 10, ERLI 0.4493585E-06, ERNI: 0.1032940E+02 Max. and WRMS norm residual= 0.2418952E-02 0.7158671E+00 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.1620182E-01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1620182E-01 1 0.1337516E-02 0.8255347E-01 2 0.1748890E-03 0.1079441E-01 3 0.2211550E-04 0.1365001E-02 4 0.2567074E-05 0.1584436E-03 Result GMRES:4, 2.5E-2, 2.567074492827E-6, 0 1 4 0.2567074E-05 0.1572678E-01 NI: 2, NLI: 5, ERLI 0.2567074E-05, ERNI: 0.1572678E-01 T= 0.79E+00, LEVEL= 1 ,TOLWGT=0.9, SPCMON= 0.19E+02 Time integration at T= 0.79E+00, Grid level= 2, NPTS= 2346 Nonlinear system solver at T = 0.7879697E+00 Max. and WRMS norm residual= 0.4568013E+01 0.1263044E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 7038 # it. GCRO # it.GMRES Error Estimate 0 0 0.4100029E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4100029E+02 1 0.6258770E+01 0.1526519E+00 2 0.7740386E+00 0.1887886E-01 3 0.1757877E+00 0.4287476E-02 4 0.3259284E-01 0.7949418E-03 Result GMRES:4, 5.E-2, 3.2592838581282E-2, 0 1 4 0.3259284E-01 0.4004979E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3259284E-01 1 0.1083547E-01 0.3324493E+00 2 0.2739578E-02 0.8405460E-01 3 0.8205360E-03 0.2517535E-01 4 0.1942787E-03 0.5960778E-02 5 0.5480900E-04 0.1681627E-02 6 0.1326368E-04 0.4069507E-03 Result GMRES:6, 5.E-2, 1.3263677693598E-5, 0 2 10 0.1326368E-04 0.2978169E-01 NI: 1, NLI: 12, ERLI 0.1326368E-04, ERNI: 0.4005103E+02 Max. and WRMS norm residual= 0.3724209E-01 0.1009908E+02 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 7038 # it. GCRO # it.GMRES Error Estimate 0 0 0.2247068E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2247068E+00 1 0.3295299E-01 0.1466488E+00 2 0.5859330E-02 0.2607544E-01 3 0.1303459E-02 0.5800710E-02 4 0.3828709E-03 0.1703869E-02 5 0.1092098E-03 0.4860103E-03 Result GMRES:5, 2.5E-2, 1.0920983919E-4, 0 1 5 0.1092098E-03 0.2039726E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1092098E-03 1 0.3981597E-04 0.3645823E+00 2 0.1028305E-04 0.9415866E-01 3 0.2256829E-05 0.2066507E-01 4 0.5447505E-06 0.4988108E-02 5 0.1407174E-06 0.1288505E-02 6 0.3970131E-07 0.3635323E-03 Result GMRES:6, 2.5E-2, 3.9701305546647E-8, 0 2 11 0.3970131E-07 0.1030220E-03 NI: 2, NLI: 13, ERLI 0.3970131E-07, ERNI: 0.2039758E+00 T= 0.79E+00, LEVEL= 2 ,TOLWGT=0.9, SPCMON= 0.13E+02 Time integration at T= 0.79E+00, Grid level= 3, NPTS= 12869 Nonlinear system solver at T = 0.7879697E+00 Max. and WRMS norm residual= 0.6991351E+01 0.1919272E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 38607 # it. GCRO # it.GMRES Error Estimate 0 0 0.4151044E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4151044E+02 1 0.1087264E+02 0.2619255E+00 2 0.2973481E+01 0.7163212E-01 3 0.8487456E+00 0.2044656E-01 4 0.3341289E+00 0.8049275E-02 5 0.1596683E+00 0.3846461E-02 6 0.6308772E-01 0.1519804E-02 7 0.2801782E-01 0.6749583E-03 Result GMRES:7, 5.E-2, 2.8017816518134E-2, 0 1 7 0.2801782E-01 0.4444298E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2801782E-01 1 0.1474014E-01 0.5260988E+00 2 0.6129945E-02 0.2187874E+00 3 0.2602764E-02 0.9289675E-01 4 0.1316205E-02 0.4697742E-01 5 0.5305290E-03 0.1893542E-01 6 0.2691680E-03 0.9607029E-02 7 0.1126338E-03 0.4020078E-02 8 0.5466867E-04 0.1951211E-02 9 0.2435104E-04 0.8691271E-03 Result GMRES:9, 5.E-2, 2.4351043613156E-5, 0 2 16 0.2435104E-04 0.2568365E-01 NI: 1, NLI: 18, ERLI 0.2435104E-04, ERNI: 0.4444369E+02 Max. and WRMS norm residual= 0.5539869E+00 0.1386918E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 38607 # it. GCRO # it.GMRES Error Estimate 0 0 0.2603467E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2603467E+01 1 0.6939079E+00 0.2665322E+00 2 0.1207055E+00 0.4636336E-01 3 0.5083060E-01 0.1952419E-01 4 0.2212264E-01 0.8497376E-02 5 0.9789594E-02 0.3760214E-02 6 0.4158529E-02 0.1597304E-02 7 0.1876377E-02 0.7207221E-03 Result GMRES:7, 2.5E-2, 1.8763765574955E-3, 0 1 7 0.1876377E-02 0.2260799E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1876377E-02 1 0.1001583E-02 0.5337857E+00 2 0.4253520E-03 0.2266880E+00 3 0.1749431E-03 0.9323454E-01 4 0.8797195E-04 0.4688396E-01 5 0.3784580E-04 0.2016962E-01 6 0.1777248E-04 0.9471704E-02 7 0.8080443E-05 0.4306408E-02 8 0.3750844E-05 0.1998983E-02 9 0.1710032E-05 0.9113478E-03 Result GMRES:9, 2.5E-2, 1.7100316339687E-6, 0 2 16 0.1710032E-05 0.1726011E-02 NI: 2, NLI: 18, ERLI 0.1710032E-05, ERNI: 0.2261008E+01 T= 0.79E+00, LEVEL= 3 ,TOLWGT=0.9, SPCMON= 0.59E+01 Time integration at T= 0.79E+00, Grid level= 4, NPTS= 59106 Nonlinear system solver at T = 0.7879697E+00 Max. and WRMS norm residual= 0.7233722E+01 0.2605736E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 177318 # it. GCRO # it.GMRES Error Estimate 0 0 0.3138796E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3138796E+02 1 0.1359255E+02 0.4330499E+00 2 0.5583789E+01 0.1778959E+00 3 0.2469110E+01 0.7866423E-01 4 0.1388420E+01 0.4423417E-01 5 0.8664012E+00 0.2760298E-01 6 0.5079230E+00 0.1618210E-01 7 0.3162699E+00 0.1007615E-01 8 0.1971090E+00 0.6279765E-02 9 0.1227731E+00 0.3911471E-02 10 0.7811220E-01 0.2488604E-02 11 0.4965604E-01 0.1582009E-02 12 0.3171906E-01 0.1010549E-02 13 0.2045098E-01 0.6515549E-03 Result GMRES:13, 5.E-2, 2.0450979331329E-2, 0 1 13 0.2045098E-01 0.5541804E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2045098E-01 1 0.1358737E-01 0.6643872E+00 2 0.8637830E-02 0.4223675E+00 3 0.5608085E-02 0.2742209E+00 4 0.3677189E-02 0.1798050E+00 5 0.2403653E-02 0.1175324E+00 6 0.1577790E-02 0.7714987E-01 7 0.1033578E-02 0.5053929E-01 8 0.6768778E-03 0.3309757E-01 9 0.4454670E-03 0.2178218E-01 10 0.2893612E-03 0.1414901E-01 11 0.1903141E-03 0.9305865E-02 12 0.1242065E-03 0.6073377E-02 13 0.8193457E-04 0.4006389E-02 14 0.5404253E-04 0.2642540E-02 15 0.3575968E-04 0.1748556E-02 16 0.2364918E-04 0.1156384E-02 17 0.1566842E-04 0.7661451E-03 Result GMRES:17, 5.E-2, 1.5668416769632E-5, 0 2 30 0.1566842E-04 0.3115819E-01 NI: 1, NLI: 32, ERLI 0.1566842E-04, ERNI: 0.5541857E+02 Max. and WRMS norm residual= 0.7907296E+00 0.2301931E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 177318 # it. GCRO # it.GMRES Error Estimate 0 0 0.2187983E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2187983E+01 1 0.1113465E+01 0.5089004E+00 2 0.3882702E+00 0.1774558E+00 3 0.1696313E+00 0.7752866E-01 4 0.9060453E-01 0.4141008E-01 5 0.5765280E-01 0.2634975E-01 6 0.3227081E-01 0.1474912E-01 7 0.1982830E-01 0.9062366E-02 8 0.1221985E-01 0.5584985E-02 9 0.7320940E-02 0.3345978E-02 10 0.4599646E-02 0.2102232E-02 11 0.2831455E-02 0.1294094E-02 12 0.1761659E-02 0.8051522E-03 Result GMRES:12, 2.5E-2, 1.7616588851909E-3, 0 1 12 0.1761659E-02 0.2999390E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1761659E-02 1 0.1157613E-02 0.6571152E+00 2 0.7155531E-03 0.4061814E+00 3 0.4547007E-03 0.2581094E+00 4 0.2957163E-03 0.1678624E+00 5 0.1883041E-03 0.1068902E+00 6 0.1219278E-03 0.6921195E-01 7 0.7846888E-04 0.4454261E-01 8 0.5003463E-04 0.2840200E-01 9 0.3268249E-04 0.1855211E-01 10 0.2053685E-04 0.1165767E-01 11 0.1357113E-04 0.7703607E-02 12 0.8783295E-05 0.4985809E-02 13 0.5827201E-05 0.3307792E-02 14 0.3841340E-05 0.2180524E-02 15 0.2564660E-05 0.1455821E-02 16 0.1703575E-05 0.9670288E-03 Result GMRES:16, 2.5E-2, 1.7035749012216E-6, 0 2 28 0.1703575E-05 0.2592626E-02 NI: 2, NLI: 30, ERLI 0.1703575E-05, ERNI: 0.2999523E+01 T= 0.79E+00, LEVEL= 4 ,TOLWGT=1.0, SPCMON= 0.20E+01 TN= 0.76E+00, DT= 0.30E-01, DTNEW= 0.30E-01, TIMMON= 0.50E+00 Time integration at T= 0.82E+00, Grid level= 1, NPTS= 384 Nonlinear system solver at T = 0.8182597E+00 Max. and WRMS norm residual= 0.5700943E+00 0.1840171E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.1047254E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1047254E+02 1 0.4807328E+00 0.4590411E-01 2 0.4365533E-01 0.4168551E-02 3 0.5642342E-02 0.5387747E-03 Result GMRES:3, 5.E-2, 5.6423416532464E-3, 0 1 3 0.5642342E-02 0.1049977E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.5642342E-02 1 0.9212774E-03 0.1632793E+00 2 0.1174334E-03 0.2081288E-01 3 0.1108941E-04 0.1965392E-02 4 0.1662720E-05 0.2946861E-03 Result GMRES:4, 5.E-2, 1.6627197431797E-6, 0 2 7 0.1662720E-05 0.5363375E-02 NI: 1, NLI: 9, ERLI 0.1662720E-05, ERNI: 0.1049982E+02 Max. and WRMS norm residual= 0.1275000E-02 0.3141021E+00 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.7227850E-02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.7227850E-02 1 0.6024026E-03 0.8334465E-01 2 0.8483955E-04 0.1173787E-01 3 0.1053290E-04 0.1457266E-02 4 0.1289630E-05 0.1784251E-03 Result GMRES:4, 2.5E-2, 1.2896301502701E-6, 0 1 4 0.1289630E-05 0.6892567E-02 NI: 2, NLI: 5, ERLI 0.1289630E-05, ERNI: 0.6892567E-02 T= 0.82E+00, LEVEL= 1 ,TOLWGT=0.9, SPCMON= 0.18E+02 Time integration at T= 0.82E+00, Grid level= 2, NPTS= 2370 Nonlinear system solver at T = 0.8182597E+00 Max. and WRMS norm residual= 0.6764811E+01 0.1644534E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 7110 # it. GCRO # it.GMRES Error Estimate 0 0 0.4351088E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4351088E+02 1 0.7089339E+01 0.1629326E+00 2 0.9267335E+00 0.2129889E-01 3 0.1960608E+00 0.4506018E-02 4 0.4351035E-01 0.9999879E-03 Result GMRES:4, 5.E-2, 4.3510352628466E-2, 0 1 4 0.4351035E-01 0.4346388E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4351035E-01 1 0.1722756E-01 0.3959416E+00 2 0.3793777E-02 0.8719252E-01 3 0.1138379E-02 0.2616341E-01 4 0.2225252E-03 0.5114304E-02 5 0.6738395E-04 0.1548688E-02 6 0.1563786E-04 0.3594056E-03 Result GMRES:6, 5.E-2, 1.5637864376897E-5, 0 2 10 0.1563786E-04 0.4152986E-01 NI: 1, NLI: 12, ERLI 0.1563786E-04, ERNI: 0.4346432E+02 Max. and WRMS norm residual= 0.1361892E+00 0.3637773E+02 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 7110 # it. GCRO # it.GMRES Error Estimate 0 0 0.8052441E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.8052441E+00 1 0.1026376E+00 0.1274614E+00 2 0.1918422E-01 0.2382410E-01 3 0.3687275E-02 0.4579078E-02 4 0.1070822E-02 0.1329810E-02 5 0.2789959E-03 0.3464738E-03 Result GMRES:5, 2.5E-2, 2.7899594956409E-4, 0 1 5 0.2789959E-03 0.7631140E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2789959E-03 1 0.9809446E-04 0.3515982E+00 2 0.2514723E-04 0.9013475E-01 3 0.6338209E-05 0.2271792E-01 4 0.1375067E-05 0.4928628E-02 5 0.3526158E-06 0.1263874E-02 6 0.9141279E-07 0.3276492E-03 Result GMRES:6, 2.5E-2, 9.1412786447572E-8, 0 2 11 0.9141279E-07 0.2539677E-03 NI: 2, NLI: 13, ERLI 0.9141279E-07, ERNI: 0.7631242E+00 T= 0.82E+00, LEVEL= 2 ,TOLWGT=0.9, SPCMON= 0.97E+01 Time integration at T= 0.82E+00, Grid level= 3, NPTS= 12701 Nonlinear system solver at T = 0.8182597E+00 Max. and WRMS norm residual= 0.6918557E+01 0.1920482E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 38103 # it. GCRO # it.GMRES Error Estimate 0 0 0.4124971E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4124971E+02 1 0.1131425E+02 0.2742868E+00 2 0.2904682E+01 0.7041704E-01 3 0.9063387E+00 0.2197200E-01 4 0.3403373E+00 0.8250659E-02 5 0.1646760E+00 0.3992174E-02 6 0.6784173E-01 0.1644660E-02 7 0.2907891E-01 0.7049483E-03 Result GMRES:7, 5.E-2, 2.9078913574886E-2, 0 1 7 0.2907891E-01 0.4424256E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2907891E-01 1 0.1511280E-01 0.5197169E+00 2 0.6413470E-02 0.2205540E+00 3 0.2672317E-02 0.9189880E-01 4 0.1347089E-02 0.4632530E-01 5 0.5582674E-03 0.1919836E-01 6 0.2794991E-03 0.9611746E-02 7 0.1201598E-03 0.4132197E-02 8 0.5721078E-04 0.1967432E-02 9 0.2562360E-04 0.8811747E-03 Result GMRES:9, 5.E-2, 2.5623601800941E-5, 0 2 16 0.2562360E-04 0.2687063E-01 NI: 1, NLI: 18, ERLI 0.2562360E-04, ERNI: 0.4424324E+02 Max. and WRMS norm residual= 0.3532734E+00 0.1105495E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 38103 # it. GCRO # it.GMRES Error Estimate 0 0 0.1984768E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1984768E+01 1 0.6763501E+00 0.3407704E+00 2 0.1123556E+00 0.5660894E-01 3 0.4478259E-01 0.2256314E-01 4 0.1877883E-01 0.9461474E-02 5 0.8870703E-02 0.4469391E-02 6 0.3554186E-02 0.1790732E-02 7 0.1614686E-02 0.8135392E-03 Result GMRES:7, 2.5E-2, 1.6146863702698E-3, 0 1 7 0.1614686E-02 0.1870981E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1614686E-02 1 0.8584960E-03 0.5316797E+00 2 0.3684049E-03 0.2281588E+00 3 0.1496070E-03 0.9265392E-01 4 0.7628802E-04 0.4724634E-01 5 0.3162442E-04 0.1958549E-01 6 0.1545726E-04 0.9572918E-02 7 0.6915863E-05 0.4283100E-02 8 0.3253957E-05 0.2015225E-02 9 0.1509955E-05 0.9351381E-03 Result GMRES:9, 2.5E-2, 1.5099546746051E-6, 0 2 16 0.1509955E-05 0.1513529E-02 NI: 2, NLI: 18, ERLI 0.1509955E-05, ERNI: 0.1871081E+01 T= 0.82E+00, LEVEL= 3 ,TOLWGT=0.9, SPCMON= 0.47E+01 Time integration at T= 0.82E+00, Grid level= 4, NPTS= 58920 Nonlinear system solver at T = 0.8182597E+00 Max. and WRMS norm residual= 0.7143383E+01 0.2599358E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 176760 # it. GCRO # it.GMRES Error Estimate 0 0 0.3132075E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3132075E+02 1 0.1355479E+02 0.4327737E+00 2 0.5569883E+01 0.1778337E+00 3 0.2468109E+01 0.7880111E-01 4 0.1390020E+01 0.4438016E-01 5 0.8671402E+00 0.2768581E-01 6 0.5086468E+00 0.1623993E-01 7 0.3167508E+00 0.1011313E-01 8 0.1974670E+00 0.6304672E-02 9 0.1230191E+00 0.3927720E-02 10 0.7828874E-01 0.2499581E-02 11 0.4979364E-01 0.1589797E-02 12 0.3180385E-01 0.1015424E-02 13 0.2052318E-01 0.6552583E-03 Result GMRES:13, 5.E-2, 2.0523180030776E-2, 0 1 13 0.2052318E-01 0.5527865E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2052318E-01 1 0.1362988E-01 0.6641211E+00 2 0.8673492E-02 0.4226193E+00 3 0.5629357E-02 0.2742926E+00 4 0.3693238E-02 0.1799545E+00 5 0.2415456E-02 0.1176940E+00 6 0.1585631E-02 0.7726050E-01 7 0.1039474E-02 0.5064880E-01 8 0.6796099E-03 0.3311426E-01 9 0.4482736E-03 0.2184231E-01 10 0.2903404E-03 0.1414695E-01 11 0.1914759E-03 0.9329737E-02 12 0.1246925E-03 0.6075693E-02 13 0.8237895E-04 0.4013947E-02 14 0.5427942E-04 0.2644786E-02 15 0.3594201E-04 0.1751288E-02 16 0.2374433E-04 0.1156952E-02 17 0.1574704E-04 0.7672806E-03 Result GMRES:17, 5.E-2, 1.5747037672283E-5, 0 2 30 0.1574704E-04 0.3126215E-01 NI: 1, NLI: 32, ERLI 0.1574704E-04, ERNI: 0.5527914E+02 Max. and WRMS norm residual= 0.7748690E+00 0.2289297E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 176760 # it. GCRO # it.GMRES Error Estimate 0 0 0.2175504E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2175504E+01 1 0.1107020E+01 0.5088570E+00 2 0.3866074E+00 0.1777093E+00 3 0.1692693E+00 0.7780692E-01 4 0.9045041E-01 0.4157676E-01 5 0.5754528E-01 0.2645147E-01 6 0.3222310E-01 0.1481179E-01 7 0.1977748E-01 0.9090987E-02 8 0.1218558E-01 0.5601268E-02 9 0.7290963E-02 0.3351390E-02 10 0.4580660E-02 0.2105563E-02 11 0.2815235E-02 0.1294061E-02 12 0.1751968E-02 0.8053157E-03 Result GMRES:12, 2.5E-2, 1.751967574727E-3, 0 1 12 0.1751968E-02 0.2985291E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1751968E-02 1 0.1152012E-02 0.6575533E+00 2 0.7114572E-03 0.4060904E+00 3 0.4519938E-03 0.2579921E+00 4 0.2942891E-03 0.1679763E+00 5 0.1868592E-03 0.1066568E+00 6 0.1214495E-03 0.6932180E-01 7 0.7778162E-04 0.4439672E-01 8 0.4995709E-04 0.2851485E-01 9 0.3243122E-04 0.1851131E-01 10 0.2052567E-04 0.1171578E-01 11 0.1352870E-04 0.7722006E-02 12 0.8781557E-05 0.5012397E-02 13 0.5825979E-05 0.3325392E-02 14 0.3845801E-05 0.2195133E-02 15 0.2567518E-05 0.1465506E-02 16 0.1706660E-05 0.9741388E-03 Result GMRES:16, 2.5E-2, 1.7066595411483E-6, 0 2 28 0.1706660E-05 0.2577843E-02 NI: 2, NLI: 30, ERLI 0.1706660E-05, ERNI: 0.2985425E+01 T= 0.82E+00, LEVEL= 4 ,TOLWGT=1.0, SPCMON= 0.20E+01 TN= 0.79E+00, DT= 0.30E-01, DTNEW= 0.30E-01, TIMMON= 0.50E+00 Time integration at T= 0.85E+00, Grid level= 1, NPTS= 384 Nonlinear system solver at T = 0.8485498E+00 Max. and WRMS norm residual= 0.1343459E+01 0.4218938E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.2585287E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2585287E+02 1 0.1183894E+01 0.4579353E-01 2 0.9784704E-01 0.3784764E-02 3 0.1146162E-01 0.4433401E-03 Result GMRES:3, 5.E-2, 1.1461616609536E-2, 0 1 3 0.1146162E-01 0.2593340E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1146162E-01 1 0.1832432E-02 0.1598755E+00 2 0.2350206E-03 0.2050502E-01 3 0.2418220E-04 0.2109842E-02 4 0.3336613E-05 0.2911119E-03 Result GMRES:4, 5.E-2, 3.3366134687176E-6, 0 2 7 0.3336613E-05 0.1086900E-01 NI: 1, NLI: 9, ERLI 0.3336613E-05, ERNI: 0.2593344E+02 Max. and WRMS norm residual= 0.7463233E-02 0.1787494E+01 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.4076785E-01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4076785E-01 1 0.3105889E-02 0.7618476E-01 2 0.4165659E-03 0.1021800E-01 3 0.5201830E-04 0.1275964E-02 4 0.6124022E-05 0.1502169E-03 Result GMRES:4, 2.5E-2, 6.1240215618558E-6, 0 1 4 0.6124022E-05 0.3898950E-01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.6124022E-05 1 0.9144351E-06 0.1493194E+00 2 0.1348231E-06 0.2201544E-01 3 0.1286431E-07 0.2100632E-02 4 0.1653554E-08 0.2700111E-03 Result GMRES:4, 2.5E-2, 1.6535536090708E-9, 0 2 8 0.1653554E-08 0.5803553E-05 NI: 2, NLI: 10, ERLI 0.1653554E-08, ERNI: 0.3898940E-01 T= 0.85E+00, LEVEL= 1 ,TOLWGT=0.9, SPCMON= 0.16E+02 Time integration at T= 0.85E+00, Grid level= 2, NPTS= 2370 Nonlinear system solver at T = 0.8485498E+00 Max. and WRMS norm residual= 0.6718678E+01 0.1608562E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 7110 # it. GCRO # it.GMRES Error Estimate 0 0 0.4025476E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4025476E+02 1 0.6198943E+01 0.1539928E+00 2 0.9695960E+00 0.2408649E-01 3 0.1914003E+00 0.4754724E-02 4 0.5009546E-01 0.1244461E-02 5 0.1450346E-01 0.3602917E-03 Result GMRES:5, 5.E-2, 1.4503456521462E-2, 0 1 5 0.1450346E-01 0.3915581E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1450346E-01 1 0.4816343E-02 0.3320824E+00 2 0.1303203E-02 0.8985464E-01 3 0.2861595E-03 0.1973043E-01 4 0.6627538E-04 0.4569626E-02 5 0.1598352E-04 0.1102049E-02 6 0.4442666E-05 0.3063178E-03 Result GMRES:6, 5.E-2, 4.4426662629194E-6, 0 2 11 0.4442666E-05 0.1338807E-01 NI: 1, NLI: 13, ERLI 0.4442666E-05, ERNI: 0.3915605E+02 Max. and WRMS norm residual= 0.1887190E+00 0.4789358E+02 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 7110 # it. GCRO # it.GMRES Error Estimate 0 0 0.1055075E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1055075E+01 1 0.1455786E+00 0.1379794E+00 2 0.2575227E-01 0.2440799E-01 3 0.5555819E-02 0.5265805E-02 4 0.1556054E-02 0.1474828E-02 5 0.4221858E-03 0.4001477E-03 Result GMRES:5, 2.5E-2, 4.2218580154072E-4, 0 1 5 0.4221858E-03 0.1004467E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4221858E-03 1 0.1391459E-03 0.3295845E+00 2 0.3740944E-04 0.8860895E-01 3 0.8970559E-05 0.2124789E-01 4 0.2135962E-05 0.5059295E-02 5 0.4580137E-06 0.1084863E-02 6 0.1258256E-06 0.2980338E-03 Result GMRES:6, 2.5E-2, 1.2582564157409E-7, 0 2 11 0.1258256E-06 0.3898182E-03 NI: 2, NLI: 13, ERLI 0.1258256E-06, ERNI: 0.1004484E+01 T= 0.85E+00, LEVEL= 2 ,TOLWGT=0.9, SPCMON= 0.13E+02 Time integration at T= 0.85E+00, Grid level= 3, NPTS= 12423 Nonlinear system solver at T = 0.8485498E+00 Max. and WRMS norm residual= 0.6768365E+01 0.1938664E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 37269 # it. GCRO # it.GMRES Error Estimate 0 0 0.4194035E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4194035E+02 1 0.1098420E+02 0.2619005E+00 2 0.3009929E+01 0.7176691E-01 3 0.8762957E+00 0.2089386E-01 4 0.3412705E+00 0.8137046E-02 5 0.1638567E+00 0.3906899E-02 6 0.6503388E-01 0.1550628E-02 7 0.2883320E-01 0.6874812E-03 Result GMRES:7, 5.E-2, 2.8833201678443E-2, 0 1 7 0.2883320E-01 0.4479379E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2883320E-01 1 0.1518914E-01 0.5267934E+00 2 0.6325478E-02 0.2193817E+00 3 0.2688854E-02 0.9325547E-01 4 0.1359250E-02 0.4714184E-01 5 0.5482485E-03 0.1901449E-01 6 0.2791964E-03 0.9683156E-02 7 0.1168515E-03 0.4052671E-02 8 0.5691155E-04 0.1973820E-02 9 0.2538791E-04 0.8805097E-03 Result GMRES:9, 5.E-2, 2.5387914931693E-5, 0 2 16 0.2538791E-04 0.2650481E-01 NI: 1, NLI: 18, ERLI 0.2538791E-04, ERNI: 0.4479451E+02 Max. and WRMS norm residual= 0.5274456E+00 0.1372958E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 37269 # it. GCRO # it.GMRES Error Estimate 0 0 0.2576656E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2576656E+01 1 0.7082781E+00 0.2748827E+00 2 0.1240877E+00 0.4815841E-01 3 0.5038234E-01 0.1955338E-01 4 0.2225708E-01 0.8637972E-02 5 0.9718064E-02 0.3771579E-02 6 0.4204112E-02 0.1631615E-02 7 0.1858378E-02 0.7212364E-03 Result GMRES:7, 2.5E-2, 1.8583782846747E-3, 0 1 7 0.1858378E-02 0.2208756E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1858378E-02 1 0.9999330E-03 0.5380675E+00 2 0.4219944E-03 0.2270767E+00 3 0.1760576E-03 0.9473724E-01 4 0.8788715E-04 0.4729239E-01 5 0.3815862E-04 0.2053329E-01 6 0.1794045E-04 0.9653818E-02 7 0.8222903E-05 0.4424773E-02 8 0.3805261E-05 0.2047624E-02 9 0.1747790E-05 0.9404921E-03 Result GMRES:9, 2.5E-2, 1.7477901155491E-6, 0 2 16 0.1747790E-05 0.1714670E-02 NI: 2, NLI: 18, ERLI 0.1747790E-05, ERNI: 0.2208952E+01 T= 0.85E+00, LEVEL= 3 ,TOLWGT=0.9, SPCMON= 0.59E+01 Time integration at T= 0.85E+00, Grid level= 4, NPTS= 58046 Nonlinear system solver at T = 0.8485498E+00 Max. and WRMS norm residual= 0.7215278E+01 0.2607475E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 174138 # it. GCRO # it.GMRES Error Estimate 0 0 0.3143305E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3143305E+02 1 0.1359291E+02 0.4324401E+00 2 0.5584681E+01 0.1776691E+00 3 0.2479932E+01 0.7889568E-01 4 0.1399813E+01 0.4453315E-01 5 0.8726718E+00 0.2776288E-01 6 0.5123418E+00 0.1629946E-01 7 0.3191079E+00 0.1015199E-01 8 0.1991044E+00 0.6334237E-02 9 0.1241785E+00 0.3950571E-02 10 0.7906481E-01 0.2515340E-02 11 0.5038012E-01 0.1602776E-02 12 0.3217188E-01 0.1023505E-02 13 0.2078940E-01 0.6613866E-03 Result GMRES:13, 5.E-2, 2.0789397180087E-2, 0 1 13 0.2078940E-01 0.5545183E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2078940E-01 1 0.1380832E-01 0.6642000E+00 2 0.8795446E-02 0.4230737E+00 3 0.5709729E-02 0.2746462E+00 4 0.3747564E-02 0.1802632E+00 5 0.2454312E-02 0.1180559E+00 6 0.1610802E-02 0.7748188E-01 7 0.1056900E-02 0.5083841E-01 8 0.6890309E-03 0.3314338E-01 9 0.4559165E-03 0.2193024E-01 10 0.2940304E-03 0.1414329E-01 11 0.1944972E-03 0.9355598E-02 12 0.1264315E-03 0.6081537E-02 13 0.8362053E-04 0.4022268E-02 14 0.5507879E-04 0.2649369E-02 15 0.3649582E-04 0.1755502E-02 16 0.2410583E-04 0.1159525E-02 17 0.1599431E-04 0.7693493E-03 Result GMRES:17, 5.E-2, 1.5994308025754E-5, 0 2 30 0.1599431E-04 0.3166272E-01 NI: 1, NLI: 32, ERLI 0.1599431E-04, ERNI: 0.5545228E+02 Max. and WRMS norm residual= 0.7536441E+00 0.2291699E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 174138 # it. GCRO # it.GMRES Error Estimate 0 0 0.2177481E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2177481E+01 1 0.1107802E+01 0.5087538E+00 2 0.3873378E+00 0.1778835E+00 3 0.1701987E+00 0.7816315E-01 4 0.9095412E-01 0.4177035E-01 5 0.5783943E-01 0.2656255E-01 6 0.3248215E-01 0.1491731E-01 7 0.1987590E-01 0.9127932E-02 8 0.1227399E-01 0.5636787E-02 9 0.7340669E-02 0.3371175E-02 10 0.4607752E-02 0.2116093E-02 11 0.2839538E-02 0.1304047E-02 12 0.1763440E-02 0.8098534E-03 Result GMRES:12, 2.5E-2, 1.7634400638756E-3, 0 1 12 0.1763440E-02 0.2989858E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1763440E-02 1 0.1158922E-02 0.6571941E+00 2 0.7168299E-03 0.4064952E+00 3 0.4554940E-03 0.2582986E+00 4 0.2967987E-03 0.1683067E+00 5 0.1889024E-03 0.1071215E+00 6 0.1227547E-03 0.6961092E-01 7 0.7891591E-04 0.4475112E-01 8 0.5062087E-04 0.2870575E-01 9 0.3299928E-04 0.1871301E-01 10 0.2086439E-04 0.1183164E-01 11 0.1377909E-04 0.7813756E-02 12 0.8944192E-05 0.5072013E-02 13 0.5939367E-05 0.3368057E-02 14 0.3921911E-05 0.2224012E-02 15 0.2620252E-05 0.1485875E-02 16 0.1741773E-05 0.9877130E-03 Result GMRES:16, 2.5E-2, 1.741772699432E-6, 0 2 28 0.1741773E-05 0.2597298E-02 NI: 2, NLI: 30, ERLI 0.1741773E-05, ERNI: 0.2989989E+01 T= 0.85E+00, LEVEL= 4 ,TOLWGT=1.0, SPCMON= 0.22E+01 TN= 0.82E+00, DT= 0.30E-01, DTNEW= 0.30E-01, TIMMON= 0.50E+00 Time integration at T= 0.88E+00, Grid level= 1, NPTS= 384 Nonlinear system solver at T = 0.8788398E+00 Max. and WRMS norm residual= 0.2907724E+01 0.8225511E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.4773688E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4773688E+02 1 0.2442975E+01 0.5117585E-01 2 0.1678072E+00 0.3515253E-02 3 0.2004990E-01 0.4200086E-03 Result GMRES:3, 5.E-2, 2.0049900180377E-2, 0 1 3 0.2004990E-01 0.4777054E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2004990E-01 1 0.2886593E-02 0.1439704E+00 2 0.3631624E-03 0.1811293E-01 3 0.3947262E-04 0.1968719E-02 4 0.5546346E-05 0.2766271E-03 Result GMRES:4, 5.E-2, 5.546346188319E-6, 0 2 7 0.5546346E-05 0.1896126E-01 NI: 1, NLI: 9, ERLI 0.5546346E-05, ERNI: 0.4777063E+02 Max. and WRMS norm residual= 0.1628936E-01 0.3496045E+01 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.7817503E-01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.7817503E-01 1 0.5548211E-02 0.7097165E-01 2 0.7101376E-03 0.9083945E-02 3 0.8867805E-04 0.1134353E-02 4 0.1030515E-04 0.1318215E-03 Result GMRES:4, 2.5E-2, 1.0305152155168E-5, 0 1 4 0.1030515E-04 0.7510497E-01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1030515E-04 1 0.1493549E-05 0.1449323E+00 2 0.2202615E-06 0.2137392E-01 3 0.2026002E-07 0.1966009E-02 4 0.2386074E-08 0.2315419E-03 Result GMRES:4, 2.5E-2, 2.38607421385E-9, 0 2 8 0.2386074E-08 0.9829587E-05 NI: 2, NLI: 10, ERLI 0.2386074E-08, ERNI: 0.7510470E-01 T= 0.88E+00, LEVEL= 1 ,TOLWGT=0.9, SPCMON= 0.13E+02 Time integration at T= 0.88E+00, Grid level= 2, NPTS= 2370 Nonlinear system solver at T = 0.8788398E+00 Max. and WRMS norm residual= 0.3866270E+01 0.1225835E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 7110 # it. GCRO # it.GMRES Error Estimate 0 0 0.3803829E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3803829E+02 1 0.5368038E+01 0.1411220E+00 2 0.8667264E+00 0.2278563E-01 3 0.1831670E+00 0.4815332E-02 4 0.4078828E-01 0.1072295E-02 5 0.1231890E-01 0.3238553E-03 Result GMRES:5, 5.E-2, 1.2318900683661E-2, 0 1 5 0.1231890E-01 0.3606079E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1231890E-01 1 0.4413504E-02 0.3582709E+00 2 0.1064989E-02 0.8645166E-01 3 0.2136175E-03 0.1734063E-01 4 0.6021949E-04 0.4888382E-02 5 0.1546123E-04 0.1255082E-02 6 0.4400245E-05 0.3571946E-03 Result GMRES:6, 5.E-2, 4.4002450469002E-6, 0 2 11 0.4400245E-05 0.1140059E-01 NI: 1, NLI: 13, ERLI 0.4400245E-05, ERNI: 0.3606110E+02 Max. and WRMS norm residual= 0.1188826E+00 0.3338337E+02 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 7110 # it. GCRO # it.GMRES Error Estimate 0 0 0.7677676E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.7677676E+00 1 0.1036448E+00 0.1349951E+00 2 0.1811002E-01 0.2358789E-01 3 0.4101108E-02 0.5341601E-02 4 0.1183801E-02 0.1541874E-02 5 0.3291739E-03 0.4287415E-03 Result GMRES:5, 2.5E-2, 3.2917385300077E-4, 0 1 5 0.3291739E-03 0.7114985E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3291739E-03 1 0.1152841E-03 0.3502224E+00 2 0.3059265E-04 0.9293766E-01 3 0.7127543E-05 0.2165282E-01 4 0.1746545E-05 0.5305844E-02 5 0.4076886E-06 0.1238521E-02 6 0.1122049E-06 0.3408683E-03 Result GMRES:6, 2.5E-2, 1.1220492173048E-7, 0 2 11 0.1122049E-06 0.3078683E-03 NI: 2, NLI: 13, ERLI 0.1122049E-06, ERNI: 0.7115095E+00 T= 0.88E+00, LEVEL= 2 ,TOLWGT=0.9, SPCMON= 0.15E+02 Time integration at T= 0.88E+00, Grid level= 3, NPTS= 12333 Nonlinear system solver at T = 0.8788398E+00 Max. and WRMS norm residual= 0.7075743E+01 0.1929635E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 36999 # it. GCRO # it.GMRES Error Estimate 0 0 0.4148726E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4148726E+02 1 0.1132373E+02 0.2729447E+00 2 0.2929609E+01 0.7061466E-01 3 0.9020140E+00 0.2174195E-01 4 0.3447128E+00 0.8308884E-02 5 0.1664789E+00 0.4012773E-02 6 0.6814505E-01 0.1642554E-02 7 0.2934956E-01 0.7074356E-03 Result GMRES:7, 5.E-2, 2.9349562783398E-2, 0 1 7 0.2934956E-01 0.4457664E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2934956E-01 1 0.1522946E-01 0.5188990E+00 2 0.6472114E-02 0.2205182E+00 3 0.2689209E-02 0.9162689E-01 4 0.1358254E-02 0.4627849E-01 5 0.5658742E-03 0.1928050E-01 6 0.2814414E-03 0.9589287E-02 7 0.1221645E-03 0.4162395E-02 8 0.5763037E-04 0.1963585E-02 9 0.2604669E-04 0.8874643E-03 Result GMRES:9, 5.E-2, 2.6046689292089E-5, 0 2 16 0.2604669E-04 0.2702305E-01 NI: 1, NLI: 18, ERLI 0.2604669E-04, ERNI: 0.4457739E+02 Max. and WRMS norm residual= 0.3748027E+00 0.1155809E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 36999 # it. GCRO # it.GMRES Error Estimate 0 0 0.2088479E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2088479E+01 1 0.6642692E+00 0.3180637E+00 2 0.1112100E+00 0.5324929E-01 3 0.4696228E-01 0.2248636E-01 4 0.1960861E-01 0.9388944E-02 5 0.9354312E-02 0.4479007E-02 6 0.3663108E-02 0.1753960E-02 7 0.1721652E-02 0.8243570E-03 Result GMRES:7, 2.5E-2, 1.7216520705894E-3, 0 1 7 0.1721652E-02 0.1978016E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1721652E-02 1 0.9103181E-03 0.5287468E+00 2 0.3919097E-03 0.2276358E+00 3 0.1554601E-03 0.9029702E-01 4 0.8079179E-04 0.4692690E-01 5 0.3287087E-04 0.1909263E-01 6 0.1614245E-04 0.9376138E-02 7 0.7088326E-05 0.4117165E-02 8 0.3387379E-05 0.1967517E-02 9 0.1547917E-05 0.8990881E-03 Result GMRES:9, 2.5E-2, 1.5479168082041E-6, 0 2 16 0.1547917E-05 0.1602173E-02 NI: 2, NLI: 18, ERLI 0.1547917E-05, ERNI: 0.1978144E+01 T= 0.88E+00, LEVEL= 3 ,TOLWGT=0.9, SPCMON= 0.44E+01 Time integration at T= 0.88E+00, Grid level= 4, NPTS= 57256 Nonlinear system solver at T = 0.8788398E+00 Max. and WRMS norm residual= 0.7265451E+01 0.2613383E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 171768 # it. GCRO # it.GMRES Error Estimate 0 0 0.3151429E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3151429E+02 1 0.1361865E+02 0.4321420E+00 2 0.5594813E+01 0.1775325E+00 3 0.2492738E+01 0.7909866E-01 4 0.1411044E+01 0.4477474E-01 5 0.8788531E+00 0.2788745E-01 6 0.5170561E+00 0.1640703E-01 7 0.3221420E+00 0.1022209E-01 8 0.2013065E+00 0.6387785E-02 9 0.1258562E+00 0.3993622E-02 10 0.8013770E-01 0.2542900E-02 11 0.5119764E-01 0.1624585E-02 12 0.3268821E-01 0.1037250E-02 13 0.2113643E-01 0.6706936E-03 Result GMRES:13, 5.E-2, 2.1136434306997E-2, 0 1 13 0.2113643E-01 0.5557348E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2113643E-01 1 0.1404827E-01 0.6646471E+00 2 0.8948132E-02 0.4233511E+00 3 0.5811674E-02 0.2749600E+00 4 0.3814991E-02 0.1804936E+00 5 0.2499608E-02 0.1182606E+00 6 0.1640917E-02 0.7763454E-01 7 0.1076876E-02 0.5094880E-01 8 0.7018078E-03 0.3320370E-01 9 0.4645267E-03 0.2197753E-01 10 0.2995443E-03 0.1417194E-01 11 0.1981557E-03 0.9375077E-02 12 0.1287962E-03 0.6093561E-02 13 0.8517972E-04 0.4029995E-02 14 0.5609051E-04 0.2653736E-02 15 0.3716048E-04 0.1758125E-02 16 0.2453197E-04 0.1160648E-02 17 0.1627500E-04 0.7699972E-03 Result GMRES:17, 5.E-2, 1.6274996090393E-5, 0 2 30 0.1627500E-04 0.3219708E-01 NI: 1, NLI: 32, ERLI 0.1627500E-04, ERNI: 0.5557394E+02 Max. and WRMS norm residual= 0.7303783E+00 0.2293862E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 171768 # it. GCRO # it.GMRES Error Estimate 0 0 0.2179316E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2179316E+01 1 0.1108578E+01 0.5086815E+00 2 0.3878313E+00 0.1779601E+00 3 0.1711625E+00 0.7853953E-01 4 0.9149230E-01 0.4198211E-01 5 0.5815204E-01 0.2668361E-01 6 0.3279958E-01 0.1505040E-01 7 0.2000423E-01 0.9179129E-02 8 0.1239576E-01 0.5687912E-02 9 0.7419356E-02 0.3404442E-02 10 0.4651154E-02 0.2134226E-02 11 0.2879472E-02 0.1321273E-02 12 0.1783746E-02 0.8184887E-03 Result GMRES:12, 2.5E-2, 1.7837459769498E-3, 0 1 12 0.1783746E-02 0.2993633E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1783746E-02 1 0.1170941E-02 0.6564504E+00 2 0.7261635E-03 0.4071003E+00 3 0.4614369E-03 0.2586898E+00 4 0.3007444E-03 0.1686027E+00 5 0.1921582E-03 0.1077273E+00 6 0.1245911E-03 0.6984798E-01 7 0.8054389E-04 0.4515435E-01 8 0.5143580E-04 0.2883583E-01 9 0.3372122E-04 0.1890472E-01 10 0.2124781E-04 0.1191190E-01 11 0.1406115E-04 0.7882932E-02 12 0.9115847E-05 0.5110507E-02 13 0.6054763E-05 0.3394409E-02 14 0.3995709E-05 0.2240066E-02 15 0.2669383E-05 0.1496504E-02 16 0.1773327E-05 0.9941589E-03 Result GMRES:16, 2.5E-2, 1.773326959303E-6, 0 2 28 0.1773327E-05 0.2631389E-02 NI: 2, NLI: 30, ERLI 0.1773327E-05, ERNI: 0.2993760E+01 T= 0.88E+00, LEVEL= 4 ,TOLWGT=1.0, SPCMON= 0.21E+01 TN= 0.85E+00, DT= 0.30E-01, DTNEW= 0.30E-01, TIMMON= 0.50E+00 Time integration at T= 0.91E+00, Grid level= 1, NPTS= 384 Nonlinear system solver at T = 0.9091299E+00 Max. and WRMS norm residual= 0.5283065E+01 0.1385845E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.5695476E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.5695476E+02 1 0.3177735E+01 0.5579403E-01 2 0.2204030E+00 0.3869790E-02 3 0.3305530E-01 0.5803783E-03 Result GMRES:3, 5.E-2, 3.3055304799855E-2, 0 1 3 0.3305530E-01 0.5691850E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3305530E-01 1 0.4670394E-02 0.1412903E+00 2 0.4897549E-03 0.1481623E-01 3 0.4689741E-04 0.1418756E-02 4 0.7442399E-05 0.2251499E-03 Result GMRES:4, 5.E-2, 7.4423993265966E-6, 0 2 7 0.7442399E-05 0.3164902E-01 NI: 1, NLI: 9, ERLI 0.7442399E-05, ERNI: 0.5691923E+02 Max. and WRMS norm residual= 0.1736247E-01 0.4757181E+01 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.1038273E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1038273E+00 1 0.7188559E-02 0.6923573E-01 2 0.9841083E-03 0.9478318E-02 3 0.1107452E-03 0.1066629E-02 4 0.1206336E-04 0.1161868E-03 Result GMRES:4, 2.5E-2, 1.2063358435248E-5, 0 1 4 0.1206336E-04 0.1004654E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1206336E-04 1 0.1725828E-05 0.1430636E+00 2 0.2416048E-06 0.2002799E-01 3 0.2231004E-07 0.1849405E-02 4 0.2477087E-08 0.2053398E-03 Result GMRES:4, 2.5E-2, 2.4770873408874E-9, 0 2 8 0.2477087E-08 0.1161446E-04 NI: 2, NLI: 10, ERLI 0.2477087E-08, ERNI: 0.1004652E+00 T= 0.91E+00, LEVEL= 1 ,TOLWGT=0.9, SPCMON= 0.86E+01 Time integration at T= 0.91E+00, Grid level= 2, NPTS= 2370 Nonlinear system solver at T = 0.9091299E+00 Max. and WRMS norm residual= 0.5369901E+01 0.1356158E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 7110 # it. GCRO # it.GMRES Error Estimate 0 0 0.4154774E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4154774E+02 1 0.6547308E+01 0.1575852E+00 2 0.7906065E+00 0.1902887E-01 3 0.1831592E+00 0.4408403E-02 4 0.3443842E-01 0.8288879E-03 Result GMRES:4, 5.E-2, 3.443841912082E-2, 0 1 4 0.3443842E-01 0.4105755E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3443842E-01 1 0.1226594E-01 0.3561701E+00 2 0.2982116E-02 0.8659271E-01 3 0.9164759E-03 0.2661202E-01 4 0.2026399E-03 0.5884123E-02 5 0.5742882E-04 0.1667580E-02 6 0.1369834E-04 0.3977633E-03 Result GMRES:6, 5.E-2, 1.36983400059E-5, 0 2 10 0.1369834E-04 0.3207477E-01 NI: 1, NLI: 12, ERLI 0.1369834E-04, ERNI: 0.4105850E+02 Max. and WRMS norm residual= 0.3935671E-01 0.1093409E+02 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 7110 # it. GCRO # it.GMRES Error Estimate 0 0 0.2350882E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2350882E+00 1 0.3058146E-01 0.1300850E+00 2 0.5093306E-02 0.2166551E-01 3 0.1084131E-02 0.4611590E-02 4 0.2761925E-03 0.1174846E-02 5 0.8006616E-04 0.3405792E-03 Result GMRES:5, 2.5E-2, 8.0066164852897E-5, 0 1 5 0.8006616E-04 0.2320919E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.8006616E-04 1 0.2703473E-04 0.3376548E+00 2 0.7640491E-05 0.9542721E-01 3 0.1819676E-05 0.2272715E-01 4 0.4402509E-06 0.5498589E-02 5 0.1203495E-06 0.1503125E-02 6 0.3079863E-07 0.3846648E-03 Result GMRES:6, 2.5E-2, 3.0798634141465E-8, 0 2 11 0.3079863E-07 0.7123610E-04 NI: 2, NLI: 13, ERLI 0.3079863E-07, ERNI: 0.2320955E+00 T= 0.91E+00, LEVEL= 2 ,TOLWGT=0.9, SPCMON= 0.11E+02 Time integration at T= 0.91E+00, Grid level= 3, NPTS= 12531 Nonlinear system solver at T = 0.9091299E+00 Max. and WRMS norm residual= 0.6456972E+01 0.1912891E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 37593 # it. GCRO # it.GMRES Error Estimate 0 0 0.4134364E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4134364E+02 1 0.1089916E+02 0.2636236E+00 2 0.2966247E+01 0.7174616E-01 3 0.8867864E+00 0.2144916E-01 4 0.3399726E+00 0.8223094E-02 5 0.1638131E+00 0.3962232E-02 6 0.6575310E-01 0.1590404E-02 7 0.2896393E-01 0.7005656E-03 Result GMRES:7, 5.E-2, 2.8963931819805E-2, 0 1 7 0.2896393E-01 0.4407594E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2896393E-01 1 0.1526690E-01 0.5271005E+00 2 0.6382201E-02 0.2203500E+00 3 0.2711501E-02 0.9361646E-01 4 0.1371012E-02 0.4733513E-01 5 0.5549926E-03 0.1916151E-01 6 0.2831942E-03 0.9777479E-02 7 0.1188415E-03 0.4103086E-02 8 0.5797530E-04 0.2001638E-02 9 0.2586310E-04 0.8929415E-03 Result GMRES:9, 5.E-2, 2.5863096571259E-5, 0 2 16 0.2586310E-04 0.2672267E-01 NI: 1, NLI: 18, ERLI 0.2586310E-04, ERNI: 0.4407666E+02 Max. and WRMS norm residual= 0.4990735E+00 0.1299547E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 37593 # it. GCRO # it.GMRES Error Estimate 0 0 0.2428546E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2428546E+01 1 0.7010905E+00 0.2886873E+00 2 0.1239598E+00 0.5104281E-01 3 0.4819503E-01 0.1984522E-01 4 0.2149931E-01 0.8852748E-02 5 0.9332303E-02 0.3842753E-02 6 0.4083469E-02 0.1681446E-02 7 0.1780275E-02 0.7330620E-03 Result GMRES:7, 2.5E-2, 1.7802749561188E-3, 0 1 7 0.1780275E-02 0.2072581E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1780275E-02 1 0.9667663E-03 0.5430433E+00 2 0.4061600E-03 0.2281445E+00 3 0.1713621E-03 0.9625598E-01 4 0.8525222E-04 0.4788711E-01 5 0.3705305E-04 0.2081310E-01 6 0.1750357E-04 0.9831949E-02 7 0.8074527E-05 0.4535551E-02 8 0.3728014E-05 0.2094066E-02 9 0.1728776E-05 0.9710725E-03 Result GMRES:9, 2.5E-2, 1.7287760494003E-6, 0 2 16 0.1728776E-05 0.1652837E-02 NI: 2, NLI: 18, ERLI 0.1728776E-05, ERNI: 0.2072755E+01 T= 0.91E+00, LEVEL= 3 ,TOLWGT=0.9, SPCMON= 0.59E+01 Time integration at T= 0.91E+00, Grid level= 4, NPTS= 56978 Nonlinear system solver at T = 0.9091299E+00 Max. and WRMS norm residual= 0.7297546E+01 0.2607062E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 170934 # it. GCRO # it.GMRES Error Estimate 0 0 0.3142351E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3142351E+02 1 0.1357522E+02 0.4320084E+00 2 0.5575706E+01 0.1774374E+00 3 0.2488100E+01 0.7917958E-01 4 0.1411775E+01 0.4492735E-01 5 0.8803599E+00 0.2801596E-01 6 0.5203074E+00 0.1655790E-01 7 0.3245982E+00 0.1032979E-01 8 0.2033750E+00 0.6472066E-02 9 0.1273918E+00 0.4054028E-02 10 0.8112559E-01 0.2581684E-02 11 0.5187228E-01 0.1650747E-02 12 0.3311987E-01 0.1053984E-02 13 0.2140902E-01 0.6813058E-03 Result GMRES:13, 5.E-2, 2.1409018667055E-2, 0 1 13 0.2140902E-01 0.5541865E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2140902E-01 1 0.1423779E-01 0.6650371E+00 2 0.9066672E-02 0.4234978E+00 3 0.5891141E-02 0.2751710E+00 4 0.3867022E-02 0.1806258E+00 5 0.2535157E-02 0.1184154E+00 6 0.1665064E-02 0.7777395E-01 7 0.1093160E-02 0.5106073E-01 8 0.7131335E-03 0.3330996E-01 9 0.4718129E-03 0.2203804E-01 10 0.3050973E-03 0.1425088E-01 11 0.2015280E-03 0.9413231E-02 12 0.1312996E-03 0.6132910E-02 13 0.8680669E-04 0.4054679E-02 14 0.5721883E-04 0.2672651E-02 15 0.3791336E-04 0.1770906E-02 16 0.2505055E-04 0.1170093E-02 17 0.1662074E-04 0.7763427E-03 Result GMRES:17, 5.E-2, 1.6620736145456E-5, 0 2 30 0.1662074E-04 0.3263690E-01 NI: 1, NLI: 32, ERLI 0.1662074E-04, ERNI: 0.5541914E+02 Max. and WRMS norm residual= 0.6917954E+00 0.2286577E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 170934 # it. GCRO # it.GMRES Error Estimate 0 0 0.2172254E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2172254E+01 1 0.1104938E+01 0.5086595E+00 2 0.3863501E+00 0.1778568E+00 3 0.1713394E+00 0.7887632E-01 4 0.9170811E-01 0.4221795E-01 5 0.5828897E-01 0.2683341E-01 6 0.3303618E-01 0.1520825E-01 7 0.2011090E-01 0.9258078E-02 8 0.1249875E-01 0.5753815E-02 9 0.7491951E-02 0.3448930E-02 10 0.4690489E-02 0.2159273E-02 11 0.2914168E-02 0.1341541E-02 12 0.1802232E-02 0.8296599E-03 Result GMRES:12, 2.5E-2, 1.802231773591E-3, 0 1 12 0.1802232E-02 0.2984476E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1802232E-02 1 0.1181752E-02 0.6557157E+00 2 0.7342412E-03 0.4074066E+00 3 0.4661649E-03 0.2586598E+00 4 0.3037334E-03 0.1685318E+00 5 0.1943840E-03 0.1078574E+00 6 0.1257510E-03 0.6977517E-01 7 0.8149348E-04 0.4521809E-01 8 0.5189401E-04 0.2879430E-01 9 0.3411347E-04 0.1892846E-01 10 0.2147228E-04 0.1191427E-01 11 0.1422322E-04 0.7892003E-02 12 0.9223950E-05 0.5118071E-02 13 0.6128483E-05 0.3400497E-02 14 0.4048148E-05 0.2246186E-02 15 0.2706137E-05 0.1501548E-02 16 0.1799708E-05 0.9985995E-03 Result GMRES:16, 2.5E-2, 1.7997077112927E-6, 0 2 28 0.1799708E-05 0.2663683E-02 NI: 2, NLI: 30, ERLI 0.1799708E-05, ERNI: 0.2984602E+01 T= 0.91E+00, LEVEL= 4 ,TOLWGT=1.0, SPCMON= 0.18E+01 TN= 0.88E+00, DT= 0.30E-01, DTNEW= 0.30E-01, TIMMON= 0.50E+00 Time integration at T= 0.94E+00, Grid level= 1, NPTS= 384 Nonlinear system solver at T = 0.9394199E+00 Max. and WRMS norm residual= 0.7013243E+01 0.1696404E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.4855039E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4855039E+02 1 0.3157846E+01 0.6504264E-01 2 0.2998583E+00 0.6176228E-02 3 0.4100310E-01 0.8445472E-03 Result GMRES:3, 5.E-2, 4.1003099100394E-2, 0 1 3 0.4100310E-01 0.4852844E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4100310E-01 1 0.5427522E-02 0.1323686E+00 2 0.6347704E-03 0.1548103E-01 3 0.4600850E-04 0.1122074E-02 4 0.7469199E-05 0.1821618E-03 Result GMRES:4, 5.E-2, 7.469199209797E-6, 0 2 7 0.7469199E-05 0.4000404E-01 NI: 1, NLI: 9, ERLI 0.7469199E-05, ERNI: 0.4852947E+02 Max. and WRMS norm residual= 0.1805292E-01 0.4630678E+01 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.9886630E-01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.9886630E-01 1 0.8439274E-02 0.8536047E-01 2 0.1128578E-02 0.1141520E-01 3 0.1019735E-03 0.1031429E-02 4 0.1093427E-04 0.1105966E-03 Result GMRES:4, 2.5E-2, 1.0934272165968E-5, 0 1 4 0.1093427E-04 0.9624240E-01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1093427E-04 1 0.1629606E-05 0.1490365E+00 2 0.1879561E-06 0.1718963E-01 3 0.2061848E-07 0.1885674E-02 4 0.1922732E-08 0.1758446E-03 Result GMRES:4, 2.5E-2, 1.9227324000398E-9, 0 2 8 0.1922732E-08 0.1072021E-04 NI: 2, NLI: 10, ERLI 0.1922732E-08, ERNI: 0.9624238E-01 T= 0.94E+00, LEVEL= 1 ,TOLWGT=0.9, SPCMON= 0.12E+02 Time integration at T= 0.94E+00, Grid level= 2, NPTS= 2370 Nonlinear system solver at T = 0.9394199E+00 Max. and WRMS norm residual= 0.7048191E+01 0.1663354E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 7110 # it. GCRO # it.GMRES Error Estimate 0 0 0.4214726E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4214726E+02 1 0.6908005E+01 0.1639016E+00 2 0.9504969E+00 0.2255181E-01 3 0.1991488E+00 0.4725071E-02 4 0.4773558E-01 0.1132590E-02 5 0.1492948E-01 0.3542218E-03 Result GMRES:5, 5.E-2, 1.4929477991974E-2, 0 1 5 0.1492948E-01 0.4199907E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1492948E-01 1 0.4875949E-02 0.3265988E+00 2 0.1347128E-02 0.9023275E-01 3 0.2922315E-03 0.1957413E-01 4 0.6646780E-04 0.4452118E-02 5 0.1640075E-04 0.1098548E-02 6 0.4439619E-05 0.2973727E-03 Result GMRES:6, 5.E-2, 4.4396192599248E-6, 0 2 11 0.4439619E-05 0.1343397E-01 NI: 1, NLI: 13, ERLI 0.4439619E-05, ERNI: 0.4199928E+02 Max. and WRMS norm residual= 0.1687189E+00 0.4305637E+02 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 7110 # it. GCRO # it.GMRES Error Estimate 0 0 0.9454489E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.9454489E+00 1 0.1250587E+00 0.1322744E+00 2 0.2331660E-01 0.2466193E-01 3 0.4673773E-02 0.4943444E-02 4 0.1340286E-02 0.1417619E-02 5 0.3554140E-03 0.3759210E-03 Result GMRES:5, 2.5E-2, 3.5541404533659E-4, 0 1 5 0.3554140E-03 0.8976613E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3554140E-03 1 0.1201588E-03 0.3380813E+00 2 0.3166124E-04 0.8908270E-01 3 0.8016494E-05 0.2255537E-01 4 0.1719674E-05 0.4838509E-02 5 0.4096027E-06 0.1152466E-02 6 0.1052804E-06 0.2962191E-03 Result GMRES:6, 2.5E-2, 1.052804249958E-7, 0 2 11 0.1052804E-06 0.3240493E-03 NI: 2, NLI: 13, ERLI 0.1052804E-06, ERNI: 0.8976743E+00 T= 0.94E+00, LEVEL= 2 ,TOLWGT=0.9, SPCMON= 0.10E+02 Time integration at T= 0.94E+00, Grid level= 3, NPTS= 12261 Nonlinear system solver at T = 0.9394199E+00 Max. and WRMS norm residual= 0.7149692E+01 0.1915280E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 36783 # it. GCRO # it.GMRES Error Estimate 0 0 0.4117866E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4117866E+02 1 0.1114542E+02 0.2706600E+00 2 0.2925181E+01 0.7103633E-01 3 0.8809649E+00 0.2139372E-01 4 0.3436351E+00 0.8344979E-02 5 0.1653898E+00 0.4016395E-02 6 0.6721835E-01 0.1632359E-02 7 0.2922717E-01 0.7097649E-03 Result GMRES:7, 5.E-2, 2.9227169095536E-2, 0 1 7 0.2922717E-01 0.4428581E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2922717E-01 1 0.1518463E-01 0.5195382E+00 2 0.6437276E-02 0.2202497E+00 3 0.2681410E-02 0.9174374E-01 4 0.1358135E-02 0.4646824E-01 5 0.5661054E-03 0.1936915E-01 6 0.2806799E-03 0.9603391E-02 7 0.1222169E-03 0.4181620E-02 8 0.5743032E-04 0.1964963E-02 9 0.2610236E-04 0.8930855E-03 Result GMRES:9, 5.E-2, 2.6102359575337E-5, 0 2 16 0.2610236E-04 0.2679433E-01 NI: 1, NLI: 18, ERLI 0.2610236E-04, ERNI: 0.4428664E+02 Max. and WRMS norm residual= 0.4515413E+00 0.1220052E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 36783 # it. GCRO # it.GMRES Error Estimate 0 0 0.2231067E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2231067E+01 1 0.6526648E+00 0.2925349E+00 2 0.1116508E+00 0.5004367E-01 3 0.4925468E-01 0.2207674E-01 4 0.2054808E-01 0.9209981E-02 5 0.9702030E-02 0.4348606E-02 6 0.3824926E-02 0.1714393E-02 7 0.1828642E-02 0.8196266E-03 Result GMRES:7, 2.5E-2, 1.8286416109307E-3, 0 1 7 0.1828642E-02 0.2082605E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1828642E-02 1 0.9640695E-03 0.5272053E+00 2 0.4166524E-03 0.2278480E+00 3 0.1641688E-03 0.8977639E-01 4 0.8569317E-04 0.4686165E-01 5 0.3514697E-04 0.1922026E-01 6 0.1706493E-04 0.9332026E-02 7 0.7488162E-05 0.4094931E-02 8 0.3590921E-05 0.1963709E-02 9 0.1625345E-05 0.8888265E-03 Result GMRES:9, 2.5E-2, 1.6253451215707E-6, 0 2 16 0.1625345E-05 0.1690067E-02 NI: 2, NLI: 18, ERLI 0.1625345E-05, ERNI: 0.2082773E+01 T= 0.94E+00, LEVEL= 3 ,TOLWGT=0.9, SPCMON= 0.49E+01 Time integration at T= 0.94E+00, Grid level= 4, NPTS= 54706 Nonlinear system solver at T = 0.9394199E+00 Max. and WRMS norm residual= 0.7358676E+01 0.2646880E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 164118 # it. GCRO # it.GMRES Error Estimate 0 0 0.3185798E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3185798E+02 1 0.1376482E+02 0.4320683E+00 2 0.5656671E+01 0.1775590E+00 3 0.2521725E+01 0.7915520E-01 4 0.1431941E+01 0.4494766E-01 5 0.8941481E+00 0.2806670E-01 6 0.5274366E+00 0.1655587E-01 7 0.3298922E+00 0.1035509E-01 8 0.2066364E+00 0.6486173E-02 9 0.1296957E+00 0.4071059E-02 10 0.8272253E-01 0.2596604E-02 11 0.5300724E-01 0.1663861E-02 12 0.3385891E-01 0.1062808E-02 13 0.2192499E-01 0.6882104E-03 Result GMRES:13, 5.E-2, 2.1924990920992E-2, 0 1 13 0.2192499E-01 0.5622253E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2192499E-01 1 0.1459498E-01 0.6656779E+00 2 0.9297444E-02 0.4240569E+00 3 0.6045483E-02 0.2757348E+00 4 0.3970336E-02 0.1810872E+00 5 0.2604837E-02 0.1188068E+00 6 0.1711030E-02 0.7804016E-01 7 0.1123225E-02 0.5123034E-01 8 0.7318359E-03 0.3337908E-01 9 0.4852756E-03 0.2213344E-01 10 0.3120802E-03 0.1423399E-01 11 0.2069655E-03 0.9439710E-02 12 0.1343196E-03 0.6126325E-02 13 0.8893949E-04 0.4056535E-02 14 0.5854451E-04 0.2670218E-02 15 0.3882303E-04 0.1770720E-02 16 0.2562263E-04 0.1168649E-02 17 0.1700598E-04 0.7756435E-03 Result GMRES:17, 5.E-2, 1.7005975999575E-5, 0 2 30 0.1700598E-04 0.3344366E-01 NI: 1, NLI: 32, ERLI 0.1700598E-04, ERNI: 0.5622303E+02 Max. and WRMS norm residual= 0.6622569E+00 0.2319590E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 164118 # it. GCRO # it.GMRES Error Estimate 0 0 0.2203579E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2203579E+01 1 0.1121231E+01 0.5088230E+00 2 0.3916352E+00 0.1777269E+00 3 0.1747127E+00 0.7928587E-01 4 0.9408236E-01 0.4269526E-01 5 0.5977508E-01 0.2712637E-01 6 0.3392595E-01 0.1539584E-01 7 0.2065808E-01 0.9374787E-02 8 0.1284942E-01 0.5831159E-02 9 0.7708299E-02 0.3498082E-02 10 0.4822883E-02 0.2188659E-02 11 0.3000199E-02 0.1361512E-02 12 0.1853915E-02 0.8413200E-03 Result GMRES:12, 2.5E-2, 1.8539148259427E-3, 0 1 12 0.1853915E-02 0.3026857E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1853915E-02 1 0.1214600E-02 0.6551543E+00 2 0.7551260E-03 0.4073143E+00 3 0.4788617E-03 0.2582976E+00 4 0.3117817E-03 0.1681747E+00 5 0.1996047E-03 0.1076666E+00 6 0.1288715E-03 0.6951316E-01 7 0.8358741E-04 0.4508697E-01 8 0.5311341E-04 0.2864933E-01 9 0.3496533E-04 0.1886027E-01 10 0.2197603E-04 0.1185385E-01 11 0.1456169E-04 0.7854560E-02 12 0.9440955E-05 0.5092443E-02 13 0.6270050E-05 0.3382059E-02 14 0.4142164E-05 0.2234280E-02 15 0.2768326E-05 0.1493232E-02 16 0.1841639E-05 0.9933784E-03 Result GMRES:16, 2.5E-2, 1.8416390115214E-6, 0 2 28 0.1841639E-05 0.2742288E-02 NI: 2, NLI: 30, ERLI 0.1841639E-05, ERNI: 0.3026983E+01 T= 0.94E+00, LEVEL= 4 ,TOLWGT=1.0, SPCMON= 0.17E+01 TN= 0.91E+00, DT= 0.30E-01, DTNEW= 0.30E-01, TIMMON= 0.51E+00 Time integration at T= 0.97E+00, Grid level= 1, NPTS= 384 Nonlinear system solver at T = 0.9697100E+00 Max. and WRMS norm residual= 0.5936228E+01 0.1388131E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.3371792E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3371792E+02 1 0.2527935E+01 0.7497303E-01 2 0.2802136E+00 0.8310525E-02 3 0.3491067E-01 0.1035374E-02 4 0.3049295E-02 0.9043545E-04 Result GMRES:4, 5.E-2, 3.0492952421455E-3, 0 1 4 0.3049295E-02 0.3337559E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3049295E-02 1 0.4173739E-03 0.1368755E+00 2 0.5433923E-04 0.1782026E-01 3 0.6022282E-05 0.1974975E-02 4 0.6856211E-06 0.2248457E-03 Result GMRES:4, 5.E-2, 6.8562107434607E-7, 0 2 8 0.6856211E-06 0.2950650E-02 NI: 1, NLI: 10, ERLI 0.6856211E-06, ERNI: 0.3337557E+02 Max. and WRMS norm residual= 0.1511456E-01 0.2868310E+01 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.6114540E-01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.6114540E-01 1 0.6413789E-02 0.1048941E+00 2 0.7519716E-03 0.1229809E-01 3 0.7354497E-04 0.1202788E-02 4 0.7638125E-05 0.1249174E-03 Result GMRES:4, 2.5E-2, 7.6381251289632E-6, 0 1 4 0.7638125E-05 0.5963122E-01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.7638125E-05 1 0.1077589E-05 0.1410803E+00 2 0.1352920E-06 0.1771273E-01 3 0.1513217E-07 0.1981137E-02 4 0.1739009E-08 0.2276748E-03 Result GMRES:4, 2.5E-2, 1.739008714131E-9, 0 2 8 0.1739009E-08 0.7474579E-05 NI: 2, NLI: 10, ERLI 0.1739009E-08, ERNI: 0.5963123E-01 T= 0.97E+00, LEVEL= 1 ,TOLWGT=0.9, SPCMON= 0.15E+02 Time integration at T= 0.97E+00, Grid level= 2, NPTS= 2354 Nonlinear system solver at T = 0.9697100E+00 Max. and WRMS norm residual= 0.5975782E+01 0.1463801E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 7062 # it. GCRO # it.GMRES Error Estimate 0 0 0.3813850E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3813850E+02 1 0.5594852E+01 0.1466983E+00 2 0.9507022E+00 0.2492762E-01 3 0.1900355E+00 0.4982773E-02 4 0.4997748E-01 0.1310420E-02 5 0.1486763E-01 0.3898326E-03 Result GMRES:5, 5.E-2, 1.486763309452E-2, 0 1 5 0.1486763E-01 0.3646553E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1486763E-01 1 0.4965261E-02 0.3339644E+00 2 0.1360252E-02 0.9149080E-01 3 0.2783525E-03 0.1872205E-01 4 0.6656718E-04 0.4477322E-02 5 0.1623637E-04 0.1092061E-02 6 0.4426801E-05 0.2977475E-03 Result GMRES:6, 5.E-2, 4.4268009307971E-6, 0 2 11 0.4426801E-05 0.1373498E-01 NI: 1, NLI: 13, ERLI 0.4426801E-05, ERNI: 0.3646588E+02 Max. and WRMS norm residual= 0.1780816E+00 0.4511546E+02 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 7062 # it. GCRO # it.GMRES Error Estimate 0 0 0.1007332E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1007332E+01 1 0.1402462E+00 0.1392254E+00 2 0.2446850E-01 0.2429041E-01 3 0.5613678E-02 0.5572819E-02 4 0.1587092E-02 0.1575541E-02 5 0.4338326E-03 0.4306750E-03 Result GMRES:5, 2.5E-2, 4.3383258684373E-4, 0 1 5 0.4338326E-03 0.9540372E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4338326E-03 1 0.1422819E-03 0.3279650E+00 2 0.3884691E-04 0.8954356E-01 3 0.9192315E-05 0.2118862E-01 4 0.2251090E-05 0.5188844E-02 5 0.4718814E-06 0.1087704E-02 6 0.1242483E-06 0.2863969E-03 Result GMRES:6, 2.5E-2, 1.2424830530968E-7, 0 2 11 0.1242483E-06 0.4014762E-03 NI: 2, NLI: 13, ERLI 0.1242483E-06, ERNI: 0.9540567E+00 T= 0.97E+00, LEVEL= 2 ,TOLWGT=0.9, SPCMON= 0.14E+02 Time integration at T= 0.97E+00, Grid level= 3, NPTS= 11594 Nonlinear system solver at T = 0.9697100E+00 Max. and WRMS norm residual= 0.6110613E+01 0.1967504E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 34782 # it. GCRO # it.GMRES Error Estimate 0 0 0.4235400E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4235400E+02 1 0.1131904E+02 0.2672484E+00 2 0.3038353E+01 0.7173710E-01 3 0.9352720E+00 0.2208226E-01 4 0.3572633E+00 0.8435173E-02 5 0.1726304E+00 0.4075894E-02 6 0.6985344E-01 0.1649276E-02 7 0.3061200E-01 0.7227654E-03 Result GMRES:7, 5.E-2, 3.0612004177433E-2, 0 1 7 0.3061200E-01 0.4513492E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3061200E-01 1 0.1612078E-01 0.5266162E+00 2 0.6761387E-02 0.2208737E+00 3 0.2864259E-02 0.9356652E-01 4 0.1448831E-02 0.4732886E-01 5 0.5889747E-03 0.1923999E-01 6 0.3000655E-03 0.9802217E-02 7 0.1263550E-03 0.4127628E-02 8 0.6148416E-04 0.2008498E-02 9 0.2737262E-04 0.8941792E-03 Result GMRES:9, 5.E-2, 2.7372617044779E-5, 0 2 16 0.2737262E-04 0.2831629E-01 NI: 1, NLI: 18, ERLI 0.2737262E-04, ERNI: 0.4513571E+02 Max. and WRMS norm residual= 0.4694041E+00 0.1257957E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 34782 # it. GCRO # it.GMRES Error Estimate 0 0 0.2329876E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2329876E+01 1 0.7183972E+00 0.3083414E+00 2 0.1268739E+00 0.5445521E-01 3 0.4823482E-01 0.2070274E-01 4 0.2145795E-01 0.9209914E-02 5 0.9329959E-02 0.4004488E-02 6 0.4091495E-02 0.1756100E-02 7 0.1767669E-02 0.7586968E-03 Result GMRES:7, 2.5E-2, 1.7676692750447E-3, 0 1 7 0.1767669E-02 0.2004453E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1767669E-02 1 0.9641796E-03 0.5454525E+00 2 0.4049815E-03 0.2291048E+00 3 0.1715605E-03 0.9705464E-01 4 0.8521168E-04 0.4820567E-01 5 0.3700303E-04 0.2093323E-01 6 0.1750349E-04 0.9902017E-02 7 0.8146513E-05 0.4608618E-02 8 0.3741359E-05 0.2116549E-02 9 0.1752668E-05 0.9915137E-03 Result GMRES:9, 2.5E-2, 1.7526683455783E-6, 0 2 16 0.1752668E-05 0.1650573E-02 NI: 2, NLI: 18, ERLI 0.1752668E-05, ERNI: 0.2004606E+01 T= 0.97E+00, LEVEL= 3 ,TOLWGT=0.9, SPCMON= 0.56E+01 Time integration at T= 0.97E+00, Grid level= 4, NPTS= 55409 Nonlinear system solver at T = 0.9697100E+00 Max. and WRMS norm residual= 0.7400358E+01 0.2615140E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 166227 # it. GCRO # it.GMRES Error Estimate 0 0 0.3142041E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3142041E+02 1 0.1357733E+02 0.4321183E+00 2 0.5592017E+01 0.1779740E+00 3 0.2504849E+01 0.7972042E-01 4 0.1427856E+01 0.4544357E-01 5 0.8917382E+00 0.2838086E-01 6 0.5254599E+00 0.1672352E-01 7 0.3292412E+00 0.1047858E-01 8 0.2060800E+00 0.6558794E-02 9 0.1294389E+00 0.4119581E-02 10 0.8264967E-01 0.2630445E-02 11 0.5297990E-01 0.1686162E-02 12 0.3386441E-01 0.1077784E-02 13 0.2193887E-01 0.6982362E-03 Result GMRES:13, 5.E-2, 2.1938871938012E-2, 0 1 13 0.2193887E-01 0.5549341E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2193887E-01 1 0.1461229E-01 0.6660457E+00 2 0.9310794E-02 0.4243971E+00 3 0.6057396E-02 0.2761034E+00 4 0.3978832E-02 0.1813599E+00 5 0.2611644E-02 0.1190419E+00 6 0.1715625E-02 0.7820024E-01 7 0.1126207E-02 0.5133386E-01 8 0.7340023E-03 0.3345670E-01 9 0.4869959E-03 0.2219786E-01 10 0.3130799E-03 0.1427055E-01 11 0.2078515E-03 0.9474119E-02 12 0.1348452E-03 0.6146403E-02 13 0.8934701E-04 0.4072543E-02 14 0.5882757E-04 0.2681431E-02 15 0.3903954E-04 0.1779469E-02 16 0.2577709E-04 0.1174951E-02 17 0.1711771E-04 0.7802458E-03 Result GMRES:17, 5.E-2, 1.7117713326743E-5, 0 2 30 0.1711771E-04 0.3347935E-01 NI: 1, NLI: 32, ERLI 0.1711771E-04, ERNI: 0.5549394E+02 Max. and WRMS norm residual= 0.6852987E+00 0.2290752E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 166227 # it. GCRO # it.GMRES Error Estimate 0 0 0.2176250E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2176250E+01 1 0.1107918E+01 0.5090952E+00 2 0.3864580E+00 0.1775798E+00 3 0.1733427E+00 0.7965203E-01 4 0.9399171E-01 0.4318976E-01 5 0.5968142E-01 0.2742398E-01 6 0.3388036E-01 0.1556823E-01 7 0.2067972E-01 0.9502458E-02 8 0.1285113E-01 0.5905172E-02 9 0.7717327E-02 0.3546159E-02 10 0.4829709E-02 0.2219281E-02 11 0.3003338E-02 0.1380052E-02 12 0.1856850E-02 0.8532341E-03 Result GMRES:12, 2.5E-2, 1.8568503211003E-3, 0 1 12 0.1856850E-02 0.2987760E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1856850E-02 1 0.1216463E-02 0.6551217E+00 2 0.7560157E-03 0.4071495E+00 3 0.4793154E-03 0.2581335E+00 4 0.3118848E-03 0.1679644E+00 5 0.1997351E-03 0.1075666E+00 6 0.1288820E-03 0.6940893E-01 7 0.8365127E-04 0.4505009E-01 8 0.5311802E-04 0.2860652E-01 9 0.3502273E-04 0.1886137E-01 10 0.2198706E-04 0.1184105E-01 11 0.1458667E-04 0.7855598E-02 12 0.9455932E-05 0.5092458E-02 13 0.6283511E-05 0.3383962E-02 14 0.4152472E-05 0.2236299E-02 15 0.2777012E-05 0.1495549E-02 16 0.1848653E-05 0.9955855E-03 Result GMRES:16, 2.5E-2, 1.8486532625533E-6, 0 2 28 0.1848653E-05 0.2745465E-02 NI: 2, NLI: 30, ERLI 0.1848653E-05, ERNI: 0.2987880E+01 T= 0.97E+00, LEVEL= 4 ,TOLWGT=1.0, SPCMON= 0.18E+01 TN= 0.94E+00, DT= 0.30E-01, DTNEW= 0.30E-01, TIMMON= 0.50E+00 Time integration at T= 0.10E+01, Grid level= 1, NPTS= 384 Nonlinear system solver at T = 0.1000000E+01 Max. and WRMS norm residual= 0.2689513E+01 0.6698103E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.1621717E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1621717E+02 1 0.1229680E+01 0.7582579E-01 2 0.1483405E+00 0.9147129E-02 3 0.1973752E-01 0.1217076E-02 4 0.2089783E-02 0.1288624E-03 Result GMRES:4, 5.E-2, 2.0897831163513E-3, 0 1 4 0.2089783E-02 0.1551260E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2089783E-02 1 0.2990304E-03 0.1430916E+00 2 0.4018314E-04 0.1922838E-01 3 0.4133976E-05 0.1978184E-02 4 0.4686443E-06 0.2242550E-03 Result GMRES:4, 5.E-2, 4.6864434404646E-7, 0 2 8 0.4686443E-06 0.1980861E-02 NI: 1, NLI: 10, ERLI 0.4686443E-06, ERNI: 0.1551258E+02 Max. and WRMS norm residual= 0.4455466E-02 0.1024421E+01 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 1152 # it. GCRO # it.GMRES Error Estimate 0 0 0.2281666E-01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2281666E-01 1 0.2158281E-02 0.9459229E-01 2 0.2756682E-03 0.1208188E-01 3 0.3303394E-04 0.1447799E-02 4 0.3568639E-05 0.1564050E-03 Result GMRES:4, 2.5E-2, 3.5686393783501E-6, 0 1 4 0.3568639E-05 0.2213959E-01 NI: 2, NLI: 5, ERLI 0.3568639E-05, ERNI: 0.2213959E-01 T= 0.10E+01, LEVEL= 1 ,TOLWGT=0.9, SPCMON= 0.18E+02 Time integration at T= 0.10E+01, Grid level= 2, NPTS= 2314 Nonlinear system solver at T = 0.1000000E+01 Max. and WRMS norm residual= 0.3710051E+01 0.1173869E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 6942 # it. GCRO # it.GMRES Error Estimate 0 0 0.3821434E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3821434E+02 1 0.5679172E+01 0.1486136E+00 2 0.7977140E+00 0.2087473E-01 3 0.1772203E+00 0.4637535E-02 4 0.3657893E-01 0.9572044E-03 Result GMRES:4, 5.E-2, 3.6578932427648E-2, 0 1 4 0.3657893E-01 0.3666139E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3657893E-01 1 0.1214998E-01 0.3321578E+00 2 0.3190225E-02 0.8721483E-01 3 0.8464334E-03 0.2313991E-01 4 0.2082059E-03 0.5691961E-02 5 0.5651985E-04 0.1545147E-02 6 0.1401173E-04 0.3830548E-03 Result GMRES:6, 5.E-2, 1.4011734145858E-5, 0 2 10 0.1401173E-04 0.3273737E-01 NI: 1, NLI: 12, ERLI 0.1401173E-04, ERNI: 0.3666324E+02 Max. and WRMS norm residual= 0.8377888E-01 0.2290046E+02 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 6942 # it. GCRO # it.GMRES Error Estimate 0 0 0.5295308E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.5295308E+00 1 0.7117741E-01 0.1344160E+00 2 0.1289615E-01 0.2435391E-01 3 0.2879497E-02 0.5437827E-02 4 0.8671518E-03 0.1637585E-02 5 0.2388157E-03 0.4509949E-03 Result GMRES:5, 2.5E-2, 2.3881571588709E-4, 0 1 5 0.2388157E-03 0.4831804E+00 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2388157E-03 1 0.8513641E-04 0.3564942E+00 2 0.2251837E-04 0.9429182E-01 3 0.5352333E-05 0.2241198E-01 4 0.1293183E-05 0.5414981E-02 5 0.3039160E-06 0.1272596E-02 6 0.8314234E-07 0.3481444E-03 Result GMRES:6, 2.5E-2, 8.314234380366E-8, 0 2 11 0.8314234E-07 0.2251022E-03 NI: 2, NLI: 13, ERLI 0.8314234E-07, ERNI: 0.4831864E+00 T= 0.10E+01, LEVEL= 2 ,TOLWGT=0.9, SPCMON= 0.14E+02 Time integration at T= 0.10E+01, Grid level= 3, NPTS= 11918 Nonlinear system solver at T = 0.1000000E+01 Max. and WRMS norm residual= 0.7131150E+01 0.1921215E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 35754 # it. GCRO # it.GMRES Error Estimate 0 0 0.4128517E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.4128517E+02 1 0.1105698E+02 0.2678197E+00 2 0.2958377E+01 0.7165713E-01 3 0.8746034E+00 0.2118444E-01 4 0.3496689E+00 0.8469600E-02 5 0.1667794E+00 0.4039693E-02 6 0.6701516E-01 0.1623226E-02 7 0.2951278E-01 0.7148518E-03 Result GMRES:7, 5.E-2, 2.9512777583462E-2, 0 1 7 0.2951278E-01 0.4437321E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2951278E-01 1 0.1541465E-01 0.5223043E+00 2 0.6486654E-02 0.2197914E+00 3 0.2718025E-02 0.9209655E-01 4 0.1380117E-02 0.4676339E-01 5 0.5702989E-03 0.1932380E-01 6 0.2834898E-03 0.9605664E-02 7 0.1225315E-03 0.4151812E-02 8 0.5782818E-04 0.1959429E-02 9 0.2621454E-04 0.8882436E-03 Result GMRES:9, 5.E-2, 2.6214536785945E-5, 0 2 16 0.2621454E-04 0.2698015E-01 NI: 1, NLI: 18, ERLI 0.2621454E-04, ERNI: 0.4437408E+02 Max. and WRMS norm residual= 0.5135784E+00 0.1300398E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 35754 # it. GCRO # it.GMRES Error Estimate 0 0 0.2406332E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2406332E+01 1 0.6619412E+00 0.2750831E+00 2 0.1156458E+00 0.4805896E-01 3 0.5192851E-01 0.2157994E-01 4 0.2168598E-01 0.9012049E-02 5 0.1001989E-01 0.4163969E-02 6 0.4062619E-02 0.1688303E-02 7 0.1926427E-02 0.8005655E-03 Result GMRES:7, 2.5E-2, 1.9264265478518E-3, 0 1 7 0.1926427E-02 0.2192499E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1926427E-02 1 0.1014721E-02 0.5267374E+00 2 0.4401996E-03 0.2285058E+00 3 0.1745272E-03 0.9059636E-01 4 0.9035289E-04 0.4690181E-01 5 0.3795683E-04 0.1970323E-01 6 0.1807021E-04 0.9380170E-02 7 0.8055858E-05 0.4181762E-02 8 0.3826903E-05 0.1986529E-02 9 0.1731041E-05 0.8985762E-03 Result GMRES:9, 2.5E-2, 1.7310410734273E-6, 0 2 16 0.1731041E-05 0.1772735E-02 NI: 2, NLI: 18, ERLI 0.1731041E-05, ERNI: 0.2192707E+01 T= 0.10E+01, LEVEL= 3 ,TOLWGT=0.9, SPCMON= 0.53E+01 Time integration at T= 0.10E+01, Grid level= 4, NPTS= 52925 Nonlinear system solver at T = 0.1000000E+01 Max. and WRMS norm residual= 0.7418179E+01 0.2658777E+04 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 158775 # it. GCRO # it.GMRES Error Estimate 0 0 0.3189089E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.3189089E+02 1 0.1378035E+02 0.4321093E+00 2 0.5689334E+01 0.1784000E+00 3 0.2565228E+01 0.8043765E-01 4 0.1468769E+01 0.4605608E-01 5 0.9167256E+00 0.2874569E-01 6 0.5404611E+00 0.1694719E-01 7 0.3391124E+00 0.1063352E-01 8 0.2120302E+00 0.6648615E-02 9 0.1332757E+00 0.4179115E-02 10 0.8510342E-01 0.2668581E-02 11 0.5454212E-01 0.1710273E-02 12 0.3489368E-01 0.1094158E-02 13 0.2260531E-01 0.7088327E-03 Result GMRES:13, 5.E-2, 2.2605305923118E-2, 0 1 13 0.2260531E-01 0.5636109E+02 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2260531E-01 1 0.1505293E-01 0.6659025E+00 2 0.9595949E-02 0.4244999E+00 3 0.6244419E-02 0.2762369E+00 4 0.4100798E-02 0.1814087E+00 5 0.2692772E-02 0.1191213E+00 6 0.1768697E-02 0.7824256E-01 7 0.1161101E-02 0.5136408E-01 8 0.7569040E-03 0.3348347E-01 9 0.5022755E-03 0.2221936E-01 10 0.3230791E-03 0.1429218E-01 11 0.2145089E-03 0.9489315E-02 12 0.1391939E-03 0.6157576E-02 13 0.9222987E-04 0.4080010E-02 14 0.6072991E-04 0.2686534E-02 15 0.4029708E-04 0.1782638E-02 16 0.2660804E-04 0.1177071E-02 17 0.1766560E-04 0.7814802E-03 Result GMRES:17, 5.E-2, 1.7665598763831E-5, 0 2 30 0.1766560E-04 0.3450222E-01 NI: 1, NLI: 32, ERLI 0.1766560E-04, ERNI: 0.5636167E+02 Max. and WRMS norm residual= 0.7256899E+00 0.2327747E+03 Diag. scaled GCRO(NRRMAX,MAXLR)) NRRMAX, MAXLR, N: 1 5 158775 # it. GCRO # it.GMRES Error Estimate 0 0 0.2211529E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.2211529E+01 1 0.1126529E+01 0.5093893E+00 2 0.3924826E+00 0.1774711E+00 3 0.1767464E+00 0.7992042E-01 4 0.9658697E-01 0.4367429E-01 5 0.6132877E-01 0.2773138E-01 6 0.3475598E-01 0.1571581E-01 7 0.2129546E-01 0.9629291E-02 8 0.1320818E-01 0.5972419E-02 9 0.7938845E-02 0.3589753E-02 10 0.4972992E-02 0.2248667E-02 11 0.3088286E-02 0.1396448E-02 12 0.1911630E-02 0.8643927E-03 Result GMRES:12, 2.5E-2, 1.9116298132013E-3, 0 1 12 0.1911630E-02 0.3034381E+01 Diagonally scaled GMRESO(MAXL) 20 ITER Error Estimate 0 0.1911630E-02 1 0.1252988E-02 0.6554553E+00 2 0.7779782E-03 0.4069712E+00 3 0.4934332E-03 0.2581217E+00 4 0.3208949E-03 0.1678645E+00 5 0.2055348E-03 0.1075181E+00 6 0.1326375E-03 0.6938449E-01 7 0.8610442E-04 0.4504241E-01 8 0.5466872E-04 0.2859796E-01 9 0.3607698E-04 0.1887237E-01 10 0.2260601E-04 0.1182552E-01 11 0.1501044E-04 0.7852168E-02 12 0.9718428E-05 0.5083844E-02 13 0.6457632E-05 0.3378076E-02 14 0.4263492E-05 0.2230292E-02 15 0.2850310E-05 0.1491037E-02 16 0.1896122E-05 0.9918876E-03 Result GMRES:16, 2.5E-2, 1.8961220021531E-6, 0 2 28 0.1896122E-05 0.2823338E-02 NI: 2, NLI: 30, ERLI 0.1896122E-05, ERNI: 0.3034498E+01 T= 0.10E+01, LEVEL= 4 ,TOLWGT=1.0, SPCMON= 0.18E+01 TN= 0.97E+00, DT= 0.30E-01, DTNEW= 0.30E-01, TIMMON= 0.51E+00 # steps accepted: 38, # steps rejected: 0 Statistics: # accepted timesteps = 38, # rejected timesteps = 0 Level # Nit # Jacs # Res 1 76 38 76 2 76 38 76 3 76 38 76 4 76 38 76 Nit Level # Lin. sys. it 1 1 329 1 2 436 1 3 628 1 4 1057 2 1 273 2 2 438 2 3 624 2 4 1008 SHAR_EOF fi # end of overwriting check if test -f 'exmplr_28' then echo shar: will not over-write existing file "'exmplr_28'" else cat << \SHAR_EOF > 'exmplr_28' Error at T=0.103E+01, level=1 : 384 0.177E-01 0.177E-01 0.177E-01 Error at T=0.103E+01, level=2 : 2274 0.428E-01 0.428E-01 0.428E-01 Error at T=0.103E+01, level=3 : 11589 0.467E-01 0.467E-01 0.467E-01 Error at T=0.107E+01, level=1 : 384 0.116E-01 0.116E-01 0.116E-01 Error at T=0.107E+01, level=2 : 2282 0.251E-01 0.251E-01 0.251E-01 Error at T=0.107E+01, level=3 : 11339 0.702E-01 0.702E-01 0.702E-01 Error at T=0.111E+01, level=1 : 384 0.635E-01 0.635E-01 0.635E-01 Error at T=0.111E+01, level=2 : 2282 0.669E-01 0.669E-01 0.669E-01 Error at T=0.111E+01, level=3 : 11159 0.670E-01 0.670E-01 0.670E-01 Error at T=0.115E+01, level=1 : 384 0.610E-01 0.610E-01 0.610E-01 Error at T=0.115E+01, level=2 : 2266 0.717E-01 0.717E-01 0.717E-01 Error at T=0.115E+01, level=3 : 11685 0.764E-01 0.764E-01 0.764E-01 Error at T=0.119E+01, level=1 : 384 0.285E-01 0.285E-01 0.285E-01 Error at T=0.119E+01, level=2 : 2166 0.358E-01 0.358E-01 0.358E-01 Error at T=0.119E+01, level=3 : 11515 0.928E-01 0.928E-01 0.928E-01 Error at T=0.123E+01, level=1 : 384 0.672E-01 0.672E-01 0.672E-01 Error at T=0.123E+01, level=2 : 2138 0.908E-01 0.908E-01 0.908E-01 Error at T=0.123E+01, level=3 : 10733 0.908E-01 0.908E-01 0.908E-01 Error at T=0.127E+01, level=1 : 384 0.488E-01 0.488E-01 0.488E-01 Error at T=0.127E+01, level=2 : 2138 0.682E-01 0.682E-01 0.682E-01 Error at T=0.127E+01, level=3 : 10449 0.803E-01 0.803E-01 0.803E-01 Error at T=0.131E+01, level=1 : 384 0.408E-01 0.408E-01 0.408E-01 Error at T=0.131E+01, level=2 : 2114 0.530E-01 0.530E-01 0.530E-01 Error at T=0.131E+01, level=3 : 10609 0.988E-01 0.988E-01 0.988E-01 Error at T=0.135E+01, level=1 : 384 0.988E-01 0.988E-01 0.988E-01 Error at T=0.135E+01, level=2 : 2086 0.101E+00 0.101E+00 0.101E+00 Error at T=0.135E+01, level=3 : 10263 0.102E+00 0.102E+00 0.102E+00 Error at T=0.139E+01, level=1 : 384 0.559E-01 0.559E-01 0.559E-01 Error at T=0.139E+01, level=2 : 2014 0.688E-01 0.688E-01 0.688E-01 Error at T=0.139E+01, level=3 : 9849 0.942E-01 0.942E-01 0.942E-01 Error at T=0.143E+01, level=1 : 384 0.590E-01 0.590E-01 0.590E-01 Error at T=0.143E+01, level=2 : 1931 0.693E-01 0.693E-01 0.693E-01 Error at T=0.143E+01, level=3 : 9653 0.103E+00 0.103E+00 0.103E+00 Error at T=0.147E+01, level=1 : 384 0.716E-01 0.716E-01 0.716E-01 Error at T=0.147E+01, level=2 : 1851 0.104E+00 0.104E+00 0.104E+00 Error at T=0.147E+01, level=3 : 9225 0.114E+00 0.114E+00 0.114E+00 Error at T=0.151E+01, level=1 : 384 0.398E-01 0.398E-01 0.398E-01 Error at T=0.151E+01, level=2 : 1851 0.622E-01 0.622E-01 0.622E-01 Error at T=0.151E+01, level=3 : 8805 0.108E+00 0.108E+00 0.108E+00 Error at T=0.155E+01, level=1 : 384 0.867E-01 0.867E-01 0.867E-01 Error at T=0.155E+01, level=2 : 1749 0.867E-01 0.867E-01 0.867E-01 Error at T=0.155E+01, level=3 : 8761 0.104E+00 0.104E+00 0.104E+00 Error at T=0.159E+01, level=1 : 384 0.995E-01 0.995E-01 0.995E-01 Error at T=0.159E+01, level=2 : 1693 0.995E-01 0.995E-01 0.995E-01 Error at T=0.159E+01, level=3 : 8357 0.120E+00 0.120E+00 0.120E+00 Error at T=0.163E+01, level=1 : 384 0.280E-01 0.280E-01 0.280E-01 Error at T=0.163E+01, level=2 : 1673 0.547E-01 0.547E-01 0.547E-01 Error at T=0.163E+01, level=3 : 7909 0.121E+00 0.121E+00 0.121E+00 Error at T=0.167E+01, level=1 : 384 0.762E-01 0.762E-01 0.762E-01 Error at T=0.167E+01, level=2 : 1553 0.105E+00 0.105E+00 0.105E+00 Error at T=0.167E+01, level=3 : 7705 0.108E+00 0.108E+00 0.108E+00 Error at T=0.172E+01, level=1 : 384 0.568E-01 0.568E-01 0.568E-01 Error at T=0.172E+01, level=2 : 1483 0.929E-01 0.929E-01 0.929E-01 Error at T=0.172E+01, level=3 : 7273 0.115E+00 0.115E+00 0.115E+00 Error at T=0.177E+01, level=1 : 384 0.501E-01 0.501E-01 0.501E-01 Error at T=0.177E+01, level=2 : 1405 0.683E-01 0.683E-01 0.683E-01 Error at T=0.177E+01, level=3 : 6945 0.132E+00 0.132E+00 0.132E+00 Error at T=0.181E+01, level=1 : 384 0.665E-01 0.665E-01 0.665E-01 Error at T=0.181E+01, level=2 : 1345 0.103E+00 0.103E+00 0.103E+00 Error at T=0.181E+01, level=3 : 6361 0.133E+00 0.133E+00 0.133E+00 Error at T=0.186E+01, level=1 : 384 0.286E-01 0.286E-01 0.286E-01 Error at T=0.186E+01, level=2 : 1325 0.590E-01 0.590E-01 0.590E-01 Error at T=0.186E+01, level=3 : 6129 0.114E+00 0.114E+00 0.114E+00 Error at T=0.191E+01, level=1 : 384 0.723E-01 0.723E-01 0.723E-01 Error at T=0.191E+01, level=2 : 1185 0.881E-01 0.881E-01 0.881E-01 Error at T=0.191E+01, level=3 : 5657 0.881E-01 0.881E-01 0.881E-01 Error at T=0.195E+01, level=1 : 384 0.455E-01 0.455E-01 0.455E-01 Error at T=0.195E+01, level=2 : 1075 0.668E-01 0.668E-01 0.668E-01 Error at T=0.195E+01, level=3 : 5001 0.858E-01 0.858E-01 0.858E-01 Error at T=0.200E+01, level=1 : 384 0.642E-01 0.642E-01 0.642E-01 Error at T=0.200E+01, level=2 : 1035 0.824E-01 0.824E-01 0.824E-01 Error at T=0.200E+01, level=3 : 4729 0.824E-01 0.824E-01 0.824E-01 SHAR_EOF fi # end of overwriting check if test -f 'exmplr_output' then echo shar: will not over-write existing file "'exmplr_output'" else cat << \SHAR_EOF > 'exmplr_output' Newton: MAXNIT, MAXJAC, TOLNEW:10, 2, 1. Lin. solver BiCGStab + ILU: MAXLIT, TOLLSB:100, 0.1 Max. grid level exceeded at T= 0.1029412E+01 Max. grid level exceeded at T= 0.1069853E+01 Max. grid level exceeded at T= 0.1110294E+01 Max. grid level exceeded at T= 0.1150735E+01 Max. grid level exceeded at T= 0.1191176E+01 Max. grid level exceeded at T= 0.1231618E+01 Max. grid level exceeded at T= 0.1270037E+01 Max. grid level exceeded at T= 0.1308456E+01 Max. grid level exceeded at T= 0.1349135E+01 Max. grid level exceeded at T= 0.1389814E+01 Max. grid level exceeded at T= 0.1430493E+01 Max. grid level exceeded at T= 0.1471172E+01 Max. grid level exceeded at T= 0.1511851E+01 Max. grid level exceeded at T= 0.1552530E+01 Max. grid level exceeded at T= 0.1593209E+01 Max. grid level exceeded at T= 0.1633888E+01 Max. grid level exceeded at T= 0.1674567E+01 Max. grid level exceeded at T= 0.1721058E+01 Max. grid level exceeded at T= 0.1767548E+01 Max. grid level exceeded at T= 0.1814039E+01 Max. grid level exceeded at T= 0.1860529E+01 Max. grid level exceeded at T= 0.1907019E+01 Max. grid level exceeded at T= 0.1953510E+01 Max. grid level exceeded at T= 0.2000000E+01 Statistics: # accepted timesteps = 62, # rejected timesteps = 0 Level # Nit # Jacs # Res 1 124 62 124 2 134 62 134 3 149 62 149 4 76 38 76 Nit Level # Lin. sys. it 1 1 353 1 2 460 1 3 652 1 4 1057 2 1 296 2 2 462 2 3 648 2 4 1008 3 2 10 3 3 23 4 3 2 VLUGR3 returned with MNTR=1 SHAR_EOF fi # end of overwriting check if test -f 'plot.m' then echo shar: will not over-write existing file "'plot.m'" else cat << \SHAR_EOF > 'plot.m' % Plots solution and grid levels from data files sol.dat and grid.dat % generated by WRTUNI.f % NB. pcolor with default shading colors a cell with the lowerleft value and % ignores the last row and column. % nxb=input('nX base grid? '); nyb=input('nY base grid? '); nzb=input('nZ base grid? '); load sol.dat load grid.dat [n,npde]=size(sol); unilev=floor(log(n/(nxb*nyb*nzb))/(log(2)*3)+1); lmul = 2^(unilev-1); nx=nxb*2^(unilev-1); ny=nyb*2^(unilev-1); nz=nzb*2^(unilev-1); while 1 sldir = input('Enter slice coordinate direction, 1=x, 2=y, 3=z; 0 quits: '); if sldir == 0, break, end if sldir == 1 slind = input(['Base grid index for slice, (0..',int2str(nxb),')? ']); elseif sldir == 2 slind = input(['Base grid index for slice, (0..',int2str(nyb),')? ']); elseif sldir == 3 slind = input(['Base grid index for slice, (0..',int2str(nzb),')? ']); end slind = slind*lmul; for ic=1:npde Umin=input(['min. sol. value comp. ',int2str(ic),'? ']); Umax=input(['max. sol. value comp. ',int2str(ic),'? ']); if sldir == 1 U = zeros(nz+1,ny+1); for k = 0:nz for j = 0:ny U(k+1,j+1) = sol(((ny+1)*k+j)*(nx+1)+slind+1,ic); end end elseif sldir == 2 U = zeros(nz+1,nx+1); for k = 0:nz for i = 0:nx U(k+1,i+1) = sol(((ny+1)*k+slind)*(nx+1)+i+1,ic); end end elseif sldir == 3 U = zeros(ny+1,nx+1); for j = 0:ny for i = 0:nx U(j+1,i+1) = sol(((ny+1)*slind+j)*(nx+1)+i+1,ic); end end end figure(ic); colormap(jet); pcolor(U); shading('interp'); if Umin < Umax caxis([Umin Umax]); end keyboard end if sldir == 1 G = zeros(nz+2,ny+2); for k = 0:nz for j = 0:ny G(k+1,j+1) = grid(((ny+1)*k+j)*(nx+1)+slind+1); end end elseif sldir == 2 G = zeros(nz+2,nx+2); for k = 0:nz for i = 0:nx G(k+1,i+1) = grid(((ny+1)*k+slind)*(nx+1)+i+1); end end elseif sldir == 3 G = zeros(ny+2,nx+2); for j = 0:ny for i = 0:nx G(j+1,i+1) = grid(((ny+1)*slind+j)*(nx+1)+i+1); end end end figure(npde+1); grc=[1 1 1; 1 1 0; 0 1 0; 0 1 1; 0 0 1; 1 0 0; 1 0 1]; colormap(grc(1:unilev,:)); pcolor(G); caxis([0.99 unilev]); keyboard end SHAR_EOF fi # end of overwriting check if test -f 'exmpl.f' then echo shar: will not over-write existing file "'exmpl.f'" else cat << \SHAR_EOF > 'exmpl.f' PROGRAM EXMPL C C Ccc INCLUDE 'PARNEWTON' C C PARNEWTON C C Parameters for Newton process C MAXNIT : Max. number of Newton iterations C MAXJAC : Max. number of Jacobian / preconditioner evaluations during C a Newton process C TOLNEW : Tolerance for Newton process: C rho/(1-rho)*|| corr.||_w < TOLNEW INTEGER MAXNIT, MAXJAC REAL TOLNEW PARAMETER (MAXNIT = 10, MAXJAC = 2, TOLNEW = 1.0) C C end INCLUDE 'PARNEWTON' C C Ccc INCLUDE 'PARGCRO' C C PARGCRO C C Parameters for linear system solver GCRO + (block-)diagonal C preconditioner C IDIAGP : 0: block-diagonal + first order derivatives C 1: block-diagonal neglecting first order derivatives C 2: diagonal + first order derivatives C 3: diagonal neglecting first order derivatives C NRRMAX : Max. number of restarts of outer loop C MAXLR : Max. number of iterations in outer loop C MAXL : Max. number of iterations in GMRES inner loop C TOLLSC : Tolerance for linear system solver INTEGER IDIAGP, NRRMAX, MAXLR, MAXL REAL TOLLSC PARAMETER (NRRMAX = 1, MAXLR = 5, MAXL = 20) C PARAMETER (NRRMAX = 1, MAXLR = 3, MAXL = 15) PARAMETER (TOLLSC = TOLNEW/10) COMMON /IGCRO/ IDIAGP SAVE /IGCRO/ C C end INCLUDE 'PARGCRO' C INTEGER MXLEV, NPD, NPTS, LENIWK, LENRWK, LENLWK PARAMETER (MXLEV=2, NPD=3, NPTS=61000) PARAMETER (LENIWK=NPTS*(7*MXLEV+7), + LENRWK=NPTS*NPD*(5*MXLEV+13 + (2*MAXLR+MAXL+7)), + LENLWK=2*NPTS) C C----------------------------------------------------------------------- C INTEGER LUNDMP PARAMETER (LUNDMP = 89) C INTEGER NPDE, INFO(7), IWK(LENIWK), MNTR LOGICAL LWK(LENLWK) REAL T, TOUT, DT, XL, YF, ZD, XR, YB, ZU, DX, DY, DZ, + TOLS, TOLT, RINFO(2+3*NPD), RWK(LENRWK) C First call of VLUGR3 MNTR = 0 NPDE = 3 T = 0.0 TOUT = 1.0 DT = 0.001 C Since domain is not a rectangular prism the grid parameters need not C to be specified here (cf. INIDOM) TOLS = 0.1 TOLT = 0.1 INFO(1) = 1 C MAXLEV INFO(2) = 4 C Domain not a rectangular prism INFO(3) = 1 C Linear system solver: matrix-free GCRO + Diagonal scaling C (no first order derivatives at the boundaries) INFO(4) = 13 OPEN (UNIT=61,FILE='RunInfo') C Write integration history to unit # 61 INFO(5) = 61 C Write Newton info to unit # 61 INFO(6) = 61 C Write GCRO info to unit # 61 INFO(7) = 61 C DTMIN = 1E-7 RINFO(1) = 1.0E-7 C DTMAX = 1.0 RINFO(2) = 1.0 C UMAX = 1.0 RINFO(3) = 1.0 RINFO(4) = 1.0 RINFO(5) = 1.0 C SPCWGT = 1.0 RINFO(6) = 1.0 RINFO(7) = 1.0 RINFO(8) = 1.0 C TIMWGT = 1.0 RINFO( 9) = 1.0 RINFO(10) = 1.0 RINFO(11) = 1.0 C C Call main routine CALL VLUGR3 (NPDE, T, TOUT, DT, XL,YF,ZD, XR,YB,ZU, DX, DY, DZ, + TOLS, TOLT, INFO, RINFO, RWK, LENRWK, IWK, LENIWK, LWK, LENLWK, + MNTR) PRINT *, 'VLUGR3 returned with MNTR=', MNTR C C Save info on file OPEN(UNIT=LUNDMP,FILE='DUMP',FORM='UNFORMATTED') CALL DUMP (LUNDMP, RWK, IWK) CLOSE(LUNDMP) END LOGICAL FUNCTION INIDOM (MAXPTS, + XL, YF, ZD, XR, YB, ZU, DX, DY, DZ, + LPLN, IPLN, LROW, IROW, ICOL, LLBND, ILBND, LBND) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER MAXPTS, LPLN(0:*), IPLN(*), LROW(*), IROW(*), ICOL(*), + LLBND(0:*), ILBND(*), LBND(*) REAL XL, YF, ZD, XR, YB, ZU, DX, DY, DZ C Ccc PURPOSE: C Define initial domain. NB. Boundaries should consist of as many points C as are necessary to employ second order space discretization, i.e., C a boundary enclosing the internal part of the domain should not C include less than 3 grid points in any coordinate direction including C the corners. If Neumann boundaries are used the minimum is 4 since C otherwise the Jacobian matrix will be singular. C C A (virtual) box is placed upon the (irregular) domain. C The left/front/down point of this box is (XL,YF,ZD) in physical C coordinates and (0,0,0) in column, row, plane coordinates, resp.. C The right/back/upper point is (XR,YB,ZU) resp. (Nx,Ny,Nz), where C Nx = (XR-XL)/DX, Ny = (YB-YF)/DY, and Nz = (ZU-ZD)/DZ. C Only real grid points are stored. C The coordinate values of the initial grid should be stored plane C after plane and rowwise in LPLN, IPLN, LROW, IROW, ICOL. C Pointers to the boundary points should be stored in a list together C with the type of the boundary. (LLBND, ILBND, LBND) C C On exit INIDOM = .FALSE. if the # grid points required is larger C than MAXPTS and MAXPTS is set to the required # points. C Ccc PARAMETER DESCRIPTION: C MAXPTS : INOUT. C IN: Max. # grid points allowed by the available workspace C OUT: # grid points required, if larger than # points allowed C XL : OUT. X-coordinate of left/front/down point of virtual box C YF : OUT. Y-coordinate of left/front/down point of virtual box C ZD : OUT. Z-coordinate of left/front/down point of virtual box C XR : OUT. X-coordinate of right/back/upper point of virtual box C YB : OUT. Y-coordinate of right/back/upper point of virtual box C ZU : OUT. Z-coordinate of right/back/upper point of virtual box C DX : OUT. Grid width in X-direction C DY : OUT. Grid width in Y-direction C DZ : OUT. Grid width in Z-direction C LPLN : OUT. (0:LPLN(0)+1) C LPLN(0) = NPLNS: Actual # horizontal planes in LROW C LPLN(1:NPLNS): pointers to the start of a plane in LROW C LPLN(NPLNS+1) = NROWS+1: Total # rows in grid + 1 C IPLN : OUT. (NPLNS) C IPLN(IP): plane number of plane IP in virtual box C LROW : OUT. (NROWS+1) C LROW(1:NROWS): pointers to the start of a row in the grid C LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 C IROW : OUT. (NROWS) C IROW(IR): row number of row IR in virtual box C ICOL : OUT. (NPTS) C ICOL(IPT): column number of grid point IPT in virtual box C LLBND : OUT. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : OUT. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : OUT. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C structure C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C C Domain [0,1]x[0,1]x[0,1] with hole in the middle and projection C at [1,1.333]x[0,1]x[0.666,1]. C Virtual box: [0,1.333]x[0,1]x[0,1] C INTEGER NX, NY, NZ PARAMETER (NX = 8, NY = 6, NZ = 6) INTEGER IDOM(0:(NX+1)*(NY+1)*(NZ+1)) C INTEGER I, IPT, IR, J, K, NPLNS, NROWS, NPTS, NBNDS, + NPTSP1, NPTSP2 NPLNS = NZ+1 NROWS = (NY+1)*NPLNS NPTS = (NX+1)*NROWS-1-2*(NY+1)*(NZ-2) IF (MAXPTS .LT. NPTS) THEN INIDOM = .FALSE. MAXPTS = NPTS RETURN ELSE INIDOM = .TRUE. ENDIF XL = 0.0 YF = 0.0 ZD = 0.0 XR = 4.0/3.0 YB = 1.0 ZU = 1.0 DX = (XR-XL)/NX DY = (YB-YF)/NY DZ = (ZU-ZD)/NZ C C Make grid structure LPLN(0) = NPLNS IPT = 1 IR = 1 DO 10 K = 0, 2 LPLN(K+1) = IR IPLN(K+1) = K DO 20 I = 0, NY LROW(IR) = IPT IROW(IR) = I IR = IR+1 DO 30 J = 0, NX-2 ICOL(IPT) = J IPT = IPT + 1 30 CONTINUE 20 CONTINUE 10 CONTINUE K = 3 LPLN(K+1) = IR IPLN(K+1) = K DO 40 I = 0, 2 LROW(IR) = IPT IROW(IR) = I IR = IR+1 DO 50 J = 0, NX-2 ICOL(IPT) = J IPT = IPT + 1 50 CONTINUE 40 CONTINUE I = 3 LROW(IR) = IPT IROW(IR) = I IR = IR+1 DO 60 J = 0, 2 ICOL(IPT) = J IPT = IPT + 1 60 CONTINUE DO 70 J = 4, NX-2 ICOL(IPT) = J IPT = IPT + 1 70 CONTINUE DO 80 I = 4, NY LROW(IR) = IPT IROW(IR) = I IR = IR+1 DO 90 J = 0, NX-2 ICOL(IPT) = J IPT = IPT + 1 90 CONTINUE 80 CONTINUE DO 100 K = 4, NZ LPLN(K+1) = IR IPLN(K+1) = K DO 110 I = 0, NY LROW(IR) = IPT IROW(IR) = I IR = IR+1 DO 120 J = 0, NX ICOL(IPT) = J IPT = IPT + 1 120 CONTINUE 110 CONTINUE 100 CONTINUE LROW(NROWS+1) = NPTS+1 LPLN(NPLNS+1) = NROWS+1 C Ccc Boundaries NBNDS = 14 ILBND( 1) = 1 ILBND( 2) = 2 ILBND( 3) = 3 ILBND( 4) = 2 ILBND( 5) = 3 ILBND( 6) = 4 ILBND( 7) = 5 ILBND( 8) = 6 ILBND( 9) = 1 ILBND(10) = 2 ILBND(11) = 3 ILBND(12) = 4 ILBND(13) = 5 ILBND(14) = 6 LLBND( 0) = NBNDS LLBND( 1) = 1 LLBND( 2) = LLBND( 1) + (NY+1)*(NZ+1) LLBND( 3) = LLBND( 2) + (NX-1)*(NY+1) LLBND( 4) = LLBND( 3) + (NY+1)*(NZ-1) LLBND( 5) = LLBND( 4) + 3 *(NY+1) LLBND( 6) = LLBND( 5) + (NY+1)* 3 LLBND( 7) = LLBND( 6) + (NX+1)*(NY+1) LLBND( 8) = LLBND( 7) + (NX-1)*(NZ-2)+(NX+1)*3 LLBND( 9) = LLBND( 8) + (NX-1)*(NZ-2)+(NX+1)*3 LLBND(10) = LLBND( 9) + 9 LLBND(11) = LLBND(10) + 9 LLBND(12) = LLBND(11) + 9 LLBND(13) = LLBND(12) + 9 LLBND(14) = LLBND(13) + 9 LLBND(15) = LLBND(14) + 9 C Ccc Outer planes C Left boundary plane pointers NPTSP1 = (NX-1)*(NY+1) NPTSP2 = (NX+1)*(NY+1) DO 200 K = 0, 3 DO 201 I = 0, NY IPT = K*NPTSP1 + I*(NX-1) + 1 IF (K .EQ. 3 .AND. I .GT. 3) IPT = IPT-1 LBND(LLBND(1)+K*(NY+1)+I) = IPT 201 CONTINUE 200 CONTINUE DO 202 K = NZ-2, NZ DO 203 I = 0, NY IPT = (NZ-2)*NPTSP1+(K-NZ+2)*NPTSP2 + I*(NX+1) LBND(LLBND(1)+K*(NY+1)+I) = IPT 203 CONTINUE 202 CONTINUE C Right boundary plane pointers DO 210 K = 0, 3 DO 211 I = 0, NY IPT = (K+1)*NPTSP1 - I*(NX-1) IF (K .EQ. 3 .AND. I .LE. 3) IPT = IPT-1 LBND(LLBND(3)+K*(NY+1)+I) = IPT 211 CONTINUE 210 CONTINUE K = NZ-2 DO 209 I = 0, NY IPT = 4*NPTSP1 + NPTSP2-3 - I*(NX+1) LBND(LLBND(3)+K*(NY+1)+I) = IPT 209 CONTINUE DO 212 I = 0, NY DO 213 J = NX-2, NX IPT = NPTSP1*(NZ-2)+I*(NX+1) + J LBND(LLBND(4)+I*3+J-NX+2) = IPT 213 CONTINUE 212 CONTINUE DO 214 K = NZ-2, NZ DO 215 I = 0, NY IPT = NPTSP1*(NZ-2)+(K-NZ+3)*NPTSP2 - I*(NX+1) - 1 LBND(LLBND(5)+(K-NZ+2)*(NY+1)+I) = IPT 215 CONTINUE 214 CONTINUE C Down and up boundary plane pointers DO 220 I = 0, NY DO 221 J = 0, NX-2 IPT = I*(NX-1) + J + 1 LBND(LLBND(2)+I*(NX-1)+J) = IPT 221 CONTINUE 220 CONTINUE DO 230 I = 0, NY DO 231 J = 0, NX IPT = (NPTS - (I*(NX+1)+J)) LBND(LLBND(6)+I*(NX+1)+J) = IPT 231 CONTINUE 230 CONTINUE C Front and back boundary plane pointers DO 240 K = 0, 3 DO 241 J = 0, NX-2 IPT = K*NPTSP1 + J + 1 LBND(LLBND(7)+K*(NX-1)+J) = IPT IPT = (K+1)*NPTSP1 - J IF (K .EQ. 3) IPT = IPT-1 LBND(LLBND(8)+K*(NX-1)+J) = IPT 241 CONTINUE 240 CONTINUE DO 242 K = NZ-2, NZ DO 243 J = 0, NX IPT = (NZ-2)*NPTSP1+(K-NZ+2)*NPTSP2 + J LBND(LLBND(7)+4*(NX-1)+(K-NZ+2)*(NX+1)+J) = IPT IPT = 4*NPTSP1+(K-NZ+3)*NPTSP2 - J - 1 LBND(LLBND(8)+4*(NX-1)+(K-NZ+2)*(NX+1)+J) = IPT 243 CONTINUE 242 CONTINUE C Ccc Inner planes C Left and right boundary plane pointers LBND(LLBND( 9) ) = 117 LBND(LLBND( 9)+1) = 124 LBND(LLBND( 9)+2) = 131 LBND(LLBND( 9)+3) = 166 LBND(LLBND( 9)+4) = 172 LBND(LLBND( 9)+5) = 179 LBND(LLBND( 9)+6) = 218 LBND(LLBND( 9)+7) = 227 LBND(LLBND( 9)+8) = 236 LBND(LLBND(11) ) = 115 LBND(LLBND(11)+1) = 122 LBND(LLBND(11)+2) = 129 LBND(LLBND(11)+3) = 164 LBND(LLBND(11)+4) = 171 LBND(LLBND(11)+5) = 177 LBND(LLBND(11)+6) = 216 LBND(LLBND(11)+7) = 225 LBND(LLBND(11)+8) = 234 C Down and up boundary plane pointers DO 260 I = 0, 2 DO 270 J = 0, 2 LBND(LLBND(10)+I*3+J) = 236 - (I*(NX+1)+J) LBND(LLBND(12)+I*3+J) = 115 + I*(NX-1) + J 270 CONTINUE 260 CONTINUE C Front and back boundary plane pointers LBND(LLBND(13) ) = 129 LBND(LLBND(13)+1) = 130 LBND(LLBND(13)+2) = 131 LBND(LLBND(13)+3) = 177 LBND(LLBND(13)+4) = 178 LBND(LLBND(13)+5) = 179 LBND(LLBND(13)+6) = 234 LBND(LLBND(13)+7) = 235 LBND(LLBND(13)+8) = 236 LBND(LLBND(14) ) = 115 LBND(LLBND(14)+1) = 116 LBND(LLBND(14)+2) = 117 LBND(LLBND(14)+3) = 164 LBND(LLBND(14)+4) = 165 LBND(LLBND(14)+5) = 166 LBND(LLBND(14)+6) = 216 LBND(LLBND(14)+7) = 217 LBND(LLBND(14)+8) = 218 C LLBND(NBNDS+2) = LLBND(NBNDS+1) PRINT *, 'Input domain:' CALL PRDOM (LPLN, IPLN, LROW, IROW, ICOL, LLBND, ILBND, LBND, + IDOM, NX, NY, NZ) RETURN END SUBROUTINE CHSPCM (T, LEVEL, NPTS, X, Y, Z, NPDE, U, SPCMON, TOL) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER LEVEL, NPTS, NPDE REAL T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE), SPCMON(NPTS), TOL C Ccc PURPOSE: C Force grid refinement. C If for a node IPT SPCMON(IPT) > TOL the 64 surrounding cells will be C refined. C Ccc PARAMETER DESCRIPTION: C T : IN. Current value of time variable C LEVEL : IN. Current grid level C NPTS : IN. Number of grid points at this level C X,Y,Z : IN. Arrays of physical coordinates for the gridpoints C NPDE : IN. Number of PDE components C U : IN. Array of PDE components for the gridpoints C SPCMON : INOUT. C IN: Space monitor values as determined by VLUGR3 C OUT: Changed to a value > TOL where refinement is required C TOL : IN. Tolerance with which SPCMON will be compared C C----------------------------------------------------------------------- INTEGER I C IF (LEVEL .GE. 3) RETURN DO 10 I = 1, NPTS IF (ABS(X(I)-1.0) .LT. 0.0001 .AND. + ABS(Y(I)-0.5) .LT. 0.0001 .AND. + ABS(Z(I)) .LT. 0.0001) THEN SPCMON(I) = 2*TOL ENDIF 10 CONTINUE C RETURN END SUBROUTINE MONITR (T, DT, DTNEW, XL, YF, ZD, DXB, DYB, DZB, + LGRID, ISTRUC, LSOL, SOL) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER LGRID(0:*), ISTRUC(*), LSOL(*) REAL T, DT, DTNEW, XL, YF, ZD, DXB, DYB, DZB, SOL(*) C Ccc PURPOSE: C Control after a successful time step. The solution can be printed, C plotted or compared with the exact solution. C Ccc PARAMETER DESCRIPTION: C T : IN. Current value of time variable C DT : IN. Current time step size C DTNEW : IN. Time step size for next time step C XL : IN. X-coordinate of left/front/down point of (virtual) box C YF : IN. Y-coordinate of left/front/down point of (virtual) box C ZD : IN. Z-coordinate of left/front/down point of (virtual) box C DXB : IN. Cell width in X-direction of base grid C DYB : IN. Cell width in Y-direction of base grid C DZB : IN. Cell width in Z-direction of base grid C LGRID : IN. (0:*) C LGRID(0) = max. grid level used at T C LGRID(1): pointer to base grid structure ISTRUC C LGRID(LEVEL): pointer to grid structure C (LPLN,IPLN,LROW,IROW,ICOL) of refinement C level LEVEL for time T C ISTRUC : IN. (*) C ISTRUC(LGRID(LEVEL):.) contains (LPLN,IPLN,LROW,IROW,ICOL) C of grid level LEVEL, C LPLN : (0:LPLN(0)+1) C LPLN(0) = NPLNS: Actual # planes in LROW C LPLN(1:NPLNS): pointers to the start of a plane in LROW C LPLN(NPLNS+1) = NROWS+1: Total # rows in grid + 1 C IPLN : (NPLNS) C IPLN(IP): plane number of plane IP in virtual box C LROW : (NROWS+1) C LROW(1:NROWS): pointers to the start of a row in the grid C LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 C IROW : (NROWS) C IROW(IR): row number of row IR in virtual box C ICOL : (NPTS) C ICOL(IPT): column number of grid point IPT in virtual box C LSOL : IN. (*) C LSOL(LEVEL): pointer to (injected) solution at grid C of refinement level LEVEL for time T C SOL : IN. (*) C SOL(LSOL(LEVEL)+1:LSOL(LEVEL)+NPTS(LEVEL)*NPDE) contains C U_LEVEL(NPTS,NPDE) C C C Local arrays: INTEGER MAXPTS, NPDE PARAMETER (MAXPTS=250000, NPDE=3) REAL X(MAXPTS), Y(MAXPTS), Z(MAXPTS), UEX(MAXPTS*NPDE) C C----------------------------------------------------------------------- C INTEGER MAXLEV, LEVEL, LLPLN, LIPLN, LLROW, LIROW, LICOL, + NPLNS, NROWS, NPTS REAL DX, DY, DZ C C Loop over the grid levels from coarse to fine. C Get physical coordinates of grid points C Compute ||err||_max MAXLEV = LGRID(0) DX = DXB DY = DYB DZ = DZB DO 10 LEVEL = 1, MAXLEV LLPLN = LGRID(LEVEL) NPLNS = ISTRUC(LLPLN) NROWS = ISTRUC(LLPLN+NPLNS+1)-1 LIPLN = LLPLN+NPLNS+2 LLROW = LIPLN+NPLNS NPTS = ISTRUC(LLROW+NROWS)-1 IF (NPTS .GT. MAXPTS) stop 'MONITR' LIROW = LLROW+NROWS+1 LICOL = LIROW+NROWS CALL SETXYZ (XL, YF, ZD, DX, DY, DZ, + ISTRUC(LLPLN), ISTRUC(LIPLN), + ISTRUC(LLROW), ISTRUC(LIROW), ISTRUC(LICOL), X, Y, Z) DX = DX/2 DY = DY/2 DZ = DZ/2 CALL PRERR (LEVEL, T, NPTS, NPDE, X, Y, Z, SOL(LSOL(LEVEL)+1), + UEX) 10 CONTINUE RETURN END SUBROUTINE PRERR (LEVEL, T, NPTS, NPDE, X, Y, Z, U, UEX) INTEGER LEVEL, NPTS, NPDE REAL T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE), UEX(NPTS,NPDE) INTEGER I,J REAL RMAX(3) CALL PDEIV (T, X, Y, Z, UEX, NPTS, NPDE) DO 1 J = 1,NPDE RMAX(J) = 0.0 DO 10 I = 1, NPTS RMAX(J) = MAX(RMAX(J),ABS(UEX(I,J)-U(I,J))) 10 CONTINUE 1 CONTINUE WRITE(28,'(''Error at T='',E9.3,'', level='',I1,'' :'', + I10,3E12.3)') + T, LEVEL, NPTS, (RMAX(J), J=1, NPDE) RETURN END SUBROUTINE PDEIV (T, X, Y, Z, U, NPTS, NPDE) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE REAL T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE) C Ccc PURPOSE: C Define (initial) solution of PDE. C Ccc PARAMETER DESCRIPTION: C T : IN. Time at which (initial) solution should be given C X,Y,Z : IN. Arrays of physical coordinates for the gridpoints C U : OUT. Array of PDE component values for the gridpoints. C NPTS : IN. Number of gridpoints C NPDE : IN. # PDE components C C----------------------------------------------------------------------- C C INTEGER I REAL EPS PARAMETER (EPS = 5.0E-3) DO 10 I = 1, NPTS U(I,1) = 1-0.5/(1+EXP((-X(I)+Y(I)+Z(I)-0.75*T)/(4*EPS))) U(I,2) = 1.5-U(I,1) U(I,3) = 1.5-U(I,1) 10 CONTINUE RETURN END SUBROUTINE PDEF (T, X, Y, Z, U, + UT, UX, UY, UZ, UXX, UYY, UZZ, UXY, UXZ, UYZ, RES, NPTS, NPDE) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE REAL T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE), + UT(NPTS,NPDE), UX(NPTS,NPDE), UY(NPTS,NPDE), UZ(NPTS,NPDE), + UXX(NPTS,NPDE), UYY(NPTS,NPDE), UZZ(NPTS,NPDE), + UXY(NPTS,NPDE), UXZ(NPTS,NPDE), UYZ(NPTS,NPDE), + RES(NPTS,NPDE) C Ccc PURPOSE: C Define residual of PDE on interior of domain. Boundary values will be C overwritten later on. C Ccc PARAMETER DESCRIPTION: C T : IN. Time at which residual should be evaluated C X,Y,Z : IN. Physical coordinates of gridpoints C U : IN. Array of PDE components for the gridpoints. C UT : IN. Array of time derivative of PDE components C UX : IN. -I C UY : IN. I C UZ : IN. I C UXX : IN. I C UYY : IN. I Space derivatives of U on current grid C UZZ : IN. I C UXY : IN. I C UXZ : IN. I C UYZ : IN. -I C RES : OUT. Array containg PDE residual at gridpoints in interior of C domain. The residual values at boundary points will be C overwritten by a call to PDEBC. C NPTS : IN. Number of gridpoints C NPDE : IN. Number of PDE components C C----------------------------------------------------------------------- C INTEGER I REAL EPS PARAMETER (EPS = 5.0E-3) DO 10 I = 1, NPTS RES(I,1) = UT(I,1) + U(I,1)*UX(I,1) + + U(I,2)*UY(I,1) + U(I,3)*UZ(I,1) - + EPS*(UXX(I,1)+UYY(I,1)+UZZ(I,1)) RES(I,2) = UT(I,2) + U(I,1)*UX(I,2) + + U(I,2)*UY(I,2) + U(I,3)*UZ(I,2) - + EPS*(UXX(I,2)+UYY(I,2)+UZZ(I,2)) RES(I,3) = UT(I,3) + U(I,1)*UX(I,3) + + U(I,2)*UY(I,3) + U(I,3)*UZ(I,3) - + EPS*(UXX(I,3)+UYY(I,3)+UZZ(I,3)) 10 CONTINUE RETURN END SUBROUTINE PDEBC (T, X, Y, Z, U, UT, UX, UY, UZ, RES, NPTS, NPDE, + LLBND, ILBND, LBND) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE, LLBND(0:*), ILBND(*), LBND(*) REAL T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE), + UT(NPTS,NPDE), UX(NPTS,NPDE), UY(NPTS,NPDE), UZ(NPTS,NPDE), + RES(NPTS,NPDE) C Ccc PURPOSE: C Define residual of boundary equations of PDE. The residual on interior C points has already been stored in RES. C Ccc PARAMETER DESCRIPTION: C T : IN. Time at which BC's should be evaluated C X,Y,Z : IN. Physical coordinates of gridpoints C U : IN. Array of PDE components for the gridpoints. C UT : IN. Array of time derivative of PDE components C UX : IN. -I C UY : IN. I Arrays containing space derivatives of PDE components C UZ : IN. -I C RES : INOUT. C IN: PDE residual for interior points (set by PDEF) C OUT: Array with PDE residual at physical boundary points C inserted C NPTS : IN. Number of grid components C NPDE : IN. Number of PDE components C LLBND : IN. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C C----------------------------------------------------------------------- C INTEGER I, J, K, NBNDS REAL EPS, UI PARAMETER (EPS = 5.0E-3) NBNDS = LLBND(0) DO 10 J = 1, NBNDS DO 20 K = LLBND(J), LLBND(J+1)-1 I = LBND(K) UI = 1-0.5/(1+EXP((-X(I)+Y(I)+Z(I)-0.75*T)/(4*EPS))) RES(I,1) = U(I,1) - UI RES(I,2) = U(I,2) - (1.5-UI) RES(I,3) = U(I,3) - (1.5-UI) 20 CONTINUE 10 CONTINUE RETURN END SHAR_EOF fi # end of overwriting check if test -f 'exmplr.f' then echo shar: will not over-write existing file "'exmplr.f'" else cat << \SHAR_EOF > 'exmplr.f' PROGRAM EXMPLR C INTEGER MXLEV, NPD, NPTS, LENIWK, LENRWK, LENLWK PARAMETER (MXLEV=2, NPD=3, NPTS=60000) PARAMETER (LENIWK=NPTS*(7*MXLEV+25), + LENRWK=NPTS*NPD*(5*MXLEV+13+38*NPD), + LENLWK=2*NPTS) C C----------------------------------------------------------------------- C INTEGER LUNDMP PARAMETER (LUNDMP = 89) C INTEGER NPDE, INFO(7), IWK(LENIWK), MNTR LOGICAL LWK(LENLWK) REAL T, TOUT, DT, XL, YF, ZD, XR, YB, ZU, DX, DY, DZ, + TOLS, TOLT, RINFO(2+3*NPD), RWK(LENRWK) C Continuation call of VLUGR3 MNTR = 1 TOUT = 2.0 TOLS = 0.1 TOLT = 0.1 C Default choices INFO(1) = 0 C C Read info from file OPEN(UNIT=LUNDMP,FILE='DUMP',FORM='UNFORMATTED') CALL RDDUMP (LUNDMP, RWK, LENRWK, IWK, LENIWK) CLOSE(LUNDMP) C C Call main routine CALL VLUGR3 (NPDE, T, TOUT, DT, XL,YF,ZD, XR,YB,ZU, DX, DY, DZ, + TOLS, TOLT, INFO, RINFO, RWK, LENRWK, IWK, LENIWK, LWK, LENLWK, + MNTR) PRINT *, 'VLUGR3 returned with MNTR=', MNTR C C Save info on file OPEN(UNIT=LUNDMP,FILE='DUMP2',FORM='UNFORMATTED') CALL DUMP (LUNDMP, RWK, IWK) CLOSE(LUNDMP) END SUBROUTINE DERIVF (F, T, X, Y, Z, NPTS, NPDE, U, + A0, DT, DX, DY, DZ, + LLBND, ILBND, LBND, UIB, UT, UX, UY, UZ, UXX, UYY, UZZ, + UXY, UXZ, UYZ, ATOL, DEL, WORK, + FU, FUX, FUY, FUZ, FUXX, FUYY, FUZZ, FUXY, FUXZ, FUYZ) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE, LLBND(0:*), ILBND(*), LBND(*) REAL F(NPTS,NPDE), T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE), + A0, DT, DX, DY, DZ, UIB(*), + UT(NPTS,NPDE), UX(NPTS,NPDE), UY(NPTS,NPDE), UZ(NPTS,NPDE), + UXX(NPTS,NPDE), UYY(NPTS,NPDE), UZZ(NPTS,NPDE), + UXY(NPTS,NPDE), UXZ(NPTS,NPDE), UYZ(NPTS,NPDE), + ATOL(NPDE), DEL(NPTS), WORK(2*NPTS*NPDE), + FU(NPTS,NPDE,NPDE), + FUX(NPTS,NPDE,NPDE), FUY(NPTS,NPDE,NPDE), FUZ(NPTS,NPDE,NPDE), + FUXX(NPTS,NPDE,NPDE),FUYY(NPTS,NPDE,NPDE),FUZZ(NPTS,NPDE,NPDE), + FUXY(NPTS,NPDE,NPDE),FUXZ(NPTS,NPDE,NPDE),FUYZ(NPTS,NPDE,NPDE) C Ccc PURPOSE: C Compute derivatives of residual wrt (derivatives of) U C C PARAMETER DESCRIPTION: C F : IN. Residual F(t,U,Ut) C T : IN. Current time C X,Y,Z : IN. Physical coordinates of gridpoints C NPTS : IN. # grid points C NPDE : IN. # PDE components C U : IN. Solution at T on current grid C A0 : IN. Coefficient of U_n+1 in time derivative C DT : IN. Current time step size C DX : IN. Cell width in X-direction for current grid C DY : IN. Cell width in Y-direction for current grid C DZ : IN. Cell width in Z-direction for current grid C LLBND : IN. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C UIB : IN. Solution at T on internal boundaries C UT : IN. Time derivative of U on current grid C UX : IN. -I C UY : IN. I C UZ : IN. I C UXX : IN. I C UYY : IN. I Space derivatives of U on current grid C UZZ : IN. I C UXY : IN. I C UXZ : IN. I C UYZ : IN. -I C ATOL : IN. Absolute tolerance for Newton process C DEL : WORK. (NPTS) C WORK : WORK. (2.LENU) C FU : OUT. dF(U,Ut)dU C FUX : OUT. dF(Ux)dUx C FUY : OUT. dF(Uy)dUy C FUZ : OUT. dF(Uz)dUz C FUXX : OUT. dF(Uxx)dUxx C FUYY : OUT. dF(Uyy)dUyy C FUZZ : OUT. dF(Uzz)dUzz C FUXY : OUT. dF(Uxy)dUxy C FUXZ : OUT. dF(Uxz)dUxz C FUYZ : OUT. dF(Uyz)dUyz C Ccc EXTERNALS USED: EXTERNAL ZERO C C----------------------------------------------------------------------- C REAL EPS PARAMETER (EPS = 5E-3) C INTEGER IC, IPT, JC, LB, NBNDS C CALL ZERO (NPTS*NPDE*NPDE, FUX) CALL ZERO (NPTS*NPDE*NPDE, FUY) CALL ZERO (NPTS*NPDE*NPDE, FUZ) CALL ZERO (NPTS*NPDE*NPDE, FUXX) CALL ZERO (NPTS*NPDE*NPDE, FUYY) CALL ZERO (NPTS*NPDE*NPDE, FUZZ) CALL ZERO (NPTS*NPDE*NPDE, FUXY) CALL ZERO (NPTS*NPDE*NPDE, FUXZ) CALL ZERO (NPTS*NPDE*NPDE, FUYZ) C DO 10 IPT = 1, NPTS C dF_1(U,Ut)/dU_ic FU(IPT,1,1) = UX(IPT,1) + A0 FU(IPT,1,2) = UY(IPT,1) FU(IPT,1,3) = UZ(IPT,1) C dF_1(Up)/dUp_ic FUX(IPT,1,1) = U(IPT,1) FUY(IPT,1,1) = U(IPT,2) FUZ(IPT,1,1) = U(IPT,3) C dF_1(Upp)/dUpp_ic FUXX(IPT,1,1) = -EPS FUYY(IPT,1,1) = -EPS FUZZ(IPT,1,1) = -EPS C dF_2(U,Ut)/dU_ic FU(IPT,2,1) = UX(IPT,2) FU(IPT,2,2) = UY(IPT,2) + A0 FU(IPT,2,3) = UZ(IPT,2) C dF_2(Up)/dUp_ic FUX(IPT,2,2) = U(IPT,1) FUY(IPT,2,2) = U(IPT,2) FUZ(IPT,2,2) = U(IPT,3) C dF_2(Upp)/dUpp_ic FUXX(IPT,2,2) = -EPS FUYY(IPT,2,2) = -EPS FUZZ(IPT,2,2) = -EPS C dF_3(U,Ut)/dU_ic FU(IPT,3,1) = UX(IPT,3) FU(IPT,3,2) = UY(IPT,3) FU(IPT,3,3) = UZ(IPT,3) + A0 C dF_3(Up)/dUp_ic FUX(IPT,3,3) = U(IPT,1) FUY(IPT,3,3) = U(IPT,2) FUZ(IPT,3,3) = U(IPT,3) C dF_3(Upp)/dUpp_ic FUXX(IPT,3,3) = -EPS FUYY(IPT,3,3) = -EPS FUZZ(IPT,3,3) = -EPS 10 CONTINUE C C Correct boundaries (incl. the internal) NBNDS = LLBND(0) DO 100 LB = LLBND(1), LLBND(NBNDS+2)-1 IPT = LBND(LB) DO 110 IC = 1, NPDE DO 120 JC = 1, NPDE FU (IPT,IC,JC) = 0.0 FUX (IPT,IC,JC) = 0.0 FUY (IPT,IC,JC) = 0.0 FUZ (IPT,IC,JC) = 0.0 FUXX(IPT,IC,JC) = 0.0 FUYY(IPT,IC,JC) = 0.0 FUZZ(IPT,IC,JC) = 0.0 120 CONTINUE FU(IPT,IC,IC) = 1.0 110 CONTINUE 100 CONTINUE RETURN END SUBROUTINE MONITR (T, DT, DTNEW, XL, YF, ZD, DXB, DYB, DZB, + LGRID, ISTRUC, LSOL, SOL) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER LGRID(0:*), ISTRUC(*), LSOL(*) REAL T, DT, DTNEW, XL, YF, ZD, DXB, DYB, DZB, SOL(*) C Ccc PURPOSE: C Control after a successful time step. The solution can be printed, C plotted or compared with the exact solution. C Ccc PARAMETER DESCRIPTION: C T : IN. Current value of time variable C DT : IN. Current time step size C DTNEW : IN. Time step size for next time step C XL : IN. X-coordinate of left/front/down point of (virtual) box C YF : IN. Y-coordinate of left/front/down point of (virtual) box C ZD : IN. Z-coordinate of left/front/down point of (virtual) box C DXB : IN. Cell width in X-direction of base grid C DYB : IN. Cell width in Y-direction of base grid C DZB : IN. Cell width in Z-direction of base grid C LGRID : IN. (0:*) C LGRID(0) = max. grid level used at T C LGRID(1): pointer to base grid structure ISTRUC C LGRID(LEVEL): pointer to grid structure C (LPLN,IPLN,LROW,IROW,ICOL) of refinement C level LEVEL for time T C ISTRUC : IN. (*) C ISTRUC(LGRID(LEVEL):.) contains (LPLN,IPLN,LROW,IROW,ICOL) C of grid level LEVEL, C LPLN : (0:LPLN(0)+1) C LPLN(0) = NPLNS: Actual # planes in LROW C LPLN(1:NPLNS): pointers to the start of a plane in LROW C LPLN(NPLNS+1) = NROWS+1: Total # rows in grid + 1 C IPLN : (NPLNS) C IPLN(IP): plane number of plane IP in virtual box C LROW : (NROWS+1) C LROW(1:NROWS): pointers to the start of a row in the grid C LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 C IROW : (NROWS) C IROW(IR): row number of row IR in virtual box C ICOL : (NPTS) C ICOL(IPT): column number of grid point IPT in virtual box C LSOL : IN. (*) C LSOL(LEVEL): pointer to (injected) solution at grid C of refinement level LEVEL for time T C SOL : IN. (*) C SOL(LSOL(LEVEL)+1:LSOL(LEVEL)+NPTS(LEVEL)*NPDE) contains C U_LEVEL(NPTS,NPDE) C C C Local arrays: INTEGER MAXPTS, NPDE PARAMETER (MAXPTS=75000, NPDE=3) REAL X(MAXPTS), Y(MAXPTS), Z(MAXPTS), UEX(MAXPTS*NPDE) C C----------------------------------------------------------------------- C INTEGER MAXLEV, LEVEL, LLPLN, LIPLN, LLROW, LIROW, LICOL, + NPLNS, NROWS, NPTS REAL DX, DY, DZ C C Loop over the grid levels from coarse to fine. C Get physical coordinates of grid points C Compute ||err||_max MAXLEV = LGRID(0) DX = DXB DY = DYB DZ = DZB DO 10 LEVEL = 1, MAXLEV LLPLN = LGRID(LEVEL) NPLNS = ISTRUC(LLPLN) NROWS = ISTRUC(LLPLN+NPLNS+1)-1 LIPLN = LLPLN+NPLNS+2 LLROW = LIPLN+NPLNS NPTS = ISTRUC(LLROW+NROWS)-1 IF (NPTS .GT. MAXPTS) stop 'MONITR' LIROW = LLROW+NROWS+1 LICOL = LIROW+NROWS CALL SETXYZ (XL, YF, ZD, DX, DY, DZ, + ISTRUC(LLPLN), ISTRUC(LIPLN), + ISTRUC(LLROW), ISTRUC(LIROW), ISTRUC(LICOL), X, Y, Z) DX = DX/2 DY = DY/2 DZ = DZ/2 CALL PRERR (LEVEL, T, NPTS, NPDE, X, Y, Z, SOL(LSOL(LEVEL)+1), + UEX) 10 CONTINUE RETURN END SUBROUTINE PRERR (LEVEL, T, NPTS, NPDE, X, Y, Z, U, UEX) INTEGER LEVEL, NPTS, NPDE REAL T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE), UEX(NPTS,NPDE) INTEGER I,J REAL RMAX(3) CALL PDEIV (T, X, Y, Z, UEX, NPTS, NPDE) DO 1 J = 1, NPDE RMAX(J) = 0.0 DO 10 I = 1, NPTS RMAX(J) = MAX(RMAX(J),ABS(UEX(I,J)-U(I,J))) 10 CONTINUE 1 CONTINUE WRITE(28,'(''Error at T='',E9.3,'', level='',I1,'' :'', + I10,3E12.3)') + T, LEVEL, NPTS, (RMAX(J), J=1, NPDE) RETURN END SUBROUTINE PDEIV (T, X, Y, Z, U, NPTS, NPDE) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE REAL T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE) C Ccc PURPOSE: C Define (initial) solution of PDE. C Ccc PARAMETER DESCRIPTION: C T : IN. Time at which (initial) solution should be given C X,Y,Z : IN. Arrays of physical coordinates for the gridpoints C U : OUT. Array of PDE component values for the gridpoints. C NPTS : IN. Number of gridpoints C NPDE : IN. # PDE components C C----------------------------------------------------------------------- C C INTEGER I REAL EPS PARAMETER (EPS = 5.0E-3) DO 10 I = 1, NPTS U(I,1) = 1-0.5/(1+EXP((-X(I)+Y(I)+Z(I)-0.75*T)/(4*EPS))) U(I,2) = 1.5-U(I,1) U(I,3) = 1.5-U(I,1) 10 CONTINUE RETURN END SUBROUTINE PDEF (T, X, Y, Z, U, + UT, UX, UY, UZ, UXX, UYY, UZZ, UXY, UXZ, UYZ, RES, NPTS, NPDE) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE REAL T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE), + UT(NPTS,NPDE), UX(NPTS,NPDE), UY(NPTS,NPDE), UZ(NPTS,NPDE), + UXX(NPTS,NPDE), UYY(NPTS,NPDE), UZZ(NPTS,NPDE), + UXY(NPTS,NPDE), UXZ(NPTS,NPDE), UYZ(NPTS,NPDE), + RES(NPTS,NPDE) C Ccc PURPOSE: C Define residual of PDE on interior of domain. Boundary values will be C overwritten later on. C Ccc PARAMETER DESCRIPTION: C T : IN. Time at which residual should be evaluated C X,Y,Z : IN. Physical coordinates of gridpoints C U : IN. Array of PDE components for the gridpoints. C UT : IN. Array of time derivative of PDE components C UX : IN. -I C UY : IN. I C UZ : IN. I C UXX : IN. I C UYY : IN. I Space derivatives of U on current grid C UZZ : IN. I C UXY : IN. I C UXZ : IN. I C UYZ : IN. -I C RES : OUT. Array containg PDE residual at gridpoints in interior of C domain. The residual values at boundary points will be C overwritten by a call to PDEBC. C NPTS : IN. Number of gridpoints C NPDE : IN. Number of PDE components C C----------------------------------------------------------------------- C INTEGER I REAL EPS PARAMETER (EPS = 5.0E-3) DO 10 I = 1, NPTS RES(I,1) = UT(I,1) + U(I,1)*UX(I,1) + + U(I,2)*UY(I,1) + U(I,3)*UZ(I,1) - + EPS*(UXX(I,1)+UYY(I,1)+UZZ(I,1)) RES(I,2) = UT(I,2) + U(I,1)*UX(I,2) + + U(I,2)*UY(I,2) + U(I,3)*UZ(I,2) - + EPS*(UXX(I,2)+UYY(I,2)+UZZ(I,2)) RES(I,3) = UT(I,3) + U(I,1)*UX(I,3) + + U(I,2)*UY(I,3) + U(I,3)*UZ(I,3) - + EPS*(UXX(I,3)+UYY(I,3)+UZZ(I,3)) 10 CONTINUE RETURN END SUBROUTINE PDEBC (T, X, Y, Z, U, UT, UX, UY, UZ, RES, NPTS, NPDE, + LLBND, ILBND, LBND) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE, LLBND(0:*), ILBND(*), LBND(*) REAL T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE), + UT(NPTS,NPDE), UX(NPTS,NPDE), UY(NPTS,NPDE), UZ(NPTS,NPDE), + RES(NPTS,NPDE) C Ccc PURPOSE: C Define residual of boundary equations of PDE. The residual on interior C points has already been stored in RES. C Ccc PARAMETER DESCRIPTION: C T : IN. Time at which BC's should be evaluated C X,Y,Z : IN. Physical coordinates of gridpoints C U : IN. Array of PDE components for the gridpoints. C UT : IN. Array of time derivative of PDE components C UX : IN. -I C UY : IN. I Arrays containing space derivatives of PDE components C UZ : IN. -I C RES : INOUT. C IN: PDE residual for interior points (set by PDEF) C OUT: Array with PDE residual at physical boundary points C inserted C NPTS : IN. Number of grid components C NPDE : IN. Number of PDE components C LLBND : IN. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C C----------------------------------------------------------------------- C INTEGER I, J, K, NBNDS REAL EPS, UI PARAMETER (EPS = 5.0E-3) NBNDS = LLBND(0) DO 10 J = 1, NBNDS DO 20 K = LLBND(J), LLBND(J+1)-1 I = LBND(K) UI = 1-0.5/(1+EXP((-X(I)+Y(I)+Z(I)-0.75*T)/(4*EPS))) RES(I,1) = U(I,1) - UI RES(I,2) = U(I,2) - (1.5-UI) RES(I,3) = U(I,3) - (1.5-UI) 20 CONTINUE 10 CONTINUE RETURN END SHAR_EOF fi # end of overwriting check if test -f 'probia.f' then echo shar: will not over-write existing file "'probia.f'" else cat << \SHAR_EOF > 'probia.f' PROGRAM EXIA C INTEGER MXLEV, NPD, NPTS, LENIWK, LENRWK, LENLWK PARAMETER (MXLEV=2, NPD=1, NPTS=170000) PARAMETER (LENIWK=NPTS*(7*MXLEV+25), + LENRWK=NPTS*NPD*(5*MXLEV+38*NPD+13), + LENLWK=2*NPTS) C C----------------------------------------------------------------------- C INTEGER LUNDMP PARAMETER (LUNDMP = 89) C INTEGER NPDE, INFO(7), IWK(LENIWK), MNTR LOGICAL LWK(LENLWK) REAL T, TOUT, DT, XL, YF, ZD, XR, YB, ZU, DX, DY, DZ, + TOLS, TOLT, RINFO(2+3*NPD), RWK(LENRWK) C First call of VLUGR3 MNTR = 0 NPDE = 1 T = 0.0 TOUT = 1.0 DT = 0.001 XL = 0.0 YF = 0.0 ZD = 0.0 XR = 1.0 YB = 1.0 ZU = 1.0 DX = 0.1 DY = 0.1 DZ = 0.1 TOLS = 0.1 TOLT = 0.1 INFO(1) = 1 C MAXLEV INFO(2) = 4 C Domain a rectangular prism INFO(3) = 0 C Linear system solver print *, 'Lin.sys.solver BiCGStab or GCRO (0 / 10,11,12,13) ?' read *, INFO(4) OPEN (UNIT=61,FILE='RunInfo') C Write integration history to unit # 61 INFO(5) = 61 C Write Newton info to unit # 61 INFO(6) = 61 C Write linear solver info to unit # 61 INFO(7) = 61 C DTMIN = 1E-7 RINFO(1) = 1.0E-7 C DTMAX = 1.0 RINFO(2) = 1.0 C UMAX = 1.0 RINFO(3) = 1.0 C SPCWGT = 1.0 RINFO(4) = 1.0 C TIMWGT = 1.0 RINFO(5) = 1.0 C C Call main routine CALL VLUGR3 (NPDE, T, TOUT, DT, XL,YF,ZD, XR,YB,ZU, DX, DY, DZ, + TOLS, TOLT, INFO, RINFO, RWK, LENRWK, IWK, LENIWK, LWK, LENLWK, + MNTR) PRINT *, 'VLUGR3 returned with MNTR=', MNTR C C Save info on file OPEN(UNIT=LUNDMP,FILE='DUMP',FORM='UNFORMATTED') CALL DUMP (LUNDMP, RWK, IWK) CLOSE(LUNDMP) END SUBROUTINE MONITR (T, DT, DTNEW, XL, YF, ZD, DXB, DYB, DZB, + LGRID, ISTRUC, LSOL, SOL) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER LGRID(0:*), ISTRUC(*), LSOL(*) REAL T, DT, DTNEW, XL, YF, ZD, DXB, DYB, DZB, SOL(*) C Ccc PURPOSE: C Control after a successful time step. The solution can be printed, C plotted or compared with the exact solution. C Ccc PARAMETER DESCRIPTION: C T : IN. Current value of time variable C DT : IN. Current time step size C DTNEW : IN. Time step size for next time step C XL : IN. X-coordinate of left/front/down point of (virtual) box C YF : IN. Y-coordinate of left/front/down point of (virtual) box C ZD : IN. Z-coordinate of left/front/down point of (virtual) box C DXB : IN. Cell width in X-direction of base grid C DYB : IN. Cell width in Y-direction of base grid C DZB : IN. Cell width in Z-direction of base grid C LGRID : IN. (0:*) C LGRID(0) = max. grid level used at T C LGRID(1): pointer to base grid structure ISTRUC C LGRID(LEVEL): pointer to grid structure C (LPLN,IPLN,LROW,IROW,ICOL) of refinement C level LEVEL for time T C ISTRUC : IN. (*) C ISTRUC(LGRID(LEVEL):.) contains (LPLN,IPLN,LROW,IROW,ICOL) C of grid level LEVEL, C LPLN : (0:LPLN(0)+1) C LPLN(0) = NPLNS: Actual # planes in LROW C LPLN(1:NPLNS): pointers to the start of a plane in LROW C LPLN(NPLNS+1) = NROWS+1: Total # rows in grid + 1 C IPLN : (NPLNS) C IPLN(IP): plane number of plane IP in virtual box C LROW : (NROWS+1) C LROW(1:NROWS): pointers to the start of a row in the grid C LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 C IROW : (NROWS) C IROW(IR): row number of row IR in virtual box C ICOL : (NPTS) C ICOL(IPT): column number of grid point IPT in virtual box C LSOL : IN. (*) C LSOL(LEVEL): pointer to (injected) solution at grid C of refinement level LEVEL for time T C SOL : IN. (*) C SOL(LSOL(LEVEL)+1:LSOL(LEVEL)+NPTS(LEVEL)*NPDE) contains C U_LEVEL(NPTS,NPDE) C C C Local arrays: INTEGER MAXPTS, NPDE PARAMETER (MAXPTS=250000, NPDE=1) REAL X(MAXPTS), Y(MAXPTS), Z(MAXPTS), UEX(MAXPTS*NPDE) C C----------------------------------------------------------------------- C INTEGER MAXLEV, LEVEL, LLPLN, LIPLN, LLROW, LIROW, LICOL, + NPLNS, NROWS, NPTS REAL DX, DY, DZ C C Loop over the grid levels from coarse to fine. C Get physical coordinates of grid points C Compute ||err||_max MAXLEV = LGRID(0) DX = DXB DY = DYB DZ = DZB DO 10 LEVEL = 1, MAXLEV LLPLN = LGRID(LEVEL) NPLNS = ISTRUC(LLPLN) NROWS = ISTRUC(LLPLN+NPLNS+1)-1 LIPLN = LLPLN+NPLNS+2 LLROW = LIPLN+NPLNS NPTS = ISTRUC(LLROW+NROWS)-1 IF (NPTS .GT. MAXPTS) stop 'MONITR' LIROW = LLROW+NROWS+1 LICOL = LIROW+NROWS CALL SETXYZ (XL, YF, ZD, DX, DY, DZ, + ISTRUC(LLPLN), ISTRUC(LIPLN), + ISTRUC(LLROW), ISTRUC(LIROW), ISTRUC(LICOL), X, Y, Z) DX = DX/2 DY = DY/2 DZ = DZ/2 CALL PRERR (LEVEL, T, NPTS, NPDE, X, Y, Z, SOL(LSOL(LEVEL)+1), + UEX) 10 CONTINUE RETURN END SUBROUTINE PRERR (LEVEL, T, NPTS, NPDE, X, Y, Z, U, UEX) INTEGER LEVEL, NPTS, NPDE REAL T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE), UEX(NPTS,NPDE) INTEGER I,J REAL RMAX CALL PDEIV (T, X, Y, Z, UEX, NPTS, NPDE) RMAX = 0.0 J = 1 DO 10 I = 1, NPTS RMAX = MAX(RMAX,ABS(UEX(I,J)-U(I,J))) 10 CONTINUE WRITE(28,'(''Error at T='',E9.3,'', level='',I1,'' :'',E9.3,I10)') + T, LEVEL, RMAX, NPTS RETURN END SUBROUTINE PDEIV (T, X, Y, Z, U, NPTS, NPDE) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE REAL T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE) C Ccc PURPOSE: C Define (initial) solution of PDE. C Ccc PARAMETER DESCRIPTION: C T : IN. Time at which (initial) solution should be given C X,Y,Z : IN. Arrays of physical coordinates for the gridpoints C U : OUT. Array of PDE component values for the gridpoints. C NPTS : IN. Number of gridpoints C NPDE : IN. # PDE components C C----------------------------------------------------------------------- C INTEGER I REAL EPS PARAMETER (EPS = 2.0E-3) DO 10 I = 1, NPTS U(I,1) = 1-0.5/(1+EXP((-X(I)+Y(I)+Z(I)-0.75*T)/(4*EPS))) 10 CONTINUE RETURN END SUBROUTINE PDEF (T, X, Y, Z, U, + UT, UX, UY, UZ, UXX, UYY, UZZ, UXY, UXZ, UYZ, RES, NPTS, NPDE) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE REAL T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE), + UT(NPTS,NPDE), UX(NPTS,NPDE), UY(NPTS,NPDE), UZ(NPTS,NPDE), + UXX(NPTS,NPDE), UYY(NPTS,NPDE), UZZ(NPTS,NPDE), + UXY(NPTS,NPDE), UXZ(NPTS,NPDE), UYZ(NPTS,NPDE), + RES(NPTS,NPDE) C Ccc PURPOSE: C Define residual of PDE on interior of domain. Boundary values will be C overwritten later on. C Ccc PARAMETER DESCRIPTION: C T : IN. Time at which residual should be evaluated C X,Y,Z : IN. Physical coordinates of gridpoints C U : IN. Array of PDE components for the gridpoints. C UT : IN. Array of time derivative of PDE components C UX : IN. -I C UY : IN. I C UZ : IN. I C UXX : IN. I C UYY : IN. I Space derivatives of U on current grid C UZZ : IN. I C UXY : IN. I C UXZ : IN. I C UYZ : IN. -I C RES : OUT. Array containg PDE residual at gridpoints in interior of C domain. The residual values at boundary points will be C overwritten by a call to PDEBC. C NPTS : IN. Number of gridpoints C NPDE : IN. Number of PDE components C C----------------------------------------------------------------------- C INTEGER I REAL EPS PARAMETER (EPS = 2.0E-3) DO 10 I = 1, NPTS RES(I,1) = UT(I,1) + U(I,1)*UX(I,1) + + (1.5-U(I,1))*(UY(I,1)+UZ(I,1)) - + EPS*(UXX(I,1)+UYY(I,1)+UZZ(I,1)) 10 CONTINUE RETURN END SUBROUTINE PDEBC (T, X, Y, Z, U, UT, UX, UY, UZ, RES, NPTS, NPDE, + LLBND, ILBND, LBND) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE, LLBND(0:*), ILBND(*), LBND(*) REAL T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE), + UT(NPTS,NPDE), UX(NPTS,NPDE), UY(NPTS,NPDE), UZ(NPTS,NPDE), + RES(NPTS,NPDE) C Ccc PURPOSE: C Define residual of boundary equations of PDE. The residual on interior C points has already been stored in RES. C Ccc PARAMETER DESCRIPTION: C T : IN. Time at which BC's should be evaluated C X,Y,Z : IN. Physical coordinates of gridpoints C U : IN. Array of PDE components for the gridpoints. C UT : IN. Array of time derivative of PDE components C UX : IN. -I C UY : IN. I Arrays containing space derivatives of PDE components C UZ : IN. -I C RES : INOUT. C IN: PDE residual for interior points (set by PDEF) C OUT: Array with PDE residual at physical boundary points C inserted C NPTS : IN. Number of grid components C NPDE : IN. Number of PDE components C LLBND : IN. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C C----------------------------------------------------------------------- C INTEGER I, J, K, NBNDS REAL EPS, UI PARAMETER (EPS = 2.0E-3) NBNDS = LLBND(0) DO 10 J = 1, NBNDS DO 20 K = LLBND(J), LLBND(J+1)-1 I = LBND(K) UI = 1-0.5/(1+EXP((-X(I)+Y(I)+Z(I)-0.75*T)/(4*EPS))) RES(I,1) = U(I,1) - UI 20 CONTINUE 10 CONTINUE RETURN END SHAR_EOF fi # end of overwriting check if test -f 'probib.f' then echo shar: will not over-write existing file "'probib.f'" else cat << \SHAR_EOF > 'probib.f' PROGRAM EXIB C C PARAMETER (NRRMAX = 1, MAXLR = 3, MAXL = 15) INTEGER MXLEV, NPD, NPTS, LENIWK, LENRWK, LENLWK PARAMETER (MXLEV=1, NPD=3, NPTS=190000) PARAMETER (LENIWK=NPTS*(9*MXLEV+24), + LENRWK=NPTS*NPD*(5*MXLEV+26+13), + LENLWK=2*NPTS) C C----------------------------------------------------------------------- C INTEGER LUNDMP PARAMETER (LUNDMP = 89) C INTEGER NPDE, INFO(7), IWK(LENIWK), MNTR LOGICAL LWK(LENLWK) REAL T, TOUT, DT, XL, YF, ZD, XR, YB, ZU, DX, DY, DZ, + TOLS, TOLT, RINFO(2+3*NPD), RWK(LENRWK) C First call of VLUGR3 MNTR = 0 NPDE = 3 T = 0.0 TOUT = 1.0 DT = 0.001 XL = 0.0 YF = 0.0 ZD = 0.0 XR = 1.0 YB = 1.0 ZU = 1.0 DX = 0.1 DY = 0.1 DZ = 0.1 TOLS = 0.1 TOLT = 0.1 INFO(1) = 1 C MAXLEV INFO(2) = 4 C Domain a rectangular prism INFO(3) = 0 C Linear system solver print *, 'Lin.sys.solver BiCGStab or GCRO (0 / 10,11,12,13) ?' read *, INFO(4) OPEN (UNIT=61,FILE='RunInfo') C Write integration history to unit # 61 INFO(5) = 61 C Write Newton info to unit # 61 INFO(6) = 61 C Write linear solver info to unit # 61 INFO(7) = 61 C DTMIN = 1E-7 RINFO(1) = 1.0E-7 C DTMAX = 1.0 RINFO(2) = 1.0 C UMAX = 1.0 RINFO(3) = 1.0 RINFO(4) = 1.0 RINFO(5) = 1.0 C SPCWGT = 1.0 RINFO(6) = 1.0 RINFO(7) = 1.0 RINFO(8) = 1.0 C TIMWGT = 1.0 RINFO(9) = 1.0 RINFO(10) = 1.0 RINFO(11) = 1.0 C C Call main routine CALL VLUGR3 (NPDE, T, TOUT, DT, XL,YF,ZD, XR,YB,ZU, DX, DY, DZ, + TOLS, TOLT, INFO, RINFO, RWK, LENRWK, IWK, LENIWK, LWK, LENLWK, + MNTR) PRINT *, 'VLUGR3 returned with MNTR=', MNTR C C Save info on file OPEN(UNIT=LUNDMP,FILE='DUMP',FORM='UNFORMATTED') CALL DUMP (LUNDMP, RWK, IWK) CLOSE(LUNDMP) END SUBROUTINE MONITR (T, DT, DTNEW, XL, YF, ZD, DXB, DYB, DZB, + LGRID, ISTRUC, LSOL, SOL) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER LGRID(0:*), ISTRUC(*), LSOL(*) REAL T, DT, DTNEW, XL, YF, ZD, DXB, DYB, DZB, SOL(*) C Ccc PURPOSE: C Control after a successful time step. The solution can be printed, C plotted or compared with the exact solution. C Ccc PARAMETER DESCRIPTION: C T : IN. Current value of time variable C DT : IN. Current time step size C DTNEW : IN. Time step size for next time step C XL : IN. X-coordinate of left/front/down point of (virtual) box C YF : IN. Y-coordinate of left/front/down point of (virtual) box C ZD : IN. Z-coordinate of left/front/down point of (virtual) box C DXB : IN. Cell width in X-direction of base grid C DYB : IN. Cell width in Y-direction of base grid C DZB : IN. Cell width in Z-direction of base grid C LGRID : IN. (0:*) C LGRID(0) = max. grid level used at T C LGRID(1): pointer to base grid structure ISTRUC C LGRID(LEVEL): pointer to grid structure C (LPLN,IPLN,LROW,IROW,ICOL) of refinement C level LEVEL for time T C ISTRUC : IN. (*) C ISTRUC(LGRID(LEVEL):.) contains (LPLN,IPLN,LROW,IROW,ICOL) C of grid level LEVEL, C LPLN : (0:LPLN(0)+1) C LPLN(0) = NPLNS: Actual # planes in LROW C LPLN(1:NPLNS): pointers to the start of a plane in LROW C LPLN(NPLNS+1) = NROWS+1: Total # rows in grid + 1 C IPLN : (NPLNS) C IPLN(IP): plane number of plane IP in virtual box C LROW : (NROWS+1) C LROW(1:NROWS): pointers to the start of a row in the grid C LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 C IROW : (NROWS) C IROW(IR): row number of row IR in virtual box C ICOL : (NPTS) C ICOL(IPT): column number of grid point IPT in virtual box C LSOL : IN. (*) C LSOL(LEVEL): pointer to (injected) solution at grid C of refinement level LEVEL for time T C SOL : IN. (*) C SOL(LSOL(LEVEL)+1:LSOL(LEVEL)+NPTS(LEVEL)*NPDE) contains C U_LEVEL(NPTS,NPDE) C C C Local arrays: INTEGER MAXPTS, NPDE PARAMETER (MAXPTS=170000, NPDE=3) REAL X(MAXPTS), Y(MAXPTS), Z(MAXPTS), UEX(MAXPTS*NPDE) C C----------------------------------------------------------------------- C INTEGER MAXLEV, LEVEL, LLPLN, LIPLN, LLROW, LIROW, LICOL, + NPLNS, NROWS, NPTS REAL DX, DY, DZ C C Loop over the grid levels from coarse to fine. C Get physical coordinates of grid points C Compute ||err||_max MAXLEV = LGRID(0) DX = DXB DY = DYB DZ = DZB DO 10 LEVEL = 1, MAXLEV LLPLN = LGRID(LEVEL) NPLNS = ISTRUC(LLPLN) NROWS = ISTRUC(LLPLN+NPLNS+1)-1 LIPLN = LLPLN+NPLNS+2 LLROW = LIPLN+NPLNS NPTS = ISTRUC(LLROW+NROWS)-1 IF (NPTS .GT. MAXPTS) stop 'MONITR' LIROW = LLROW+NROWS+1 LICOL = LIROW+NROWS CALL SETXYZ (XL, YF, ZD, DX, DY, DZ, + ISTRUC(LLPLN), ISTRUC(LIPLN), + ISTRUC(LLROW), ISTRUC(LIROW), ISTRUC(LICOL), X, Y, Z) DX = DX/2 DY = DY/2 DZ = DZ/2 CALL PRERR (LEVEL, T, NPTS, NPDE, X, Y, Z, SOL(LSOL(LEVEL)+1), + UEX) 10 CONTINUE RETURN END SUBROUTINE PRERR (LEVEL, T, NPTS, NPDE, X, Y, Z, U, UEX) INTEGER LEVEL, NPTS, NPDE REAL T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE), UEX(NPTS,NPDE) INTEGER I,J REAL RMAX(3) CALL PDEIV (T, X, Y, Z, UEX, NPTS, NPDE) DO 1 J = 1, NPDE RMAX(J) = 0.0 DO 10 I = 1, NPTS RMAX(J) = MAX(RMAX(J),ABS(UEX(I,J)-U(I,J))) 10 CONTINUE 1 CONTINUE WRITE(28,'(''Error at T='',E9.3,'', level='',I1,'' :'', + I10,3E10.3)') T, LEVEL, NPTS, (RMAX(J), J=1, NPDE) RETURN END SUBROUTINE PDEIV (T, X, Y, Z, U, NPTS, NPDE) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE REAL T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE) C Ccc PURPOSE: C Define (initial) solution of PDE. C Ccc PARAMETER DESCRIPTION: C T : IN. Time at which (initial) solution should be given C X,Y,Z : IN. Arrays of physical coordinates for the gridpoints C U : OUT. Array of PDE component values for the gridpoints. C NPTS : IN. Number of gridpoints C NPDE : IN. # PDE components C C----------------------------------------------------------------------- C C INTEGER I REAL EPS PARAMETER (EPS = 2.0E-3) DO 10 I = 1, NPTS U(I,1) = 1-0.5/(1+EXP((-X(I)+Y(I)+Z(I)-0.75*T)/(4*EPS))) U(I,2) = 1.5-U(I,1) U(I,3) = 1.5-U(I,1) 10 CONTINUE RETURN END SUBROUTINE PDEF (T, X, Y, Z, U, + UT, UX, UY, UZ, UXX, UYY, UZZ, UXY, UXZ, UYZ, RES, NPTS, NPDE) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE REAL T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE), + UT(NPTS,NPDE), UX(NPTS,NPDE), UY(NPTS,NPDE), UZ(NPTS,NPDE), + UXX(NPTS,NPDE), UYY(NPTS,NPDE), UZZ(NPTS,NPDE), + UXY(NPTS,NPDE), UXZ(NPTS,NPDE), UYZ(NPTS,NPDE), + RES(NPTS,NPDE) C Ccc PURPOSE: C Define residual of PDE on interior of domain. Boundary values will be C overwritten later on. C Ccc PARAMETER DESCRIPTION: C T : IN. Time at which residual should be evaluated C X,Y,Z : IN. Physical coordinates of gridpoints C U : IN. Array of PDE components for the gridpoints. C UT : IN. Array of time derivative of PDE components C UX : IN. -I C UY : IN. I C UZ : IN. I C UXX : IN. I C UYY : IN. I Space derivatives of U on current grid C UZZ : IN. I C UXY : IN. I C UXZ : IN. I C UYZ : IN. -I C RES : OUT. Array containg PDE residual at gridpoints in interior of C domain. The residual values at boundary points will be C overwritten by a call to PDEBC. C NPTS : IN. Number of gridpoints C NPDE : IN. Number of PDE components C C----------------------------------------------------------------------- C INTEGER I REAL EPS PARAMETER (EPS = 2.0E-3) DO 10 I = 1, NPTS RES(I,1) = UT(I,1) + U(I,1)*UX(I,1) + + U(I,2)*UY(I,1) + U(I,3)*UZ(I,1) - + EPS*(UXX(I,1)+UYY(I,1)+UZZ(I,1)) RES(I,2) = UT(I,2) + U(I,1)*UX(I,2) + + U(I,2)*UY(I,2) + U(I,3)*UZ(I,2) - + EPS*(UXX(I,2)+UYY(I,2)+UZZ(I,2)) RES(I,3) = UT(I,3) + U(I,1)*UX(I,3) + + U(I,2)*UY(I,3) + U(I,3)*UZ(I,3) - + EPS*(UXX(I,3)+UYY(I,3)+UZZ(I,3)) 10 CONTINUE RETURN END SUBROUTINE PDEBC (T, X, Y, Z, U, UT, UX, UY, UZ, RES, NPTS, NPDE, + LLBND, ILBND, LBND) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE, LLBND(0:*), ILBND(*), LBND(*) REAL T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE), + UT(NPTS,NPDE), UX(NPTS,NPDE), UY(NPTS,NPDE), UZ(NPTS,NPDE), + RES(NPTS,NPDE) C Ccc PURPOSE: C Define residual of boundary equations of PDE. The residual on interior C points has already been stored in RES. C Ccc PARAMETER DESCRIPTION: C T : IN. Time at which BC's should be evaluated C X,Y,Z : IN. Physical coordinates of gridpoints C U : IN. Array of PDE components for the gridpoints. C UT : IN. Array of time derivative of PDE components C UX : IN. -I C UY : IN. I Arrays containing space derivatives of PDE components C UZ : IN. -I C RES : INOUT. C IN: PDE residual for interior points (set by PDEF) C OUT: Array with PDE residual at physical boundary points C inserted C NPTS : IN. Number of grid components C NPDE : IN. Number of PDE components C LLBND : IN. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C C----------------------------------------------------------------------- C INTEGER I, J, K, NBNDS REAL EPS, UI PARAMETER (EPS = 2.0E-3) NBNDS = LLBND(0) DO 10 J = 1, NBNDS DO 20 K = LLBND(J), LLBND(J+1)-1 I = LBND(K) UI = 1-0.5/(1+EXP((-X(I)+Y(I)+Z(I)-0.75*T)/(4*EPS))) RES(I,1) = U(I,1) - UI RES(I,2) = U(I,2) - (1.5-UI) RES(I,3) = U(I,3) - (1.5-UI) 20 CONTINUE 10 CONTINUE RETURN END SHAR_EOF fi # end of overwriting check if test -f 'probic.f' then echo shar: will not over-write existing file "'probic.f'" else cat << \SHAR_EOF > 'probic.f' PROGRAM EXIC C INTEGER MXLEV, NPD, NPTS, LENIWK, LENRWK, LENLWK PARAMETER (MXLEV=2, NPD=3, NPTS=40000) PARAMETER (LENIWK=NPTS*(7*MXLEV+25), + LENRWK=NPTS*NPD*(5*MXLEV+38*NPD+13), + LENLWK=2*NPTS) C C----------------------------------------------------------------------- C INTEGER LUNDMP PARAMETER (LUNDMP = 89) C INTEGER NPDE, INFO(7), IWK(LENIWK), MNTR LOGICAL LWK(LENLWK) REAL T, TOUT, DT, XL, YF, ZD, XR, YB, ZU, DX, DY, DZ, + TOLS, TOLT, RINFO(2+3*NPD), RWK(LENRWK) C First call of VLUGR3 MNTR = 0 NPDE = 3 T = 0.0 TOUT = 1.0 DT = 0.001 XL = 0.0 YF = 0.0 ZD = 0.0 XR = 1.0 YB = 1.0 ZU = 1.0 DX = 0.1 DY = 0.1 DZ = 0.1 TOLS = 0.1 TOLT = 0.1 INFO(1) = 1 C MAXLEV INFO(2) = 3 C Domain a rectangular prism INFO(3) = 0 C Linear system solver print *, 'Lin.sys.solver BiCGStab or GCRO (0 / 10,11,12,13) ?' read *, INFO(4) OPEN (UNIT=61,FILE='RunInfo') C Write integration history to unit # 61 INFO(5) = 61 C Write Newton info to unit # 61 INFO(6) = 61 C Write linear solver info to unit # 61 INFO(7) = 61 C DTMIN = 1E-7 RINFO(1) = 1.0E-7 C DTMAX = 1.0 RINFO(2) = 1.0 C UMAX = 1.0 RINFO(3) = 1.0 RINFO(4) = 1.0 RINFO(5) = 1.0 C SPCWGT = 1.0 RINFO(6) = 1.0 RINFO(7) = 1.0 RINFO(8) = 1.0 C TIMWGT = 1.0 RINFO(9) = 1.0 RINFO(10) = 1.0 RINFO(11) = 1.0 C C Call main routine CALL VLUGR3 (NPDE, T, TOUT, DT, XL,YF,ZD, XR,YB,ZU, DX, DY, DZ, + TOLS, TOLT, INFO, RINFO, RWK, LENRWK, IWK, LENIWK, LWK, LENLWK, + MNTR) PRINT *, 'VLUGR3 returned with MNTR=', MNTR C C Save info on file OPEN(UNIT=LUNDMP,FILE='DUMP',FORM='UNFORMATTED') CALL DUMP (LUNDMP, RWK, IWK) CLOSE(LUNDMP) END SUBROUTINE MONITR (T, DT, DTNEW, XL, YF, ZD, DXB, DYB, DZB, + LGRID, ISTRUC, LSOL, SOL) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER LGRID(0:*), ISTRUC(*), LSOL(*) REAL T, DT, DTNEW, XL, YF, ZD, DXB, DYB, DZB, SOL(*) C Ccc PURPOSE: C Control after a successful time step. The solution can be printed, C plotted or compared with the exact solution. C Ccc PARAMETER DESCRIPTION: C T : IN. Current value of time variable C DT : IN. Current time step size C DTNEW : IN. Time step size for next time step C XL : IN. X-coordinate of left/front/down point of (virtual) box C YF : IN. Y-coordinate of left/front/down point of (virtual) box C ZD : IN. Z-coordinate of left/front/down point of (virtual) box C DXB : IN. Cell width in X-direction of base grid C DYB : IN. Cell width in Y-direction of base grid C DZB : IN. Cell width in Z-direction of base grid C LGRID : IN. (0:*) C LGRID(0) = max. grid level used at T C LGRID(1): pointer to base grid structure ISTRUC C LGRID(LEVEL): pointer to grid structure C (LPLN,IPLN,LROW,IROW,ICOL) of refinement C level LEVEL for time T C ISTRUC : IN. (*) C ISTRUC(LGRID(LEVEL):.) contains (LPLN,IPLN,LROW,IROW,ICOL) C of grid level LEVEL, C LPLN : (0:LPLN(0)+1) C LPLN(0) = NPLNS: Actual # planes in LROW C LPLN(1:NPLNS): pointers to the start of a plane in LROW C LPLN(NPLNS+1) = NROWS+1: Total # rows in grid + 1 C IPLN : (NPLNS) C IPLN(IP): plane number of plane IP in virtual box C LROW : (NROWS+1) C LROW(1:NROWS): pointers to the start of a row in the grid C LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 C IROW : (NROWS) C IROW(IR): row number of row IR in virtual box C ICOL : (NPTS) C ICOL(IPT): column number of grid point IPT in virtual box C LSOL : IN. (*) C LSOL(LEVEL): pointer to (injected) solution at grid C of refinement level LEVEL for time T C SOL : IN. (*) C SOL(LSOL(LEVEL)+1:LSOL(LEVEL)+NPTS(LEVEL)*NPDE) contains C U_LEVEL(NPTS,NPDE) C C C Local arrays: INTEGER MAXPTS, NPDE PARAMETER (MAXPTS=250000, NPDE=1) REAL X(MAXPTS), Y(MAXPTS), Z(MAXPTS), UEX(MAXPTS*NPDE) C C----------------------------------------------------------------------- C INTEGER MAXLEV, LEVEL, LLPLN, LIPLN, LLROW, LIROW, LICOL, + NPLNS, NROWS, NPTS REAL DX, DY, DZ C C Loop over the grid levels from coarse to fine. C Get physical coordinates of grid points C Compute ||err||_max MAXLEV = LGRID(0) DX = DXB DY = DYB DZ = DZB DO 10 LEVEL = 1, MAXLEV LLPLN = LGRID(LEVEL) NPLNS = ISTRUC(LLPLN) NROWS = ISTRUC(LLPLN+NPLNS+1)-1 LIPLN = LLPLN+NPLNS+2 LLROW = LIPLN+NPLNS NPTS = ISTRUC(LLROW+NROWS)-1 IF (NPTS .GT. MAXPTS) stop 'MONITR' LIROW = LLROW+NROWS+1 LICOL = LIROW+NROWS CALL SETXYZ (XL, YF, ZD, DX, DY, DZ, + ISTRUC(LLPLN), ISTRUC(LIPLN), + ISTRUC(LLROW), ISTRUC(LIROW), ISTRUC(LICOL), X, Y, Z) DX = DX/2 DY = DY/2 DZ = DZ/2 CALL PRERR (LEVEL, T, NPTS, NPDE, X, Y, Z, SOL(LSOL(LEVEL)+1), + UEX) 10 CONTINUE RETURN END SUBROUTINE PRERR (LEVEL, T, NPTS, NPDE, X, Y, Z, U, UEX) INTEGER LEVEL, NPTS, NPDE REAL T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE), UEX(NPTS,NPDE) INTEGER I,J REAL RMAX(3) CALL PDEIV (T, X, Y, Z, UEX, NPTS, NPDE) DO 1 J = 1, NPDE RMAX(J) = 0.0 DO 10 I = 1, NPTS RMAX(J) = MAX(RMAX(J),ABS(UEX(I,J)-U(I,J))) 10 CONTINUE 1 CONTINUE WRITE(28,'(''Error at T='',E9.3,'', level='',I1,'' :'', + I10,3E10.3)') T, LEVEL, NPTS, (RMAX(J), J=1, NPDE) RETURN END SUBROUTINE PDEIV (T, X, Y, Z, U, NPTS, NPDE) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE REAL T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE) C Ccc PURPOSE: C Define (initial) solution of PDE. C Ccc PARAMETER DESCRIPTION: C T : IN. Time at which (initial) solution should be given C X,Y,Z : IN. Arrays of physical coordinates for the gridpoints C U : OUT. Array of PDE component values for the gridpoints. C NPTS : IN. Number of gridpoints C NPDE : IN. # PDE components C C----------------------------------------------------------------------- C C INTEGER I REAL EPS PARAMETER (EPS = 5.0E-3) DO 10 I = 1, NPTS U(I,1) = 1-0.5/(1+EXP((-X(I)+Y(I)+Z(I)-0.75*T)/(4*EPS))) U(I,2) = 1.5-U(I,1) U(I,3) = 1.5-U(I,1) 10 CONTINUE RETURN END SUBROUTINE PDEF (T, X, Y, Z, U, + UT, UX, UY, UZ, UXX, UYY, UZZ, UXY, UXZ, UYZ, RES, NPTS, NPDE) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE REAL T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE), + UT(NPTS,NPDE), UX(NPTS,NPDE), UY(NPTS,NPDE), UZ(NPTS,NPDE), + UXX(NPTS,NPDE), UYY(NPTS,NPDE), UZZ(NPTS,NPDE), + UXY(NPTS,NPDE), UXZ(NPTS,NPDE), UYZ(NPTS,NPDE), + RES(NPTS,NPDE) C Ccc PURPOSE: C Define residual of PDE on interior of domain. Boundary values will be C overwritten later on. C Ccc PARAMETER DESCRIPTION: C T : IN. Time at which residual should be evaluated C X,Y,Z : IN. Physical coordinates of gridpoints C U : IN. Array of PDE components for the gridpoints. C UT : IN. Array of time derivative of PDE components C UX : IN. -I C UY : IN. I C UZ : IN. I C UXX : IN. I C UYY : IN. I Space derivatives of U on current grid C UZZ : IN. I C UXY : IN. I C UXZ : IN. I C UYZ : IN. -I C RES : OUT. Array containg PDE residual at gridpoints in interior of C domain. The residual values at boundary points will be C overwritten by a call to PDEBC. C NPTS : IN. Number of gridpoints C NPDE : IN. Number of PDE components C C----------------------------------------------------------------------- C INTEGER I REAL EPS PARAMETER (EPS = 5.0E-3) DO 10 I = 1, NPTS RES(I,1) = UT(I,1) + U(I,1)*UX(I,1) + + U(I,2)*UY(I,1) + U(I,3)*UZ(I,1) - + EPS*(UXX(I,1)+UYY(I,1)+UZZ(I,1)) RES(I,2) = UT(I,2) + U(I,1)*UX(I,2) + + U(I,2)*UY(I,2) + U(I,3)*UZ(I,2) - + EPS*(UXX(I,2)+UYY(I,2)+UZZ(I,2)) RES(I,3) = UT(I,3) + U(I,1)*UX(I,3) + + U(I,2)*UY(I,3) + U(I,3)*UZ(I,3) - + EPS*(UXX(I,3)+UYY(I,3)+UZZ(I,3)) 10 CONTINUE RETURN END SUBROUTINE PDEBC (T, X, Y, Z, U, UT, UX, UY, UZ, RES, NPTS, NPDE, + LLBND, ILBND, LBND) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE, LLBND(0:*), ILBND(*), LBND(*) REAL T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE), + UT(NPTS,NPDE), UX(NPTS,NPDE), UY(NPTS,NPDE), UZ(NPTS,NPDE), + RES(NPTS,NPDE) C Ccc PURPOSE: C Define residual of boundary equations of PDE. The residual on interior C points has already been stored in RES. C Ccc PARAMETER DESCRIPTION: C T : IN. Time at which BC's should be evaluated C X,Y,Z : IN. Physical coordinates of gridpoints C U : IN. Array of PDE components for the gridpoints. C UT : IN. Array of time derivative of PDE components C UX : IN. -I C UY : IN. I Arrays containing space derivatives of PDE components C UZ : IN. -I C RES : INOUT. C IN: PDE residual for interior points (set by PDEF) C OUT: Array with PDE residual at physical boundary points C inserted C NPTS : IN. Number of grid components C NPDE : IN. Number of PDE components C LLBND : IN. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C C----------------------------------------------------------------------- C INTEGER I, J, K, NBNDS REAL EPS, UI PARAMETER (EPS = 5.0E-3) NBNDS = LLBND(0) DO 10 J = 1, NBNDS DO 20 K = LLBND(J), LLBND(J+1)-1 I = LBND(K) UI = 1-0.5/(1+EXP((-X(I)+Y(I)+Z(I)-0.75*T)/(4*EPS))) RES(I,1) = U(I,1) - UI RES(I,2) = U(I,2) - (1.5-UI) RES(I,3) = U(I,3) - (1.5-UI) 20 CONTINUE 10 CONTINUE RETURN END SHAR_EOF fi # end of overwriting check if test -f 'probii.f' then echo shar: will not over-write existing file "'probii.f'" else cat << \SHAR_EOF > 'probii.f' PROGRAM EXII C INTEGER MXLEV, NPD, NPTS, LENIWK, LENRWK, LENLWK PARAMETER (MXLEV=2, NPD=2, NPTS=70000) C PARAMETER (LENIWK=NPTS*(7*MXLEV+43), C + LENRWK=NPTS*NPD*(5*MXLEV+38*NPD+13), PARAMETER (LENIWK=NPTS*(7*MXLEV+24), + LENRWK=NPTS*NPD*(5*MXLEV+37+21), + LENLWK=2*NPTS) C C----------------------------------------------------------------------- C INTEGER LUNDMP PARAMETER (LUNDMP = 89) C CHARACTER*2 NR INTEGER I, NPDE, INFO(7), IWK(LENIWK), MNTR LOGICAL LWK(LENLWK) REAL T, TOUT, TE, DT, XL, YF, ZD, XR, YB, ZU, DX, DY, DZ, + TOLS, TOLT, RINFO(2+3*NPD), RWK(LENRWK) C First call of VLUGR3 MNTR = 0 NPDE = 2 T = 0.0 TOUT = 1.0 DT = 1E-5 XL = 0.0 YF = 0.0 ZD = 0.0 XR = 1.0 YB = 1.0 ZU = 1.0 DX = 0.1 DY = 0.1 DZ = 0.1 TOLS = 0.1 TOLT = 0.1 INFO(1) = 1 C MAXLEV INFO(2) = 4 C Domain a rectangular prism INFO(3) = 0 C Linear system solver print *, 'Lin.sys.solver BiCGStab or GCRO (0 / 10,11,12,13) ?' read *, INFO(4) OPEN (UNIT=61,FILE='RunInfo') C Write integration history to unit # 61 INFO(5) = 61 C Write Newton info to unit # 61 INFO(6) = 61 C Write linear solver info to unit # 61 INFO(7) = 61 C DTMIN = 1E-9 RINFO(1) = 1.0E-9 C DTMAX = TE - TS RINFO(2) = 0.0 C UMAX = 1.0 RINFO(3) = 1.0 RINFO(4) = 1.0 C SPCWGT = 1.0 RINFO(5) = 1.0 RINFO(6) = 1.0 C TIMWGT = 1.0 RINFO(7) = 1.0 RINFO(8) = 1.0 C C Call main routine DO 10 I = 1, 10 TE = T + TOUT/10 CALL VLUGR3 (NPDE, T, TE, DT, XL,YF,ZD, XR,YB,ZU, DX, DY, DZ, + TOLS, TOLT, INFO, RINFO, RWK, LENRWK, IWK, LENIWK, LWK, LENLWK, + MNTR) PRINT *, 'VLUGR3 returned with MNTR=', MNTR C C Save info on file WRITE(NR,'(I2.2)') I OPEN(UNIT=LUNDMP,FILE='DUMP'//NR,FORM='UNFORMATTED') CALL DUMP (LUNDMP, RWK, IWK) CLOSE(LUNDMP) 10 CONTINUE END SUBROUTINE MONITR (T, DT, DTNEW, XL, YF, ZD, DXB, DYB, DZB, + LGRID, ISTRUC, LSOL, SOL) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER LGRID(0:*), ISTRUC(*), LSOL(*) REAL T, DT, DTNEW, XL, YF, ZD, DXB, DYB, DZB, SOL(*) C Ccc PURPOSE: C Control after a successful time step. The solution can be printed, C plotted or compared with the exact solution. C Ccc PARAMETER DESCRIPTION: C T : IN. Current value of time variable C DT : IN. Current time step size C DTNEW : IN. Time step size for next time step C XL : IN. X-coordinate of left/front/down point of (virtual) box C YF : IN. Y-coordinate of left/front/down point of (virtual) box C ZD : IN. Z-coordinate of left/front/down point of (virtual) box C DXB : IN. Cell width in X-direction of base grid C DYB : IN. Cell width in Y-direction of base grid C DZB : IN. Cell width in Z-direction of base grid C LGRID : IN. (0:*) C LGRID(0) = max. grid level used at T C LGRID(1): pointer to base grid structure ISTRUC C LGRID(LEVEL): pointer to grid structure C (LPLN,IPLN,LROW,IROW,ICOL) of refinement C level LEVEL for time T C ISTRUC : IN. (*) C ISTRUC(LGRID(LEVEL):.) contains (LPLN,IPLN,LROW,IROW,ICOL) C of grid level LEVEL, C LPLN : (0:LPLN(0)+1) C LPLN(0) = NPLNS: Actual # planes in LROW C LPLN(1:NPLNS): pointers to the start of a plane in LROW C LPLN(NPLNS+1) = NROWS+1: Total # rows in grid + 1 C IPLN : (NPLNS) C IPLN(IP): plane number of plane IP in virtual box C LROW : (NROWS+1) C LROW(1:NROWS): pointers to the start of a row in the grid C LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 C IROW : (NROWS) C IROW(IR): row number of row IR in virtual box C ICOL : (NPTS) C ICOL(IPT): column number of grid point IPT in virtual box C LSOL : IN. (*) C LSOL(LEVEL): pointer to (injected) solution at grid C of refinement level LEVEL for time T C SOL : IN. (*) C SOL(LSOL(LEVEL)+1:LSOL(LEVEL)+NPTS(LEVEL)*NPDE) contains C U_LEVEL(NPTS,NPDE) C C C Local arrays: INTEGER MAXPTS, NPDE PARAMETER (MAXPTS=50000, NPDE=2) REAL X(MAXPTS), Y(MAXPTS), Z(MAXPTS), UEX(MAXPTS*NPDE) C C----------------------------------------------------------------------- C INTEGER MAXLEV, LEVEL, LLPLN, LIPLN, LLROW, LIROW, LICOL, + NPLNS, NROWS, NPTS REAL DX, DY, DZ C C Loop over the grid levels from coarse to fine. C Get physical coordinates of grid points C Compute ||err||_max and clip negative solution values MAXLEV = LGRID(0) DX = DXB DY = DYB DZ = DZB DO 10 LEVEL = 1, MAXLEV LLPLN = LGRID(LEVEL) NPLNS = ISTRUC(LLPLN) NROWS = ISTRUC(LLPLN+NPLNS+1)-1 LIPLN = LLPLN+NPLNS+2 LLROW = LIPLN+NPLNS NPTS = ISTRUC(LLROW+NROWS)-1 IF (NPTS .GT. MAXPTS) stop 'MONITR' LIROW = LLROW+NROWS+1 LICOL = LIROW+NROWS CALL SETXYZ (XL, YF, ZD, DX, DY, DZ, + ISTRUC(LLPLN), ISTRUC(LIPLN), + ISTRUC(LLROW), ISTRUC(LIROW), ISTRUC(LICOL), X, Y, Z) DX = DX/2 DY = DY/2 DZ = DZ/2 CALL PRERR (LEVEL, T, NPTS, NPDE, X, Y, Z, SOL(LSOL(LEVEL)+1), + UEX) 10 CONTINUE RETURN END SUBROUTINE PRERR (LEVEL, T, NPTS, NPDE, X, Y, Z, U, UEX) INTEGER LEVEL, NPTS, NPDE REAL T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE), UEX(NPTS,NPDE) INTEGER I REAL RMAX1, RMAX2 CALL PDEIV (T, X, Y, Z, UEX, NPTS, NPDE) RMAX1 = 0.0 RMAX2 = 0.0 DO 10 I = 1, NPTS RMAX1 = MAX(RMAX1,ABS(UEX(I,1)-U(I,1))) RMAX2 = MAX(RMAX2,ABS(UEX(I,2)-U(I,2))) IF (U(I,1) .LT. 0) U(I,1) = 0.0 IF (U(I,2) .LT. 0) U(I,2) = 0.0 10 CONTINUE WRITE(28,'("Error at T=",E9.3,", level=",I1," :",2E10.3,I10)') + T, LEVEL, RMAX1, RMAX2, NPTS RETURN END SUBROUTINE PDEIV (T, X, Y, Z, U, NPTS, NPDE) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE REAL T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE) C Ccc PURPOSE: C Define (initial) solution of PDE. C Ccc PARAMETER DESCRIPTION: C T : IN. Time at which (initial) solution should be given C X,Y,Z : IN. Arrays of physical coordinates for the gridpoints C U : OUT. Array of PDE component values for the gridpoints. C NPTS : IN. Number of gridpoints C NPDE : IN. # PDE components C C----------------------------------------------------------------------- C C REAL PI, S2, R, S, D, K1, K2, C2, EDKT PARAMETER (PI = 3.141592653589793, S2 = 1.414213562373095) PARAMETER (K1 = 1000.0, K2 = 1.0) PARAMETER (C2 = -K1/K2) INTEGER I R = (2+SIN(2*PI*T))/4 S = (2+S2/2*COS(2*PI*T))/4 DO 10 I = 1, NPTS D = EXP(-80*((X(I)-R)**2+(Y(I)-S)**2+(Z(I)-S)**2)) EDKT = EXP(-D*K2*T) U(I,1) = D/(K1+K2) * (K1*(1-C2)+(K1+K2)*C2*EDKT)/(1-C2+C2*EDKT) U(I,2) = D - U(I,1) 10 CONTINUE RETURN END SUBROUTINE PDEF (T, X, Y, Z, U, + UT, UX, UY, UZ, UXX, UYY, UZZ, UXY, UXZ, UYZ, RES, NPTS, NPDE) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE REAL T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE), + UT(NPTS,NPDE), UX(NPTS,NPDE), UY(NPTS,NPDE), UZ(NPTS,NPDE), + UXX(NPTS,NPDE), UYY(NPTS,NPDE), UZZ(NPTS,NPDE), + UXY(NPTS,NPDE), UXZ(NPTS,NPDE), UYZ(NPTS,NPDE), + RES(NPTS,NPDE) C Ccc PURPOSE: C Define residual of PDE on interior of domain. Boundary values will be C overwritten later on. C Ccc PARAMETER DESCRIPTION: C T : IN. Time at which residual should be evaluated C X,Y,Z : IN. Physical coordinates of gridpoints C U : IN. Array of PDE components for the gridpoints. C UT : IN. Array of time derivative of PDE components C UX : IN. -I C UY : IN. I C UZ : IN. I C UXX : IN. I C UYY : IN. I Space derivatives of U on current grid C UZZ : IN. I C UXY : IN. I C UXZ : IN. I C UYZ : IN. -I C RES : OUT. Array containg PDE residual at gridpoints in interior of C domain. The residual values at boundary points will be C overwritten by a call to PDEBC. C NPTS : IN. Number of gridpoints C NPDE : IN. Number of PDE components C C----------------------------------------------------------------------- C REAL PI, S2, K1, K2 PARAMETER (PI = 3.141592653589793, S2 = 1.414213562373095) PARAMETER (K1 = 1000.0, K2 = 1.0) INTEGER I DO 10 I = 1, NPTS RES(I,1) = UT(I,1) + + 2*PI*S2*((Y(I)+Z(I))/2-0.5)*UX(I,1) - + 2*PI/S2*(X(I)-0.5)*(UY(I,1)+UZ(I,1)) + - (-K2*U(I,1)*U(I,2) + K1*U(I,2)*U(I,2)) RES(I,2) = UT(I,2) + + 2*PI*S2*((Y(I)+Z(I))/2-0.5)*UX(I,2) - + 2*PI/S2*(X(I)-0.5)*(UY(I,2)+UZ(I,2)) + - (-K1*U(I,2)*U(I,2) + K2*U(I,1)*U(I,2)) 10 CONTINUE RETURN END SUBROUTINE PDEBC (T, X, Y, Z, U, UT, UX, UY, UZ, RES, NPTS, NPDE, + LLBND, ILBND, LBND) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE, LLBND(0:*), ILBND(*), LBND(*) REAL T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE), + UT(NPTS,NPDE), UX(NPTS,NPDE), UY(NPTS,NPDE), UZ(NPTS,NPDE), + RES(NPTS,NPDE) C Ccc PURPOSE: C Define residual of boundary equations of PDE. The residual on interior C points has already been stored in RES. C Ccc PARAMETER DESCRIPTION: C T : IN. Time at which BC's should be evaluated C X,Y,Z : IN. Physical coordinates of gridpoints C U : IN. Array of PDE components for the gridpoints. C UT : IN. Array of time derivative of PDE components C UX : IN. -I C UY : IN. I Arrays containing space derivatives of PDE components C UZ : IN. -I C RES : INOUT. C IN: PDE residual for interior points (set by PDEF) C OUT: Array with PDE residual at physical boundary points C inserted C NPTS : IN. Number of grid components C NPDE : IN. Number of PDE components C LLBND : IN. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C C----------------------------------------------------------------------- C REAL PI, S2, R, S, D, K1, K2, C2, EDKT, UI1 PARAMETER (PI = 3.141592653589793, S2 = 1.414213562373095) PARAMETER (K1 = 1000.0, K2 = 1.0) PARAMETER (C2 = -K1/K2) INTEGER I, J, K, NBNDS R = (2+SIN(2*PI*T))/4 S = (2+S2/2*COS(2*PI*T))/4 C NBNDS = LLBND(0) DO 10 J = 1, NBNDS C C Change the inflow boundaries IF (ILBND(J) .EQ. 1) THEN DO 20 K = LLBND(J), LLBND(J+1)-1 I = LBND(K) IF (Y(I)+Z(I) .GE. 1.0) THEN D = EXP(-80*((X(I)-R)**2+(Y(I)-S)**2+(Z(I)-S)**2)) EDKT = EXP(-D*K2*T) UI1 = D/(K1+K2) * + (K1*(1-C2)+(K1+K2)*C2*EDKT)/(1-C2+C2*EDKT) RES(I,1) = U(I,1) - UI1 RES(I,2) = U(I,2) - (D - UI1) ENDIF 20 CONTINUE ELSE IF (ILBND(J) .EQ. 2 .OR. ILBND(J) .EQ. 5) THEN DO 30 K = LLBND(J), LLBND(J+1)-1 I = LBND(K) IF (X(I) .LE. 0.5) THEN D = EXP(-80*((X(I)-R)**2+(Y(I)-S)**2+(Z(I)-S)**2)) EDKT = EXP(-D*K2*T) UI1 = D/(K1+K2) * + (K1*(1-C2)+(K1+K2)*C2*EDKT)/(1-C2+C2*EDKT) RES(I,1) = U(I,1) - UI1 RES(I,2) = U(I,2) - (D - UI1) ENDIF 30 CONTINUE ELSE IF (ILBND(J) .EQ. 3)THEN DO 40 K = LLBND(J), LLBND(J+1)-1 I = LBND(K) IF (Y(I)+Z(I) .LE. 1.0) THEN D = EXP(-80*((X(I)-R)**2+(Y(I)-S)**2+(Z(I)-S)**2)) EDKT = EXP(-D*K2*T) UI1 = D/(K1+K2) * + (K1*(1-C2)+(K1+K2)*C2*EDKT)/(1-C2+C2*EDKT) RES(I,1) = U(I,1) - UI1 RES(I,2) = U(I,2) - (D - UI1) ENDIF 40 CONTINUE ELSE IF (ILBND(J) .EQ. 4 .OR. ILBND(J) .EQ. 6) THEN DO 50 K = LLBND(J), LLBND(J+1)-1 I = LBND(K) IF (X(I) .GE. 0.5) THEN D = EXP(-80*((X(I)-R)**2+(Y(I)-S)**2+(Z(I)-S)**2)) EDKT = EXP(-D*K2*T) UI1 = D/(K1+K2) * + (K1*(1-C2)+(K1+K2)*C2*EDKT)/(1-C2+C2*EDKT) RES(I,1) = U(I,1) - UI1 RES(I,2) = U(I,2) - (D - UI1) ENDIF 50 CONTINUE ENDIF 10 CONTINUE RETURN END SHAR_EOF fi # end of overwriting check if test -f 'prtsol.f' then echo shar: will not over-write existing file "'prtsol.f'" else cat << \SHAR_EOF > 'prtsol.f' PROGRAM PRTSOL C C----------------------------------------------------------------------- C Ccc This program reads a file made by subroutine DUMP and prints the C solution on an output file. Both filenames are read from standard C input. C Ccc EXTERNALS USED: EXTERNAL PRSOL, RDDUMP C C Ccc INCLUDE 'CMNWRITEF' C C CMNWRITEF C C COMMON needed for continuation calls INTEGER MAXLVW, NPDEW, LRWKPS, LIWKPS, LRWKB, LIWKB LOGICAL FIRST, SECOND REAL T0,TW,TEW,DTW, XLW,YFW,ZDW, XRW,YBW,ZUW, DXB,DYB,DZB, DTO COMMON /WRITIF/ MAXLVW, NPDEW, LRWKPS, LIWKPS, LRWKB, LIWKB COMMON /WRITLF/ FIRST, SECOND COMMON /WRITRF/ T0,TW,TEW,DTW, XLW,YFW,ZDW, XRW,YBW,ZUW, + DXB,DYB,DZB, DTO SAVE /WRITIF/, /WRITLF/, /WRITRF/ C C end INCLUDE 'CMNWRITEF' C C C----------------------------------------------------------------------- C INTEGER MXLEV, NPD, NPTS, LENIWK, LENRWK PARAMETER (MXLEV=3, NPD=1, NPTS=100000) PARAMETER (LENIWK=NPTS*(7*MXLEV+23), + LENRWK=5*NPTS*NPD*MXLEV) C CHARACTER FILE*128 INTEGER IWK(LENIWK), + LSGNM1, LSGN, LSGNP1, LSUNM1, LSSN, LSUN REAL RWK(LENRWK) PRINT *, 'DUMP file?' READ '(A)', FILE C OPEN(UNIT=62,FILE=FILE,FORM='UNFORMATTED') CALL RDDUMP (62, RWK, LENRWK, IWK, LENIWK) CLOSE(62) C C Setup work storage LSGNM1 = 1 LSGN = LSGNM1 + MAXLVW+1 LSGNP1 = LSGN + MAXLVW+1 LSUNM1 = LSGNP1 + MAXLVW+1 LSSN = LSUNM1 + MAXLVW LSUN = LSSN + MAXLVW C C call print routine PRINT *, 'output file?' READ '(A)', FILE C OPEN(UNIT=61,FILE=FILE) CALL PRSOL (61, TW, NPDEW, XLW, YFW, ZDW, DXB, DYB, DZB, + IWK(LSGN), IWK(LIWKPS), IWK(LSUN), RWK(LRWKPS)) CLOSE(61) END SUBROUTINE RDDUMP (LUNDMP, RWK, LENRWK, IWK, LENIWK) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER LENIWK INTEGER LUNDMP, LENRWK, IWK(LENIWK) REAL RWK(LENRWK) C Ccc PURPOSE: C Read all information necessary for a restart of VLUGR3 from file C Ccc PARAMETER DESCRIPTION: C LUNDMP : IN. Logical unit number of dumpfile. Should be opened as an C unformatted file. C RWK : OUT. Real workstorage intended to pass to VLUGR3 C LENRWK : IN. Dimension of RWK. C IWK : OUT. Integer workstorage intended to pass to VLUGR3 C LENIWK : IN. Dimension of IWK. C Ccc EXTERNALS USED: NONE C C Ccc INCLUDE 'CMNSTATS' C C CMNSTATS C C COMMON with integration statistics INTEGER MXCLEV, MXCNIT PARAMETER (MXCLEV = 10, MXCNIT = 20) INTEGER LUNPDS, LUNNLS, LUNLSS, LEVEL, NSTEPS, NREJS, + NJACS(MXCLEV), NRESID(MXCLEV), NNIT(MXCLEV), + NLSIT(MXCLEV,MXCNIT) COMMON /STATS/ LUNPDS, LUNNLS, LUNLSS, LEVEL, NSTEPS, NREJS, + NJACS, NRESID, NNIT, NLSIT SAVE /STATS/ C C end INCLUDE 'CMNSTATS' C C Ccc INCLUDE 'CMNWRITEF' C C CMNWRITEF C C COMMON needed for continuation calls INTEGER MAXLVW, NPDEW, LRWKPS, LIWKPS, LRWKB, LIWKB LOGICAL FIRST, SECOND REAL T0,TW,TEW,DTW, XLW,YFW,ZDW, XRW,YBW,ZUW, DXB,DYB,DZB, DTO COMMON /WRITIF/ MAXLVW, NPDEW, LRWKPS, LIWKPS, LRWKB, LIWKB COMMON /WRITLF/ FIRST, SECOND COMMON /WRITRF/ T0,TW,TEW,DTW, XLW,YFW,ZDW, XRW,YBW,ZUW, + DXB,DYB,DZB, DTO SAVE /WRITIF/, /WRITLF/, /WRITRF/ C C end INCLUDE 'CMNWRITEF' C C C----------------------------------------------------------------------- C INTEGER I, J READ(LUNDMP) MAXLVW, NPDEW, LRWKPS, LIWKPS, LRWKB, LIWKB, + FIRST, SECOND, + T0,TW,TEW,DTW, XLW,YFW,ZDW, XRW,YBW,ZUW, DXB,DYB,DZB, DTO IF (LENRWK .LT. LRWKPS+LRWKB .OR. LENIWK .LT. LIWKPS+LIWKB) THEN PRINT *, LENRWK, LRWKPS+LRWKB, LENIWK, LIWKPS+LIWKB STOP 'work space too small' ENDIF READ(LUNDMP) LUNPDS, LUNNLS, LUNLSS, LEVEL, NSTEPS, NREJS, + (NJACS(I), I=1,MXCLEV), (NRESID(I), I=1,MXCLEV), + (NNIT(I), I=1,MXCLEV), ((NLSIT(I,J), I=1,MXCLEV), J=1,MXCNIT) READ(LUNDMP) (RWK(I), I=1,LRWKPS+LRWKB) READ(LUNDMP) (IWK(I), I=1,LIWKPS+LIWKB) C RETURN END SUBROUTINE PRSOL (LUN, T, NPDE, XL, YF, ZD, DXB, DYB, DZB, + LGRID, ISTRUC, LSOL, SOL) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER LUN, NPDE, LGRID(0:*), ISTRUC(*), LSOL(*) REAL T, XL, YF, ZD, DXB, DYB, DZB, SOL(*) C Ccc PURPOSE: C Print solution and coordinate values at all grid levels. C Ccc PARAMETER DESCRIPTION: C LUN : IN. Logical unit number of print file C T : IN. Current value of time variable C NPDE : IN. # PDE components C XL : IN. X-coordinate of left/front/down point of virtual box C YF : IN. Y-coordinate of left/front/down point of virtual box C ZD : IN. Z-coordinate of left/front/down point of virtual box C DXB : IN. Cell width in X-direction of base grid C DYB : IN. Cell width in Y-direction of base grid C DZB : IN. Cell width in Z-direction of base grid C LGRID : IN. (0:*) C LGRID(0) = max. grid level used at T C LGRID(1): pointer to base grid structure ISTRUC C LGRID(LEVEL): pointer to grid structure C (LPLN,IPLN,LROW,IROW,ICOL) C of refinement level LEVEL for time T C ISTRUC : IN. (*) C ISTRUC(LGRID(LEVEL):.) contains (LPLN,IPLN,LROW,IROW,ICOL) C of grid level LEVEL, C LPLN : (0:LPLN(0)+1) C LPLN(0) = NPLNS: Actual # planes in grid C LPLN(1:NPLNS): pointers to the start of a plane in LROW C LPLN(NPLNS+1) = NROWS+1: Actual # rows in grid + 1 C IPLN : (NPLNS) C IPLN(IP): plane number of plane IP in virtual box C LROW : (NROWS+1) C LROW(1:NROWS): pointers to the start of a row in the grid C LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 C IROW : (NROWS) C IROW(IR): row number of row IR in virtual box C ICOL : (NPTS) C ICOL(IPT): column number of grid point IPT in virtual box C LSOL : IN. (*) C LSOL(LEVEL): pointer to (injected) solution at grid C of refinement level LEVEL for time T C SOL : IN. (*) C SOL(LSOL(LEVEL)+1:LSOL(LEVEL)+NPTS(LEVEL)*NPDE) contains C U_LEVEL(NPTS,NPDE) C Ccc EXTERNALS USED: EXTERNAL PRSOLL C C----------------------------------------------------------------------- C INTEGER MAXLEV, LEVEL, LLPLN, LIPLN, LLROW, LIROW, LICOL, + NPLNS, NROWS, NPTS REAL DX, DY, DZ MAXLEV = LGRID(0) DX = DXB DY = DYB DZ = DZB DO 10 LEVEL = 1, MAXLEV LLPLN = LGRID(LEVEL) NPLNS = ISTRUC(LLPLN) NROWS = ISTRUC(LLPLN+NPLNS+1)-1 LIPLN = LLPLN+NPLNS+2 LLROW = LIPLN+NPLNS NPTS = ISTRUC(LLROW+NROWS)-1 LIROW = LLROW+NROWS+1 LICOL = LIROW+NROWS CALL PRSOLL (LUN, LEVEL, T, NPTS, NPDE, XL, YF, ZD, DX, DY, DZ, + ISTRUC(LLPLN), ISTRUC(LIPLN), ISTRUC(LLROW), ISTRUC(LIROW), + ISTRUC(LICOL), SOL(LSOL(LEVEL)+1)) DX = DX/2 DY = DY/2 DZ = DZ/2 10 CONTINUE RETURN END SUBROUTINE PRSOLL (LUN, LEVEL, T, NPTS, NPDE, XL, YF, ZD, + DX, DY, DZ, LPLN, IPLN, LROW, IROW, ICOL, U) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER LUN, LEVEL, NPTS, NPDE, LPLN(0:*), IPLN(*), + LROW(*), IROW(*), ICOL(*) REAL T, XL, YF, ZD, DX, DY, DZ, U(NPTS,NPDE) C Ccc PURPOSE: C Print solution and X-, Y- and Z-coordinates of gridlevel LEVEL. C Ccc PARAMETER DESCRIPTION: C LUN : IN. Logical unit number of print file C LEVEL : IN. Grid level corresponding with solution U. C T : IN. Current value of time variable C NPTS : IN. # grid points at this level C NPDE : IN. # PDE components C XL : IN. X-coordinate of left/front/down point of virtual box C YF : IN. Y-coordinate of left/front/down point of virtual box C ZD : IN. Z-coordinate of left/front/down point of virtual box C DX : IN. Grid width in X-direction C DY : IN. Grid width in Y-direction C DZ : IN. Grid width in Z-direction C LPLN : IN. (0:LPLN(0)+1) C LPLN(0) = NPLNS: Actual # planes in LROW C LPLN(1:NPLNS): pointers to the start of a plane in LROW C LPLN(NPLNS+1) = NROWS+1: Total # rows in grid + 1 C IPLN : IN. (NPLNS) C IPLN(IP): plane number of plane IP in virtual box C LROW : IN. (NROWS+1) C LROW(1:NROWS): pointers to the start of a row in the grid C LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 C IROW : IN. (NROWS) C IROW(IR): row number of row IR in virtual box C ICOL : IN. (NPTS) C ICOL(IPT): column number of grid point IPT in virtual box C U : IN. Solution on this grid level C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER IC, IP, IPT, IR, NPLNS REAL X, Y, Z C NPLNS = LPLN(0) WRITE(LUN,'(//// A,T14,A,T30,A,T46,A,T62,A,T71,A //)') + 'Lev', 't', 'Z', 'Y', 'X', 'Solution' IP = 1 Z = ZD + IPLN(IP)*DZ IR = LPLN(IP) Y = YF + IROW(IR)*DY IPT = LROW(IR) X = XL + ICOL(IPT)*DX WRITE(LUN, + '(I3,T5,E12.5,T21,E12.5,T37,E12.5,T53,E12.5,T69,E12.5)') + LEVEL, T, Z, Y, X, U(IPT,1) DO 10 IC = 2, NPDE WRITE(LUN,'(T69,E12.5)') U(IPT,IC) 10 CONTINUE DO 14 IPT = LROW(IR)+1, LROW(IR+1)-1 X = XL + ICOL(IPT)*DX WRITE(LUN, + '(T53,E12.5,T69,E12.5)') + X, U(IPT,1) DO 15 IC = 2, NPDE WRITE(LUN,'(T69,E12.5)') U(IPT,IC) 15 CONTINUE 14 CONTINUE DO 20 IR = LPLN(IP)+1, LPLN(IP+1)-1 Y = YF + IROW(IR)*DY IPT = LROW(IR) X = XL + ICOL(IPT)*DX WRITE(LUN, + '(T37,E12.5,T53,E12.5,T69,E12.5)') + Y, X, U(IPT,1) DO 30 IC = 2, NPDE WRITE(LUN,'(T69,E12.5)') U(IPT,IC) 30 CONTINUE DO 40 IPT = LROW(IR)+1, LROW(IR+1)-1 X = XL + ICOL(IPT)*DX WRITE(LUN, + '(T53,E12.5,T69,E12.5)') + X, U(IPT,1) DO 50 IC = 2, NPDE WRITE(LUN,'(T69,E12.5)') U(IPT,IC) 50 CONTINUE 40 CONTINUE 20 CONTINUE DO 100 IP = 2, NPLNS Z = ZD + IPLN(IP)*DZ IR = LPLN(IP) Y = YF + IROW(IR)*DY IPT = LROW(IR) X = XL + ICOL(IPT)*DX WRITE(LUN, + '(T21,E12.5,T37,E12.5,T53,E12.5,T69,E12.5)') + Z, Y, X, U(IPT,1) DO 110 IC = 2, NPDE WRITE(LUN,'(T69,E12.5)') U(IPT,IC) 110 CONTINUE DO 114 IPT = LROW(IR)+1, LROW(IR+1)-1 X = XL + ICOL(IPT)*DX WRITE(LUN, + '(T53,E12.5,T69,E12.5)') + X, U(IPT,1) DO 115 IC = 2, NPDE WRITE(LUN,'(T69,E12.5)') U(IPT,IC) 115 CONTINUE 114 CONTINUE DO 120 IR = LPLN(IP)+1, LPLN(IP+1)-1 Y = YF + IROW(IR)*DY IPT = LROW(IR) X = XL + ICOL(IPT)*DX WRITE(LUN, + '(T37,E12.5,T53,E12.5,T69,E12.5)') + Y, X, U(IPT,1) DO 130 IC = 2, NPDE WRITE(LUN,'(T69,E12.5)') U(IPT,IC) 130 CONTINUE DO 140 IPT = LROW(IR)+1, LROW(IR+1)-1 X = XL + ICOL(IPT)*DX WRITE(LUN, + '(T53,E12.5,T69,E12.5)') + X, U(IPT,1) DO 150 IC = 2, NPDE WRITE(LUN,'(T69,E12.5)') U(IPT,IC) 150 CONTINUE 140 CONTINUE 120 CONTINUE 100 CONTINUE RETURN END SHAR_EOF fi # end of overwriting check if test -f 'wrtuni.f' then echo shar: will not over-write existing file "'wrtuni.f'" else cat << \SHAR_EOF > 'wrtuni.f' PROGRAM WRTUNI C C !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! C !!! !!! C !!! In subroutine WRUNI the constant NONVAL should be adjusted to !!! C !!! the data (NONVAL = impossible value for the first componenent) !!! C !!! !!! C !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! C C----------------------------------------------------------------------- C Ccc This program reads a file made by subroutine DUMP and writes the C (interpolated) solution on a uniform grid of a specified grid level C to the output file sol.dat. The maximum grid level used in each point C is written to the file grid.dat. C NB. This program is not correct for a domain with holes in it with C a size of the width of the base grid. C Ccc EXTERNALS USED: EXTERNAL WRUNI, RDDUMP C C Ccc INCLUDE 'CMNWRITEF' C C CMNWRITEF C C COMMON needed for continuation calls INTEGER MAXLVW, NPDEW, LRWKPS, LIWKPS, LRWKB, LIWKB LOGICAL FIRST, SECOND REAL T0,TW,TEW,DTW, XLW,YFW,ZDW, XRW,YBW,ZUW, DXB,DYB,DZB, DTO COMMON /WRITIF/ MAXLVW, NPDEW, LRWKPS, LIWKPS, LRWKB, LIWKB COMMON /WRITLF/ FIRST, SECOND COMMON /WRITRF/ T0,TW,TEW,DTW, XLW,YFW,ZDW, XRW,YBW,ZUW, + DXB,DYB,DZB, DTO SAVE /WRITIF/, /WRITLF/, /WRITRF/ C C end INCLUDE 'CMNWRITEF' C C C----------------------------------------------------------------------- C INTEGER MXLEV, NPD, NPTS, LENIWK, LENRWK PARAMETER (MXLEV=3, NPD=1, NPTS=100000) PARAMETER (LENIWK=NPTS*(7*MXLEV+23), + LENRWK=5*NPTS*NPD*MXLEV) C CHARACTER FILE*128 INTEGER IWK(LENIWK), + LSGNM1, LSGN, LSGNP1, LSUNM1, LSSN, LSUN, + LUNI, MAXLEV, NX, NXB, NY, NYB, NZ, NZB, UNILEV REAL RWK(LENRWK) PRINT *, 'DUMP file?' READ '(A)', FILE C OPEN(UNIT=62,FILE=FILE,FORM='UNFORMATTED') CALL RDDUMP (62, RWK, LENRWK, IWK, LENIWK) CLOSE(62) C C Setup work storage LSGNM1 = 1 LSGN = LSGNM1 + MAXLVW+1 LSGNP1 = LSGN + MAXLVW+1 LSUNM1 = LSGNP1 + MAXLVW+1 LSSN = LSUNM1 + MAXLVW LSUN = LSSN + MAXLVW C C Check workspace MAXLEV = IWK(LSGN) PRINT *, 'Max. grid level?' READ *, UNILEV UNILEV = MIN(UNILEV,MAXLEV) NXB = NINT((XRW - XLW)/DXB) NYB = NINT((YBW - YFW)/DYB) NZB = NINT((ZUW - ZDW)/DZB) NX = NXB * 2**(UNILEV-1) NY = NYB * 2**(UNILEV-1) NZ = NZB * 2**(UNILEV-1) LUNI = LENRWK - (NX+1)*(NY+1)*(NZ+1)*NPDEW IF (LUNI .LT. IWK(LSUN+MAXLVW)) STOP 'workspace' C C Write problem info to standard output and write the interpolated C solution and grid levels to the files PRINT *, 'T, NPDE, XL, YF, ZD, DXB, DYB, DZB, NXB, NYB, NZB' PRINT *, TW, NPDEW, XLW, YFW, ZDW, DXB, DYB, DZB, NXB, NYB, NZB FILE = 'sol.dat' OPEN(UNIT=61,FILE=FILE) FILE = 'grid.dat' OPEN(UNIT=63,FILE=FILE) CALL WRUNI (61, 63, UNILEV, + TW, NPDEW, XLW, YFW, ZDW, DXB, DYB, DZB, NXB, NYB, NZB, + IWK(LSGN), IWK(LIWKPS), IWK(LSUN), RWK(LRWKPS), + RWK(LUNI), NX, NY, NZ) CLOSE(61) CLOSE(63) END SUBROUTINE RDDUMP (LUNDMP, RWK, LENRWK, IWK, LENIWK) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER LENIWK INTEGER LUNDMP, LENRWK, IWK(LENIWK) REAL RWK(LENRWK) C Ccc PURPOSE: C Read all information necessary for a restart of VLUGR3 from file C Ccc PARAMETER DESCRIPTION: C LUNDMP : IN. Logical unit number of dumpfile. Should be opened as an C unformatted file. C RWK : OUT. Real workstorage intended to pass to VLUGR3 C LENRWK : IN. Dimension of RWK. C IWK : OUT. Integer workstorage intended to pass to VLUGR3 C LENIWK : IN. Dimension of IWK. C Ccc EXTERNALS USED: NONE C C Ccc INCLUDE 'CMNSTATS' C C CMNSTATS C C COMMON with integration statistics INTEGER MXCLEV, MXCNIT PARAMETER (MXCLEV = 10, MXCNIT = 20) INTEGER LUNPDS, LUNNLS, LUNLSS, LEVEL, NSTEPS, NREJS, + NJACS(MXCLEV), NRESID(MXCLEV), NNIT(MXCLEV), + NLSIT(MXCLEV,MXCNIT) COMMON /STATS/ LUNPDS, LUNNLS, LUNLSS, LEVEL, NSTEPS, NREJS, + NJACS, NRESID, NNIT, NLSIT SAVE /STATS/ C C end INCLUDE 'CMNSTATS' C C Ccc INCLUDE 'CMNWRITEF' C C CMNWRITEF C C COMMON needed for continuation calls INTEGER MAXLVW, NPDEW, LRWKPS, LIWKPS, LRWKB, LIWKB LOGICAL FIRST, SECOND REAL T0,TW,TEW,DTW, XLW,YFW,ZDW, XRW,YBW,ZUW, DXB,DYB,DZB, DTO COMMON /WRITIF/ MAXLVW, NPDEW, LRWKPS, LIWKPS, LRWKB, LIWKB COMMON /WRITLF/ FIRST, SECOND COMMON /WRITRF/ T0,TW,TEW,DTW, XLW,YFW,ZDW, XRW,YBW,ZUW, + DXB,DYB,DZB, DTO SAVE /WRITIF/, /WRITLF/, /WRITRF/ C C end INCLUDE 'CMNWRITEF' C C C----------------------------------------------------------------------- C INTEGER I, J READ(LUNDMP) MAXLVW, NPDEW, LRWKPS, LIWKPS, LRWKB, LIWKB, + FIRST, SECOND, + T0,TW,TEW,DTW, XLW,YFW,ZDW, XRW,YBW,ZUW, DXB,DYB,DZB, DTO IF (LENRWK .LT. LRWKPS+LRWKB .OR. LENIWK .LT. LIWKPS+LIWKB) THEN PRINT *, LENRWK, LRWKPS+LRWKB, LENIWK, LIWKPS+LIWKB STOP 'work space too small' ENDIF READ(LUNDMP) LUNPDS, LUNNLS, LUNLSS, LEVEL, NSTEPS, NREJS, + (NJACS(I), I=1,MXCLEV), (NRESID(I), I=1,MXCLEV), + (NNIT(I), I=1,MXCLEV), ((NLSIT(I,J), I=1,MXCLEV), J=1,MXCNIT) READ(LUNDMP) (RWK(I), I=1,LRWKPS+LRWKB) READ(LUNDMP) (IWK(I), I=1,LIWKPS+LIWKB) C RETURN END SUBROUTINE WRUNI (LUNS, LUNG, UNILEV, + T, NPDE, XL, YF, ZD, DXB, DYB, DZB, NXB, NYB, NZB, + LGRID, ISTRUC, LSOL, SOL, UNIFRM, NX, NY, NZ) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER LUNS, LUNG, UNILEV, + NPDE, NXB, NYB, NZB, LGRID(0:*), ISTRUC(*), LSOL(*), NX, NY, NZ REAL T, XL, YF, ZD, DXB, DYB, DZB, SOL(*), + UNIFRM(0:NX,0:NY,0:NZ,NPDE) C Ccc PURPOSE: C Write (interpolated) solution values at grid level UNILEV to file C LUNS. C Write maximum gridlevel used in each point to file LUNG. C NB. The data will not be correct for a domain with holes in it with C a size of the width of the base grid. C Ccc PARAMETER DESCRIPTION: C LUNS : IN. Logical unit number of solution file C LUNG : IN. Logical unit number of grid level file C UNILEV : IN. Maximum grid level to be used to generate the data C T : IN. Value of time variable C NPDE : IN. # PDE components C XL : IN. X-coordinate of left/front/down point of virtual box C YF : IN. Y-coordinate of left/front/down point of virtual box C ZD : IN. Z-coordinate of left/front/down point of virtual box C DXB : IN. Cell width in X-direction of base grid C DYB : IN. Cell width in Y-direction of base grid C DZB : IN. Cell width in Z-direction of base grid C NXB,NYB,NZB: IN. # gridcells in X-, Y- and Z-direction, resp., on grid C of base level C LGRID : IN. (0:*) C LGRID(0) = max. grid level used at T C LGRID(1): pointer to base grid structure ISTRUC C LGRID(LEVEL): pointer to grid structure C (LPLN,IPLN,LROW,IROW,ICOL) C of refinement level LEVEL for time T C ISTRUC : IN. (*) C ISTRUC(LGRID(LEVEL):.) contains (LPLN,IPLN,LROW,IROW,ICOL) C of grid level LEVEL, C LPLN : (0:LPLN(0)+1) C LPLN(0) = NPLNS: Actual # planes in grid C LPLN(1:NPLNS): pointers to the start of a plane in LROW C LPLN(NPLNS+1) = NROWS+1: Actual # rows in grid + 1 C IPLN : (NPLNS) C IPLN(IP): plane number of plane IP in virtual box C LROW : (NROWS+1) C LROW(1:NROWS): pointers to the start of a row in the grid C LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 C IROW : (NROWS) C IROW(IR): row number of row IR in virtual box C ICOL : (NPTS) C ICOL(IPT): column number of grid point IPT in virtual box C LSOL : IN. (*) C LSOL(LEVEL): pointer to (injected) solution at grid C of refinement level LEVEL for time T C SOL : IN. (*) C SOL(LSOL(LEVEL)+1:LSOL(LEVEL)+NPTS(LEVEL)*NPDE) contains C U_LEVEL(NPTS,NPDE) C UNIFRM : WORK. (Interpolated) solution on level UNILEV / max. grid C level used. C NX,NY,NZ: IN. # gridcells in X-, Y- and Z-direction, resp., on grid C of level UNILEV C C----------------------------------------------------------------------- C C !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! C !!! !!! C !!! In subroutine WRUNI the constant NONVAL should be adjusted to !!! C !!! the data (NONVAL = impossible value for the first componenent) !!! C !!! !!! REAL NONVAL PARAMETER (NONVAL = -999.999) C !!! !!! C !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! C C----------------------------------------------------------------------- C INTEGER I, IC, ICOL, IMUL, IP, IPLN, IPT, IR, IROW, J, K, + LEVEL, LLPLN, LIPLN, LLROW, LIROW, LICOL, MAXLEV, + NPLNS, NROWS, NPTS DO 1 IC = 1, NPDE DO 1 IPLN = 0, NZ DO 1 IROW = 0, NY DO 1 ICOL = 0, NX UNIFRM(ICOL,IROW,IPLN,IC) = NONVAL 1 CONTINUE MAXLEV = LGRID(0) DO 10 LEVEL = 1, UNILEV IMUL = 2**(UNILEV-LEVEL) LLPLN = LGRID(LEVEL) NPLNS = ISTRUC(LLPLN) NROWS = ISTRUC(LLPLN+NPLNS+1)-1 LIPLN = LLPLN+NPLNS+2 LLROW = LIPLN+NPLNS NPTS = ISTRUC(LLROW+NROWS)-1 LIROW = LLROW+NROWS+1 LICOL = LIROW+NROWS DO 20 IP = 1, NPLNS IPLN = ISTRUC(LIPLN-1+IP)*IMUL DO 30 IR = ISTRUC(LLPLN+IP), ISTRUC(LLPLN+IP+1)-1 IROW = ISTRUC(LIROW-1+IR)*IMUL DO 40 IPT = ISTRUC(LLROW-1+IR), ISTRUC(LLROW+IR)-1 ICOL = ISTRUC(LICOL-1+IPT)*IMUL DO 50 IC = 1, NPDE UNIFRM(ICOL,IROW,IPLN,IC) = + SOL(LSOL(LEVEL)+(IC-1)*NPTS+IPT) 50 CONTINUE 40 CONTINUE 30 CONTINUE 20 CONTINUE 10 CONTINUE DO 100 LEVEL = 2, UNILEV IMUL = 2**(UNILEV-LEVEL) DO 110 K = IMUL, NZ, IMUL*2 DO 110 J = 0, NY, IMUL*2 DO 110 I = 0, NX, IMUL*2 IF (UNIFRM(I,J,K,1) .EQ. NONVAL) THEN DO 120 IC = 1, NPDE UNIFRM(I,J,K,IC) = + (UNIFRM(I,J,K-IMUL,IC)+UNIFRM(I,J,K+IMUL,IC))/2 120 CONTINUE ENDIF 110 CONTINUE DO 130 K = 0, NZ, IMUL DO 130 J = IMUL, NY, IMUL*2 DO 130 I = 0, NX, IMUL*2 IF (UNIFRM(I,J,K,1) .EQ. NONVAL) THEN DO 140 IC = 1, NPDE UNIFRM(I,J,K,IC) = + (UNIFRM(I,J-IMUL,K,IC)+UNIFRM(I,J+IMUL,K,IC))/2 140 CONTINUE ENDIF 130 CONTINUE DO 150 K = 0, NZ, IMUL DO 150 J = 0, NY, IMUL DO 150 I = IMUL, NX, IMUL*2 IF (UNIFRM(I,J,K,1) .EQ. NONVAL) THEN DO 160 IC = 1, NPDE UNIFRM(I,J,K,IC) = + (UNIFRM(I-IMUL,J,K,IC)+UNIFRM(I+IMUL,J,K,IC))/2 160 CONTINUE ENDIF 150 CONTINUE 100 CONTINUE DO 170 K = 0, NZ DO 170 J = 0, NY DO 170 I = 0, NX WRITE(LUNS,'(100E13.3)') (UNIFRM(I,J,K,IC), IC = 1, NPDE) 170 CONTINUE C C Grids DO 201 IPLN = 0, NZ DO 201 IROW = 0, NY DO 201 ICOL = 0, NX UNIFRM(ICOL,IROW,IPLN,1) = 0 201 CONTINUE DO 210 LEVEL = 1, UNILEV IMUL = 2**(UNILEV-LEVEL) LLPLN = LGRID(LEVEL) NPLNS = ISTRUC(LLPLN) NROWS = ISTRUC(LLPLN+NPLNS+1)-1 LIPLN = LLPLN+NPLNS+2 LLROW = LIPLN+NPLNS NPTS = ISTRUC(LLROW+NROWS)-1 LIROW = LLROW+NROWS+1 LICOL = LIROW+NROWS DO 220 IP = 1, NPLNS IPLN = ISTRUC(LIPLN-1+IP)*IMUL DO 230 IR = ISTRUC(LLPLN+IP), ISTRUC(LLPLN+IP+1)-1 IROW = ISTRUC(LIROW-1+IR)*IMUL DO 240 IPT = ISTRUC(LLROW-1+IR), ISTRUC(LLROW+IR)-1 ICOL = ISTRUC(LICOL-1+IPT)*IMUL UNIFRM(ICOL,IROW,IPLN,1) = LEVEL 240 CONTINUE 230 CONTINUE 220 CONTINUE 210 CONTINUE DO 300 LEVEL = 2, UNILEV IMUL = 2**(UNILEV-LEVEL) DO 310 K = IMUL, NZ, IMUL*2 DO 310 J = 0, NY, IMUL*2 DO 310 I = 0, NX, IMUL*2 IF (UNIFRM(I,J,K,1) .LT. LEVEL) THEN UNIFRM(I,J,K,1) = + MIN(UNIFRM(I,J,K-IMUL,1),UNIFRM(I,J,K+IMUL,1)) ENDIF 310 CONTINUE DO 320 K = 0, NZ, IMUL DO 320 J = IMUL, NY, IMUL*2 DO 320 I = 0, NX, IMUL*2 IF (UNIFRM(I,J,K,1) .LT. LEVEL) THEN UNIFRM(I,J,K,1) = + MIN(UNIFRM(I,J-IMUL,K,1),UNIFRM(I,J+IMUL,K,1)) ENDIF 320 CONTINUE DO 330 K = 0, NZ, IMUL DO 330 J = 0, NY, IMUL DO 330 I = IMUL, NX, IMUL*2 IF (UNIFRM(I,J,K,1) .LT. LEVEL) THEN UNIFRM(I,J,K,1) = + MIN(UNIFRM(I-IMUL,J,K,1),UNIFRM(I+IMUL,J,K,1)) ENDIF 330 CONTINUE 300 CONTINUE DO 350 K = 0, NZ DO 350 J = 0, NY DO 350 I = 0, NX WRITE(LUNG,'(I2)') NINT(UNIFRM(I,J,K,1)) 350 CONTINUE RETURN END SHAR_EOF fi # end of overwriting check cd .. cd .. if test ! -d 'Info' then mkdir 'Info' fi cd 'Info' if test -f 'depend' then echo shar: will not over-write existing file "'depend'" else cat << \SHAR_EOF > 'depend' port/i1mach.f port/d1mach.f blas1/ddot.f blas1/daxpy.f blas1/dnrm2.f blas1/sdot.f blas1/saxpy.f blas1/snrm2.f SHAR_EOF fi # end of overwriting check cd .. if test ! -d 'Src' then mkdir 'Src' fi cd 'Src' if test ! -d 'Dp' then mkdir 'Dp' fi cd 'Dp' if test -f 'ilubs1.f' then echo shar: will not over-write existing file "'ilubs1.f'" else cat << \SHAR_EOF > 'ilubs1.f' SUBROUTINE ILU (NPTS, NPD, A, LLDG, LSL, LLSL) INTEGER NPDE PARAMETER (NPDE = 1) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPD, LLDG(NPTS,-9:-2), LSL(*), LLSL(0:*) DOUBLE PRECISION A(NPTS,-9:9) C Ccc PURPOSE: C Incomplete LU decomposition of A C A stems from a 19-point stencil on a grid with irregular row and C plane sizes C A = ILU, vectorized by `hyperplane' ordening, where the `hyperplanes' C are sets of points that can be treated simultaneously. C A((i,j,k),1:NPDE,1:NPDE,.) contains a block of NPDE.NPDE elements C corresponding with node (i,j,k) C Ccc PARAMETER DESCRIPTION: C NPTS : IN. # gridpoints C NPDE : IN. # components of the PDE C A : INOUT. C IN: A(.,1:NPDE,1:NPDE,-9:-1) : lower block diagonals C A(.,1:NPDE,1:NPDE,0) : main block diagonal C A(.,1:NPDE,1:NPDE, 1: 9) : upper block diagonals C OUT: A(.,1:NPDE,1:NPDE,-9:-1) : lower block diagonals of L C A(.,ic,jc,0): jc < ic: main block diagonal of L C main diagonal L == I C jc >=ic: main block diagonal of U C main diagonal U inverted C A(.,1:NPDE,1:NPDE, 1: 9) : upper block diagonals of U C LLDG : IN. Block-column index of lower 8 block-diagonals C If block ld does not exist the LLDG(K,ld) = K C LSL : IN. (NPTS) C LSL(LLSL(m-1)+1:LLSL(m)): pointers to set of points S_m C in actual grid that can be treated at the m-th iteration C LLSL : IN. (0:LLSL(0)) C LLSL(0) = # iterations needed C LLSL(1:LLSL(0)): pointers to the start of a list in LSL C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER N, L, M C IF (NPDE .NE. NPD) STOP 'Wrong ILUBS loaded.' C C Loop over `hyperplanes' S_m, m = 1, LLSL(0) C Node # N = S_m(LLSL(l)) C C S_1 = {(i,j,k)| (i,j,k) not dependent on (i-ii,j-jj,k-kk), C ii,jj,kk >= 0, not ii=jj=kk=0; C i.e., Dirichlet points and left/down/front corners} M = 1 CDIR$ IVDEP DO 553 L = 1, LLSL(M) N = LSL(L) A(N,0) = 1.0 / A(N,0) 553 CONTINUE C C Loop over rest of `hyperplane' sets C NB. No exception handling is necessary for the first row and the first C point of the second row, since N > 1 in the loop and for those C points LLDG(N,.) = N, (=> no array index problems), C and the multiplicator of `non existing' array elements is zero. C DO 10 M = 2, LLSL(0) C C Compute lower diagonals CDIR$ IVDEP DO 20 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,-9) = (A(N,-9)) * A(LLDG(N,-9),0) A(N,-8) = (A(N,-8) - A(N,-9)*A(LLDG(N,-9),2)) + * A(LLDG(N,-8),0) A(N,-7) = (A(N,-7) - A(N,-9)*A(LLDG(N,-9),3) + - A(N,-8)*A(LLDG(N,-8),1)) + * A(LLDG(N,-7),0) A(N,-6) = (A(N,-6) - A(N,-9)*A(LLDG(N,-9),4) + - A(N,-7)*A(LLDG(N,-7),1)) + * A(LLDG(N,-6),0) A(N,-5) = (A(N,-5) - A(N,-8)*A(LLDG(N,-8),4) + - A(N,-7)*A(LLDG(N,-7),3) + - A(N,-6)*A(LLDG(N,-6),2)) + * A(LLDG(N,-5),0) A(N,-4) = (A(N,-4) - A(N,-9)*A(LLDG(N,-9),6) + - A(N,-8)*A(LLDG(N,-8),5)) + * A(LLDG(N,-4),0) A(N,-3) = (A(N,-3) - A(N,-9)*A(LLDG(N,-9),8) + - A(N,-7)*A(LLDG(N,-7),5) + - A(N,-4)*A(LLDG(N,-4),1)) + * A(LLDG(N,-3),0) A(N,-2) = (A(N,-2) - A(N,-9)*A(LLDG(N,-9),8) + - A(N,-6)*A(LLDG(N,-6),5) + - A(N,-3)*A(LLDG(N,-3),1)) + * A(LLDG(N,-2),0) A(N,-1) = (A(N,-1) - A(N,-8)*A(LLDG(N,-8),7) + - A(N,-7)*A(LLDG(N,-7),6) + - A(N,-4)*A(LLDG(N,-4),3) + - A(N,-3)*A(LLDG(N,-3),2)) + * A(N-1,0) C C Compute main diagonal A(N,0) = 1.0 / (A(N, 0) - A(N,-9)*A(LLDG(N,-9),9) + - A(N,-8)*A(LLDG(N,-8),8) + - A(N,-7)*A(LLDG(N,-7),7) + - A(N,-6)*A(LLDG(N,-6),6) + - A(N,-5)*A(LLDG(N,-5),5) + - A(N,-4)*A(LLDG(N,-4),4) + - A(N,-3)*A(LLDG(N,-3),3) + - A(N,-2)*A(LLDG(N,-2),2) + - A(N,-1)*A(N-1 ,1)) C C Compute upper diagonals A(N,1) = A(N, 1) - A(N,-7)*A(LLDG(N,-7),8) + - A(N,-6)*A(LLDG(N,-6),7) + - A(N,-3)*A(LLDG(N,-3),4) + - A(N,-2)*A(LLDG(N,-2),3) A(N,2) = A(N, 2) - A(N,-8)*A(LLDG(N,-8),9) + - A(N,-5)*A(LLDG(N,-5),6) + - A(N,-1)*A(N-1 ,3) A(N,3) = A(N, 3) - A(N,-7)*A(LLDG(N,-7),9) + - A(N,-5)*A(LLDG(N,-5),7) + - A(N,-1)*A(N-1 ,4) A(N,4) = A(N, 4) - A(N,-6)*A(LLDG(N,-6),9) + - A(N,-5)*A(LLDG(N,-5),8) A(N,5) = A(N, 5) - A(N,-9)*A(LLDG(N,-9),8) + - A(N,-3)*A(LLDG(N,-3),7) + - A(N,-2)*A(LLDG(N,-2),6) A(N,6) = A(N, 6) - A(N,-4)*A(LLDG(N,-4),9) + - A(N,-1)*A(N-1 ,7) A(N,7) = A(N, 7) - A(N,-3)*A(LLDG(N,-3),9) + - A(N,-1)*A(N-1 ,8) A(N,8) = A(N, 8) - A(N,-2)*A(LLDG(N,-2),9) 20 CONTINUE C 10 CONTINUE C RETURN END SUBROUTINE BCKSLV (NPTS, NPD, A, LLDG, LUDG, LSL, LLSL, LSU, LLSU, + B) INTEGER NPDE PARAMETER (NPDE = 1) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPD, LLDG(NPTS,-9:-2), LUDG(NPTS,2:9), + LSL(*), LLSL(0:*), LSU(*), LLSU(0:*) DOUBLE PRECISION A(NPTS,-9:9), B(NPTS) C Ccc PURPOSE: C Solve LUx = b C A stems from a 19-point stencil on a grid with irregular row and C plane sizes C A = ILU, vectorized by `hyperplane' ordening, where the `hyperplanes' C are sets of points that can be treated simultaneously. C A((i,j,k),1:NPDE,1:NPDE,.) contains a block of NPDE.NPDE elements C corresponding with node (i,j,k) C Ccc PARAMETER DESCRIPTION: C NPTS : IN. # gridpoints C NPDE : IN. # components of the PDE C A : IN. A(.,1:NPDE,1:NPDE,-9:-1) : lower block diagonals of L C A(.,ic,jc,0): jc < ic: main block diagonal of L C main diagonal L == I C jc >=ic: main block diagonal of U C main diagonal U inverted C A(.,1:NPDE,1:NPDE, 1: 9) : upper block diagonals of U C LLDG : IN. Block-column index of lower 8 block-diagonals C If block ld does not exist the LLDG(K,ld) = K C LUDG : IN. Block-column index of upper 8 block-diagonals C If block ud does not exist the LUDG(K,lu) = K C LSL : IN. (NPTS) C LSL(LLSL(m-1)+1:LLSL(m)): pointers to set of points S_m C in actual grid that can be treated at the m-th iteration C of Ly = b C LLSL : IN. (0:LLSL(0)) C LLSL(0) = # iterations needed C LLSL(1:LLSL(0)): pointers to the start of a list in LSL C LSU : IN. (NPTS) C LSU(LLSU(m-1)+1:LLSU(m)): pointers to set of points S_m C in actual grid that can be treated at the m-th iteration C of Ux = y C LLSU : IN. (0:LLSU(0)) C LLSU(0) = # iterations needed C LLSU(1:LLSU(0)): pointers to the start of a list in LSU C B : INOUT. C IN: right-hand side vector b C OUT: solution vector x C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER N, L, M C CCC Ly = b C C Loop over `hyperplanes' S_m, m = 1, LLSL(0) C Node # N = LSL_m(LLSL(l)) C C Loop over rest of `hyperplane' sets C NB. No exception handling is necessary for the first row and the first C point of the second row, since N > 1 in the loop and for those C points LLDG(N,.) = N, (=> no array index problems), C and the multiplicator of `non existing' array elements is zero. C DO 10 M = 2, LLSL(0) C C Compute y elements in this set CDIR$ IVDEP DO 20 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) B(N) = B(N) - A(N,-1)*B(N- 1) + - A(N,-2)*B(LLDG(N,-2)) + - A(N,-3)*B(LLDG(N,-3)) + - A(N,-4)*B(LLDG(N,-4)) + - A(N,-5)*B(LLDG(N,-5)) + - A(N,-6)*B(LLDG(N,-6)) + - A(N,-7)*B(LLDG(N,-7)) + - A(N,-8)*B(LLDG(N,-8)) + - A(N,-9)*B(LLDG(N,-9)) 20 CONTINUE C 10 CONTINUE C CCC Ux = y C C Loop over `hyperplanes' LSU_m, m = 1, LLSU(0) C Node # N = LSU_m(LLSU(l)) C C LSU_1 = {(i,j,k)| (i,j,k) not dependent on (i+ii,j+jj,k+kk), C ii,jj,kk >= 0, not ii=jj=kk=0; C e.g., Dirichlet points and right/up/back corners} C M = 1 CDIR$ IVDEP DO 133 L = 1, LLSU(M) N = LSU(L) B(N) = B(N) * A(N,0) 133 CONTINUE C C Loop over rest of `hyperplane' sets C NB. No exception handling is necessary for the last row and the first C point of the second last row, since N < NPTS in the loop and for C those points LUDG(N,.) = N (=> no array index problems), C and the multiplicator of `non existing' array elements is zero. C DO 30 M = 2, LLSU(0) C C Compute x elements in this set CDIR$ IVDEP DO 40 L = LLSU(M-1)+1, LLSU(M) N = LSU(L) B(N) = (B(N) - A(N,1)*B(N+1 ) + - A(N,2)*B(LUDG(N,2)) + - A(N,3)*B(LUDG(N,3)) + - A(N,4)*B(LUDG(N,4)) + - A(N,5)*B(LUDG(N,5)) + - A(N,6)*B(LUDG(N,6)) + - A(N,7)*B(LUDG(N,7)) + - A(N,8)*B(LUDG(N,8)) + - A(N,9)*B(LUDG(N,9))) * A(N,0) 40 CONTINUE C 30 CONTINUE C RETURN END SHAR_EOF fi # end of overwriting check if test -f 'ilubs2.f' then echo shar: will not over-write existing file "'ilubs2.f'" else cat << \SHAR_EOF > 'ilubs2.f' SUBROUTINE ILU (NPTS, NPD, A, LLDG, LSL, LLSL) INTEGER NPDE PARAMETER (NPDE = 2) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPD, LLDG(NPTS,-9:-2), LSL(*), LLSL(0:*) DOUBLE PRECISION A(NPTS,NPDE,NPDE,-9:9) C Ccc PURPOSE: C Incomplete LU decomposition of A C A stems from a 19-point stencil on a grid with irregular row and C plane sizes C A = ILU, vectorized by `hyperplane' ordening, where the `hyperplanes' C are sets of points that can be treated simultaneously. C A((i,j,k),1:NPDE,1:NPDE,.) contains a block of NPDE.NPDE elements C corresponding with node (i,j,k) C Ccc PARAMETER DESCRIPTION: C NPTS : IN. # gridpoints C NPDE : IN. # components of the PDE C A : INOUT. C IN: A(.,1:NPDE,1:NPDE,-9:-1) : lower block diagonals C A(.,1:NPDE,1:NPDE,0) : main block diagonal C A(.,1:NPDE,1:NPDE, 1: 9) : upper block diagonals C OUT: A(.,1:NPDE,1:NPDE,-9:-1) : lower block diagonals of L C A(.,ic,jc,0): jc < ic: main block diagonal of L C main diagonal L == I C jc >=ic: main block diagonal of U C main diagonal U inverted C A(.,1:NPDE,1:NPDE, 1: 9) : upper block diagonals of U C LLDG : IN. Block-column index of lower 8 block-diagonals C If block ld does not exist the LLDG(N,ld) = N C LSL : IN. (NPTS) C LSL(LLSL(m-1)+1:LLSL(m)): pointers to set of points S_m C in actual grid that can be treated at the m-th iteration C LLSL : IN. (0:LLSL(0)) C LLSL(0) = # iterations needed C LLSL(1:LLSL(0)): pointers to the start of a list in LSL C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER IC, JC, LC, N, L, M C IF (NPDE .NE. NPD) STOP 'Wrong ILUBS loaded.' C C Loop over `hyperplanes' S_m, m = 1, LLSL(0) C Node # N = S_m(LLSL(l)) C C S_1 = {(i,j,k)| (i,j,k) not dependent on (i-ii,j-jj,k-kk), C ii,jj,kk >= 0, not ii=jj=kk=0; C i.e., Dirichlet points and left/down/front corners} M = 1 C C Compute main block diagonal DO 550 IC = 1, NPDE DO 554 LC = 1, IC-1 DO 555 JC = IC, NPDE CDIR$ IVDEP DO 551 L = 1, LLSL(M) N = LSL(L) A(N,IC,JC,0) = A(N,IC,JC,0) + - A(N,IC,LC,0)*A(N,LC,JC,0) 551 CONTINUE 555 CONTINUE DO 556 JC = IC+1, NPDE CDIR$ IVDEP DO 552 L = 1, LLSL(M) N = LSL(L) A(N,JC,IC,0) = A(N,JC,IC,0) + - A(N,JC,LC,0)*A(N,LC,IC,0) 552 CONTINUE 556 CONTINUE 554 CONTINUE CDIR$ IVDEP DO 553 L = 1, LLSL(M) N = LSL(L) A(N,IC,IC,0) = 1.0 / A(N,IC,IC,0) 553 CONTINUE DO 557 JC = IC+1, NPDE CDIR$ IVDEP DO 559 L = 1, LLSL(M) N = LSL(L) A(N,JC,IC,0) = A(N,JC,IC,0) * A(N,IC,IC,0) 559 CONTINUE 557 CONTINUE 550 CONTINUE C C Compute upper block diagonals DO 560 IC = 1, NPDE DO 563 LC = 1, IC-1 DO 564 JC = 1, NPDE CDIR$ IVDEP DO 561 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,1) = A(N,IC,JC,1) + - A(N,IC,LC,0)*A(N,LC,JC,1) A(N,IC,JC,2) = A(N,IC,JC,2) + - A(N,IC,LC,0)*A(N,LC,JC,2) A(N,IC,JC,3) = A(N,IC,JC,3) + - A(N,IC,LC,0)*A(N,LC,JC,3) A(N,IC,JC,4) = A(N,IC,JC,4) + - A(N,IC,LC,0)*A(N,LC,JC,4) A(N,IC,JC,5) = A(N,IC,JC,5) + - A(N,IC,LC,0)*A(N,LC,JC,5) A(N,IC,JC,6) = A(N,IC,JC,6) + - A(N,IC,LC,0)*A(N,LC,JC,6) A(N,IC,JC,7) = A(N,IC,JC,7) + - A(N,IC,LC,0)*A(N,LC,JC,7) A(N,IC,JC,8) = A(N,IC,JC,8) + - A(N,IC,LC,0)*A(N,LC,JC,8) A(N,IC,JC,9) = A(N,IC,JC,9) + - A(N,IC,LC,0)*A(N,LC,JC,9) 561 CONTINUE 564 CONTINUE 563 CONTINUE 560 CONTINUE C C Loop over rest of `hyperplane' sets C NB. No exception handling is necessary for the first row and the first C point of the second row, since N > 1 in the loop and for those C points LLDG(N,.) = N, (=> no array index problems), C and the multiplicator of `non existing' array elements is zero. C DO 10 M = 2, LLSL(0) C C Compute lower diagonals DO 120 JC = 1, NPDE DO 121 LC = 1, JC-1 CDIR$ IVDEP DO 20 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 122 IC = 1, NPDE A(N,IC,JC,-9) = A(N,IC,JC,-9) + - A(N,IC,LC,-9) * A(LLDG(N,-9),LC,JC,0) 122 CONTINUE 20 CONTINUE 121 CONTINUE CDIR$ IVDEP DO 21 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 123 IC = 1, NPDE A(N,IC,JC,-9) = A(N,IC,JC,-9) * A(LLDG(N,-9),JC,JC,0) 123 CONTINUE 21 CONTINUE 120 CONTINUE DO 130 JC = 1, NPDE CDIR$ IVDEP DO 30 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 131 LC = 1, NPDE CFPP$ UNROLL DO 132 IC = 1, NPDE A(N,IC,JC,-8) = A(N,IC,JC,-8) + - A(N,IC,LC,-9)*A(LLDG(N,-9),LC,JC,2) 132 CONTINUE 131 CONTINUE 30 CONTINUE DO 133 LC = 1, JC-1 CDIR$ IVDEP DO 31 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 134 IC = 1, NPDE A(N,IC,JC,-8) = A(N,IC,JC,-8) + - A(N,IC,LC,-8)*A(LLDG(N,-8),LC,JC,0) 134 CONTINUE 31 CONTINUE 133 CONTINUE CDIR$ IVDEP DO 32 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 135 IC = 1, NPDE A(N,IC,JC,-8) = A(N,IC,JC,-8) * A(LLDG(N,-8),JC,JC,0) 135 CONTINUE 32 CONTINUE 130 CONTINUE DO 140 JC = 1, NPDE CDIR$ IVDEP DO 40 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 141 LC = 1, NPDE CFPP$ UNROLL DO 142 IC = 1, NPDE A(N,IC,JC,-7) = A(N,IC,JC,-7) + - A(N,IC,LC,-9)*A(LLDG(N,-9),LC,JC,3) + - A(N,IC,LC,-8)*A(LLDG(N,-8),LC,JC,1) 142 CONTINUE 141 CONTINUE 40 CONTINUE DO 143 LC = 1, JC-1 CDIR$ IVDEP DO 41 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 144 IC = 1, NPDE A(N,IC,JC,-7) = A(N,IC,JC,-7) + - A(N,IC,LC,-7)*A(LLDG(N,-7),LC,JC,0) 144 CONTINUE 41 CONTINUE 143 CONTINUE CDIR$ IVDEP DO 42 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 145 IC = 1, NPDE A(N,IC,JC,-7) = A(N,IC,JC,-7) * A(LLDG(N,-7),JC,JC,0) 145 CONTINUE 42 CONTINUE 140 CONTINUE DO 150 JC = 1, NPDE CDIR$ IVDEP DO 50 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 151 LC = 1, NPDE CFPP$ UNROLL DO 152 IC = 1, NPDE A(N,IC,JC,-6) = A(N,IC,JC,-6) + - A(N,IC,LC,-9)*A(LLDG(N,-9),LC,JC,4) + - A(N,IC,LC,-7)*A(LLDG(N,-7),LC,JC,1) 152 CONTINUE 151 CONTINUE 50 CONTINUE DO 153 LC = 1, JC-1 CDIR$ IVDEP DO 51 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 154 IC = 1, NPDE A(N,IC,JC,-6) = A(N,IC,JC,-6) + - A(N,IC,LC,-6)*A(LLDG(N,-6),LC,JC,0) 154 CONTINUE 51 CONTINUE 153 CONTINUE CDIR$ IVDEP DO 52 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 155 IC = 1, NPDE A(N,IC,JC,-6) = A(N,IC,JC,-6) * A(LLDG(N,-6),JC,JC,0) 155 CONTINUE 52 CONTINUE 150 CONTINUE DO 160 JC = 1, NPDE CDIR$ IVDEP DO 60 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 161 LC = 1, NPDE CFPP$ UNROLL DO 162 IC = 1, NPDE A(N,IC,JC,-5) = A(N,IC,JC,-5) + - A(N,IC,LC,-8)*A(LLDG(N,-8),LC,JC,4) + - A(N,IC,LC,-7)*A(LLDG(N,-7),LC,JC,3) + - A(N,IC,LC,-6)*A(LLDG(N,-6),LC,JC,2) A(N,IC,JC,-4) = A(N,IC,JC,-4) + - A(N,IC,LC,-9)*A(LLDG(N,-9),LC,JC,6) + - A(N,IC,LC,-8)*A(LLDG(N,-8),LC,JC,5) 162 CONTINUE 161 CONTINUE 60 CONTINUE DO 163 LC = 1, JC-1 CDIR$ IVDEP DO 61 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 164 IC = 1, NPDE A(N,IC,JC,-5) = A(N,IC,JC,-5) + - A(N,IC,LC,-5)*A(LLDG(N,-5),LC,JC,0) A(N,IC,JC,-4) = A(N,IC,JC,-4) + - A(N,IC,LC,-4)*A(LLDG(N,-4),LC,JC,0) 164 CONTINUE 61 CONTINUE 163 CONTINUE CDIR$ IVDEP DO 62 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 165 IC = 1, NPDE A(N,IC,JC,-5) = A(N,IC,JC,-5) * A(LLDG(N,-5),JC,JC,0) A(N,IC,JC,-4) = A(N,IC,JC,-4) * A(LLDG(N,-4),JC,JC,0) 165 CONTINUE 62 CONTINUE 160 CONTINUE DO 170 JC = 1, NPDE CDIR$ IVDEP DO 70 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 171 LC = 1, NPDE CFPP$ UNROLL DO 172 IC = 1, NPDE A(N,IC,JC,-3) = A(N,IC,JC,-3) + - A(N,IC,LC,-9)*A(LLDG(N,-9),LC,JC,8) + - A(N,IC,LC,-7)*A(LLDG(N,-7),LC,JC,5) + - A(N,IC,LC,-4)*A(LLDG(N,-4),LC,JC,1) 172 CONTINUE 171 CONTINUE 70 CONTINUE DO 173 LC = 1, JC-1 CDIR$ IVDEP DO 71 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 174 IC = 1, NPDE A(N,IC,JC,-3) = A(N,IC,JC,-3) + - A(N,IC,LC,-3)*A(LLDG(N,-3),LC,JC,0) 174 CONTINUE 71 CONTINUE 173 CONTINUE CDIR$ IVDEP DO 72 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 175 IC = 1, NPDE A(N,IC,JC,-3) = A(N,IC,JC,-3) * A(LLDG(N,-3),JC,JC,0) 175 CONTINUE 72 CONTINUE 170 CONTINUE DO 180 JC = 1, NPDE CDIR$ IVDEP DO 80 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 181 LC = 1, NPDE CFPP$ UNROLL DO 182 IC = 1, NPDE A(N,IC,JC,-2) = A(N,IC,JC,-2) + - A(N,IC,LC,-9)*A(LLDG(N,-9),LC,JC,8) + - A(N,IC,LC,-6)*A(LLDG(N,-6),LC,JC,5) + - A(N,IC,LC,-3)*A(LLDG(N,-3),LC,JC,1) A(N,IC,JC,-1) = A(N,IC,JC,-1) + - A(N,IC,LC,-8)*A(LLDG(N,-8),LC,JC,7) + - A(N,IC,LC,-7)*A(LLDG(N,-7),LC,JC,6) + - A(N,IC,LC,-4)*A(LLDG(N,-4),LC,JC,3) + - A(N,IC,LC,-3)*A(LLDG(N,-3),LC,JC,2) 182 CONTINUE 181 CONTINUE 80 CONTINUE DO 183 LC = 1, JC-1 CDIR$ IVDEP DO 81 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 184 IC = 1, NPDE A(N,IC,JC,-2) = A(N,IC,JC,-2) + - A(N,IC,LC,-2)*A(LLDG(N,-2),LC,JC,0) A(N,IC,JC,-1) = A(N,IC,JC,-1) + - A(N,IC,LC,-1)*A(N-1 ,LC,JC,0) 184 CONTINUE 81 CONTINUE 183 CONTINUE CDIR$ IVDEP DO 82 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 185 IC = 1, NPDE A(N,IC,JC,-2) = A(N,IC,JC,-2) * A(LLDG(N,-2),JC,JC,0) A(N,IC,JC,-1) = A(N,IC,JC,-1) * A(N-1 ,JC,JC,0) 185 CONTINUE 82 CONTINUE 180 CONTINUE C C Compute main diagonal DO 300 IC = 1, NPDE DO 302 JC = IC, NPDE CDIR$ IVDEP DO 200 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 301 LC = 1, NPDE A(N,IC,JC,0) = A(N,IC,JC, 0) + - A(N,IC,LC,-9)*A(LLDG(N,-9),LC,JC,9) + - A(N,IC,LC,-8)*A(LLDG(N,-8),LC,JC,8) + - A(N,IC,LC,-7)*A(LLDG(N,-7),LC,JC,7) + - A(N,IC,LC,-6)*A(LLDG(N,-6),LC,JC,6) + - A(N,IC,LC,-5)*A(LLDG(N,-5),LC,JC,5) + - A(N,IC,LC,-4)*A(LLDG(N,-4),LC,JC,4) + - A(N,IC,LC,-3)*A(LLDG(N,-3),LC,JC,3) + - A(N,IC,LC,-2)*A(LLDG(N,-2),LC,JC,2) + - A(N,IC,LC,-1)*A(N-1 ,LC,JC,1) 301 CONTINUE 200 CONTINUE 302 CONTINUE DO 303 JC = IC+1, NPDE CDIR$ IVDEP DO 201 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 1301 LC = 1, NPDE A(N,JC,IC,0) = A(N,JC,IC, 0) + - A(N,JC,LC,-9)*A(LLDG(N,-9),LC,IC,9) + - A(N,JC,LC,-8)*A(LLDG(N,-8),LC,IC,8) + - A(N,JC,LC,-7)*A(LLDG(N,-7),LC,IC,7) + - A(N,JC,LC,-6)*A(LLDG(N,-6),LC,IC,6) + - A(N,JC,LC,-5)*A(LLDG(N,-5),LC,IC,5) + - A(N,JC,LC,-4)*A(LLDG(N,-4),LC,IC,4) + - A(N,JC,LC,-3)*A(LLDG(N,-3),LC,IC,3) + - A(N,JC,LC,-2)*A(LLDG(N,-2),LC,IC,2) + - A(N,JC,LC,-1)*A(N-1 ,LC,IC,1) 1301 CONTINUE 201 CONTINUE 303 CONTINUE DO 304 LC = 1, IC-1 DO 305 JC = IC, NPDE CDIR$ IVDEP DO 202 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,0) = A(N,IC,JC,0) + - A(N,IC,LC,0)*A(N ,LC,JC,0) 202 CONTINUE 305 CONTINUE DO 306 JC = IC+1, NPDE CDIR$ IVDEP DO 203 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,JC,IC,0) = A(N,JC,IC,0) + - A(N,JC,LC,0)*A(N ,LC,IC,0) 203 CONTINUE 306 CONTINUE 304 CONTINUE CDIR$ IVDEP DO 204 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,IC,0) = 1.0 / A(N,IC,IC,0) 204 CONTINUE DO 307 JC = IC+1, NPDE CDIR$ IVDEP DO 205 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,JC,IC,0) = A(N,JC,IC,0) * A(N,IC,IC,0) 205 CONTINUE 307 CONTINUE 300 CONTINUE C C Compute upper diagonals DO 500 IC = 1, NPDE CDIR$ IVDEP DO 400 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 501 LC = 1, NPDE A(N,IC,1,1) = A(N,IC,1,1) - A(N,IC,LC,-7)*A(LLDG(N,-7),LC,1,8) - A 1 (N,IC,LC,-6)*A(LLDG(N,-6),LC,1,7) - A(N,IC,LC,-3)*A(LLDG(N,-3), 2 LC,1,4) - A(N,IC,LC,-2)*A(LLDG(N,-2),LC,1,3) A(N,IC,1,2) = A(N,IC,1,2) - A(N,IC,LC,-8)*A(LLDG(N,-8),LC,1,9) - A 1 (N,IC,LC,-5)*A(LLDG(N,-5),LC,1,6) - A(N,IC,LC,-1)*A(N-1,LC,1,3) A(N,IC,1,3) = A(N,IC,1,3) - A(N,IC,LC,-7)*A(LLDG(N,-7),LC,1,9) - A 1 (N,IC,LC,-5)*A(LLDG(N,-5),LC,1,7) - A(N,IC,LC,-1)*A(N-1,LC,1,4) A(N,IC,1,4) = A(N,IC,1,4) - A(N,IC,LC,-6)*A(LLDG(N,-6),LC,1,9) - A 1 (N,IC,LC,-5)*A(LLDG(N,-5),LC,1,8) A(N,IC,1,5) = A(N,IC,1,5) - A(N,IC,LC,-9)*A(LLDG(N,-9),LC,1,8) - A 1 (N,IC,LC,-3)*A(LLDG(N,-3),LC,1,7) - A(N,IC,LC,-2)*A(LLDG(N,-2), 2 LC,1,6) A(N,IC,1,6) = A(N,IC,1,6) - A(N,IC,LC,-4)*A(LLDG(N,-4),LC,1,9) - A 1 (N,IC,LC,-1)*A(N-1,LC,1,7) A(N,IC,1,7) = A(N,IC,1,7) - A(N,IC,LC,-3)*A(LLDG(N,-3),LC,1,9) - A 1 (N,IC,LC,-1)*A(N-1,LC,1,8) A(N,IC,1,8) = A(N,IC,1,8) - A(N,IC,LC,-2)*A(LLDG(N,-2),LC,1,9) A(N,IC,2,1) = A(N,IC,2,1) - A(N,IC,LC,-7)*A(LLDG(N,-7),LC,2,8) - A 1 (N,IC,LC,-6)*A(LLDG(N,-6),LC,2,7) - A(N,IC,LC,-3)*A(LLDG(N,-3), 2 LC,2,4) - A(N,IC,LC,-2)*A(LLDG(N,-2),LC,2,3) A(N,IC,2,2) = A(N,IC,2,2) - A(N,IC,LC,-8)*A(LLDG(N,-8),LC,2,9) - A 1 (N,IC,LC,-5)*A(LLDG(N,-5),LC,2,6) - A(N,IC,LC,-1)*A(N-1,LC,2,3) A(N,IC,2,3) = A(N,IC,2,3) - A(N,IC,LC,-7)*A(LLDG(N,-7),LC,2,9) - A 1 (N,IC,LC,-5)*A(LLDG(N,-5),LC,2,7) - A(N,IC,LC,-1)*A(N-1,LC,2,4) A(N,IC,2,4) = A(N,IC,2,4) - A(N,IC,LC,-6)*A(LLDG(N,-6),LC,2,9) - A 1 (N,IC,LC,-5)*A(LLDG(N,-5),LC,2,8) A(N,IC,2,5) = A(N,IC,2,5) - A(N,IC,LC,-9)*A(LLDG(N,-9),LC,2,8) - A 1 (N,IC,LC,-3)*A(LLDG(N,-3),LC,2,7) - A(N,IC,LC,-2)*A(LLDG(N,-2), 2 LC,2,6) A(N,IC,2,6) = A(N,IC,2,6) - A(N,IC,LC,-4)*A(LLDG(N,-4),LC,2,9) - A 1 (N,IC,LC,-1)*A(N-1,LC,2,7) A(N,IC,2,7) = A(N,IC,2,7) - A(N,IC,LC,-3)*A(LLDG(N,-3),LC,2,9) - A 1 (N,IC,LC,-1)*A(N-1,LC,2,8) A(N,IC,2,8) = A(N,IC,2,8) - A(N,IC,LC,-2)*A(LLDG(N,-2),LC,2,9) 501 CONTINUE 400 CONTINUE DO 503 LC = 1, IC-1 CDIR$ IVDEP DO 401 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 504 JC = 1, NPDE A(N,IC,JC,1) = A(N,IC,JC,1) + - A(N,IC,LC,0)*A(N,LC,JC,1) A(N,IC,JC,2) = A(N,IC,JC,2) + - A(N,IC,LC,0)*A(N,LC,JC,2) A(N,IC,JC,3) = A(N,IC,JC,3) + - A(N,IC,LC,0)*A(N,LC,JC,3) A(N,IC,JC,4) = A(N,IC,JC,4) + - A(N,IC,LC,0)*A(N,LC,JC,4) A(N,IC,JC,5) = A(N,IC,JC,5) + - A(N,IC,LC,0)*A(N,LC,JC,5) A(N,IC,JC,6) = A(N,IC,JC,6) + - A(N,IC,LC,0)*A(N,LC,JC,6) A(N,IC,JC,7) = A(N,IC,JC,7) + - A(N,IC,LC,0)*A(N,LC,JC,7) A(N,IC,JC,8) = A(N,IC,JC,8) + - A(N,IC,LC,0)*A(N,LC,JC,8) A(N,IC,JC,9) = A(N,IC,JC,9) + - A(N,IC,LC,0)*A(N,LC,JC,9) 504 CONTINUE 401 CONTINUE 503 CONTINUE 500 CONTINUE C 10 CONTINUE C RETURN END SUBROUTINE BCKSLV (NPTS, NPD, A, LLDG, LUDG, LSL, LLSL, LSU, LLSU, + B) INTEGER NPDE PARAMETER (NPDE = 2) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPD, LLDG(NPTS,-9:-2), LUDG(NPTS,2:9), + LSL(*), LLSL(0:*), LSU(*), LLSU(0:*) DOUBLE PRECISION A(NPTS,NPDE,NPDE,-9:9), B(NPTS,NPDE) C Ccc PURPOSE: C Solve LUx = b C A stems from a 19-point stencil on a grid with irregular row and C plane sizes C A = ILU, vectorized by `hyperplane' ordening, where the `hyperplanes' C are sets of points that can be treated simultaneously. C A((i,j,k),1:NPDE,1:NPDE,.) contains a block of NPDE.NPDE elements C corresponding with node (i,j,k) C Ccc PARAMETER DESCRIPTION: C NPTS : IN. # gridpoints C NPDE : IN. # components of the PDE C A : IN. A(.,1:NPDE,1:NPDE,-9:-1) : lower block diagonals of L C A(.,ic,jc,0): jc < ic: main block diagonal of L C main diagonal L == I C jc >=ic: main block diagonal of U C main diagonal U inverted C A(.,1:NPDE,1:NPDE, 1: 9) : upper block diagonals of U C LLDG : IN. Block-column index of lower 8 block-diagonals C If block ld does not exist the LLDG(N,ld) = N C LUDG : IN. Block-column index of upper 8 block-diagonals C If block ud does not exist the LUDG(N,lu) = N C LSL : IN. (NPTS) C LSL(LLSL(m-1)+1:LLSL(m)): pointers to set of points S_m C in actual grid that can be treated at the m-th iteration C of Ly = b C LLSL : IN. (0:LLSL(0)) C LLSL(0) = # iterations needed C LLSL(1:LLSL(0)): pointers to the start of a list in LSL C LSU : IN. (NPTS) C LSU(LLSU(m-1)+1:LLSU(m)): pointers to set of points S_m C in actual grid that can be treated at the m-th iteration C of Ux = y C LLSU : IN. (0:LLSU(0)) C LLSU(0) = # iterations needed C LLSU(1:LLSU(0)): pointers to the start of a list in LSU C B : INOUT. C IN: right-hand side vector b C OUT: solution vector x C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER IC, JC, N, L, M C CCC Ly = b C C Loop over `hyperplanes' S_m, m = 1, LLSL(0) C Node # N = LSL_m(LLSL(l)) C C LSL_1 = {(i,j,k)| (i,j,k) not dependent on (i-ii,j-jj,k-kk), C ii,jj,kk >= 0, not ii=jj=kk=0; C i.e., Dirichlet points and left/down/front corners} M = 1 DO 100 IC = 2, NPDE DO 101 JC = 1, IC-1 CDIR$ IVDEP DO 1 L = 1, LLSL(M) N = LSL(L) B(N,IC) = B(N,IC) - A(N,IC,JC,0)*B(N,JC) 1 CONTINUE 101 CONTINUE 100 CONTINUE C C Loop over rest of `hyperplane' sets C NB. No exception handling is necessary for the first row and the first C point of the second row, since N > 1 in the loop and for those C points LLDG(N,.) = N, (=> no array index problems), C and the multiplicator of `non existing' array elements is zero. C DO 10 M = 2, LLSL(0) C C Compute y elements in this set CDIR$ IVDEP DO 20 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 120 IC = 1, NPDE CFPP$ UNROLL DO 121 JC = 1, NPDE B(N,IC) = B(N,IC) - A(N,IC,JC,-1)*B(N- 1,JC) + - A(N,IC,JC,-2)*B(LLDG(N,-2),JC) + - A(N,IC,JC,-3)*B(LLDG(N,-3),JC) + - A(N,IC,JC,-4)*B(LLDG(N,-4),JC) + - A(N,IC,JC,-5)*B(LLDG(N,-5),JC) + - A(N,IC,JC,-6)*B(LLDG(N,-6),JC) + - A(N,IC,JC,-7)*B(LLDG(N,-7),JC) + - A(N,IC,JC,-8)*B(LLDG(N,-8),JC) + - A(N,IC,JC,-9)*B(LLDG(N,-9),JC) 121 CONTINUE 120 CONTINUE 20 CONTINUE DO 123 IC = 2, NPDE DO 122 JC = 1, IC-1 CDIR$ IVDEP DO 21 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) B(N,IC) = B(N,IC) - A(N,IC,JC,0)*B(N,JC) 21 CONTINUE 122 CONTINUE 123 CONTINUE C 10 CONTINUE C CCC Ux = y C C Loop over `hyperplanes' LSU_m, m = 1, LLSU(0) C Node # N = LSU_m(LLSU(l)) C C LSU_1 = {(i,j,k)| (i,j,k) not dependent on (i+ii,j+jj,k+kk), C ii,jj,kk >= 0, not ii=jj=kk=0; C e.g., Dirichlet points and right/up/back corners} C M = 1 DO 130 IC = NPDE, 1, -1 DO 131 JC = NPDE, IC+1, -1 CDIR$ IVDEP DO 132 L = 1, LLSU(M) N = LSU(L) B(N,IC) = B(N,IC) - A(N,IC,JC,0)*B(N,JC) 132 CONTINUE 131 CONTINUE CDIR$ IVDEP DO 133 L = 1, LLSU(M) N = LSU(L) B(N,IC) = B(N,IC) * A(N,IC,IC,0) 133 CONTINUE 130 CONTINUE C C Loop over rest of `hyperplane' sets C NB. No exception handling is necessary for the last row and the first C point of the second last row, since N < NPTS in the loop and for C those points LUDG(N,.) = N (=> no array index problems), C and the multiplicator of `non existing' array elements is zero. C DO 30 M = 2, LLSU(0) C C Compute x elements in this set CDIR$ IVDEP DO 40 L = LLSU(M-1)+1, LLSU(M) N = LSU(L) CFPP$ UNROLL DO 150 IC = NPDE, 1, -1 CFPP$ UNROLL DO 151 JC = NPDE, 1, -1 B(N,IC) = B(N,IC) - A(N,IC,JC,1)*B(N+1 ,JC) + - A(N,IC,JC,2)*B(LUDG(N,2),JC) + - A(N,IC,JC,3)*B(LUDG(N,3),JC) + - A(N,IC,JC,4)*B(LUDG(N,4),JC) + - A(N,IC,JC,5)*B(LUDG(N,5),JC) + - A(N,IC,JC,6)*B(LUDG(N,6),JC) + - A(N,IC,JC,7)*B(LUDG(N,7),JC) + - A(N,IC,JC,8)*B(LUDG(N,8),JC) + - A(N,IC,JC,9)*B(LUDG(N,9),JC) 151 CONTINUE 150 CONTINUE 40 CONTINUE DO 1150 IC = NPDE, 1, -1 DO 152 JC = NPDE, IC+1, -1 CDIR$ IVDEP DO 51 L = LLSU(M-1)+1, LLSU(M) N = LSU(L) B(N,IC) = B(N,IC) - A(N,IC,JC,0)*B(N,JC) 51 CONTINUE 152 CONTINUE CDIR$ IVDEP DO 52 L = LLSU(M-1)+1, LLSU(M) N = LSU(L) B(N,IC) = B(N,IC) * A(N,IC,IC,0) 52 CONTINUE 1150 CONTINUE C 30 CONTINUE C RETURN END SHAR_EOF fi # end of overwriting check if test -f 'ilubs3.f' then echo shar: will not over-write existing file "'ilubs3.f'" else cat << \SHAR_EOF > 'ilubs3.f' SUBROUTINE ILU (NPTS, NPD, A, LLDG, LSL, LLSL) INTEGER NPDE PARAMETER (NPDE = 3) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPD, LLDG(NPTS,-9:-2), LSL(*), LLSL(0:*) DOUBLE PRECISION A(NPTS,NPDE,NPDE,-9:9) C Ccc PURPOSE: C Incomplete LU decomposition of A C A stems from a 19-point stencil on a grid with irregular row and C plane sizes C A = ILU, vectorized by `hyperplane' ordening, where the `hyperplanes' C are sets of points that can be treated simultaneously. C A((i,j,k),1:NPDE,1:NPDE,.) contains a block of NPDE.NPDE elements C corresponding with node (i,j,k) C Ccc PARAMETER DESCRIPTION: C NPTS : IN. # gridpoints C NPDE : IN. # components of the PDE C A : INOUT. C IN: A(.,1:NPDE,1:NPDE,-9:-1) : lower block diagonals C A(.,1:NPDE,1:NPDE,0) : main block diagonal C A(.,1:NPDE,1:NPDE, 1: 9) : upper block diagonals C OUT: A(.,1:NPDE,1:NPDE,-9:-1) : lower block diagonals of L C A(.,ic,jc,0): jc < ic: main block diagonal of L C main diagonal L == I C jc >=ic: main block diagonal of U C main diagonal U inverted C A(.,1:NPDE,1:NPDE, 1: 9) : upper block diagonals of U C LLDG : IN. Block-column index of lower 8 block-diagonals C If block ld does not exist the LLDG(N,ld) = N C LSL : IN. (NPTS) C LSL(LLSL(m-1)+1:LLSL(m)): pointers to set of points S_m C in actual grid that can be treated at the m-th iteration C LLSL : IN. (0:LLSL(0)) C LLSL(0) = # iterations needed C LLSL(1:LLSL(0)): pointers to the start of a list in LSL C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER IC, JC, LC, N, L, M C IF (NPDE .NE. NPD) STOP 'Wrong ILUBS loaded.' C C Loop over `hyperplanes' S_m, m = 1, LLSL(0) C Node # N = S_m(LLSL(l)) C C S_1 = {(i,j,k)| (i,j,k) not dependent on (i-ii,j-jj,k-kk), C ii,jj,kk >= 0, not ii=jj=kk=0; C i.e., Dirichlet points and left/down/front corners} M = 1 C C Compute main block diagonal DO 550 IC = 1, NPDE DO 554 LC = 1, IC-1 DO 555 JC = IC, NPDE CDIR$ IVDEP DO 551 L = 1, LLSL(M) N = LSL(L) A(N,IC,JC,0) = A(N,IC,JC,0) + - A(N,IC,LC,0)*A(N,LC,JC,0) 551 CONTINUE 555 CONTINUE DO 556 JC = IC+1, NPDE CDIR$ IVDEP DO 552 L = 1, LLSL(M) N = LSL(L) A(N,JC,IC,0) = A(N,JC,IC,0) + - A(N,JC,LC,0)*A(N,LC,IC,0) 552 CONTINUE 556 CONTINUE 554 CONTINUE CDIR$ IVDEP DO 553 L = 1, LLSL(M) N = LSL(L) A(N,IC,IC,0) = 1.0 / A(N,IC,IC,0) 553 CONTINUE DO 557 JC = IC+1, NPDE CDIR$ IVDEP DO 559 L = 1, LLSL(M) N = LSL(L) A(N,JC,IC,0) = A(N,JC,IC,0) * A(N,IC,IC,0) 559 CONTINUE 557 CONTINUE 550 CONTINUE C C Compute upper block diagonals DO 560 IC = 1, NPDE DO 563 LC = 1, IC-1 DO 564 JC = 1, NPDE CDIR$ IVDEP DO 561 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,1) = A(N,IC,JC,1) + - A(N,IC,LC,0)*A(N,LC,JC,1) A(N,IC,JC,2) = A(N,IC,JC,2) + - A(N,IC,LC,0)*A(N,LC,JC,2) A(N,IC,JC,3) = A(N,IC,JC,3) + - A(N,IC,LC,0)*A(N,LC,JC,3) A(N,IC,JC,4) = A(N,IC,JC,4) + - A(N,IC,LC,0)*A(N,LC,JC,4) A(N,IC,JC,5) = A(N,IC,JC,5) + - A(N,IC,LC,0)*A(N,LC,JC,5) A(N,IC,JC,6) = A(N,IC,JC,6) + - A(N,IC,LC,0)*A(N,LC,JC,6) A(N,IC,JC,7) = A(N,IC,JC,7) + - A(N,IC,LC,0)*A(N,LC,JC,7) A(N,IC,JC,8) = A(N,IC,JC,8) + - A(N,IC,LC,0)*A(N,LC,JC,8) A(N,IC,JC,9) = A(N,IC,JC,9) + - A(N,IC,LC,0)*A(N,LC,JC,9) 561 CONTINUE 564 CONTINUE 563 CONTINUE 560 CONTINUE C C Loop over rest of `hyperplane' sets C NB. No exception handling is necessary for the first row and the first C point of the second row, since N > 1 in the loop and for those C points LLDG(N,.) = N, (=> no array index problems), C and the multiplicator of `non existing' array elements is zero. C DO 10 M = 2, LLSL(0) C C Compute lower diagonals DO 120 JC = 1, NPDE DO 121 LC = 1, JC-1 CDIR$ IVDEP DO 20 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 122 IC = 1, NPDE A(N,IC,JC,-9) = A(N,IC,JC,-9) + - A(N,IC,LC,-9) * A(LLDG(N,-9),LC,JC,0) 122 CONTINUE 20 CONTINUE 121 CONTINUE CDIR$ IVDEP DO 21 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 123 IC = 1, NPDE A(N,IC,JC,-9) = A(N,IC,JC,-9) * A(LLDG(N,-9),JC,JC,0) 123 CONTINUE 21 CONTINUE 120 CONTINUE DO 130 JC = 1, NPDE CDIR$ IVDEP DO 30 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 131 LC = 1, NPDE CFPP$ UNROLL DO 132 IC = 1, NPDE A(N,IC,JC,-8) = A(N,IC,JC,-8) + - A(N,IC,LC,-9)*A(LLDG(N,-9),LC,JC,2) 132 CONTINUE 131 CONTINUE 30 CONTINUE DO 133 LC = 1, JC-1 CDIR$ IVDEP DO 31 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 134 IC = 1, NPDE A(N,IC,JC,-8) = A(N,IC,JC,-8) + - A(N,IC,LC,-8)*A(LLDG(N,-8),LC,JC,0) 134 CONTINUE 31 CONTINUE 133 CONTINUE CDIR$ IVDEP DO 32 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 135 IC = 1, NPDE A(N,IC,JC,-8) = A(N,IC,JC,-8) * A(LLDG(N,-8),JC,JC,0) 135 CONTINUE 32 CONTINUE 130 CONTINUE DO 140 JC = 1, NPDE CDIR$ IVDEP DO 40 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 141 LC = 1, NPDE CFPP$ UNROLL DO 142 IC = 1, NPDE A(N,IC,JC,-7) = A(N,IC,JC,-7) + - A(N,IC,LC,-9)*A(LLDG(N,-9),LC,JC,3) + - A(N,IC,LC,-8)*A(LLDG(N,-8),LC,JC,1) 142 CONTINUE 141 CONTINUE 40 CONTINUE DO 143 LC = 1, JC-1 CDIR$ IVDEP DO 41 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 144 IC = 1, NPDE A(N,IC,JC,-7) = A(N,IC,JC,-7) + - A(N,IC,LC,-7)*A(LLDG(N,-7),LC,JC,0) 144 CONTINUE 41 CONTINUE 143 CONTINUE CDIR$ IVDEP DO 42 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 145 IC = 1, NPDE A(N,IC,JC,-7) = A(N,IC,JC,-7) * A(LLDG(N,-7),JC,JC,0) 145 CONTINUE 42 CONTINUE 140 CONTINUE DO 150 JC = 1, NPDE CDIR$ IVDEP DO 50 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 151 LC = 1, NPDE CFPP$ UNROLL DO 152 IC = 1, NPDE A(N,IC,JC,-6) = A(N,IC,JC,-6) + - A(N,IC,LC,-9)*A(LLDG(N,-9),LC,JC,4) + - A(N,IC,LC,-7)*A(LLDG(N,-7),LC,JC,1) 152 CONTINUE 151 CONTINUE 50 CONTINUE DO 153 LC = 1, JC-1 CDIR$ IVDEP DO 51 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 154 IC = 1, NPDE A(N,IC,JC,-6) = A(N,IC,JC,-6) + - A(N,IC,LC,-6)*A(LLDG(N,-6),LC,JC,0) 154 CONTINUE 51 CONTINUE 153 CONTINUE CDIR$ IVDEP DO 52 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 155 IC = 1, NPDE A(N,IC,JC,-6) = A(N,IC,JC,-6) * A(LLDG(N,-6),JC,JC,0) 155 CONTINUE 52 CONTINUE 150 CONTINUE DO 160 JC = 1, NPDE CDIR$ IVDEP DO 60 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 161 LC = 1, NPDE CFPP$ UNROLL DO 162 IC = 1, NPDE A(N,IC,JC,-5) = A(N,IC,JC,-5) + - A(N,IC,LC,-8)*A(LLDG(N,-8),LC,JC,4) + - A(N,IC,LC,-7)*A(LLDG(N,-7),LC,JC,3) + - A(N,IC,LC,-6)*A(LLDG(N,-6),LC,JC,2) A(N,IC,JC,-4) = A(N,IC,JC,-4) + - A(N,IC,LC,-9)*A(LLDG(N,-9),LC,JC,6) + - A(N,IC,LC,-8)*A(LLDG(N,-8),LC,JC,5) 162 CONTINUE 161 CONTINUE 60 CONTINUE DO 163 LC = 1, JC-1 CDIR$ IVDEP DO 61 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 164 IC = 1, NPDE A(N,IC,JC,-5) = A(N,IC,JC,-5) + - A(N,IC,LC,-5)*A(LLDG(N,-5),LC,JC,0) A(N,IC,JC,-4) = A(N,IC,JC,-4) + - A(N,IC,LC,-4)*A(LLDG(N,-4),LC,JC,0) 164 CONTINUE 61 CONTINUE 163 CONTINUE CDIR$ IVDEP DO 62 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 165 IC = 1, NPDE A(N,IC,JC,-5) = A(N,IC,JC,-5) * A(LLDG(N,-5),JC,JC,0) A(N,IC,JC,-4) = A(N,IC,JC,-4) * A(LLDG(N,-4),JC,JC,0) 165 CONTINUE 62 CONTINUE 160 CONTINUE DO 170 JC = 1, NPDE CDIR$ IVDEP DO 70 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 171 LC = 1, NPDE CFPP$ UNROLL DO 172 IC = 1, NPDE A(N,IC,JC,-3) = A(N,IC,JC,-3) + - A(N,IC,LC,-9)*A(LLDG(N,-9),LC,JC,8) + - A(N,IC,LC,-7)*A(LLDG(N,-7),LC,JC,5) + - A(N,IC,LC,-4)*A(LLDG(N,-4),LC,JC,1) 172 CONTINUE 171 CONTINUE 70 CONTINUE DO 173 LC = 1, JC-1 CDIR$ IVDEP DO 71 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 174 IC = 1, NPDE A(N,IC,JC,-3) = A(N,IC,JC,-3) + - A(N,IC,LC,-3)*A(LLDG(N,-3),LC,JC,0) 174 CONTINUE 71 CONTINUE 173 CONTINUE CDIR$ IVDEP DO 72 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 175 IC = 1, NPDE A(N,IC,JC,-3) = A(N,IC,JC,-3) * A(LLDG(N,-3),JC,JC,0) 175 CONTINUE 72 CONTINUE 170 CONTINUE DO 180 JC = 1, NPDE CDIR$ IVDEP DO 80 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 181 LC = 1, NPDE CFPP$ UNROLL DO 182 IC = 1, NPDE A(N,IC,JC,-2) = A(N,IC,JC,-2) + - A(N,IC,LC,-9)*A(LLDG(N,-9),LC,JC,8) + - A(N,IC,LC,-6)*A(LLDG(N,-6),LC,JC,5) + - A(N,IC,LC,-3)*A(LLDG(N,-3),LC,JC,1) A(N,IC,JC,-1) = A(N,IC,JC,-1) + - A(N,IC,LC,-8)*A(LLDG(N,-8),LC,JC,7) + - A(N,IC,LC,-7)*A(LLDG(N,-7),LC,JC,6) + - A(N,IC,LC,-4)*A(LLDG(N,-4),LC,JC,3) + - A(N,IC,LC,-3)*A(LLDG(N,-3),LC,JC,2) 182 CONTINUE 181 CONTINUE 80 CONTINUE DO 183 LC = 1, JC-1 CDIR$ IVDEP DO 81 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 184 IC = 1, NPDE A(N,IC,JC,-2) = A(N,IC,JC,-2) + - A(N,IC,LC,-2)*A(LLDG(N,-2),LC,JC,0) A(N,IC,JC,-1) = A(N,IC,JC,-1) + - A(N,IC,LC,-1)*A(N-1 ,LC,JC,0) 184 CONTINUE 81 CONTINUE 183 CONTINUE CDIR$ IVDEP DO 82 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 185 IC = 1, NPDE A(N,IC,JC,-2) = A(N,IC,JC,-2) * A(LLDG(N,-2),JC,JC,0) A(N,IC,JC,-1) = A(N,IC,JC,-1) * A(N-1 ,JC,JC,0) 185 CONTINUE 82 CONTINUE 180 CONTINUE C C Compute main diagonal DO 300 IC = 1, NPDE DO 302 JC = IC, NPDE CDIR$ IVDEP DO 200 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 301 LC = 1, NPDE A(N,IC,JC,0) = A(N,IC,JC, 0) + - A(N,IC,LC,-9)*A(LLDG(N,-9),LC,JC,9) + - A(N,IC,LC,-8)*A(LLDG(N,-8),LC,JC,8) + - A(N,IC,LC,-7)*A(LLDG(N,-7),LC,JC,7) + - A(N,IC,LC,-6)*A(LLDG(N,-6),LC,JC,6) + - A(N,IC,LC,-5)*A(LLDG(N,-5),LC,JC,5) + - A(N,IC,LC,-4)*A(LLDG(N,-4),LC,JC,4) + - A(N,IC,LC,-3)*A(LLDG(N,-3),LC,JC,3) + - A(N,IC,LC,-2)*A(LLDG(N,-2),LC,JC,2) + - A(N,IC,LC,-1)*A(N-1 ,LC,JC,1) 301 CONTINUE 200 CONTINUE 302 CONTINUE DO 303 JC = IC+1, NPDE CDIR$ IVDEP DO 201 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 1301 LC = 1, NPDE A(N,JC,IC,0) = A(N,JC,IC, 0) + - A(N,JC,LC,-9)*A(LLDG(N,-9),LC,IC,9) + - A(N,JC,LC,-8)*A(LLDG(N,-8),LC,IC,8) + - A(N,JC,LC,-7)*A(LLDG(N,-7),LC,IC,7) + - A(N,JC,LC,-6)*A(LLDG(N,-6),LC,IC,6) + - A(N,JC,LC,-5)*A(LLDG(N,-5),LC,IC,5) + - A(N,JC,LC,-4)*A(LLDG(N,-4),LC,IC,4) + - A(N,JC,LC,-3)*A(LLDG(N,-3),LC,IC,3) + - A(N,JC,LC,-2)*A(LLDG(N,-2),LC,IC,2) + - A(N,JC,LC,-1)*A(N-1 ,LC,IC,1) 1301 CONTINUE 201 CONTINUE 303 CONTINUE DO 304 LC = 1, IC-1 DO 305 JC = IC, NPDE CDIR$ IVDEP DO 202 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,0) = A(N,IC,JC,0) + - A(N,IC,LC,0)*A(N ,LC,JC,0) 202 CONTINUE 305 CONTINUE DO 306 JC = IC+1, NPDE CDIR$ IVDEP DO 203 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,JC,IC,0) = A(N,JC,IC,0) + - A(N,JC,LC,0)*A(N ,LC,IC,0) 203 CONTINUE 306 CONTINUE 304 CONTINUE CDIR$ IVDEP DO 204 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,IC,0) = 1.0 / A(N,IC,IC,0) 204 CONTINUE DO 307 JC = IC+1, NPDE CDIR$ IVDEP DO 205 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,JC,IC,0) = A(N,JC,IC,0) * A(N,IC,IC,0) 205 CONTINUE 307 CONTINUE 300 CONTINUE C C Compute upper diagonals DO 500 IC = 1, NPDE CDIR$ IVDEP DO 400 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL A(N,IC,1,1) = A(N,IC,1,1) - A(N,IC,1,-7)*A(LLDG(N,-7),1,1,8) - A 1 (N,IC,1,-6)*A(LLDG(N,-6),1,1,7) - A(N,IC,1,-3)*A(LLDG(N,-3), 2 1,1,4) - A(N,IC,1,-2)*A(LLDG(N,-2),1,1,3) A(N,IC,1,2) = A(N,IC,1,2) - A(N,IC,1,-8)*A(LLDG(N,-8),1,1,9) - A 1 (N,IC,1,-5)*A(LLDG(N,-5),1,1,6) - A(N,IC,1,-1)*A(N-1,1,1,3) A(N,IC,1,3) = A(N,IC,1,3) - A(N,IC,1,-7)*A(LLDG(N,-7),1,1,9) - A 1 (N,IC,1,-5)*A(LLDG(N,-5),1,1,7) - A(N,IC,1,-1)*A(N-1,1,1,4) A(N,IC,1,4) = A(N,IC,1,4) - A(N,IC,1,-6)*A(LLDG(N,-6),1,1,9) - A 1 (N,IC,1,-5)*A(LLDG(N,-5),1,1,8) A(N,IC,1,5) = A(N,IC,1,5) - A(N,IC,1,-9)*A(LLDG(N,-9),1,1,8) - A 1 (N,IC,1,-3)*A(LLDG(N,-3),1,1,7) - A(N,IC,1,-2)*A(LLDG(N,-2), 2 1,1,6) A(N,IC,1,6) = A(N,IC,1,6) - A(N,IC,1,-4)*A(LLDG(N,-4),1,1,9) - A 1 (N,IC,1,-1)*A(N-1,1,1,7) A(N,IC,1,7) = A(N,IC,1,7) - A(N,IC,1,-3)*A(LLDG(N,-3),1,1,9) - A 1 (N,IC,1,-1)*A(N-1,1,1,8) A(N,IC,1,8) = A(N,IC,1,8) - A(N,IC,1,-2)*A(LLDG(N,-2),1,1,9) A(N,IC,2,1) = A(N,IC,2,1) - A(N,IC,1,-7)*A(LLDG(N,-7),1,2,8) - A 1 (N,IC,1,-6)*A(LLDG(N,-6),1,2,7) - A(N,IC,1,-3)*A(LLDG(N,-3), 2 1,2,4) - A(N,IC,1,-2)*A(LLDG(N,-2),1,2,3) A(N,IC,2,2) = A(N,IC,2,2) - A(N,IC,1,-8)*A(LLDG(N,-8),1,2,9) - A 1 (N,IC,1,-5)*A(LLDG(N,-5),1,2,6) - A(N,IC,1,-1)*A(N-1,1,2,3) A(N,IC,2,3) = A(N,IC,2,3) - A(N,IC,1,-7)*A(LLDG(N,-7),1,2,9) - A 1 (N,IC,1,-5)*A(LLDG(N,-5),1,2,7) - A(N,IC,1,-1)*A(N-1,1,2,4) A(N,IC,2,4) = A(N,IC,2,4) - A(N,IC,1,-6)*A(LLDG(N,-6),1,2,9) - A 1 (N,IC,1,-5)*A(LLDG(N,-5),1,2,8) A(N,IC,2,5) = A(N,IC,2,5) - A(N,IC,1,-9)*A(LLDG(N,-9),1,2,8) - A 1 (N,IC,1,-3)*A(LLDG(N,-3),1,2,7) - A(N,IC,1,-2)*A(LLDG(N,-2), 2 1,2,6) A(N,IC,2,6) = A(N,IC,2,6) - A(N,IC,1,-4)*A(LLDG(N,-4),1,2,9) - A 1 (N,IC,1,-1)*A(N-1,1,2,7) A(N,IC,2,7) = A(N,IC,2,7) - A(N,IC,1,-3)*A(LLDG(N,-3),1,2,9) - A 1 (N,IC,1,-1)*A(N-1,1,2,8) A(N,IC,2,8) = A(N,IC,2,8) - A(N,IC,1,-2)*A(LLDG(N,-2),1,2,9) A(N,IC,3,1) = A(N,IC,3,1) - A(N,IC,1,-7)*A(LLDG(N,-7),1,3,8) - A 1 (N,IC,1,-6)*A(LLDG(N,-6),1,3,7) - A(N,IC,1,-3)*A(LLDG(N,-3), 2 1,3,4) - A(N,IC,1,-2)*A(LLDG(N,-2),1,3,3) A(N,IC,3,2) = A(N,IC,3,2) - A(N,IC,1,-8)*A(LLDG(N,-8),1,3,9) - A 1 (N,IC,1,-5)*A(LLDG(N,-5),1,3,6) - A(N,IC,1,-1)*A(N-1,1,3,3) A(N,IC,3,3) = A(N,IC,3,3) - A(N,IC,1,-7)*A(LLDG(N,-7),1,3,9) - A 1 (N,IC,1,-5)*A(LLDG(N,-5),1,3,7) - A(N,IC,1,-1)*A(N-1,1,3,4) A(N,IC,3,4) = A(N,IC,3,4) - A(N,IC,1,-6)*A(LLDG(N,-6),1,3,9) - A 1 (N,IC,1,-5)*A(LLDG(N,-5),1,3,8) A(N,IC,3,5) = A(N,IC,3,5) - A(N,IC,1,-9)*A(LLDG(N,-9),1,3,8) - A 1 (N,IC,1,-3)*A(LLDG(N,-3),1,3,7) - A(N,IC,1,-2)*A(LLDG(N,-2), 2 1,3,6) A(N,IC,3,6) = A(N,IC,3,6) - A(N,IC,1,-4)*A(LLDG(N,-4),1,3,9) - A 1 (N,IC,1,-1)*A(N-1,1,3,7) A(N,IC,3,7) = A(N,IC,3,7) - A(N,IC,1,-3)*A(LLDG(N,-3),1,3,9) - A 1 (N,IC,1,-1)*A(N-1,1,3,8) A(N,IC,3,8) = A(N,IC,3,8) - A(N,IC,1,-2)*A(LLDG(N,-2),1,3,9) A(N,IC,1,1) = A(N,IC,1,1) - A(N,IC,2,-7)*A(LLDG(N,-7),2,1,8) - A 1 (N,IC,2,-6)*A(LLDG(N,-6),2,1,7) - A(N,IC,2,-3)*A(LLDG(N,-3), 2 2,1,4) - A(N,IC,2,-2)*A(LLDG(N,-2),2,1,3) A(N,IC,1,2) = A(N,IC,1,2) - A(N,IC,2,-8)*A(LLDG(N,-8),2,1,9) - A 1 (N,IC,2,-5)*A(LLDG(N,-5),2,1,6) - A(N,IC,2,-1)*A(N-1,2,1,3) A(N,IC,1,3) = A(N,IC,1,3) - A(N,IC,2,-7)*A(LLDG(N,-7),2,1,9) - A 1 (N,IC,2,-5)*A(LLDG(N,-5),2,1,7) - A(N,IC,2,-1)*A(N-1,2,1,4) A(N,IC,1,4) = A(N,IC,1,4) - A(N,IC,2,-6)*A(LLDG(N,-6),2,1,9) - A 1 (N,IC,2,-5)*A(LLDG(N,-5),2,1,8) A(N,IC,1,5) = A(N,IC,1,5) - A(N,IC,2,-9)*A(LLDG(N,-9),2,1,8) - A 1 (N,IC,2,-3)*A(LLDG(N,-3),2,1,7) - A(N,IC,2,-2)*A(LLDG(N,-2), 2 2,1,6) A(N,IC,1,6) = A(N,IC,1,6) - A(N,IC,2,-4)*A(LLDG(N,-4),2,1,9) - A 1 (N,IC,2,-1)*A(N-1,2,1,7) A(N,IC,1,7) = A(N,IC,1,7) - A(N,IC,2,-3)*A(LLDG(N,-3),2,1,9) - A 1 (N,IC,2,-1)*A(N-1,2,1,8) A(N,IC,1,8) = A(N,IC,1,8) - A(N,IC,2,-2)*A(LLDG(N,-2),2,1,9) A(N,IC,2,1) = A(N,IC,2,1) - A(N,IC,2,-7)*A(LLDG(N,-7),2,2,8) - A 1 (N,IC,2,-6)*A(LLDG(N,-6),2,2,7) - A(N,IC,2,-3)*A(LLDG(N,-3), 2 2,2,4) - A(N,IC,2,-2)*A(LLDG(N,-2),2,2,3) A(N,IC,2,2) = A(N,IC,2,2) - A(N,IC,2,-8)*A(LLDG(N,-8),2,2,9) - A 1 (N,IC,2,-5)*A(LLDG(N,-5),2,2,6) - A(N,IC,2,-1)*A(N-1,2,2,3) A(N,IC,2,3) = A(N,IC,2,3) - A(N,IC,2,-7)*A(LLDG(N,-7),2,2,9) - A 1 (N,IC,2,-5)*A(LLDG(N,-5),2,2,7) - A(N,IC,2,-1)*A(N-1,2,2,4) A(N,IC,2,4) = A(N,IC,2,4) - A(N,IC,2,-6)*A(LLDG(N,-6),2,2,9) - A 1 (N,IC,2,-5)*A(LLDG(N,-5),2,2,8) A(N,IC,2,5) = A(N,IC,2,5) - A(N,IC,2,-9)*A(LLDG(N,-9),2,2,8) - A 1 (N,IC,2,-3)*A(LLDG(N,-3),2,2,7) - A(N,IC,2,-2)*A(LLDG(N,-2), 2 2,2,6) A(N,IC,2,6) = A(N,IC,2,6) - A(N,IC,2,-4)*A(LLDG(N,-4),2,2,9) - A 1 (N,IC,2,-1)*A(N-1,2,2,7) A(N,IC,2,7) = A(N,IC,2,7) - A(N,IC,2,-3)*A(LLDG(N,-3),2,2,9) - A 1 (N,IC,2,-1)*A(N-1,2,2,8) A(N,IC,2,8) = A(N,IC,2,8) - A(N,IC,2,-2)*A(LLDG(N,-2),2,2,9) A(N,IC,3,1) = A(N,IC,3,1) - A(N,IC,2,-7)*A(LLDG(N,-7),2,3,8) - A 1 (N,IC,2,-6)*A(LLDG(N,-6),2,3,7) - A(N,IC,2,-3)*A(LLDG(N,-3), 2 2,3,4) - A(N,IC,2,-2)*A(LLDG(N,-2),2,3,3) A(N,IC,3,2) = A(N,IC,3,2) - A(N,IC,2,-8)*A(LLDG(N,-8),2,3,9) - A 1 (N,IC,2,-5)*A(LLDG(N,-5),2,3,6) - A(N,IC,2,-1)*A(N-1,2,3,3) A(N,IC,3,3) = A(N,IC,3,3) - A(N,IC,2,-7)*A(LLDG(N,-7),2,3,9) - A 1 (N,IC,2,-5)*A(LLDG(N,-5),2,3,7) - A(N,IC,2,-1)*A(N-1,2,3,4) A(N,IC,3,4) = A(N,IC,3,4) - A(N,IC,2,-6)*A(LLDG(N,-6),2,3,9) - A 1 (N,IC,2,-5)*A(LLDG(N,-5),2,3,8) A(N,IC,3,5) = A(N,IC,3,5) - A(N,IC,2,-9)*A(LLDG(N,-9),2,3,8) - A 1 (N,IC,2,-3)*A(LLDG(N,-3),2,3,7) - A(N,IC,2,-2)*A(LLDG(N,-2), 2 2,3,6) A(N,IC,3,6) = A(N,IC,3,6) - A(N,IC,2,-4)*A(LLDG(N,-4),2,3,9) - A 1 (N,IC,2,-1)*A(N-1,2,3,7) A(N,IC,3,7) = A(N,IC,3,7) - A(N,IC,2,-3)*A(LLDG(N,-3),2,3,9) - A 1 (N,IC,2,-1)*A(N-1,2,3,8) A(N,IC,3,8) = A(N,IC,3,8) - A(N,IC,2,-2)*A(LLDG(N,-2),2,3,9) A(N,IC,1,1) = A(N,IC,1,1) - A(N,IC,3,-7)*A(LLDG(N,-7),3,1,8) - A 1 (N,IC,3,-6)*A(LLDG(N,-6),3,1,7) - A(N,IC,3,-3)*A(LLDG(N,-3), 2 3,1,4) - A(N,IC,3,-2)*A(LLDG(N,-2),3,1,3) A(N,IC,1,2) = A(N,IC,1,2) - A(N,IC,3,-8)*A(LLDG(N,-8),3,1,9) - A 1 (N,IC,3,-5)*A(LLDG(N,-5),3,1,6) - A(N,IC,3,-1)*A(N-1,3,1,3) A(N,IC,1,3) = A(N,IC,1,3) - A(N,IC,3,-7)*A(LLDG(N,-7),3,1,9) - A 1 (N,IC,3,-5)*A(LLDG(N,-5),3,1,7) - A(N,IC,3,-1)*A(N-1,3,1,4) A(N,IC,1,4) = A(N,IC,1,4) - A(N,IC,3,-6)*A(LLDG(N,-6),3,1,9) - A 1 (N,IC,3,-5)*A(LLDG(N,-5),3,1,8) A(N,IC,1,5) = A(N,IC,1,5) - A(N,IC,3,-9)*A(LLDG(N,-9),3,1,8) - A 1 (N,IC,3,-3)*A(LLDG(N,-3),3,1,7) - A(N,IC,3,-2)*A(LLDG(N,-2), 2 3,1,6) A(N,IC,1,6) = A(N,IC,1,6) - A(N,IC,3,-4)*A(LLDG(N,-4),3,1,9) - A 1 (N,IC,3,-1)*A(N-1,3,1,7) A(N,IC,1,7) = A(N,IC,1,7) - A(N,IC,3,-3)*A(LLDG(N,-3),3,1,9) - A 1 (N,IC,3,-1)*A(N-1,3,1,8) A(N,IC,1,8) = A(N,IC,1,8) - A(N,IC,3,-2)*A(LLDG(N,-2),3,1,9) A(N,IC,2,1) = A(N,IC,2,1) - A(N,IC,3,-7)*A(LLDG(N,-7),3,2,8) - A 1 (N,IC,3,-6)*A(LLDG(N,-6),3,2,7) - A(N,IC,3,-3)*A(LLDG(N,-3), 2 3,2,4) - A(N,IC,3,-2)*A(LLDG(N,-2),3,2,3) A(N,IC,2,2) = A(N,IC,2,2) - A(N,IC,3,-8)*A(LLDG(N,-8),3,2,9) - A 1 (N,IC,3,-5)*A(LLDG(N,-5),3,2,6) - A(N,IC,3,-1)*A(N-1,3,2,3) A(N,IC,2,3) = A(N,IC,2,3) - A(N,IC,3,-7)*A(LLDG(N,-7),3,2,9) - A 1 (N,IC,3,-5)*A(LLDG(N,-5),3,2,7) - A(N,IC,3,-1)*A(N-1,3,2,4) A(N,IC,2,4) = A(N,IC,2,4) - A(N,IC,3,-6)*A(LLDG(N,-6),3,2,9) - A 1 (N,IC,3,-5)*A(LLDG(N,-5),3,2,8) A(N,IC,2,5) = A(N,IC,2,5) - A(N,IC,3,-9)*A(LLDG(N,-9),3,2,8) - A 1 (N,IC,3,-3)*A(LLDG(N,-3),3,2,7) - A(N,IC,3,-2)*A(LLDG(N,-2), 2 3,2,6) A(N,IC,2,6) = A(N,IC,2,6) - A(N,IC,3,-4)*A(LLDG(N,-4),3,2,9) - A 1 (N,IC,3,-1)*A(N-1,3,2,7) A(N,IC,2,7) = A(N,IC,2,7) - A(N,IC,3,-3)*A(LLDG(N,-3),3,2,9) - A 1 (N,IC,3,-1)*A(N-1,3,2,8) A(N,IC,2,8) = A(N,IC,2,8) - A(N,IC,3,-2)*A(LLDG(N,-2),3,2,9) A(N,IC,3,1) = A(N,IC,3,1) - A(N,IC,3,-7)*A(LLDG(N,-7),3,3,8) - A 1 (N,IC,3,-6)*A(LLDG(N,-6),3,3,7) - A(N,IC,3,-3)*A(LLDG(N,-3), 2 3,3,4) - A(N,IC,3,-2)*A(LLDG(N,-2),3,3,3) A(N,IC,3,2) = A(N,IC,3,2) - A(N,IC,3,-8)*A(LLDG(N,-8),3,3,9) - A 1 (N,IC,3,-5)*A(LLDG(N,-5),3,3,6) - A(N,IC,3,-1)*A(N-1,3,3,3) A(N,IC,3,3) = A(N,IC,3,3) - A(N,IC,3,-7)*A(LLDG(N,-7),3,3,9) - A 1 (N,IC,3,-5)*A(LLDG(N,-5),3,3,7) - A(N,IC,3,-1)*A(N-1,3,3,4) A(N,IC,3,4) = A(N,IC,3,4) - A(N,IC,3,-6)*A(LLDG(N,-6),3,3,9) - A 1 (N,IC,3,-5)*A(LLDG(N,-5),3,3,8) A(N,IC,3,5) = A(N,IC,3,5) - A(N,IC,3,-9)*A(LLDG(N,-9),3,3,8) - A 1 (N,IC,3,-3)*A(LLDG(N,-3),3,3,7) - A(N,IC,3,-2)*A(LLDG(N,-2), 2 3,3,6) A(N,IC,3,6) = A(N,IC,3,6) - A(N,IC,3,-4)*A(LLDG(N,-4),3,3,9) - A 1 (N,IC,3,-1)*A(N-1,3,3,7) A(N,IC,3,7) = A(N,IC,3,7) - A(N,IC,3,-3)*A(LLDG(N,-3),3,3,9) - A 1 (N,IC,3,-1)*A(N-1,3,3,8) A(N,IC,3,8) = A(N,IC,3,8) - A(N,IC,3,-2)*A(LLDG(N,-2),3,3,9) 400 CONTINUE DO 503 LC = 1, IC-1 CDIR$ IVDEP DO 401 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 504 JC = 1, NPDE A(N,IC,JC,1) = A(N,IC,JC,1) + - A(N,IC,LC,0)*A(N,LC,JC,1) A(N,IC,JC,2) = A(N,IC,JC,2) + - A(N,IC,LC,0)*A(N,LC,JC,2) A(N,IC,JC,3) = A(N,IC,JC,3) + - A(N,IC,LC,0)*A(N,LC,JC,3) A(N,IC,JC,4) = A(N,IC,JC,4) + - A(N,IC,LC,0)*A(N,LC,JC,4) A(N,IC,JC,5) = A(N,IC,JC,5) + - A(N,IC,LC,0)*A(N,LC,JC,5) A(N,IC,JC,6) = A(N,IC,JC,6) + - A(N,IC,LC,0)*A(N,LC,JC,6) A(N,IC,JC,7) = A(N,IC,JC,7) + - A(N,IC,LC,0)*A(N,LC,JC,7) A(N,IC,JC,8) = A(N,IC,JC,8) + - A(N,IC,LC,0)*A(N,LC,JC,8) A(N,IC,JC,9) = A(N,IC,JC,9) + - A(N,IC,LC,0)*A(N,LC,JC,9) 504 CONTINUE 401 CONTINUE 503 CONTINUE 500 CONTINUE C 10 CONTINUE C RETURN END SUBROUTINE BCKSLV (NPTS, NPD, A, LLDG, LUDG, LSL, LLSL, LSU, LLSU, + B) INTEGER NPDE PARAMETER (NPDE = 3) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPD, LLDG(NPTS,-9:-2), LUDG(NPTS,2:9), + LSL(*), LLSL(0:*), LSU(*), LLSU(0:*) DOUBLE PRECISION A(NPTS,NPDE,NPDE,-9:9), B(NPTS,NPDE) C Ccc PURPOSE: C Solve LUx = b C A stems from a 19-point stencil on a grid with irregular row and C plane sizes C A = ILU, vectorized by `hyperplane' ordening, where the `hyperplanes' C are sets of points that can be treated simultaneously. C A((i,j,k),1:NPDE,1:NPDE,.) contains a block of NPDE.NPDE elements C corresponding with node (i,j,k) C Ccc PARAMETER DESCRIPTION: C NPTS : IN. # gridpoints C NPDE : IN. # components of the PDE C A : IN. A(.,1:NPDE,1:NPDE,-9:-1) : lower block diagonals of L C A(.,ic,jc,0): jc < ic: main block diagonal of L C main diagonal L == I C jc >=ic: main block diagonal of U C main diagonal U inverted C A(.,1:NPDE,1:NPDE, 1: 9) : upper block diagonals of U C LLDG : IN. Block-column index of lower 8 block-diagonals C If block ld does not exist the LLDG(N,ld) = N C LUDG : IN. Block-column index of upper 8 block-diagonals C If block ud does not exist the LUDG(N,lu) = N C LSL : IN. (NPTS) C LSL(LLSL(m-1)+1:LLSL(m)): pointers to set of points S_m C in actual grid that can be treated at the m-th iteration C of Ly = b C LLSL : IN. (0:LLSL(0)) C LLSL(0) = # iterations needed C LLSL(1:LLSL(0)): pointers to the start of a list in LSL C LSU : IN. (NPTS) C LSU(LLSU(m-1)+1:LLSU(m)): pointers to set of points S_m C in actual grid that can be treated at the m-th iteration C of Ux = y C LLSU : IN. (0:LLSU(0)) C LLSU(0) = # iterations needed C LLSU(1:LLSU(0)): pointers to the start of a list in LSU C B : INOUT. C IN: right-hand side vector b C OUT: solution vector x C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER IC, JC, N, L, M C CCC Ly = b C C Loop over `hyperplanes' S_m, m = 1, LLSL(0) C Node # N = LSL_m(LLSL(l)) C C LSL_1 = {(i,j,k)| (i,j,k) not dependent on (i-ii,j-jj,k-kk), C ii,jj,kk >= 0, not ii=jj=kk=0; C i.e., Dirichlet points and left/down/front corners} M = 1 DO 100 IC = 2, NPDE DO 101 JC = 1, IC-1 CDIR$ IVDEP DO 1 L = 1, LLSL(M) N = LSL(L) B(N,IC) = B(N,IC) - A(N,IC,JC,0)*B(N,JC) 1 CONTINUE 101 CONTINUE 100 CONTINUE C C Loop over rest of `hyperplane' sets C NB. No exception handling is necessary for the first row and the first C point of the second row, since N > 1 in the loop and for those C points LLDG(N,.) = N, (=> no array index problems), C and the multiplicator of `non existing' array elements is zero. C DO 10 M = 2, LLSL(0) C C Compute y elements in this set CDIR$ IVDEP DO 20 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 120 IC = 1, NPDE CFPP$ UNROLL DO 121 JC = 1, NPDE B(N,IC) = B(N,IC) - A(N,IC,JC,-1)*B(N- 1,JC) + - A(N,IC,JC,-2)*B(LLDG(N,-2),JC) + - A(N,IC,JC,-3)*B(LLDG(N,-3),JC) + - A(N,IC,JC,-4)*B(LLDG(N,-4),JC) + - A(N,IC,JC,-5)*B(LLDG(N,-5),JC) + - A(N,IC,JC,-6)*B(LLDG(N,-6),JC) + - A(N,IC,JC,-7)*B(LLDG(N,-7),JC) + - A(N,IC,JC,-8)*B(LLDG(N,-8),JC) + - A(N,IC,JC,-9)*B(LLDG(N,-9),JC) 121 CONTINUE 120 CONTINUE 20 CONTINUE DO 123 IC = 2, NPDE DO 122 JC = 1, IC-1 CDIR$ IVDEP DO 21 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) B(N,IC) = B(N,IC) - A(N,IC,JC,0)*B(N,JC) 21 CONTINUE 122 CONTINUE 123 CONTINUE C 10 CONTINUE C CCC Ux = y C C Loop over `hyperplanes' LSU_m, m = 1, LLSU(0) C Node # N = LSU_m(LLSU(l)) C C LSU_1 = {(i,j,k)| (i,j,k) not dependent on (i+ii,j+jj,k+kk), C ii,jj,kk >= 0, not ii=jj=kk=0; C e.g., Dirichlet points and right/up/back corners} C M = 1 DO 130 IC = NPDE, 1, -1 DO 131 JC = NPDE, IC+1, -1 CDIR$ IVDEP DO 132 L = 1, LLSU(M) N = LSU(L) B(N,IC) = B(N,IC) - A(N,IC,JC,0)*B(N,JC) 132 CONTINUE 131 CONTINUE CDIR$ IVDEP DO 133 L = 1, LLSU(M) N = LSU(L) B(N,IC) = B(N,IC) * A(N,IC,IC,0) 133 CONTINUE 130 CONTINUE C C Loop over rest of `hyperplane' sets C NB. No exception handling is necessary for the last row and the first C point of the second last row, since N < NPTS in the loop and for C those points LUDG(N,.) = N (=> no array index problems), C and the multiplicator of `non existing' array elements is zero. C DO 30 M = 2, LLSU(0) C C Compute x elements in this set CDIR$ IVDEP DO 40 L = LLSU(M-1)+1, LLSU(M) N = LSU(L) CFPP$ UNROLL DO 150 IC = NPDE, 1, -1 CFPP$ UNROLL DO 151 JC = NPDE, 1, -1 B(N,IC) = B(N,IC) - A(N,IC,JC,1)*B(N+1 ,JC) + - A(N,IC,JC,2)*B(LUDG(N,2),JC) + - A(N,IC,JC,3)*B(LUDG(N,3),JC) + - A(N,IC,JC,4)*B(LUDG(N,4),JC) + - A(N,IC,JC,5)*B(LUDG(N,5),JC) + - A(N,IC,JC,6)*B(LUDG(N,6),JC) + - A(N,IC,JC,7)*B(LUDG(N,7),JC) + - A(N,IC,JC,8)*B(LUDG(N,8),JC) + - A(N,IC,JC,9)*B(LUDG(N,9),JC) 151 CONTINUE 150 CONTINUE 40 CONTINUE DO 1150 IC = NPDE, 1, -1 DO 152 JC = NPDE, IC+1, -1 CDIR$ IVDEP DO 51 L = LLSU(M-1)+1, LLSU(M) N = LSU(L) B(N,IC) = B(N,IC) - A(N,IC,JC,0)*B(N,JC) 51 CONTINUE 152 CONTINUE CDIR$ IVDEP DO 52 L = LLSU(M-1)+1, LLSU(M) N = LSU(L) B(N,IC) = B(N,IC) * A(N,IC,IC,0) 52 CONTINUE 1150 CONTINUE C 30 CONTINUE C RETURN END SHAR_EOF fi # end of overwriting check if test -f 'ilubsn.f' then echo shar: will not over-write existing file "'ilubsn.f'" else cat << \SHAR_EOF > 'ilubsn.f' SUBROUTINE ILU (NPTS, NPDE, A, LLDG, LSL, LLSL) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE, LLDG(NPTS,-9:-2), LSL(*), LLSL(0:*) DOUBLE PRECISION A(NPTS,NPDE,NPDE,-9:9) C Ccc PURPOSE: C Incomplete LU decomposition of A C A stems from a 19-point stencil on a grid with irregular row and C plane sizes C A = ILU, vectorized by `hyperplane' ordening, where the `hyperplanes' C are sets of points that can be treated simultaneously. C A((i,j,k),1:NPDE,1:NPDE,.) contains a block of NPDE.NPDE elements C corresponding with node (i,j,k) C Ccc PARAMETER DESCRIPTION: C NPTS : IN. # gridpoints C NPDE : IN. # components of the PDE C A : INOUT. C IN: A(.,1:NPDE,1:NPDE,-9:-1) : lower block diagonals C A(.,1:NPDE,1:NPDE,0) : main block diagonal C A(.,1:NPDE,1:NPDE, 1: 9) : upper block diagonals C OUT: A(.,1:NPDE,1:NPDE,-9:-1) : lower block diagonals of L C A(.,ic,jc,0): jc < ic: main block diagonal of L C main diagonal L == I C jc >=ic: main block diagonal of U C main diagonal U inverted C A(.,1:NPDE,1:NPDE, 1: 9) : upper block diagonals of U C LLDG : IN. Block-column index of lower 8 block-diagonals C If block ld does not exist the LLDG(N,ld) = N C LSL : IN. (NPTS) C LSL(LLSL(m-1)+1:LLSL(m)): pointers to set of points S_m C in actual grid that can be treated at the m-th iteration C LLSL : IN. (0:LLSL(0)) C LLSL(0) = # iterations needed C LLSL(1:LLSL(0)): pointers to the start of a list in LSL C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER IC, JC, LC, N, L, M C C Loop over `hyperplanes' S_m, m = 1, LLSL(0) C Node # N = S_m(LLSL(l)) C C S_1 = {(i,j,k)| (i,j,k) not dependent on (i-ii,j-jj,k-kk), C ii,jj,kk >= 0, not ii=jj=kk=0; C i.e., Dirichlet points and left/down/front corners} M = 1 C C Compute main block diagonal DO 550 IC = 1, NPDE DO 554 LC = 1, IC-1 DO 555 JC = IC, NPDE CDIR$ IVDEP DO 551 L = 1, LLSL(M) N = LSL(L) A(N,IC,JC,0) = A(N,IC,JC,0) + - A(N,IC,LC,0)*A(N,LC,JC,0) 551 CONTINUE 555 CONTINUE DO 556 JC = IC+1, NPDE CDIR$ IVDEP DO 552 L = 1, LLSL(M) N = LSL(L) A(N,JC,IC,0) = A(N,JC,IC,0) + - A(N,JC,LC,0)*A(N,LC,IC,0) 552 CONTINUE 556 CONTINUE 554 CONTINUE CDIR$ IVDEP DO 553 L = 1, LLSL(M) N = LSL(L) A(N,IC,IC,0) = 1.0 / A(N,IC,IC,0) 553 CONTINUE DO 557 JC = IC+1, NPDE CDIR$ IVDEP DO 559 L = 1, LLSL(M) N = LSL(L) A(N,JC,IC,0) = A(N,JC,IC,0) * A(N,IC,IC,0) 559 CONTINUE 557 CONTINUE 550 CONTINUE C C Compute upper block diagonals DO 560 IC = 1, NPDE DO 563 LC = 1, IC-1 DO 564 JC = 1, NPDE CDIR$ IVDEP DO 561 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,1) = A(N,IC,JC,1) + - A(N,IC,LC,0)*A(N,LC,JC,1) A(N,IC,JC,2) = A(N,IC,JC,2) + - A(N,IC,LC,0)*A(N,LC,JC,2) A(N,IC,JC,3) = A(N,IC,JC,3) + - A(N,IC,LC,0)*A(N,LC,JC,3) A(N,IC,JC,4) = A(N,IC,JC,4) + - A(N,IC,LC,0)*A(N,LC,JC,4) A(N,IC,JC,5) = A(N,IC,JC,5) + - A(N,IC,LC,0)*A(N,LC,JC,5) A(N,IC,JC,6) = A(N,IC,JC,6) + - A(N,IC,LC,0)*A(N,LC,JC,6) A(N,IC,JC,7) = A(N,IC,JC,7) + - A(N,IC,LC,0)*A(N,LC,JC,7) A(N,IC,JC,8) = A(N,IC,JC,8) + - A(N,IC,LC,0)*A(N,LC,JC,8) A(N,IC,JC,9) = A(N,IC,JC,9) + - A(N,IC,LC,0)*A(N,LC,JC,9) 561 CONTINUE 564 CONTINUE 563 CONTINUE 560 CONTINUE C C Loop over rest of `hyperplane' sets C NB. No exception handling is necessary for the first row and the first C point of the second row, since N > 1 in the loop and for those C points LLDG(N,.) = N, (=> no array index problems), C and the multiplicator of `non existing' array elements is zero. C DO 10 M = 2, LLSL(0) C C Compute lower diagonals DO 120 JC = 1, NPDE DO 121 LC = 1, JC-1 DO 122 IC = 1, NPDE CDIR$ IVDEP DO 20 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,-9) = A(N,IC,JC,-9) + - A(N,IC,LC,-9) * A(LLDG(N,-9),LC,JC,0) 20 CONTINUE 122 CONTINUE 121 CONTINUE DO 123 IC = 1, NPDE CDIR$ IVDEP DO 21 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,-9) = A(N,IC,JC,-9) * A(LLDG(N,-9),JC,JC,0) 21 CONTINUE 123 CONTINUE 120 CONTINUE DO 130 JC = 1, NPDE DO 131 LC = 1, NPDE DO 132 IC = 1, NPDE CDIR$ IVDEP DO 30 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,-8) = A(N,IC,JC,-8) + - A(N,IC,LC,-9)*A(LLDG(N,-9),LC,JC,2) 30 CONTINUE 132 CONTINUE 131 CONTINUE DO 133 LC = 1, JC-1 DO 134 IC = 1, NPDE CDIR$ IVDEP DO 31 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,-8) = A(N,IC,JC,-8) + - A(N,IC,LC,-8)*A(LLDG(N,-8),LC,JC,0) 31 CONTINUE 134 CONTINUE 133 CONTINUE DO 135 IC = 1, NPDE CDIR$ IVDEP DO 32 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,-8) = A(N,IC,JC,-8) * A(LLDG(N,-8),JC,JC,0) 32 CONTINUE 135 CONTINUE 130 CONTINUE DO 140 JC = 1, NPDE DO 141 LC = 1, NPDE DO 142 IC = 1, NPDE CDIR$ IVDEP DO 40 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,-7) = A(N,IC,JC,-7) + - A(N,IC,LC,-9)*A(LLDG(N,-9),LC,JC,3) + - A(N,IC,LC,-8)*A(LLDG(N,-8),LC,JC,1) 40 CONTINUE 142 CONTINUE 141 CONTINUE DO 143 LC = 1, JC-1 DO 144 IC = 1, NPDE CDIR$ IVDEP DO 41 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,-7) = A(N,IC,JC,-7) + - A(N,IC,LC,-7)*A(LLDG(N,-7),LC,JC,0) 41 CONTINUE 144 CONTINUE 143 CONTINUE DO 145 IC = 1, NPDE CDIR$ IVDEP DO 42 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,-7) = A(N,IC,JC,-7) * A(LLDG(N,-7),JC,JC,0) 42 CONTINUE 145 CONTINUE 140 CONTINUE DO 150 JC = 1, NPDE DO 151 LC = 1, NPDE DO 152 IC = 1, NPDE CDIR$ IVDEP DO 50 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,-6) = A(N,IC,JC,-6) + - A(N,IC,LC,-9)*A(LLDG(N,-9),LC,JC,4) + - A(N,IC,LC,-7)*A(LLDG(N,-7),LC,JC,1) 50 CONTINUE 152 CONTINUE 151 CONTINUE DO 153 LC = 1, JC-1 DO 154 IC = 1, NPDE CDIR$ IVDEP DO 51 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,-6) = A(N,IC,JC,-6) + - A(N,IC,LC,-6)*A(LLDG(N,-6),LC,JC,0) 51 CONTINUE 154 CONTINUE 153 CONTINUE DO 155 IC = 1, NPDE CDIR$ IVDEP DO 52 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,-6) = A(N,IC,JC,-6) * A(LLDG(N,-6),JC,JC,0) 52 CONTINUE 155 CONTINUE 150 CONTINUE DO 160 JC = 1, NPDE DO 161 LC = 1, NPDE DO 162 IC = 1, NPDE CDIR$ IVDEP DO 60 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,-5) = A(N,IC,JC,-5) + - A(N,IC,LC,-8)*A(LLDG(N,-8),LC,JC,4) + - A(N,IC,LC,-7)*A(LLDG(N,-7),LC,JC,3) + - A(N,IC,LC,-6)*A(LLDG(N,-6),LC,JC,2) A(N,IC,JC,-4) = A(N,IC,JC,-4) + - A(N,IC,LC,-9)*A(LLDG(N,-9),LC,JC,6) + - A(N,IC,LC,-8)*A(LLDG(N,-8),LC,JC,5) 60 CONTINUE 162 CONTINUE 161 CONTINUE DO 163 LC = 1, JC-1 DO 164 IC = 1, NPDE CDIR$ IVDEP DO 61 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,-5) = A(N,IC,JC,-5) + - A(N,IC,LC,-5)*A(LLDG(N,-5),LC,JC,0) A(N,IC,JC,-4) = A(N,IC,JC,-4) + - A(N,IC,LC,-4)*A(LLDG(N,-4),LC,JC,0) 61 CONTINUE 164 CONTINUE 163 CONTINUE DO 165 IC = 1, NPDE CDIR$ IVDEP DO 62 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,-5) = A(N,IC,JC,-5) * A(LLDG(N,-5),JC,JC,0) A(N,IC,JC,-4) = A(N,IC,JC,-4) * A(LLDG(N,-4),JC,JC,0) 62 CONTINUE 165 CONTINUE 160 CONTINUE DO 170 JC = 1, NPDE DO 171 LC = 1, NPDE DO 172 IC = 1, NPDE CDIR$ IVDEP DO 70 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,-3) = A(N,IC,JC,-3) + - A(N,IC,LC,-9)*A(LLDG(N,-9),LC,JC,8) + - A(N,IC,LC,-7)*A(LLDG(N,-7),LC,JC,5) + - A(N,IC,LC,-4)*A(LLDG(N,-4),LC,JC,1) 70 CONTINUE 172 CONTINUE 171 CONTINUE DO 173 LC = 1, JC-1 DO 174 IC = 1, NPDE CDIR$ IVDEP DO 71 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,-3) = A(N,IC,JC,-3) + - A(N,IC,LC,-3)*A(LLDG(N,-3),LC,JC,0) 71 CONTINUE 174 CONTINUE 173 CONTINUE DO 175 IC = 1, NPDE CDIR$ IVDEP DO 72 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,-3) = A(N,IC,JC,-3) * A(LLDG(N,-3),JC,JC,0) 72 CONTINUE 175 CONTINUE 170 CONTINUE DO 180 JC = 1, NPDE DO 181 LC = 1, NPDE DO 182 IC = 1, NPDE CDIR$ IVDEP DO 80 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,-2) = A(N,IC,JC,-2) + - A(N,IC,LC,-9)*A(LLDG(N,-9),LC,JC,8) + - A(N,IC,LC,-6)*A(LLDG(N,-6),LC,JC,5) + - A(N,IC,LC,-3)*A(LLDG(N,-3),LC,JC,1) A(N,IC,JC,-1) = A(N,IC,JC,-1) + - A(N,IC,LC,-8)*A(LLDG(N,-8),LC,JC,7) + - A(N,IC,LC,-7)*A(LLDG(N,-7),LC,JC,6) + - A(N,IC,LC,-4)*A(LLDG(N,-4),LC,JC,3) + - A(N,IC,LC,-3)*A(LLDG(N,-3),LC,JC,2) 80 CONTINUE 182 CONTINUE 181 CONTINUE DO 183 LC = 1, JC-1 DO 184 IC = 1, NPDE CDIR$ IVDEP DO 81 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,-2) = A(N,IC,JC,-2) + - A(N,IC,LC,-2)*A(LLDG(N,-2),LC,JC,0) A(N,IC,JC,-1) = A(N,IC,JC,-1) + - A(N,IC,LC,-1)*A(N-1 ,LC,JC,0) 81 CONTINUE 184 CONTINUE 183 CONTINUE DO 185 IC = 1, NPDE CDIR$ IVDEP DO 82 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,-2) = A(N,IC,JC,-2) * A(LLDG(N,-2),JC,JC,0) A(N,IC,JC,-1) = A(N,IC,JC,-1) * A(N-1 ,JC,JC,0) 82 CONTINUE 185 CONTINUE 180 CONTINUE C C Compute main diagonal DO 300 IC = 1, NPDE DO 301 LC = 1, NPDE DO 302 JC = IC, NPDE CDIR$ IVDEP DO 200 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,0) = A(N,IC,JC, 0) + - A(N,IC,LC,-9)*A(LLDG(N,-9),LC,JC,9) + - A(N,IC,LC,-8)*A(LLDG(N,-8),LC,JC,8) + - A(N,IC,LC,-7)*A(LLDG(N,-7),LC,JC,7) + - A(N,IC,LC,-6)*A(LLDG(N,-6),LC,JC,6) + - A(N,IC,LC,-5)*A(LLDG(N,-5),LC,JC,5) + - A(N,IC,LC,-4)*A(LLDG(N,-4),LC,JC,4) + - A(N,IC,LC,-3)*A(LLDG(N,-3),LC,JC,3) + - A(N,IC,LC,-2)*A(LLDG(N,-2),LC,JC,2) + - A(N,IC,LC,-1)*A(N-1 ,LC,JC,1) 200 CONTINUE 302 CONTINUE DO 303 JC = IC+1, NPDE CDIR$ IVDEP DO 201 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,JC,IC,0) = A(N,JC,IC, 0) + - A(N,JC,LC,-9)*A(LLDG(N,-9),LC,IC,9) + - A(N,JC,LC,-8)*A(LLDG(N,-8),LC,IC,8) + - A(N,JC,LC,-7)*A(LLDG(N,-7),LC,IC,7) + - A(N,JC,LC,-6)*A(LLDG(N,-6),LC,IC,6) + - A(N,JC,LC,-5)*A(LLDG(N,-5),LC,IC,5) + - A(N,JC,LC,-4)*A(LLDG(N,-4),LC,IC,4) + - A(N,JC,LC,-3)*A(LLDG(N,-3),LC,IC,3) + - A(N,JC,LC,-2)*A(LLDG(N,-2),LC,IC,2) + - A(N,JC,LC,-1)*A(N-1 ,LC,IC,1) 201 CONTINUE 303 CONTINUE 301 CONTINUE DO 304 LC = 1, IC-1 DO 305 JC = IC, NPDE CDIR$ IVDEP DO 202 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,0) = A(N,IC,JC,0) + - A(N,IC,LC,0)*A(N ,LC,JC,0) 202 CONTINUE 305 CONTINUE DO 306 JC = IC+1, NPDE CDIR$ IVDEP DO 203 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,JC,IC,0) = A(N,JC,IC,0) + - A(N,JC,LC,0)*A(N ,LC,IC,0) 203 CONTINUE 306 CONTINUE 304 CONTINUE CDIR$ IVDEP DO 204 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,IC,0) = 1.0 / A(N,IC,IC,0) 204 CONTINUE DO 307 JC = IC+1, NPDE CDIR$ IVDEP DO 205 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,JC,IC,0) = A(N,JC,IC,0) * A(N,IC,IC,0) 205 CONTINUE 307 CONTINUE 300 CONTINUE C C Compute upper diagonals DO 500 IC = 1, NPDE DO 501 LC = 1, NPDE DO 502 JC = 1, NPDE CDIR$ IVDEP DO 400 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,1) = A(N,IC,JC, 1) + - A(N,IC,LC,-7)*A(LLDG(N,-7),LC,JC,8) + - A(N,IC,LC,-6)*A(LLDG(N,-6),LC,JC,7) + - A(N,IC,LC,-3)*A(LLDG(N,-3),LC,JC,4) + - A(N,IC,LC,-2)*A(LLDG(N,-2),LC,JC,3) A(N,IC,JC,2) = A(N,IC,JC, 2) + - A(N,IC,LC,-8)*A(LLDG(N,-8),LC,JC,9) + - A(N,IC,LC,-5)*A(LLDG(N,-5),LC,JC,6) + - A(N,IC,LC,-1)*A(N-1 ,LC,JC,3) A(N,IC,JC,3) = A(N,IC,JC, 3) + - A(N,IC,LC,-7)*A(LLDG(N,-7),LC,JC,9) + - A(N,IC,LC,-5)*A(LLDG(N,-5),LC,JC,7) + - A(N,IC,LC,-1)*A(N-1 ,LC,JC,4) A(N,IC,JC,4) = A(N,IC,JC, 4) + - A(N,IC,LC,-6)*A(LLDG(N,-6),LC,JC,9) + - A(N,IC,LC,-5)*A(LLDG(N,-5),LC,JC,8) A(N,IC,JC,5) = A(N,IC,JC, 5) + - A(N,IC,LC,-9)*A(LLDG(N,-9),LC,JC,8) + - A(N,IC,LC,-3)*A(LLDG(N,-3),LC,JC,7) + - A(N,IC,LC,-2)*A(LLDG(N,-2),LC,JC,6) A(N,IC,JC,6) = A(N,IC,JC, 6) + - A(N,IC,LC,-4)*A(LLDG(N,-4),LC,JC,9) + - A(N,IC,LC,-1)*A(N-1 ,LC,JC,7) A(N,IC,JC,7) = A(N,IC,JC, 7) + - A(N,IC,LC,-3)*A(LLDG(N,-3),LC,JC,9) + - A(N,IC,LC,-1)*A(N-1 ,LC,JC,8) A(N,IC,JC,8) = A(N,IC,JC, 8) + - A(N,IC,LC,-2)*A(LLDG(N,-2),LC,JC,9) 400 CONTINUE 502 CONTINUE 501 CONTINUE DO 503 LC = 1, IC-1 DO 504 JC = 1, NPDE CDIR$ IVDEP DO 401 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,1) = A(N,IC,JC,1) + - A(N,IC,LC,0)*A(N,LC,JC,1) A(N,IC,JC,2) = A(N,IC,JC,2) + - A(N,IC,LC,0)*A(N,LC,JC,2) A(N,IC,JC,3) = A(N,IC,JC,3) + - A(N,IC,LC,0)*A(N,LC,JC,3) A(N,IC,JC,4) = A(N,IC,JC,4) + - A(N,IC,LC,0)*A(N,LC,JC,4) A(N,IC,JC,5) = A(N,IC,JC,5) + - A(N,IC,LC,0)*A(N,LC,JC,5) A(N,IC,JC,6) = A(N,IC,JC,6) + - A(N,IC,LC,0)*A(N,LC,JC,6) A(N,IC,JC,7) = A(N,IC,JC,7) + - A(N,IC,LC,0)*A(N,LC,JC,7) A(N,IC,JC,8) = A(N,IC,JC,8) + - A(N,IC,LC,0)*A(N,LC,JC,8) A(N,IC,JC,9) = A(N,IC,JC,9) + - A(N,IC,LC,0)*A(N,LC,JC,9) 401 CONTINUE 504 CONTINUE 503 CONTINUE 500 CONTINUE C 10 CONTINUE C RETURN END SUBROUTINE BCKSLV (NPTS,NPDE, A, LLDG, LUDG, LSL, LLSL, LSU, LLSU, + B) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE, LLDG(NPTS,-9:-2), LUDG(NPTS,2:9), + LSL(*), LLSL(0:*), LSU(*), LLSU(0:*) DOUBLE PRECISION A(NPTS,NPDE,NPDE,-9:9), B(NPTS,NPDE) C Ccc PURPOSE: C Solve LUx = b C A stems from a 19-point stencil on a grid with irregular row and C plane sizes C A = ILU, vectorized by `hyperplane' ordening, where the `hyperplanes' C are sets of points that can be treated simultaneously. C A((i,j,k),1:NPDE,1:NPDE,.) contains a block of NPDE.NPDE elements C corresponding with node (i,j,k) C Ccc PARAMETER DESCRIPTION: C NPTS : IN. # gridpoints C NPDE : IN. # components of the PDE C A : IN. A(.,1:NPDE,1:NPDE,-9:-1) : lower block diagonals of L C A(.,ic,jc,0): jc < ic: main block diagonal of L C main diagonal L == I C jc >=ic: main block diagonal of U C main diagonal U inverted C A(.,1:NPDE,1:NPDE, 1: 9) : upper block diagonals of U C LLDG : IN. Block-column index of lower 8 block-diagonals C If block ld does not exist the LLDG(N,ld) = N C LUDG : IN. Block-column index of upper 8 block-diagonals C If block ud does not exist the LUDG(N,lu) = N C LSL : IN. (NPTS) C LSL(LLSL(m-1)+1:LLSL(m)): pointers to set of points S_m C in actual grid that can be treated at the m-th iteration C of Ly = b C LLSL : IN. (0:LLSL(0)) C LLSL(0) = # iterations needed C LLSL(1:LLSL(0)): pointers to the start of a list in LSL C LSU : IN. (NPTS) C LSU(LLSU(m-1)+1:LLSU(m)): pointers to set of points S_m C in actual grid that can be treated at the m-th iteration C of Ux = y C LLSU : IN. (0:LLSU(0)) C LLSU(0) = # iterations needed C LLSU(1:LLSU(0)): pointers to the start of a list in LSU C B : INOUT. C IN: right-hand side vector b C OUT: solution vector x C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER IC, JC, N, L, M C CCC Ly = b C C Loop over `hyperplanes' S_m, m = 1, LLSL(0) C Node # N = LSL_m(LLSL(l)) C C LSL_1 = {(i,j,k)| (i,j,k) not dependent on (i-ii,j-jj,k-kk), C ii,jj,kk >= 0, not ii=jj=kk=0; C i.e., Dirichlet points and left/down/front corners} M = 1 DO 100 IC = 2, NPDE DO 101 JC = 1, IC-1 CDIR$ IVDEP DO 1 L = 1, LLSL(M) N = LSL(L) B(N,IC) = B(N,IC) - A(N,IC,JC,0)*B(N,JC) 1 CONTINUE 101 CONTINUE 100 CONTINUE C C Loop over rest of `hyperplane' sets C NB. No exception handling is necessary for the first row and the first C point of the second row, since N > 1 in the loop and for those C points LLDG(N,.) = N, (=> no array index problems), C and the multiplicator of `non existing' array elements is zero. C DO 10 M = 2, LLSL(0) C C Compute y elements in this set DO 120 IC = 1, NPDE DO 121 JC = 1, NPDE CDIR$ IVDEP DO 20 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) B(N,IC) = B(N,IC) - A(N,IC,JC,-1)*B(N- 1,JC) + - A(N,IC,JC,-2)*B(LLDG(N,-2),JC) + - A(N,IC,JC,-3)*B(LLDG(N,-3),JC) + - A(N,IC,JC,-4)*B(LLDG(N,-4),JC) + - A(N,IC,JC,-5)*B(LLDG(N,-5),JC) + - A(N,IC,JC,-6)*B(LLDG(N,-6),JC) + - A(N,IC,JC,-7)*B(LLDG(N,-7),JC) + - A(N,IC,JC,-8)*B(LLDG(N,-8),JC) + - A(N,IC,JC,-9)*B(LLDG(N,-9),JC) 20 CONTINUE 121 CONTINUE 120 CONTINUE DO 123 IC = 2, NPDE DO 122 JC = 1, IC-1 CDIR$ IVDEP DO 21 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) B(N,IC) = B(N,IC) - A(N,IC,JC,0)*B(N,JC) 21 CONTINUE 122 CONTINUE 123 CONTINUE C 10 CONTINUE C CCC Ux = y C C Loop over `hyperplanes' LSU_m, m = 1, LLSU(0) C Node # N = LSU_m(LLSU(l)) C C LSU_1 = {(i,j,k)| (i,j,k) not dependent on (i+ii,j+jj,k+kk), C ii,jj,kk >= 0, not ii=jj=kk=0; C e.g., Dirichlet points and right/up/back corners} C M = 1 DO 130 IC = NPDE, 1, -1 DO 131 JC = NPDE, IC+1, -1 CDIR$ IVDEP DO 132 L = 1, LLSU(M) N = LSU(L) B(N,IC) = B(N,IC) - A(N,IC,JC,0)*B(N,JC) 132 CONTINUE 131 CONTINUE CDIR$ IVDEP DO 133 L = 1, LLSU(M) N = LSU(L) B(N,IC) = B(N,IC) * A(N,IC,IC,0) 133 CONTINUE 130 CONTINUE C C Loop over rest of `hyperplane' sets C NB. No exception handling is necessary for the last row and the first C point of the second last row, since N < NPTS in the loop and for C those points LUDG(N,.) = N (=> no array index problems), C and the multiplicator of `non existing' array elements is zero. C DO 30 M = 2, LLSU(0) C C Compute x elements in this set CDIR$ IVDEP DO 150 IC = NPDE, 1, -1 DO 151 JC = NPDE, 1, -1 DO 40 L = LLSU(M-1)+1, LLSU(M) N = LSU(L) B(N,IC) = B(N,IC) - A(N,IC,JC,1)*B(N+1 ,JC) + - A(N,IC,JC,2)*B(LUDG(N,2),JC) + - A(N,IC,JC,3)*B(LUDG(N,3),JC) + - A(N,IC,JC,4)*B(LUDG(N,4),JC) + - A(N,IC,JC,5)*B(LUDG(N,5),JC) + - A(N,IC,JC,6)*B(LUDG(N,6),JC) + - A(N,IC,JC,7)*B(LUDG(N,7),JC) + - A(N,IC,JC,8)*B(LUDG(N,8),JC) + - A(N,IC,JC,9)*B(LUDG(N,9),JC) 40 CONTINUE 151 CONTINUE DO 152 JC = NPDE, IC+1, -1 CDIR$ IVDEP DO 51 L = LLSU(M-1)+1, LLSU(M) N = LSU(L) B(N,IC) = B(N,IC) - A(N,IC,JC,0)*B(N,JC) 51 CONTINUE 152 CONTINUE CDIR$ IVDEP DO 52 L = LLSU(M-1)+1, LLSU(M) N = LSU(L) B(N,IC) = B(N,IC) * A(N,IC,IC,0) 52 CONTINUE 150 CONTINUE C 30 CONTINUE C RETURN END SHAR_EOF fi # end of overwriting check if test -f 'user.f' then echo shar: will not over-write existing file "'user.f'" else cat << \SHAR_EOF > 'user.f' LOGICAL FUNCTION INIDOM (MAXPTS, + XL, YF, ZD, XR, YB, ZU, DX, DY, DZ, + LPLN, IPLN, LROW, IROW, ICOL, LLBND, ILBND, LBND) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER MAXPTS, LPLN(0:*), IPLN(*), LROW(*), IROW(*), ICOL(*), + LLBND(0:*), ILBND(*), LBND(*) DOUBLE PRECISION XL, YF, ZD, XR, YB, ZU, DX, DY, DZ C Ccc PURPOSE: C Define grid for initial rectangular-prism domain C ((XL,YF,ZD),(XR,YB,ZU)) in physical coordinates and C (( 0, 0, 0),(Nx,Ny,Nz)) in computational grid coordinates, C where Nx = (XR-XL)/DX, Ny = (YB-YF)/DY, and Nz = (ZU-ZD)/DZ. C Only real grid points are stored. C The coordinate values of the initial grid should be stored rowwise, C in LPLN, IPLN, LROW, IROW, ICOL. C Pointers to the boundary points should be stored in a list together C with the type of the boundary. (LLBND, ILBND, LBND) C C On exit INIDOM = .FALSE. if the # grid points required is larger C than MAXPTS and MAXPTS is set to the required # points. C Ccc PARAMETER DESCRIPTION: C MAXPTS : INOUT. C IN: Max. # grid points allowed by the available workspace C OUT: # grid points required, if larger than # points allowed C XL : IN. X-coordinate of left/front/down point of rectangular C prism C YF : IN. Y-coordinate of left/front/down point of rectangular C prism C ZD : IN. Z-coordinate of left/front/down point of rectangular C prism C XR : IN. X-coordinate of right/back/upper point of rectangular C prism C YB : IN. Y-coordinate of right/back/upper point of rectangular C prism C ZU : IN. Z-coordinate of right/back/upper point of rectangular C prism C DX : IN. Grid width in X-direction C DY : IN. Grid width in Y-direction C DZ : IN. Grid width in Z-direction C LPLN : OUT. (0:LPLN(0)+1) C LPLN(0) = NPLNS: Actual # planes in LROW C LPLN(1:NPLNS): pointers to the start of a plane in LROW C LPLN(NPLNS+1) = NROWS+1: Total # rows in grid + 1 C IPLN : OUT. (NPLNS) C IPLN(IP): plane number of plane IP in virtual box C LROW : OUT. (NROWS+1) C LROW(1:NROWS): pointers to the start of a row in the grid C LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 C IROW : OUT. (NROWS) C IROW(IR): row number of row IR in virtual box C ICOL : OUT. (NPTS) C ICOL(IPT): column number of grid point IPT in virtual box C LLBND : OUT. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : OUT. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : OUT. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C structure C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER NX, NY, NZ, I, IPT, IR, J, K, NPLNS, NROWS, NPTS, NBNDS, + NPTSPL NX = NINT((XR-XL)/DX) NY = NINT((YB-YF)/DY) NZ = NINT((ZU-ZD)/DZ) C Ccc Make initial grid NPLNS = NZ+1 NROWS = (NY+1)*NPLNS NPTS = (NX+1)*NROWS IF (MAXPTS .LT. NPTS) THEN INIDOM = .FALSE. MAXPTS = NPTS RETURN ELSE INIDOM = .TRUE. ENDIF C C Make grid structure LPLN(0) = NPLNS IPT = 1 IR = 1 DO 10 K = 0, NZ LPLN(K+1) = IR IPLN(K+1) = K DO 20 I = 0, NY LROW(IR) = IPT IROW(IR) = I IR = IR + 1 DO 30 J = 0, NX ICOL(IPT) = J IPT = IPT + 1 30 CONTINUE 20 CONTINUE 10 CONTINUE LROW(NROWS+1) = NPTS+1 LPLN(NPLNS+1) = NROWS+1 C C Boundaries NPTSPL = (NX+1)*(NY+1) NBNDS = 6 ILBND(1) = 1 ILBND(2) = 2 ILBND(3) = 3 ILBND(4) = 4 ILBND(5) = 5 ILBND(6) = 6 LLBND(0) = NBNDS LLBND(1) = 1 LLBND(2) = LLBND(1) + (NY+1)*(NZ+1) LLBND(3) = LLBND(2) + (NX+1)*(NY+1) LLBND(4) = LLBND(3) + (NY+1)*(NZ+1) LLBND(5) = LLBND(4) + (NX+1)*(NY+1) LLBND(6) = LLBND(5) + (NX+1)*(NZ+1) LLBND(7) = LLBND(6) + (NX+1)*(NZ+1) C Left and right boundary plane pointers DO 100 K = 0, NZ DO 110 I = 0, NY LBND(LLBND(1)+K*(NY+1)+I) = K*NPTSPL + I*(NX+1) + 1 LBND(LLBND(3)+K*(NY+1)+I) = (K+1)*NPTSPL - I*(NX+1) 110 CONTINUE 100 CONTINUE C Down and up boundary plane pointers DO 120 I = 0, NY DO 130 J = 0, NX LBND(LLBND(2)+I*(NX+1)+J) = I*(NX+1) + J + 1 LBND(LLBND(4)+I*(NX+1)+J) = NPTS - (I*(NX+1)+J) 130 CONTINUE 120 CONTINUE C Front and back boundary plane pointers DO 140 K = 0, NZ DO 150 J = 0, NX LBND(LLBND(5)+K*(NX+1)+J) = K*NPTSPL + J + 1 LBND(LLBND(6)+K*(NX+1)+J) = NPTS - (K*NPTSPL+J) 150 CONTINUE 140 CONTINUE C RETURN END SUBROUTINE DERIVF (F, T, X, Y, Z, NPTS, NPDE, U, + A0, DT, DX, DY, DZ, + LLBND, ILBND, LBND, UIB, UT, UX, UY, UZ, UXX, UYY, UZZ, + UXY, UXZ, UYZ, ABSTOL, DEL, WORK, + FU, FUX, FUY, FUZ, FUXX, FUYY, FUZZ, FUXY, FUXZ, FUYZ) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE, LLBND(0:*), ILBND(*), LBND(*) DOUBLE PRECISION F(NPTS*NPDE), T, X(*), Y(*), Z(*), U(*), A0, DT, + DX, DY, DZ, + UIB(*), UT(*), UX(*), UY(*), UZ(*), UXX(*), UYY(*), UZZ(*), + UXY(*), UXZ(*), UYZ(*), + ABSTOL(*), DEL(NPTS), WORK(2*NPTS*NPDE), + FU(NPTS*NPDE,NPDE), + FUX(NPTS*NPDE,NPDE), FUY(NPTS*NPDE,NPDE), FUZ(NPTS*NPDE,NPDE), + FUXX(NPTS*NPDE,NPDE),FUYY(NPTS*NPDE,NPDE),FUZZ(NPTS*NPDE,NPDE), + FUXY(NPTS*NPDE,NPDE),FUXZ(NPTS*NPDE,NPDE),FUYZ(NPTS*NPDE,NPDE) C Ccc PURPOSE: C Compute derivatives of residual wrt (derivatives of) U by numerical C differencing C C PARAMETER DESCRIPTION: C F : IN. Residual F(t,U,Ut) C T : IN. Current time C X,Y,Z : IN. Physical coordinates of gridpoints C NPTS : IN. # grid points C NPDE : IN. # PDE components C U : IN. Solution at T on current grid C A0 : IN. Coefficient of U_n+1 in time derivative C DT : IN. Current time step size C DX : IN. Cell width in X-direction for current grid C DY : IN. Cell width in Y-direction for current grid C DZ : IN. Cell width in Z-direction for current grid C LLBND : IN. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C UIB : IN. Solution at T on internal boundaries C UT : IN. Time derivative of U on current grid C UX : IN. -I C UY : IN. I C UZ : IN. I C UXX : IN. I C UYY : IN. I Space derivatives of U on current grid C UZZ : IN. I C UXY : IN. I C UXZ : IN. I C UYZ : IN. -I C ABSTOL : IN. Absolute tolerance for Newton process C DEL : WORK. (NPTS) C WORK : WORK. (2.LENU) C FU : OUT. dF(U,Ut)dU C FUX : OUT. dF(Ux)dUx C FUY : OUT. dF(Uy)dUy C FUZ : OUT. dF(Uz)dUz C FUXX : OUT. dF(Uxx)dUxx C FUYY : OUT. dF(Uyy)dUyy C FUZZ : OUT. dF(Uzz)dUzz C FUXY : OUT. dF(Uxy)dUxy C FUXZ : OUT. dF(Uxz)dUxz C FUYZ : OUT. dF(Uyz)dUyz C Ccc EXTERNALS USED: EXTERNAL PERTRB, PRTRBU, RES C C----------------------------------------------------------------------- C INTEGER I, IC, ICPTB, IPT, LUTBAR DOUBLE PRECISION FACX, FACY, FACZ, FACXX, FACYY, FACZZ, FACXY, + FACXZ, FACYZ, + TOL LUTBAR = 1 + NPTS*NPDE C Ccc How to decide if derivatives are `zero'? C Take `zero'-value of U divided by the grid width FACX = 1/(2*DX) FACY = 1/(2*DY) FACZ = 1/(2*DZ) FACXX = 1/DX**2 FACYY = 1/DY**2 FACZZ = 1/DZ**2 FACXY = 1/(2*DX*2*DY) FACXZ = 1/(2*DX*2*DZ) FACYZ = 1/(2*DY*2*DZ) C Ccc Loop over the components of the (derivatives of) U DO 10 ICPTB = 1, NPDE C C dF(U,Ut)/dU TOL = ABSTOL(ICPTB) CALL PRTRBU (ICPTB, NPTS, NPDE, U, A0, DT, UT, TOL, DEL, + WORK, WORK(LUTBAR)) CALL RES (T, X, Y, Z, NPTS, NPDE, WORK, + LLBND, ILBND, LBND, UIB, + WORK(LUTBAR), UX, UY, UZ, + UXX, UYY, UZZ, UXY, UXZ, UYZ, FU(1,ICPTB)) DO 20 IC = 1, NPDE DO 20 IPT = 1, NPTS I = IPT + (IC-1)*NPTS FU(I,ICPTB) = (FU(I,ICPTB) - F(I)) / DEL(IPT) 20 CONTINUE C C dF(Ux)/dUx TOL = ABSTOL(ICPTB)*FACX CALL PERTRB (ICPTB, NPTS, NPDE, UX, TOL, DEL, WORK) CALL RES (T, X, Y, Z, NPTS, NPDE, U, + LLBND, ILBND, LBND, UIB, + UT, WORK, UY, UZ, + UXX, UYY, UZZ, UXY, UXZ, UYZ, FUX(1,ICPTB)) DO 40 IC = 1, NPDE DO 40 IPT = 1, NPTS I = IPT + (IC-1)*NPTS FUX(I,ICPTB) = (FUX(I,ICPTB) - F(I)) / DEL(IPT) 40 CONTINUE C C dF(Uy)/dUy TOL = ABSTOL(ICPTB)*FACY CALL PERTRB (ICPTB, NPTS, NPDE, UY, TOL, DEL, WORK) CALL RES (T, X, Y, Z, NPTS, NPDE, U, + LLBND, ILBND, LBND, UIB, + UT, UX, WORK, UZ, + UXX, UYY, UZZ, UXY, UXZ, UYZ, FUY(1,ICPTB)) DO 50 IC = 1, NPDE DO 50 IPT = 1, NPTS I = IPT + (IC-1)*NPTS FUY(I,ICPTB) = (FUY(I,ICPTB) - F(I)) / DEL(IPT) 50 CONTINUE C C dF(Uz)/dUz TOL = ABSTOL(ICPTB)*FACZ CALL PERTRB (ICPTB, NPTS, NPDE, UZ, TOL, DEL, WORK) CALL RES (T, X, Y, Z, NPTS, NPDE, U, + LLBND, ILBND, LBND, UIB, + UT, UX, UY, WORK, + UXX, UYY, UZZ, UXY, UXZ, UYZ, FUZ(1,ICPTB)) DO 60 IC = 1, NPDE DO 60 IPT = 1, NPTS I = IPT + (IC-1)*NPTS FUZ(I,ICPTB) = (FUZ(I,ICPTB) - F(I)) / DEL(IPT) 60 CONTINUE C C dF(Uxx)/dUxx TOL = ABSTOL(ICPTB)*FACXX CALL PERTRB (ICPTB, NPTS, NPDE, UXX, TOL, DEL, WORK) CALL RES (T, X, Y, Z, NPTS, NPDE, U, + LLBND, ILBND, LBND, UIB, + UT, UX, UY, UZ, + WORK, UYY, UZZ, UXY, UXZ, UYZ, FUXX(1,ICPTB)) DO 70 IC = 1, NPDE DO 70 IPT = 1, NPTS I = IPT + (IC-1)*NPTS FUXX(I,ICPTB) = (FUXX(I,ICPTB) - F(I)) / DEL(IPT) 70 CONTINUE C C dF(Uyy)/dUyy TOL = ABSTOL(ICPTB)*FACYY CALL PERTRB (ICPTB, NPTS, NPDE, UYY, TOL, DEL, WORK) CALL RES (T, X, Y, Z, NPTS, NPDE, U, + LLBND, ILBND, LBND, UIB, + UT, UX, UY, UZ, + UXX, WORK, UZZ, UXY, UXZ, UYZ, FUYY(1,ICPTB)) DO 80 IC = 1, NPDE DO 80 IPT = 1, NPTS I = IPT + (IC-1)*NPTS FUYY(I,ICPTB) = (FUYY(I,ICPTB) - F(I)) / DEL(IPT) 80 CONTINUE C C dF(Uzz)/dUzz TOL = ABSTOL(ICPTB)*FACZZ CALL PERTRB (ICPTB, NPTS, NPDE, UZZ, TOL, DEL, WORK) CALL RES (T, X, Y, Z, NPTS, NPDE, U, + LLBND, ILBND, LBND, UIB, + UT, UX, UY, UZ, + UXX, UYY, WORK, UXY, UXZ, UYZ, FUZZ(1,ICPTB)) DO 90 IC = 1, NPDE DO 90 IPT = 1, NPTS I = IPT + (IC-1)*NPTS FUZZ(I,ICPTB) = (FUZZ(I,ICPTB) - F(I)) / DEL(IPT) 90 CONTINUE C C dF(Uxy)/dUxy TOL = ABSTOL(ICPTB)*FACXY CALL PERTRB (ICPTB, NPTS, NPDE, UXY, TOL, DEL, WORK) CALL RES (T, X, Y, Z, NPTS, NPDE, U, + LLBND, ILBND, LBND, UIB, + UT, UX, UY, UZ, + UXX, UYY, UZZ, WORK, UXZ, UYZ, FUXY(1,ICPTB)) DO 100 IC = 1, NPDE DO 100 IPT = 1, NPTS I = IPT + (IC-1)*NPTS FUXY(I,ICPTB) = (FUXY(I,ICPTB) - F(I)) / DEL(IPT) 100 CONTINUE C C dF(Uxz)/dUxz TOL = ABSTOL(ICPTB)*FACXZ CALL PERTRB (ICPTB, NPTS, NPDE, UXZ, TOL, DEL, WORK) CALL RES (T, X, Y, Z, NPTS, NPDE, U, + LLBND, ILBND, LBND, UIB, + UT, UX, UY, UZ, + UXX, UYY, UZZ, UXY, WORK, UYZ, FUXZ(1,ICPTB)) DO 110 IC = 1, NPDE DO 110 IPT = 1, NPTS I = IPT + (IC-1)*NPTS FUXZ(I,ICPTB) = (FUXZ(I,ICPTB) - F(I)) / DEL(IPT) 110 CONTINUE C C dF(Uyz)/dUyz TOL = ABSTOL(ICPTB)*FACYZ CALL PERTRB (ICPTB, NPTS, NPDE, UYZ, TOL, DEL, WORK) CALL RES (T, X, Y, Z, NPTS, NPDE, U, + LLBND, ILBND, LBND, UIB, + UT, UX, UY, UZ, + UXX, UYY, UZZ, UXY, UXZ, WORK, FUYZ(1,ICPTB)) DO 120 IC = 1, NPDE DO 120 IPT = 1, NPTS I = IPT + (IC-1)*NPTS FUYZ(I,ICPTB) = (FUYZ(I,ICPTB) - F(I)) / DEL(IPT) 120 CONTINUE 10 CONTINUE RETURN END SUBROUTINE MONITR (T, DT, DTNEW, XL, YF, ZD, DXB, DYB, DZB, + LGRID, ISTRUC, LSOL, SOL) INTEGER LGRID(0:*), ISTRUC(*), LSOL(*) DOUBLE PRECISION T, DT, DTNEW, XL, YF, ZD, DXB, DYB, DZB, SOL(*) RETURN END SUBROUTINE CHSPCM (T, LEVEL, NPTS, X, Y, Z, NPDE, U, SPCMON, TOL) INTEGER LEVEL, NPTS, NPDE DOUBLE PRECISION T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE), + SPCMON(NPTS), TOL RETURN END SHAR_EOF fi # end of overwriting check if test -f 'src.f' then echo shar: will not over-write existing file "'src.f'" else cat << \SHAR_EOF > 'src.f' SUBROUTINE VLUGR3 (NPDE, T, TOUT, DT, + XL,YF,ZD, XR,YB,ZU, DX, DY, DZ, + TOLS, TOLT, INFO, RINFO, RWK, LENRWK, IWK, LENIWK, LWK, LENLWK, + MNTR) C C======================================================================= C Ccc PURPOSE: C========== C This code solves systems of PDEs of the type C F(t,x,y,z,U,Ut,Ux,Uy,Uz,Uxx,Uyy,Uzz,Uxy,Uxz,Uyz)=0 C with boundary conditions C B(t,x,y,z,U,Ut,Ux,Uy,Uz)=0 C and initial values C U(t0,x,y,z)=U0 C on a 3D domain bounded by right-angled polyhedrons. C C In space Local Uniform Grid Refinement is applied to resolve local C sharp gradients in the solution. For the time integration the C implicit BDF2 method is used with variable stepsizes. C Although time-independent and hyperbolic PDEs fit into the problem C class, it should be observed that VLUGR3 is tuned for time-dependent C parabolic PDEs (see below `HOW TO REPLACE MODULES' and the part on C INCLUDEd files for the (non)linear solvers). C C C Ccc PARAMETER SPECIFICATION: C========================== INTEGER LENIWK INTEGER NPDE, INFO(*), LENRWK, IWK(LENIWK), LENLWK, MNTR LOGICAL LWK(LENLWK) DOUBLE PRECISION T, TOUT, DT, + XL,YF,ZD, XR,YB,ZU, DX, DY, DZ, + TOLS, TOLT, RINFO(*), RWK(LENRWK) C Ccc LANGUAGE: FORTRAN 77 C=========== C Ccc TYPE: Single precision C======= C Ccc REFERENCE: C============ C VLUGR3: A Vectorizable Adaptive Grid Solver for PDEs in 3D C Part I. Algorithmic Aspects and Applications C J.G. Blom and J.G. Verwer, Applied Numerical Mathematics, Vol.16 C pp.129-156 (1994). C C VLUGR3: A Vectorizable Adaptive Grid Solver for PDEs in 3D C Part II. Code Description C J.G. Blom and J.G. Verwer, Report NM-R9405, CWI, Amsterdam. C (to appear in ACM TOMS) C C C Ccc PARAMETER DESCRIPTION: C======================== C NPDE : IN. # PDE components. C T : INOUT. Current value of time variable C IN: If this is the first call the initial time C OUT: Time to which PDE has been integrated C TOUT : IN. Time point at which solution is desired C DT : INOUT. C IN: If this is the first call the initial time stepsize C OUT: Stepsize for next time step C XL : IN. If this is the first call and INFO(3) = 0 C X-coordinate of left/front/down point of rectangular C prism C YF : IN. If this is the first call and INFO(3) = 0 C Y-coordinate of left/front/down point of rectangular C prism C ZD : IN. If this is the first call and INFO(3) = 0 C Z-coordinate of left/front/down point of rectangular C prism C XR : IN. If this is the first call and INFO(3) = 0 C X-coordinate of right/back/upper point of rectangular C prism C YB : IN. If this is the first call and INFO(3) = 0 C Y-coordinate of right/back/upper point of rectangular C prism C ZU : IN. If this is the first call and INFO(3) = 0 C Z-coordinate of right/back/upper point of rectangular C prism C DX : IN. If this is the first call and INFO(3) = 0 C Cell width in X-direction of base grid C DY : IN. If this is the first call and INFO(3) = 0 C Cell width in Y-direction of base grid C DZ : IN. If this is the first call and INFO(3) = 0 C Cell width in Z-direction of base grid C TOLS : IN. Space tolerance C TOLT : IN. Time tolerance C INFO : IN. If INFO(1)=0, default parameters are used, otherwise C RINFO : IN. they should be specified in INFO and RINFO array C (for description see below) C RWK : WORK. (LENRWK) C LENRWK : IN. Dimension of RWK. (6.NPDE for VLUGR3)+: C Let NPTS be the max. # points on a grid level and C NPTSA the average # points over all grid levels. C Then LENRWK should be: C MAXLEV=1: 3.NPTS.NPDE+3.NPTS+13.NPTS.NPDE + LSSWRK C LSSWRK: C ( INFO(4)=0 C | 38.NPDE.NPTS.NPDE C !:INFO(4)=10 C | (MAX(NPDE.7+3,2.MAXLR+MAXL+6)+NPDE).NPTS.NPDE+ C MAXLR*MAXLR+(MAXL+3).MAXL+1 C !:INFO(4)=11 C | (MAX(NPDE.4+3,2.MAXLR+MAXL+6)+NPDE).NPTS.NPDE+ C MAXLR*MAXLR+(MAXL+3).MAXL+1 C !:INFO(4)=12 C | (2.MAXLR+MAXL+7).NPTS.NPDE+ C MAXLR*MAXLR+(MAXL+3).MAXL+1 C !:INFO(4)=13 C | (2.MAXLR+MAXL+7).NPTS.NPDE+ C MAXLR*MAXLR+(MAXL+3).MAXL+1 C ) C (default: MAXLR = 5, MAXL = 20) C Indication of the length for a maximum grid level C MAXLEV (default value MAXLEV=3): C 5.NPTSA.NPDE.MAXLEV+(3+13.NPDE).NPTS + LSSWRK C IWK : WORK. (LENIWK) C LENIWK : IN. Dimension of IWK. (8.MAXLEV+3 for VLUGR3)+: C MAXLEV=1: 28.NPTS C Indication of the length for a maximum grid level MAXLEV, C 7.NPTSA.MAXLEV+7.NPTS + ( INFO(4)=0| 19.NPTS ) C LWK : WORK. (LENLWK) C LENLWK : IN. Dimension of LWK. Indication of the length C 2.NPTS C MNTR : INOUT. Monitor of VLUGR3 C IN: State of integration C 0. First call C 1. Continuation call C OUT: Error return flag C 1. OK C -1. Workspace too small C -2. Time step size too small C -10. COMMON to keep the statistics is too small C C C Ccc HOW TO USE: Default case C=========================== C C 3 problem defining routines should be specified C C----------------------------------------------------------------------- C C SUBROUTINE PDEIV (T, X, Y, Z, U, NPTS, NPDE) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: C INTEGER NPTS, NPDE C REAL T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE) C Ccc PURPOSE: C Define (initial) solution of PDE. C Ccc PARAMETER DESCRIPTION: C T : IN. Time at which (initial) solution should be given C X,Y,Z : IN. Arrays of physical coordinates for the gridpoints C U : OUT. Array of PDE component values for the gridpoints. C NPTS : IN. Number of gridpoints C NPDE : IN. # PDE components C C----------------------------------------------------------------------- C C SUBROUTINE PDEF (T, X, Y, Z, U, C + UT, UX, UY, UZ, UXX, UYY, UZZ, UXY, UXZ, UYZ, RES, NPTS, NPDE) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: C INTEGER NPTS, NPDE C REAL T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE), C + UT(NPTS,NPDE), UX(NPTS,NPDE), UY(NPTS,NPDE), UZ(NPTS,NPDE), C + UXX(NPTS,NPDE), UYY(NPTS,NPDE), UZZ(NPTS,NPDE), C + UXY(NPTS,NPDE), UXZ(NPTS,NPDE), UYZ(NPTS,NPDE), C + RES(NPTS,NPDE) C Ccc PURPOSE: C Define residual of PDE on interior of domain. Boundary values will be C overwritten later on. C Ccc PARAMETER DESCRIPTION: C T : IN. Time at which residual should be evaluated C X,Y,Z : IN. Physical coordinates of gridpoints C U : IN. Array of PDE components for the gridpoints. C UT : IN. Array of time derivative of PDE components C UX : IN. -I C UY : IN. I C UZ : IN. I C UXX : IN. I C UYY : IN. I Space derivatives of U on current grid C UZZ : IN. I C UXY : IN. I C UXZ : IN. I C UYZ : IN. -I C RES : OUT. Array containg PDE residual at gridpoints in interior of C domain. The residual values at boundary points will be C overwritten by a call to PDEBC. C NPTS : IN. Number of gridpoints C NPDE : IN. Number of PDE components C C----------------------------------------------------------------------- C C SUBROUTINE PDEBC (T, X, Y, Z, U, UT, UX, UY, UZ, RES, NPTS, NPDE, C + LLBND, ILBND, LBND) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: C INTEGER NPTS, NPDE, LLBND(0:*), ILBND(*), LBND(*) C REAL T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE), C + UT(NPTS,NPDE), UX(NPTS,NPDE), UY(NPTS,NPDE), UZ(NPTS,NPDE), C + RES(NPTS,NPDE) C Ccc PURPOSE: C Define residual of boundary equations of PDE. The residual on interior C points has already been stored in RES. C Ccc PARAMETER DESCRIPTION: C T : IN. Time at which BC's should be evaluated C X,Y,Z : IN. Physical coordinates of gridpoints C U : IN. Array of PDE components for the gridpoints. C UT : IN. Array of time derivative of PDE components C UX : IN. -I C UY : IN. I Arrays containing space derivatives of PDE components C UZ : IN. -I C RES : INOUT. C IN: PDE residual for interior points (set by PDEF) C OUT: Array with PDE residual at physical boundary points C inserted C NPTS : IN. Number of grid components C NPDE : IN. Number of PDE components C LLBND : (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical horizontal planes in C actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBDPTS) C LBND(LB): pointer to boundary point in actual grid C structure (as in X, Y, Z, and U) C C----------------------------------------------------------------------- C C C Ccc HOW TO USE: Extra's C====================== C C If INFO(1) <> 0 a number of parameters can be specified in INFO and C RINFO that are described below. The parenthesized value is the C default value. C C INFO(2) : MAXLEV (3) C maximum # grid levels allowed C INFO(3) : RCTDOM (0) C If RCTDOM=0 the initial domain is a rectangular C prism otherwise the user should specify a subroutine C INIDOM to define the initial grid (see below) C INFO(4) : LINSYS (0) C Linear system solver in use C 0: BiCGStab + ILU C 10: GCRO + Block-diagonal preconditioning C 11: GCRO + Block-diagonal preconditioning C (neglecting first-order derivatives C at the boundaries) C 12: GCRO + Diagonal preconditioning C 13: GCRO + Diagonal preconditioning C (neglecting first-order derivatives C at the boundaries) C NB. 10-13 are matrix-free solvers C INFO(5) : LUNPDS (0) C Logical Unit # of file for information on the C integration history. If 0, only global information C will be written on standard output. C INFO(6) : LUNNLS (0) C Logical Unit # of file for information on the C Newton process. If 0, no information will be C written. C INFO(7) : LUNLSS (0) C Logical Unit # of file for information on the C linear system solver. If 0, no information will be C written. C C RINFO(1) : DTMIN (0.0) C minimum time stepsize allowed C RINFO(2) : DTMAX (TOUT-T) C maximum time stepsize allowed C RINFO(3) : UMAX ((1.0)) C approx. max. value of the PDE solution components. C Used for scaling purposes C RINFO(3+NPDE) : SPCWGT ((1.0)) C weighting factor used in the space monitor to C indicate the relative importance of a PDE C component on the space monitor C RINFO(3+2.NPDE) : TIMWGT ((1.0)) C weighting factor used in the time monitor to C indicate the relative importance of a PDE C component on the time monitor C C C C After each successful time step a subroutine MONITR is called. C Default is an empty body, but it can be overloaded with C----------------------------------------------------------------------- C C SUBROUTINE MONITR (T, DT, DTNEW, XL, YL, ZD, DXB, DYB, DZB, C + LGRID, ISTRUC, LSOL, SOL) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: C INTEGER LGRID(0:*), ISTRUC(*), LSOL(*) C REAL T, DT, DTNEW, XL, YL, ZD, DXB, DYB, DZB, SOL(*) C Ccc PURPOSE: C Control after a successful time step. The solution can be printed, C plotted or compared with the exact solution. C Ccc PARAMETER DESCRIPTION: C T : IN. Current value of time variable C DT : IN. Current time step size C DTNEW : IN. Time step size for next time step C XL : IN. X-coordinate of left/front/down point of (virtual) box C YF : IN. Y-coordinate of left/front/down point of (virtual) box C ZD : IN. Z-coordinate of left/front/down point of (virtual) box C DXB : IN. Cell width in X-direction of base grid C DYB : IN. Cell width in Y-direction of base grid C DZB : IN. Cell width in Z-direction of base grid C LGRID : IN. (0:*) C LGRID(0) = max. grid level used at T C LGRID(1): pointer to base grid structure ISTRUC C LGRID(LEVEL): pointer to grid structure C (LPLN,IPLN,LROW,IROW,ICOL) of refinement C level LEVEL for time T C ISTRUC : IN. (*) C ISTRUC(LGRID(LEVEL):.) contains (LPLN,IPLN,LROW,IROW,ICOL) C of grid level LEVEL, C LPLN : (0:LPLN(0)+1) C LPLN(0) = NPLNS: Actual # horizontal planes in LROW C LPLN(1:NPLNS): pointers to the start of a plane in LROW C LPLN(NPLNS+1) = NROWS+1: Total # rows in grid + 1 C IPLN : (NPLNS) C IPLN(IP): plane number of plane IP in virtual box C LROW : (NROWS+1) C LROW(1:NROWS): pointers to the start of a row in the grid C LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 C IROW : (NROWS) C IROW(IR): row number of row IR in virtual box C ICOL : (NPTS) C ICOL(IPT): column number of grid point IPT in virtual box C LSOL : IN. (*) C LSOL(LEVEL): pointer to (injected) solution at grid C of refinement level LEVEL for time T C SOL : IN. (*) C SOL(LSOL(LEVEL)+1:LSOL(LEVEL)+NPTS(LEVEL)*NPDE) contains C U_LEVEL(NPTS,NPDE) C C----------------------------------------------------------------------- C C C C To force grid refinement at a specific point in space and time and C on a specific level, one can overload the routine CHSPCM with C C----------------------------------------------------------------------- C C SUBROUTINE CHSPCM (T, LEVEL, NPTS, X, Y, Z, NPDE, U, SPCMON, TOL) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: C INTEGER LEVEL, NPTS, NPDE C REAL T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE), SPCMON(NPTS), TOL C Ccc PURPOSE: C Force grid refinement. C If for a node IPT SPCMON(IPT) > TOL the 64 surrounding cells will be C refined. C Ccc PARAMETER DESCRIPTION: C T : IN. Current value of time variable C LEVEL : IN. Current grid level C NPTS : IN. Number of grid points at this level C X,Y,Z : IN. Arrays of physical coordinates for the gridpoints C NPDE : IN. Number of PDE components C U : IN. Array of PDE components for the gridpoints C SPCMON : INOUT. C IN: Space monitor values as determined by VLUGR3 C OUT: Changed to a value > TOL where refinement is required C TOL : IN. Tolerance with which SPCMON will be compared C C----------------------------------------------------------------------- C C C C If the initial domain is not a rectangular prism one should specify C the initial grid via the function INIDOM C C----------------------------------------------------------------------- C C LOGICAL FUNCTION INIDOM (MAXPTS, C + XL, YF, ZD, XR, YB, ZU, DX, DY, DZ, C + LPLN, IPLN, LROW, IROW, ICOL, LLBND, ILBND, LBND) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: C INTEGER MAXPTS, LPLN(0:*), IPLN(*), LROW(*), IROW(*), ICOL(*), C + LLBND(0:*), ILBND(*), LBND(*) C REAL XL, YF, ZD, XR, YB, ZU, DX, DY, DZ C Ccc PURPOSE: C Define initial domain. NB. Boundaries should consist of as many points C as are necessary to employ second-order space discretization, i.e., C a boundary enclosing the internal part of the domain should not C include less than 3 grid points in any coordinate direction including C the corners. If Neumann boundaries are used the minimum is 4 since C otherwise the Jacobian matrix will be singular. C C A (virtual) box is placed around the (irregular) domain. C The left/front/down point of this box is (XL,YF,ZD) in physical C coordinates and (0,0,0) in column, row, plane coordinates, resp.. C The right/back/upper point is (XR,YB,ZU) resp. (Nx,Ny,Nz), where C Nx = (XR-XL)/DX, Ny = (YB-YF)/DY, and Nz = (ZU-ZD)/DZ. C Only real grid points are stored. C The coordinate values of the initial grid should be stored plane C after plane and rowwise in LPLN, IPLN, LROW, IROW, ICOL. C Pointers to the boundary points should be stored in a list together C with the type of the boundary. (LLBND, ILBND, LBND) C C On exit INIDOM = .FALSE. if the # grid points required is larger C than MAXPTS and MAXPTS is set to the required # points. C Ccc PARAMETER DESCRIPTION: C MAXPTS : INOUT. C IN: Max. # grid points allowed by the available workspace C OUT: # grid points required, if larger than # points allowed C XL : OUT. X-coordinate of left/front/down point of virtual box C YF : OUT. Y-coordinate of left/front/down point of virtual box C ZD : OUT. Z-coordinate of left/front/down point of virtual box C XR : OUT. X-coordinate of right/back/upper point of virtual box C YB : OUT. Y-coordinate of right/back/upper point of virtual box C ZU : OUT. Z-coordinate of right/back/upper point of virtual box C DX : OUT. Grid width in X-direction C DY : OUT. Grid width in Y-direction C DZ : OUT. Grid width in Z-direction C LPLN : OUT. (0:LPLN(0)+1) C LPLN(0) = NPLNS: Actual # horizontal planes in LROW C LPLN(1:NPLNS): pointers to the start of a plane in LROW C LPLN(NPLNS+1) = NROWS+1: Total # rows in grid + 1 C IPLN : OUT. (NPLNS) C IPLN(IP): plane number of plane IP in virtual box C LROW : OUT. (NROWS+1) C LROW(1:NROWS): pointers to the start of a row in the grid C LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 C IROW : OUT. (NROWS) C IROW(IR): row number of row IR in virtual box C ICOL : OUT. (NPTS) C ICOL(IPT): column number of grid point IPT in virtual box C LLBND : OUT. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : OUT. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C structure C C----------------------------------------------------------------------- C C C C To store the exact partial derivatives of the residual F with respect C to (the derivatives of) U. C C----------------------------------------------------------------------- C C SUBROUTINE DERIVF (F, T, X, Y, Z, NPTS, NPDE, U, C + A0, DT, DX, DY, DZ, C + LLBND, ILBND, LBND, UIB, UT, UX, UY, UZ, UXX, UYY, UZZ, C + UXY, UXZ, UYZ, ATOL, DEL, WORK, C + FU, FUX, FUY, FUZ, FUXX, FUYY, FUZZ, FUXY, FUXZ, FUYZ) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: C INTEGER NPTS, NPDE, LLBND(0:*), ILBND(*), LBND(*) C REAL F(NPTS,NPDE), T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE), C + A0, DT, DX, DY, DZ, UIB(*), C + UT(NPTS,NPDE), UX(NPTS,NPDE), UY(NPTS,NPDE), UZ(NPTS,NPDE), C + UXX(NPTS,NPDE), UYY(NPTS,NPDE), UZZ(NPTS,NPDE), C + UXY(NPTS,NPDE), UXZ(NPTS,NPDE), UYZ(NPTS,NPDE), C + ATOL(NPDE), DEL(NPTS), WORK(2*NPTS*NPDE), C + FUX(NPTS,NPDE,NPDE), FUY(NPTS,NPDE,NPDE), FUZ(NPTS,NPDE,NPDE), C + FUXX(NPTS,NPDE,NPDE),FUYY(NPTS,NPDE,NPDE),FUZZ(NPTS,NPDE,NPDE), C + FUXY(NPTS,NPDE,NPDE),FUXZ(NPTS,NPDE,NPDE),FUYZ(NPTS,NPDE,NPDE) C Ccc PURPOSE: C Compute derivatives of residual wrt (derivatives of) U C C PARAMETER DESCRIPTION: C F : IN. Residual F(t,U,Ut) C T : IN. Current time C X,Y,Z : IN. Physical coordinates of gridpoints C NPTS : IN. # grid points C NPDE : IN. # PDE components C U : IN. Solution at T on current grid C A0 : IN. Coefficient of U_n+1 in time derivative C DT : IN. Current time step size C DX : IN. Cell width in X-direction for current grid C DY : IN. Cell width in Y-direction for current grid C DZ : IN. Cell width in Z-direction for current grid C LLBND : IN. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C UIB : IN. Solution at T on internal boundaries C UT : IN. Time derivative of U on current grid C UX : IN. -I C UY : IN. I C UZ : IN. I C UXX : IN. I C UYY : IN. I Space derivatives of U on current grid C UZZ : IN. I C UXY : IN. I C UXZ : IN. I C UYZ : IN. -I C ATOL : IN. Absolute tolerance for Newton process C DEL : WORK. (NPTS) C WORK : WORK. (2.NPTS.NPDE) C FU : OUT. dF(U,Ut)dU C FUX : OUT. dF(Ux)dUx C FUY : OUT. dF(Uy)dUy C FUZ : OUT. dF(Uz)dUz C FUXX : OUT. dF(Uxx)dUxx C FUYY : OUT. dF(Uyy)dUyy C FUZZ : OUT. dF(Uzz)dUzz C FUXY : OUT. dF(Uxy)dUxy C FUXZ : OUT. dF(Uxz)dUxz C FUYZ : OUT. dF(Uyz)dUyz C C----------------------------------------------------------------------- C C C Ccc `HANDY' ROUTINES: C=================== C C VLUGR3 contains some routines that facilitate the use of the C data structure. C C C C To make a printout of the domain one has defined with INIDOM one C can call PRDOM C C----------------------------------------------------------------------- C C SUBROUTINE PRDOM (LPLN, IPLN, LROW, IROW, ICOL, C + LLBND, ILBND, LBND, IDOM, NX, NY, NZ) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: C INTEGER LPLN(0:*), IPLN(*), LROW(*), IROW(*), ICOL(*), C + LLBND(0:*), ILBND(*), LBND(*), IDOM(0:*), NX, NY, NZ C Ccc PURPOSE: C Print domain plane-wise. Internal points are .., external points XX, C physical plane-boundary points their ILBND value. Edges are given C both ILBND values, corners an explicated 2-character value, and C internal boundary values II. C Ccc PARAMETER DESCRIPTION: C See INIDOM C C----------------------------------------------------------------------- C C C C To get the X-,Y- and Z-coordinates corresponding with the grid points C C----------------------------------------------------------------------- C C SUBROUTINE SETXYZ (XL, YF, ZD, DX, DY, DZ, C + LPLN, IPLN, LROW, IROW, ICOL, X, Y, Z) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: C INTEGER LPLN(0:*), IPLN(*), LROW(*), IROW(*), ICOL(*) C REAL XL, YF, ZD, DX, DY, DZ, X(*), Y(*), Z(*) C Ccc PURPOSE: C Store X-, Y- and Z-coordinates of the grid points. C Ccc PARAMETER DESCRIPTION: C See MONITR. C NB. DX = DXB.2^(1-LEVEL); the same for DY and DZ. C C----------------------------------------------------------------------- C C C C To print the solution and the corresponding coordinate values at all C grid levels C C----------------------------------------------------------------------- C C SUBROUTINE PRSOL (LUN, T, NPDE, XL, YF, ZD, DXB, DYB, DZB, C + LGRID, ISTRUC, LSOL, SOL) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: C INTEGER LUN, NPDE, LGRID(0:*), ISTRUC(*), LSOL(*) C REAL T, XL, YF, ZD, DXB, DYB, DZB, SOL(*) C Ccc PURPOSE: C Print solution and coordinate values at all grid levels. C Ccc PARAMETER DESCRIPTION: C LUN : IN. Logical unit number of print file C NPDE : IN. # PDE components C Others see MONITR. C C----------------------------------------------------------------------- C C C C To write to file the (interpolated) solution values on a uniform grid C of a specified grid level and the maximum grid level used in each C point C C----------------------------------------------------------------------- C C SUBROUTINE WRUNI (LUNS, LUNG, UNILEV, C + T, NPDE, XL, YF, ZD, DXB, DYB, DZB, NXB, NYB, NZB, C + LGRID, ISTRUC, LSOL, SOL, UNIFRM, NX, NY, NZ) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: C INTEGER LUNS, LUNG, UNILEV, C + NPDE, NXB, NYB, NZB, LGRID(0:*), ISTRUC(*), LSOL(*), NX, NY, NZ C DOUBLE PRECISION T, XL, YF, ZD, DXB, DYB, DZB, SOL(*), C + UNIFRM(0:NX,0:NY,0:NZ,NPDE) C Ccc PURPOSE: C Write (interpolated) solution values at grid level UNILEV to file C LUNS. C Write maximum gridlevel used in each point to file LUNG. C NB. The data will not be correct for a domain with holes in it with C a size of the width of the base grid. C Ccc PARAMETER DESCRIPTION: C LUNS : IN. Logical unit number of solution file C LUNG : IN. Logical unit number of grid level file C UNILEV : IN. Maximum grid level to be used to generate the data C NPDE : IN. # PDE components C NXB,NYB,NZB: IN. # gridcells in X-, Y- and Z-direction, resp., on grid C of base level C UNIFRM : WORK. (Interpolated) solution on level UNILEV / max. grid C level used. C NX,NY,NZ: IN. # gridcells in X-, Y- and Z-direction, resp., on grid C of level UNILEV C Others see MONITR. C C----------------------------------------------------------------------- C C C C To dump all necessary information for a restart on file. C C----------------------------------------------------------------------- C C SUBROUTINE DUMP (LUNDMP, RWK, IWK) C C----------------------------------------------------------------------- C C C C C To read all necessary information for a restart from the dump file. C C----------------------------------------------------------------------- C C SUBROUTINE RDDUMP (LUNDMP, RWK, LENRWK, IWK, LENIWK) C C----------------------------------------------------------------------- C C C Ccc HOW TO REPLACE MODULES: C========================= C Ccc Space discretization. C Replace the computation of the derivatives in subroutine DERIVS by the C desired discretization. C If the new space discretization uses a larger stencil than the C implemented one (internally a central 19-point stencil and at the C boundary a 3-point one sided), one should use as linear system C solver the matrix-free GCRO variant (INFO(4)=10,11,12 or 13). C Moreover, one should check whether the required grid points are C available on the current grid level, e.g. using the x-, y- C and z-coordinates of the grid points (see SETXYZ above). C Note that the refinement strategy results in subgrids of at least C 5 points in every coordinate direction. C Ccc Linear system solver. C If the new solver is matrix-free: C rewrite the body of subroutine GCRO using the routines C MVDIFF to compute y=Ax C If the (block-)diagonal preconditioner is wanted, use the routine C BCKBDI to compute w=P^(-1).v C (copy the call used in GCRO and replace the vector arguments for C x, y, v, w, and, optionally for the workspace needed) C otherwise, if the ILU preconditioner is to be used: C rewrite the body of subroutine BICGST using the routines C BCKSLV to compute v=P^(-1).v and C MVDIAG to compute y=Ax C (copy the call used in BICGST and replace the vector argument(s)). C C If a user-made preconditioner is wanted, one should adapt INTGRB C (when the Jacobian is used) or INTGRC (for a matrix-free solver). C The calls to JACPB and PINIT, resp. should be replaced by calls to C the routine that computes the preconditioner. In BICGST and GCRO, C resp., one should call one's own routine to compute w=P^(-1).v C instead of BCKSLV and BCKBDI, resp.. C C If extra workspace is needed, the easiest way is to declare it in C the subroutine. C C C Ccc DESCRIPTION OF THE SETUP IN THE WORKARRAYS: C============================================= C Ccc Datastructure for the solution at a grid level C The solution is stored plane after plane, rowwise, one component C vector after the other in C REAL U(0:NPTS*NPDE) C The element U(0) is added because pointers to non-existing nodes point C to 0. C Ccc Solutions from 3 different time levels have to be saved. For Tn-1 C only the injected one (U); for Tn the original solution (S) belonging C to a specific grid, the injected solution (U), and the injected C solution at the Tn+1 grid; and for Tn+1 the solution (S) and when C finished the injected solution (U). C C The real work storage is set up as follows: C First some method related arrays of length NPDE each: SPCTOL, TIMWGT, C RELTOL, ABSTOL, RTOL, ATOL. C From 6*NPDE+1 work storage for PDESOL where the array RWK starts with C index 1. From there it will contain the following items: C First the X-, Y- and Z- coordinates for the base grid: X(NPTSB), C Y(NPTSB), and Z(NPTSB). C From 3*NPTSB+1 the solutions are stored: C First for Tn-1: U_i for i=LSGNM1(0),(-1),1 C Next for Tn: S_i for i=1,...,LSGN(0) C U_i for i=LSGN(0)-1,(-1),1 C Next for Tn+1: S_1 C U_i(Tn) at grid LSGNP1(i) I C S_i(Tn+1) I for i=2,...,LEVEL C when refinement is finished: C U_i(Tn+1) for i=LSGNP1(0)-1,(-1),1 C After the solutions work storage is available for the (interpolated) C solutions from Tn-1 at the current grid, the current X- and C Y-coordinates, if necessary the (interpolated) solution values at the C internal boundary, the initial solution at Tn+1 at the current grid C (since the not updated solution of the old time level has to be used), C and for the derivatives and the linear solver. C Ccc If the linear solver uses a Jacobian and an ILU preconditioner C (INFO(4)=0) the Jacobian is stored as a block 19-diagonal matrix. C If a second-order discretization is used at the boundary the extra C information will be stored in one of the `mixed-derivative blocks'. C Addressing is done with the use of pointers to off 3-diagonal blocks C (cf. LLDG and LUDG below). C For the incomplete LU the second-order discretization at the C boundaries is replaced by a first order discretization, since a true C block 19-diagonal matrix is required to apply the hyperplane method. C The same block structure will be used as for the Jacobian itself. C C C Ccc Datastructure for the grid at the current grid level C A (virtual) box is placed around the irregular domain. C The left/front/down point of this box is (XL,YF,ZD) in physical C coordinates and (0,0,0) in column, row, plane coordinates, resp.. C The right/back/upper point is (XR,YB,ZU) resp. (Nx,Ny,Nz), where C Nx = (XR-XL)/DX, Ny = (YB-YF)/DY, and Nz = (ZU-ZD)/DZ. C Only real grid points are stored, plane after plane, rowwise. C C INTEGER ISTRUC(0:*) C Ccc ISTRUC contains the following arrays: C LPLN : (0:LPLN(0)+1) C LPLN(0) = NPLNS: Actual # horizontal planes in LROW C LPLN(1:NPLNS): pointers to the start of a plane in LROW C LPLN(NPLNS+1) = NROWS+1: Total # rows in grid + 1 C IPLN : (NPLNS) C IPLN(IP): plane number of plane IP in virtual box C LROW : (NROWS+1) C LROW(1:NROWS): pointers to the start of a row in the grid C LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 C IROW : (NROWS) C IROW(IR): row number of row IR in virtual box C ICOL : (NPTS) C ICOL(IPT): column number of grid point IPT in virtual box C LLBND : (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C structure C LBLWY : (0:NPTS) C LBLWY(IPT): pointer to node below in Y-direction in C actual grid C 0, if index node is front-plane boundary point C LABVY : (0:NPTS) C LABVY(IPT): pointer to node above in Y-direction in C actual grid C 0, if index node is back-plane boundary point C LBLWZ : (0:NPTS) C LBLWZ(IPT): pointer to node below in Z-direction in C actual grid C 0, if index node is down-plane boundary point C LABVZ : (0:NPTS) C LABVZ(IPT): pointer to node above in Z-direction in C actual grid C 0, if index node is up-plane boundary point C C The next 6 arrays are only stored if INFO(4) = 0 C The next 2 arrays are used for the Jacobian structure and its ILU C LLDG : (NPTS,-9:-2) C LLDG(IPT,-9): pointer to node Y-below Z-below C or to node Z-below Z-below C LLDG(IPT,-8): pointer to node left of Z-below C LLDG(IPT,-7): pointer to node Z-below C LLDG(IPT,-6): pointer to node right of Z-below C LLDG(IPT,-5): pointer to node Y-above Z-below C LLDG(IPT,-4): pointer to node left of Y-below C or to node Y-below Y-below C LLDG(IPT,-3): pointer to node Y-below C LLDG(IPT,-2): pointer to node right of Y-below C or to node left of the node left C LUDG : (NPTS,2:9) C LUDG(IPT,2): pointer to node left of Y-above C or to node right of the node right C LUDG(IPT,3): pointer to node Y-above C LUDG(IPT,4): pointer to node right of node Y-above C or to node Y-above Y-above C LUDG(IPT,5): pointer to node Y-below Z-above C LUDG(IPT,6): pointer to node left of Z-above C LUDG(IPT,7): pointer to node Z-above C LUDG(IPT,8): pointer to node right of Z-above C LUDG(IPT,9): pointer to node Y-above Z-above C or to node Z-above Z-above C C The next 4 arrays are used to hold the data dependency lists C for the ILU factorization and the forward, resp. backward C sweep of the backsolve C LSL : (NPTS) C LSL(ISLPT): pointer to node in actual grid C LLSL : (0:LLSL(0)) C LLSL(0) = # independent data dependency lists in ILU C factorization and forward sweep C LLSL(1:LLSL(0)): pointers to the start of a list in LSL C LSU : (NPTS) C LSU(ISLPT): pointer to node in actual grid C LLSU : (0:LLSU(0)) C LLSU(0) = # independent data dependency lists in backward C sweep C LLSU(1:LLSU(0)): pointers to the start of a list in LSU C C For the base grid the complete datastructure is saved (including C the last 6 arrays because of restart), for higher level grids C only the first 5 arrays LPLN, IPLN, LROW, IROW and ICOL. C C Pointers to the specific arrays in ISTRUC are obtained by C LLPLN = 0 C NPLNS = ISTRUC(LLPLN) C LIPLN = LLPLN+NPLNS+2 C LLROW = LIPLN+NPLNS C NROWS = ISTRUC(LLPLN+NPLNS+1)-1 C NPTS = ISTRUC(LLROW+NROWS)-1 C LIROW = LLROW+NROWS+1 C LICOL = LIROW+NROWS C LLLBND = LICOL+NPTS C NBNDS = ISTRUC(LLLBND) C NBIPTS = ISTRUC(LLLBND+NBNDS+2)-1 C LILBND = LLLBND+NBNDS+3 C LLBNDP = LILBND+NBNDS C LLBLWY = LLBNDP+NBIPTS C LLABVY = LLBLWY+NPTS+1 C LLBLWZ = LLABVY+NPTS+1 C LLABVZ = LLBLWZ+NPTS+1 C LIWK = LLABVZ+NPTS C C LLLDG = LIWK C LLUDG = LLLDG+NPTS*8 C LLSLP = LLUDG+NPTS*8 C LLLSL = LLSLP+NPTS C LLSUP = LLLSL+ISTRUC(LLLSL)+1 C LLLSU = LLSUP+NPTS C LIWK = LLLSU+ISTRUC(LLLSU)+1 C C Ccc All grids from 3 different time levels have to be saved C The integer work storage is set up as follows: C LSGNM1 : (0:MAXLEV) C LSGNM1(0) = max. grid level used at Tn-1 C LSGNM1(1): pointer to base grid structure ISTRUC C LSGNM1(LEVEL): pointer to grid structure C (LPLN, IPLN, LROW, IROW, ICOL) C of refinement level LEVEL for time Tn-1 C LSGN : (0:MAXLEV) C LSGN(0) = max. grid level used at Tn C LSGN(1): pointer to base grid structure ISTRUC C LSGN(LEVEL): pointer to grid structure C (LPLN, IPLN, LROW, IROW, ICOL) C of refinement level LEVEL for time Tn C LSGNP1 : (0:MAXLEV) C LSGNP1(0) = max. grid level used at Tn+1 C LSGNP1(1): pointer to base grid structure ISTRUC C LSGNP1(2): pointer after grid structure of max. refinement C level for time Tn C LSGNP1(LEVEL): pointer to augmented grid structure C (LPLN, IPLN, LROW, IROW, ICOL, LLBND, ILBND, LBND) C of refinement level LEVEL for time Tn+1 C LSGNP1(LEVEL+1): pointer to grid structure ISTRUC of C refinement level LEVEL+1 for time Tn+1 C LSUNM1 : (MAXLEV) C LSUNM1(LEVEL): pointer to (injected) solution at grid C of refinement level LEVEL for time Tn-1 C LSSN : (MAXLEV) C LSSN(LEVEL): pointer to original solution belonging C to refinement level LEVEL for time Tn C LSUN : (MAXLEV) C LSUN(LEVEL): pointer to (injected) solution at grid C of refinement level LEVEL for time Tn C LSSNP1 : (MAXLEV) C LSSNP1(LEVEL): pointer to original solution belonging C to refinement level LEVEL for time Tn+1 C LSUNP1 : (MAXLEV) C LSUNP1(LEVEL): pointer to (injected) solution at grid C of refinement level LEVEL for time Tn+1 C From 8*MAXLEV+4 the grids are stored, in PDESOL the array IWK starts C with the grids at index 1. C Storage order: C First ISTRUC for the base grid C Next for Tn-1: (LPLN, IPLN, LROW, IROW, ICOL)_i for i=2,...,LSGNM1(0) C Next for Tn: (LPLN, IPLN, LROW, IROW, ICOL)_i for i=2,...,LSGN(0) C Next for Tn+1: (LPLN, IPLN, LROW, IROW, ICOL, LLBND, ILBND, LBND)_i C for i=2,...,LEVEL C ISTRUC_i for i=LEVEL+1 C After the grids work storage is available for domain flags and C the linear solver C C======================================================================= C C IMPORTANT: C ========= C C The INCLUDEd file CMNCMMACH contains machine numbers that C are set in the routine MACNUM by calling the appropriate functions C of the BLAS library. If I1MACH and D1MACH of the file blas.f are used, C the functions should be altered for the particular machine used (cf. C comment in I1MACH and D1MACH). C Ccc CMNCMMACH C C COMMON with `machine numbers' C LUNOUT : Logical unit # standard output -I C LUNERR : Logical unit # standard error I Set in the routine C UROUND : Smallest machine number such that I MACNUM C 1.0+UROUND > 1.0 and 1.0-UROUND < 1.0 I C XMIN : Smallest floating-point number > 0.0 -I C INTEGER LUNOUT, LUNERR C REAL UROUND, XMIN C COMMON /IMACH/ LUNOUT, LUNERR C COMMON /RMACH/ UROUND, XMIN C SAVE /IMACH/, /RMACH/ C C C C The INCLUDE files PARNEWTON, PARBICGSTAB, and PARGCRO contain the C method parameters for the corresponding (non)linear solvers. These C parameters may be changed by the user. C Ccc PARNEWTON C C Parameters for Newton process C MAXNIT : Max. number of Newton iterations C NB. If MAXNIT > 20 the include file CMNSTATS C == should also be changed. C MAXJAC : Max. number of Jacobian / preconditioner evaluations during C a Newton process C TOLNEW : Tolerance for Newton process: C rho/(1-rho)*|| corr.||_w < TOLNEW C INTEGER MAXNIT, MAXJAC C REAL TOLNEW C PARAMETER (MAXNIT = 10, MAXJAC = 2, TOLNEW = 1.0) C Ccc PARBICGSTAB C C Parameters for linear system solver BiCGStab C MAXLIT : Max. number of BiCGStab iterations C TOLLSB : Tolerance for linear system solver: C || P^(-1).residual ||_w < TOLLSB/2^NIT C INTEGER MAXLIT C REAL TOLLSB C PARAMETER (MAXLIT = 100, TOLLSB = TOLNEW/10) C Ccc PARGCRO C C Parameters for linear system solver GCRO + (block-)diagonal C preconditioner C IDIAGP : 0: block-diagonal + first order derivatives C 1: block-diagonal neglecting first order derivatives C 2: diagonal + first order derivatives C 3: diagonal neglecting first order derivatives C NRRMAX : Max. number of restarts of outer loop C MAXLR : Max. number of iterations in outer loop C MAXL : Max. number of iterations in GMRES inner loop C TOLLSC : Tolerance for linear system solver C || P^(-1).residual ||_w < TOLLSC/2^NIT C INTEGER IDIAGP, NRRMAX, MAXLR, MAXL C REAL TOLLSC C PARAMETER (NRRMAX = 1, MAXLR = 5, MAXL = 20) C PARAMETER (TOLLSC = TOLNEW/10) C COMMON /IGCRO/ IDIAGP C SAVE /IGCRO/ C C Note, that in the actual code the INCLUDE statements have been C replaced by C CCcc INCLUDE 'file' C ... code in file CC end INCLUDE 'file' C C So if one wishes to change the method parameters care should be taken C that it is done for all occurrences. C C======================================================================= C Ccc EXTERNALS USED: EXTERNAL ICOPY, INTGRB, INTGRC, IYPOC, PDESOL, RCOPY C C Ccc INCLUDE 'CMNSTATS' C C CMNSTATS C C COMMON with integration statistics INTEGER MXCLEV, MXCNIT PARAMETER (MXCLEV = 10, MXCNIT = 20) INTEGER LUNPDS, LUNNLS, LUNLSS, LEVEL, NSTEPS, NREJS, + NJACS(MXCLEV), NRESID(MXCLEV), NNIT(MXCLEV), + NLSIT(MXCLEV,MXCNIT) COMMON /STATS/ LUNPDS, LUNNLS, LUNLSS, LEVEL, NSTEPS, NREJS, + NJACS, NRESID, NNIT, NLSIT SAVE /STATS/ C C end INCLUDE 'CMNSTATS' C C Ccc INCLUDE 'CMNCMMACH' C C CMNCMMACH C C COMMON with `machine numbers' C LUNOUT : Logical unit # standard output -I C LUNERR : Logical unit # standard error I Set in the routine C UROUND : Smallest machine number such that I MACNUM C 1.0+UROUND > 1.0 and 1.0-UROUND < 1.0 I C XMIN : Smallest floating-point number -I INTEGER LUNOUT, LUNERR DOUBLE PRECISION UROUND, XMIN COMMON /IMACH/ LUNOUT, LUNERR COMMON /RMACH/ UROUND, XMIN SAVE /IMACH/, /RMACH/ C C end INCLUDE 'CMNCMMACH' C C Ccc INCLUDE 'CMNWRITEF' C C CMNWRITEF C C COMMON needed for continuation calls INTEGER MAXLVW, NPDEW, LRWKPS, LIWKPS, LRWKB, LIWKB LOGICAL FIRST, SECOND DOUBLE PRECISION T0,TW,TEW,DTW, XLW,YFW,ZDW, XRW,YBW,ZUW, DXB,DYB, + DZB, DTO COMMON /WRITIF/ MAXLVW, NPDEW, LRWKPS, LIWKPS, LRWKB, LIWKB COMMON /WRITLF/ FIRST, SECOND COMMON /WRITRF/ T0,TW,TEW,DTW, XLW,YFW,ZDW, XRW,YBW,ZUW, + DXB,DYB,DZB, DTO SAVE /WRITIF/, /WRITLF/, /WRITRF/ C C end INCLUDE 'CMNWRITEF' C C Ccc INCLUDE 'PARNEWTON' C C PARNEWTON C C Parameters for Newton process C MAXNIT : Max. number of Newton iterations C MAXJAC : Max. number of Jacobian / preconditioner evaluations during C a Newton process C TOLNEW : Tolerance for Newton process: C rho/(1-rho)*|| corr.||_w < TOLNEW INTEGER MAXNIT, MAXJAC DOUBLE PRECISION TOLNEW PARAMETER (MAXNIT = 10, MAXJAC = 2, TOLNEW = 1.0) C C end INCLUDE 'PARNEWTON' C C Ccc INCLUDE 'PARBICGSTAB' C C PARBICGSTAB C C Parameters for linear system solver BiCGStab C MAXLIT : Max. number of BiCGStab iterations C TOLLSB : Tolerance for linear system solver INTEGER MAXLIT DOUBLE PRECISION TOLLSB PARAMETER (MAXLIT = 100, TOLLSB = TOLNEW/10) C C end INCLUDE 'PARBICGSTAB' C C Ccc INCLUDE 'PARGCRO' C C PARGCRO C C Parameters for linear system solver GCRO + (block-)diagonal C preconditioner C IDIAGP : 0: block-diagonal + first order derivatives C 1: block-diagonal neglecting first order derivatives C 2: diagonal + first order derivatives C 3: diagonal neglecting first order derivatives C NRRMAX : Max. number of restarts of outer loop C MAXLR : Max. number of iterations in outer loop C MAXL : Max. number of iterations in GMRES inner loop C TOLLSC : Tolerance for linear system solver INTEGER IDIAGP, NRRMAX, MAXLR, MAXL DOUBLE PRECISION TOLLSC PARAMETER (NRRMAX = 1, MAXLR = 5, MAXL = 20) C PARAMETER (NRRMAX = 1, MAXLR = 3, MAXL = 15) PARAMETER (TOLLSC = TOLNEW/10) COMMON /IGCRO/ IDIAGP SAVE /IGCRO/ C C end INCLUDE 'PARGCRO' C C C----------------------------------------------------------------------- C INTEGER LSGNM1, LSGN, LSGNP1, LSUNM1, LSUN, LSUNP1, LSSN, LSSNP1, + LGNM1, LGN, LGNP1, LUNM1, LUN, LSN, LSNP1, + MAXLEV, LSPCTL, LTIMWT, LRELTL, LABSTL, LRTOL, LATOL, LSPCWT, + LUMAX, RCTDOM, LINSYS, I, I1, I2, IC, J, LRWK, LIWK, LIWKPN DOUBLE PRECISION DTMIN, DTMAX, TOL C CDIR$ NOVECTOR IF (MNTR .EQ. 1) THEN NPDE = NPDEW T = TW DT = DTW XL = XLW YF = YFW ZD = ZDW XR = XRW YB = YBW ZU = ZUW ENDIF C C Set machine numbers in /CMMACH/ CALL MACNUM C C Setup real work storage LSPCTL = 1 LTIMWT = LSPCTL+NPDE LRELTL = LTIMWT+NPDE LABSTL = LRELTL+NPDE LRTOL = LABSTL+NPDE LATOL = LRTOL +NPDE LRWKPS = LATOL +NPDE LSPCWT = LSPCTL LUMAX = LATOL C C Get User info IF (INFO(1) .EQ. 0) THEN MAXLEV = 3 RCTDOM = 0 LINSYS = 0 LUNPDS = 0 LUNNLS = 0 LUNLSS = 0 DTMIN = 0.0 DTMAX = TOUT - T DO 10 IC = 1, NPDE RWK(LUMAX-1 +IC) = 1.0 RWK(LSPCWT-1+IC) = 1.0 RWK(LTIMWT-1+IC) = 1.0 10 CONTINUE ELSE MAXLEV = INFO(2) IF (MAXLEV .EQ. 0) MAXLEV = 3 RCTDOM = INFO(3) IDIAGP = MOD(INFO(4),10) LINSYS = INFO(4)/10 LUNPDS = INFO(5) LUNNLS = INFO(6) LUNLSS = INFO(7) DTMIN = RINFO(1) DTMAX = RINFO(2) IF (DTMAX .EQ. 0.0) DTMAX = TOUT - T DO 20 IC = 1, NPDE RWK(LUMAX-1 +IC) = RINFO(2+IC) RWK(LSPCWT-1+IC) = RINFO(2+NPDE+IC) RWK(LTIMWT-1+IC) = RINFO(2+2*NPDE+IC) 20 CONTINUE ENDIF C C Store method arrays TOL = 1D-1*MIN(TOLT*TOLT,TOLS) DO 30 IC = 1, NPDE RWK(LSPCTL-1+IC) = RWK(LSPCWT-1+IC)/(RWK(LUMAX-1+IC)*TOLS) RWK(LRELTL-1+IC) = TOLT RWK(LABSTL-1+IC) = 0.01*RWK(LUMAX-1+IC)*TOLT RWK(LRTOL-1+IC) = TOL RWK(LATOL-1+IC) = 0.01*RWK(LUMAX-1+IC)*TOL 30 CONTINUE C C Setup integer work storage IF (MXCLEV .LT. MAXLEV) THEN WRITE(LUNERR,*) 'Arrays for the statistic are too small' WRITE(LUNERR,*) 'Either MAXLEV > 10 or MAXNIT > 20' WRITE(LUNERR,*) 'Adapt the parameter statements for /STATS/' MNTR = -10 RETURN ENDIF LSGNM1 = 1 LSGN = LSGNM1 + MAXLEV+1 LSGNP1 = LSGN + MAXLEV+1 LSUNM1 = LSGNP1 + MAXLEV+1 LSSN = LSUNM1 + MAXLEV LSUN = LSSN + MAXLEV LSSNP1 = LSUN + MAXLEV LSUNP1 = LSSNP1 + MAXLEV LIWKPN = LSUNP1 + MAXLEV IF (MNTR .EQ. 0) THEN C This is the first call, initialize pointer arrays and STATS common DO 50 I = 1, LIWKPN-1 IWK(I) = 1 50 CONTINUE NSTEPS = 0 NREJS = 0 DO 60 I = 1, MXCLEV NJACS(I) = 0 NRESID(I) = 0 NNIT(I) = 0 DO 70 J = 1, MXCNIT NLSIT(I,J) = 0 70 CONTINUE 60 CONTINUE ELSE IF (MAXLEV .GT. MAXLVW) THEN C MAXLEV larger than previous call; shift info in IWK array backwards IF (LENIWK .LT. LIWKPN+LIWKB) THEN WRITE(LUNERR,*) 'Integer work space too small, required:', + LIWKPN+LIWKB MNTR = -1 RETURN ENDIF CALL IYPOC (LIWKB, IWK(LIWKPS), IWK(LIWKPN)) LIWK = LIWKPS - MAXLVW CALL IYPOC (MAXLVW, IWK(LIWK), IWK(LSUNP1)) LIWK = LIWK - MAXLVW CALL IYPOC (MAXLVW, IWK(LIWK), IWK(LSSNP1)) LIWK = LIWK - MAXLVW CALL IYPOC (MAXLVW, IWK(LIWK), IWK(LSUN)) LIWK = LIWK - MAXLVW CALL IYPOC (MAXLVW, IWK(LIWK), IWK(LSSN)) LIWK = LIWK - MAXLVW CALL IYPOC (MAXLVW, IWK(LIWK), IWK(LSUNM1)) LIWK = LIWK - MAXLVW-1 CALL IYPOC (MAXLVW+1, IWK(LIWK), IWK(LSGNP1)) LIWK = LIWK - MAXLVW-1 CALL IYPOC (MAXLVW+1, IWK(LIWK), IWK(LSGN)) ELSE IF (MAXLEV .LT. MAXLVW) THEN C MAXLEV smaller than previous call; shift info in IWK array forwards LGNM1 = 1 LGN = LGNM1 + MAXLVW+1 LGNP1 = LGN + MAXLVW+1 LUNM1 = LGNP1 + MAXLVW+1 LSN = LUNM1 + MAXLVW LUN = LSN + MAXLVW LSNP1 = LUN + MAXLVW IF (IWK(LGNM1) .GT. MAXLEV) THEN C Shift grid_n forwards to LGNM1(MAXLEV+1) I1 = IWK(LGN+2) I2 = IWK(LGNM1+MAXLEV+1) CALL ICOPY (LIWKB-I1, IWK(I1), IWK(I2)) DO 110 I = 2, IWK(LGN) IWK(LGN+I) = IWK(LGN+I) - (I1-I2) 110 CONTINUE LIWKB = LIWKB - (I1-I2) C Shift info from U_n-1(MAXLEV) forwards to LUNM1(LGNM1(0)) I1 = IWK(LUNM1-1+MAXLEV) I2 = IWK(LUNM1-1+IWK(LGNM1)) CALL RCOPY (LRWKB-I1, RWK(I1), RWK(I2)) DO 120 I = 1, MAXLEV IWK(LUNM1-1+I) = IWK(LUNM1-1+I) - (I1-I2) 120 CONTINUE DO 130 I = 1, IWK(LGN) IWK(LSN-1+I) = IWK(LSN-1+I) - (I1-I2) IWK(LUN-1+I) = IWK(LUN-1+I) - (I1-I2) 130 CONTINUE IWK(LSNP1) = IWK(LSNP1) - (I1-I2) LRWKB = LRWKB - (I1-I2) IWK(LGNM1) = MAXLEV ENDIF IF (IWK(LGN) .GT. MAXLEV) THEN LIWKB = IWK(LGN+MAXLEV+1) C Shift info from U_n(MAXLEV) forwards to LUN(LGN(0)) I1 = IWK(LUN-1+MAXLEV) I2 = IWK(LUN-1+IWK(LGN)) CALL RCOPY (LRWKB-I1, RWK(I1), RWK(I2)) DO 140 I = 1, MAXLEV IWK(LUN-1+I) = IWK(LUN-1+I) - (I1-I2) 140 CONTINUE IWK(LSNP1) = IWK(LSNP1) - (I1-I2) LRWKB = LRWKB - (I1-I2) IWK(LGN) = MAXLEV ENDIF C Shift pointer arrays and grids forwards CALL ICOPY (MAXLEV+1, IWK(LGN), IWK(LSGN)) CALL ICOPY (MAXLEV+1, IWK(LGNP1), IWK(LSGNP1)) CALL ICOPY (MAXLEV, IWK(LUNM1), IWK(LSUNM1)) CALL ICOPY (MAXLEV, IWK(LSN), IWK(LSSN)) CALL ICOPY (MAXLEV, IWK(LUN), IWK(LSUN)) IWK(LSSNP1) = IWK(LSNP1) CALL ICOPY (LIWKB, IWK(LIWKPS), IWK(LIWKPN)) ENDIF LIWKPS = LIWKPN IF (LUNPDS .NE. 0) THEN LUN = LUNPDS ELSE LUN = LUNOUT ENDIF C C Call main routine LRWK = LENRWK - LRWKPS+1 LIWK = LENIWK - LIWKPS+1 WRITE(LUN,*) 'Newton: MAXNIT, MAXJAC, TOLNEW:', + MAXNIT, MAXJAC, TOLNEW IF (LINSYS .EQ. 0) THEN C Lin. sys. solver = BiCGStab WRITE(LUN,*) 'Lin. solver BiCGStab + ILU: MAXLIT, TOLLSB:', + MAXLIT, TOLLSB CALL PDESOL (MAXLEV, NPDE, IWK(LSGNM1), IWK(LSGN), IWK(LSGNP1), + IWK(LSUNM1), IWK(LSSN), IWK(LSUN), IWK(LSSNP1), IWK(LSUNP1), + T, TOUT, DT, DTMIN, DTMAX, XL, YF, ZD, XR, YB, ZU, DX, DY, DZ, + RWK(LRTOL), RWK(LATOL), RWK(LSPCTL), RWK(LTIMWT), + RWK(LRELTL), RWK(LABSTL), + LINSYS, INTGRB, + RWK(LRWKPS), LRWK, IWK(LIWKPS), LIWK, LWK, LENLWK, MNTR) ELSE IF (LINSYS .EQ. 1) THEN C Lin. sys. solver = matrix-free GCRO IF (IDIAGP .LE. 1) THEN WRITE(LUN,*) 'Lin. solver matrix-free GCRO + Block-diag:', + 'NRRMAX, MAXLR, MAXL, TOLLSC:', NRRMAX, MAXLR, MAXL, TOLLSC ELSE WRITE(LUN,*) 'Lin. solver matrix-free GCRO + Diag:', + 'NRRMAX, MAXLR, MAXL, TOLLSC:', NRRMAX, MAXLR, MAXL, TOLLSC ENDIF CALL PDESOL (MAXLEV, NPDE, IWK(LSGNM1), IWK(LSGN), IWK(LSGNP1), + IWK(LSUNM1), IWK(LSSN), IWK(LSUN), IWK(LSSNP1), IWK(LSUNP1), + T, TOUT, DT, DTMIN, DTMAX, XL, YF, ZD, XR, YB, ZU, DX, DY, DZ, + RWK(LRTOL), RWK(LATOL), RWK(LSPCTL), RWK(LTIMWT), + RWK(LRELTL), RWK(LABSTL), + LINSYS, INTGRC, + RWK(LRWKPS), LRWK, IWK(LIWKPS), LIWK, LWK, LENLWK, MNTR) ENDIF C C Give final statistics IF (MNTR .NE. 0) THEN WRITE(LUN,'(''Error exit PDESOL, MNTR='',I4)') MNTR ELSE MNTR = 1 ENDIF WRITE(LUN,*) WRITE(LUN,'(''Statistics:'')') WRITE(LUN,'('' # accepted timesteps ='', I5, + '', # rejected timesteps ='', I5)') NSTEPS, NREJS WRITE(LUN,'('' Level # Nit # Jacs # Res'')') DO 200 I = 1, MXCLEV IF (NNIT(I) .NE. 0) + WRITE(LUN,'(2I6,2I8)') I, NNIT(I), NJACS(I), NRESID(I) 200 CONTINUE WRITE(LUN,'('' Nit Level # Lin. sys. it'')') DO 210 J = 1, MXCNIT DO 210 I = 1, MXCLEV IF (NLSIT(I,J) .NE. 0) + WRITE(LUN,'(2I6,I12)') J, I, NLSIT(I,J) 210 CONTINUE C C Take care of all information needed to dump info to file MAXLVW = MAXLEV NPDEW = NPDE LRWKB = IWK(LSSNP1) TW = T TEW = TOUT DTW = DT XLW = XL YFW = YF ZDW = ZD XRW = XR YBW = YB ZUW = ZU RETURN END SUBROUTINE PDESOL (MAXLEV, NPDE, LSGNM1, LSGN, LSGNP1, + LSUNM1, LSSN, LSUN, LSSNP1, LSUNP1, + TN, TE, DT, DTMIN, DTMAX, XL, YF, ZD, XR, YB, ZU, DX, DY, DZ, + RTOL, ATOL, SPCTOL, TIMWGT, RELTOL, ABSTOL, + LINSYS, INTGRT, + RWK, LENRWK, IWK, LENIWK, LWK, LENLWK, IERR) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER LENIWK INTEGER MAXLEV, NPDE, + LSGNM1(0:MAXLEV), LSGN(0:MAXLEV), LSGNP1(0:MAXLEV), + LSUNM1(MAXLEV), LSSN(MAXLEV), LSUN(MAXLEV), + LSSNP1(MAXLEV), LSUNP1(MAXLEV), LINSYS, + LENRWK, IWK(LENIWK), LENLWK, IERR LOGICAL LWK(LENLWK) DOUBLE PRECISION TN, TE, DT, DTMIN, DTMAX, XL, YF, ZD, XR, YB, ZU, + DX, DY, DZ, + RTOL(NPDE), ATOL(NPDE), SPCTOL(NPDE), TIMWGT(NPDE), + RELTOL(NPDE), ABSTOL(NPDE), RWK(LENRWK) EXTERNAL INTGRT C Ccc PARAMETER DESCRIPTION: C MAXLEV : IN. Max. # grid levels allowed C NPDE : IN. # PDE components. C LSGNM1 : IN. (0:MAXLEV) C LSGNM1(0) = max. grid level used at Tn-1 C LSGNM1(1): pointer to base grid structure ISTRUC C LSGNM1(LEVEL): pointer to grid structure C (LPLN,IPLN,LROW,IROW,ICOL) C of refinement level LEVEL for time Tn-1 C LSGN : IN. (0:MAXLEV) C LSGN(0) = max. grid level used at Tn C LSGN(1): pointer to base grid structure ISTRUC C LSGN(LEVEL): pointer to grid structure C (LPLN,IPLN,LROW,IROW,ICOL) C of refinement level LEVEL for time Tn C LSGNP1 : IN. (0:MAXLEV) C LSGNP1(0) = max. grid level used at Tn+1 C LSGNP1(1): pointer to base grid structure ISTRUC C LSGNP1(2): pointer after grid structure of max. refinement C level for time Tn C LSGNP1(LEVEL): pointer to augmented grid structure C (LPLN,IPLN,LROW,IROW,ICOL,LLBND,ILBND,LBND) C of refinement level LEVEL for time Tn+1 C LSGNP1(LEVEL+1): pointer to grid structure ISTRUC of C refinement level LEVEL+1 for time Tn+1 C LSUNM1 : IN. (MAXLEV) C LSUNM1(LEVEL): pointer to (injected) solution at grid C of refinement level LEVEL for time Tn-1 C LSSN : IN. (MAXLEV) C LSSN(LEVEL): pointer to original solution belonging C to refinement level LEVEL for time Tn C LSUN : IN. (MAXLEV) C LSUN(LEVEL): pointer to (injected) solution at grid C of refinement level LEVEL for time Tn C LSSNP1 : IN. (MAXLEV) C LSSNP1(LEVEL): pointer to original solution belonging C to refinement level LEVEL for time Tn+1 C LSUNP1 : IN. (MAXLEV) C LSUNP1(LEVEL): pointer to (injected) solution at grid C of refinement level LEVEL for time Tn+1 C NB. All the above pointers should be initialized on 1 C TN : INOUT. Current value of time variable C IN: Initial time C OUT: Time to which PDE has been integrated C TE : IN. Time point at which solution is desired C DT : INOUT. C IN: The initial time stepsize C OUT: Stepsize for next time step C DTMIN : IN. Minimum time stepsize allowed C If IERR=0 and domain a rectangular prism: C DTMAX : IN. Maximum time stepsize allowed C XL : IN. X-coordinate of left/front/down point of rectangular C prism C YF : IN. Y-coordinate of left/front/down point of rectangular C prism C ZD : IN. Z-coordinate of left/front/down point of rectangular C prism C XR : IN. X-coordinate of right/back/upper point of rectangular C prism C YB : IN. Y-coordinate of right/back/upper point of rectangular C prism C ZU : IN. Z-coordinate of right/back/upper point of rectangular C prism C DX : IN. Cell width in X-direction of base grid C DY : IN. Cell width in Y-direction of base grid C DZ : IN. Cell width in Z-direction of base grid C C RTOL : IN. (NPDE) C Relative tolerance for the Newton iteration process C ATOL : IN. (NPDE) C Absolute tolerance for the Newton iteration process C SPCTOL : IN. (NPDE) C Space tolerance used to determine if resolution of grid C is large enough C TIMWGT : IN. (NPDE) C Time weights used in check if time stepsize can be accepted C RELTOL : IN. (NPDE) C Relative time tolerance used to determine if time stepsize C can be accepted and to determine the new step size C ABSTOL : IN. (NPDE) C Absolute time tolerance used to determine if time stepsize C can be accepted and to determine the new step size C LINSYS : IN. Linear system solver in use C 0: BiCGStab + ILU C 1: GCRO + (Block-)diagonally preconditioning C INTGRT : IN. Name of external routine that performs the integration C If LINSYS=0: INTGRB, otherwise INTGRC C RWK : WORK. (LENRWK) C LENRWK : IN. Dimension of RWK. C Let NPTS be the max. # points on a grid level and C NPTSA the average # points over all grid levels. C Then LENRWK should be: C MAXLEV=1: 3.NPTS.NPDE+3.NPTS+13.NPTS.NPDE + LSSWRK C LSSWRK: C ( INFO(4)=0 C | 38.NPDE.NPTS.NPDE C !:INFO(4)=10 C | (MAX(NPDE.7+3,2.MAXLR+MAXL+6)+NPDE).NPTS.NPDE+ C MAXLR*MAXLR+(MAXL+3).MAXL+1 C !:INFO(4)=11 C | (MAX(NPDE.4+3,2.MAXLR+MAXL+6)+NPDE).NPTS.NPDE+ C MAXLR*MAXLR+(MAXL+3).MAXL+1 C !:INFO(4)=12 C | (MAX(10, 2.MAXLR+MAXL+6) +1).NPTS.NPDE+ C MAXLR*MAXLR+(MAXL+3).MAXL+1 C !:INFO(4)=13 C | (MAX( 7, 2.MAXLR+MAXL+6) +1).NPTS.NPDE+ C MAXLR*MAXLR+(MAXL+3).MAXL+1 C ) C (default: MAXLR = 5, MAXL = 20) C Indication of the length for a maximum grid level C MAXLEV (default value MAXLEV=3): C 5.NPTSA.NPDE.MAXLEV+(3+13.NPDE).NPTS + LSSWRK C IWK : WORK. (LENIWK) C LENIWK : IN. Dimension of IWK. C MAXLEV=1: 28.NPTS C Indication of the length for a maximum grid level MAXLEV, C 7.NPTSA.MAXLEV+7.NPTS + ( INFO(4)=0| 19.NPTS ) C LWK : WORK. (LENLWK) C LENLWK : IN. Dimension of LWK >= NPTS+1 C IERR : INOUT. C IN: 0: First call of PDESOL C 1: Continuation call C OUT: 0: OK C -1: Workspace too small for required # gridpoints in C base grid. No continuation possible C -2: Stepsize too small C Ccc EXTERNALS USED: LOGICAL CHKWRK, CHKGRD, CHKTIM EXTERNAL CHKWRK, CHKGRD, CHKTIM, GETSOL, GETINI, ICOPY, INIGRD, + MKFGRD, MONITR, PDEIV, PUTSOL, RCOPY, SETXYZ C C Ccc INCLUDE 'PARNEWTON' C C PARNEWTON C C Parameters for Newton process C MAXNIT : Max. number of Newton iterations C MAXJAC : Max. number of Jacobian / preconditioner evaluations during C a Newton process C TOLNEW : Tolerance for Newton process: C rho/(1-rho)*|| corr.||_w < TOLNEW INTEGER MAXNIT, MAXJAC DOUBLE PRECISION TOLNEW PARAMETER (MAXNIT = 10, MAXJAC = 2, TOLNEW = 1.0) C C end INCLUDE 'PARNEWTON' C C Ccc INCLUDE 'PARGCRO' C C PARGCRO C C Parameters for linear system solver GCRO + (block-)diagonal C preconditioner C IDIAGP : 0: block-diagonal + first order derivatives C 1: block-diagonal neglecting first order derivatives C 2: diagonal + first order derivatives C 3: diagonal neglecting first order derivatives C NRRMAX : Max. number of restarts of outer loop C MAXLR : Max. number of iterations in outer loop C MAXL : Max. number of iterations in GMRES inner loop C TOLLSC : Tolerance for linear system solver INTEGER IDIAGP, NRRMAX, MAXLR, MAXL DOUBLE PRECISION TOLLSC PARAMETER (NRRMAX = 1, MAXLR = 5, MAXL = 20) C PARAMETER (NRRMAX = 1, MAXLR = 3, MAXL = 15) PARAMETER (TOLLSC = TOLNEW/10) COMMON /IGCRO/ IDIAGP SAVE /IGCRO/ C C end INCLUDE 'PARGCRO' C C Ccc INCLUDE 'CMNCMMACH' C C CMNCMMACH C C COMMON with `machine numbers' C LUNOUT : Logical unit # standard output -I C LUNERR : Logical unit # standard error I Set in the routine C UROUND : Smallest machine number such that I MACNUM C 1.0+UROUND > 1.0 and 1.0-UROUND < 1.0 I C XMIN : Smallest floating-point number -I INTEGER LUNOUT, LUNERR DOUBLE PRECISION UROUND, XMIN COMMON /IMACH/ LUNOUT, LUNERR COMMON /RMACH/ UROUND, XMIN SAVE /IMACH/, /RMACH/ C C end INCLUDE 'CMNCMMACH' C C Ccc INCLUDE 'CMNSTATS' C C CMNSTATS C C COMMON with integration statistics INTEGER MXCLEV, MXCNIT PARAMETER (MXCLEV = 10, MXCNIT = 20) INTEGER LUNPDS, LUNNLS, LUNLSS, LEVEL, NSTEPS, NREJS, + NJACS(MXCLEV), NRESID(MXCLEV), NNIT(MXCLEV), + NLSIT(MXCLEV,MXCNIT) COMMON /STATS/ LUNPDS, LUNNLS, LUNLSS, LEVEL, NSTEPS, NREJS, + NJACS, NRESID, NNIT, NLSIT SAVE /STATS/ C C end INCLUDE 'CMNSTATS' C C Ccc INCLUDE 'CMNWRITEF' C C CMNWRITEF C C COMMON needed for continuation calls INTEGER MAXLVW, NPDEW, LRWKPS, LIWKPS, LRWKB, LIWKB LOGICAL FIRST, SECOND DOUBLE PRECISION T0,TW,TEW,DTW, XLW,YFW,ZDW, XRW,YBW,ZUW, DXB,DYB, + DZB, DTO COMMON /WRITIF/ MAXLVW, NPDEW, LRWKPS, LIWKPS, LRWKB, LIWKB COMMON /WRITLF/ FIRST, SECOND COMMON /WRITRF/ T0,TW,TEW,DTW, XLW,YFW,ZDW, XRW,YBW,ZUW, + DXB,DYB,DZB, DTO SAVE /WRITIF/, /WRITLF/, /WRITRF/ C C end INCLUDE 'CMNWRITEF' C C C----------------------------------------------------------------------- C CDIR$ NOVECTOR C INTEGER NPTSB, LENUB, LXB, LYB, LZB, + LLPLN, NPLNS, LIPLN, LLROW, NROWS, NPTS, LIROW, LICOL, + LLLBND, NBNDS, NBDPTS, NBIPTS, LILBND, LLBNDP, NIBPTS, + LGNP1, LX, LY, LZ, LUNM1, LUN, LUNP1, LUNP1I, LENU, LUIB, + LGNP1C, LXC, LUNM1C, LUNC, LUNP1C, LENUC, + LGNM1, LGN, LSN, LUNM1T, LENS, LENG, LENGN, LENUN, LEUNP1, + LWT, LF, LCORR, LEV, MLVNM1, MLVN, MLVNP1, + LISTRF, LIWK, LRWK, LLWKN, LIWKN, LRWKN, MAXPTS, + LENPRE, LENLSW, LU, LUO LOGICAL LEVN, LEVNM1, OK DOUBLE PRECISION DTNEW, DTRAT, TOLWGT, SPCMON, TIMMON C IF (IERR .EQ. 0) THEN C Ccc This is the first call of PDESOL. T0 = TN C C Initialize datastructure, X- and Y-coordinates for base grid IF (LINSYS .EQ. 0) THEN LRWKN = (3 +16*NPDE + 38*NPDE*NPDE) ELSE IF (IDIAGP .EQ. 0) THEN LENPRE = NPDE LENLSW = NPDE*7+3 ELSE IF (IDIAGP .EQ. 1) THEN LENPRE = NPDE LENLSW = NPDE*4+3 ELSE IF (IDIAGP .EQ. 2) THEN LENPRE = 1 LENLSW = 10 ELSE LENPRE = 1 LENLSW = 7 ENDIF LENLSW = MAX(LENLSW,2*MAXLR+MAXL+6) LRWKN = (3 + 16*NPDE + (LENLSW + LENPRE)*NPDE) ENDIF LIWKN = 28 MAXPTS = MIN((LENRWK-3)/LRWKN, LENIWK/LIWKN, LENLWK-1) CALL INIGRD (MAXPTS, XL, YF, ZD, XR, YB, ZU, DX, DY, DZ, + RWK, IWK, NPTSB, LIWKB, IERR) DXB = DX DYB = DY DZB = DZ IF (IERR .EQ. 1) THEN LRWKN = LRWKN*NPTSB+3 LIWKN = LIWKN*NPTSB LLWKN = NPTSB+1 OK = CHKWRK (LRWKN+6*NPDE, LENRWK+6*NPDE, + LIWKN+8*MAXLEV+3, LENIWK+8*MAXLEV+3, LLWKN, LENLWK) IERR = -1 RETURN ELSE IF (IERR .NE. 0) THEN STOP 'Return from INIGRD with unknown IERR' ENDIF LXB = 1 LYB = LXB + NPTSB LZB = LYB + NPTSB C C Set max. grid levels for Tn and Tn-1 at 1 LSGNM1(0) = 1 LSGN (0) = 1 C C Set pointers to base grid data structures for Tn-1, Tn and Tn+1 C and to solution for Tn-1 and Tn LSGNM1(1) = 1 LSGN (1) = 1 LSGNP1(1) = 1 LSUNM1(1) = LZB + NPTSB LSSN (1) = LSUNM1(1) LSUN (1) = LSUNM1(1) C C Initialize solution values at base grid at Tn = T0 RWK(LSUN(1)) = 0.0 CALL PDEIV (T0, RWK(LXB), RWK(LYB), RWK(LZB), RWK(LSUN(1)+1), + NPTSB, NPDE) LENUB = NPTSB*NPDE+1 C C Set pointer to not updated base grid solution at Tn+1 LSSNP1(1) = LSUN(1) + LENUB C C Initialize time integration variables FIRST = .TRUE. SECOND = .FALSE. C ELSE IF (IERR .EQ. 1) THEN C Ccc This is a continuation call of PDESOL. C Set all required variables that were not saved in COMMON IF (LINSYS .EQ. 1) THEN IF (IDIAGP .EQ. 0) THEN LENPRE = NPDE LENLSW = NPDE*7+3 ELSE IF (IDIAGP .EQ. 1) THEN LENPRE = NPDE LENLSW = NPDE*4+3 ELSE IF (IDIAGP .EQ. 2) THEN LENPRE = 1 LENLSW = 10 ELSE LENPRE = 1 LENLSW = 7 ENDIF LENLSW = MAX(LENLSW,2*MAXLR+MAXL+6) ENDIF NPTSB = IWK(IWK(IWK(1)+2)+2*IWK(1)+2)-1 LENUB = NPTSB*NPDE+1 LXB = 1 LYB = LXB + NPTSB LZB = LYB + NPTSB C ELSE C This shouldn't happen STOP 'PDESOL called with unknown IERR' ENDIF C Ccccc Time integration loop 10 CONTINUE C Adjust time stepsize such that interval TE-TN takes an integer # of C time steps of this size DT = (TE-TN)/INT((TE-TN)/DT+0.95) DT = (TN+DT)-TN C Check if time stepsize is acceptable IF (DT .LT. DTMIN) THEN WRITE(LUNERR,'(''Time step size too small, DT ='',E16.7)') DT IERR = -2 RETURN ENDIF C C Time integration method: BE in first time step, BDF2 in following. C DTRAT = DT / DT_old; 0 => BE IF (FIRST) THEN DTRAT = 0 ELSE DTRAT = DT / DTO ENDIF C LEVEL = 1 C Ccc Set pointer to first free element after grid structure of max. C refinement level for Tn IF (MAXLEV .GT. 1) LSGNP1(2) = LIWKB C LGNP1 = LSGNP1(1) LX = LXB LY = LYB LZ = LZB DX = DXB DY = DYB DZ = DZB LUNM1 = LSUNM1(1) LUN = LSUN (1) LUNP1 = LSSNP1(1) LENU = LENUB LUIB = LUNP1+LENU C Pointer to space for eventual refined grid structure LISTRF = LIWKB LIWK = LIWKB LRWK = LUNP1 + LENU C Ccc Initial solution at coarse grid is coarse grid solution of previous C time level LUNP1I = LSSN(1) CALL RCOPY (LENU, RWK(LUNP1I), RWK(LUNP1)) C Ccccc Grid refinement Loop C 100 CONTINUE IF (LUNPDS .NE. 0) THEN NPLNS = IWK(LGNP1) NROWS = IWK(LGNP1+NPLNS+1)-1 NPTS = IWK(LGNP1+2*NPLNS+1+NROWS+1)-1 WRITE(LUNPDS, + '(''Time integration at T='',E10.2,'', Grid level='',I3, + '', NPTS='',I6)') TN+DT, LEVEL, NPTS ENDIF C Ccc Timestep on current level LWT = LRWK LF = LWT + LENU-1 LCORR = LF + LENU-1 LRWK = LCORR + LENU-1 CALL INTGRT (IWK(LGNP1), RWK(LX), RWK(LY), RWK(LZ), NPDE, + RWK(LUIB), RWK(LUNP1), RWK(LUN), RWK(LUNM1), RTOL, ATOL, + TN, DT, DTRAT, DX, DY, DZ, RWK(LWT), RWK(LF), RWK(LCORR), + RWK(LRWK), IERR) LRWK = LWT IF (IERR .EQ. 10) THEN C If Newton failure redo time step with stepsize quartered NREJS = NREJS+1 IF (LUNPDS .NE. 0) THEN WRITE(LUNPDS, + '(''Newton failure at T='',E10.2,'', Grid level'',I3)') + TN+DT, LEVEL ENDIF IERR = 0 DT = DT/4 GOTO 10 ELSE IF (IERR .NE. 0) THEN C This shouldn't happen STOP 'Return from INTGRT with unknown IERR' ENDIF C Ccc Compute space monitor and if necessary determine new grid IF (LSGN(0) .GT. LEVEL) THEN C More severe tolerance on grid monitor if max.grid level at Tn C exceeded current level TOLWGT = 0.9 ELSE TOLWGT = 1.0 ENDIF OK = CHKGRD (TN+DT, LEVEL, RWK(LUNP1), NPDE, + RWK(LX), RWK(LY), RWK(LZ), + SPCTOL, TOLWGT, IWK(LGNP1), RWK(LRWK), LWK, SPCMON) C If no grid refinement needed, check time error IF (LUNPDS .NE. 0) THEN WRITE(LUNPDS,'(''T='',E10.2,'', LEVEL='',I3, + '' ,TOLWGT='',F3.1,'', SPCMON='',E10.2)') + TN+DT, LEVEL, TOLWGT, SPCMON ENDIF IF (OK) GOTO 200 IF (LEVEL .EQ. MAXLEV) THEN WRITE(LUNERR,'(''Max. grid level exceeded at T='',E16.7)') + TN+DT GOTO 200 ENDIF C Ccc Create refined grid C Save coarse grid pointers LGNP1C = LGNP1 LUNP1C = LUNP1 LUNC = LUN LUNM1C = LUNM1 LXC = LX LENUC = LENU C C Make fine grid structure LGNP1 = LISTRF CALL MKFGRD (LWK, IWK, LENIWK, LGNP1C, LGNP1, LINSYS, + NPTS, LIWK, IERR) LENU = NPTS*NPDE+1 C C Check on workspace needed IF (LINSYS .EQ. 0) THEN LRWKN = LUNP1C+LENUC+8*LENU+3*NPTS+10*LENU+38*NPDE*LENU ELSE LRWKN = LUNP1C+LENUC+8*LENU+3*NPTS+10*LENU+ + (LENLSW+LENPRE)*LENU+MAXLR*MAXLR+(MAXL+3)*MAXL ENDIF LIWKN = LIWK+NPTS+1 LLWKN = NPTS+1 OK = CHKWRK (LRWKN+6*NPDE, LENRWK+6*NPDE, + LIWKN+8*MAXLEV+3, LENIWK+8*MAXLEV+3, LLWKN, LENLWK) IF (.NOT. OK) THEN IERR = -1 RETURN ENDIF C C Set fine grid pointers and values LLPLN = LGNP1 NPLNS = IWK(LLPLN) LIPLN = LLPLN+NPLNS+2 NROWS = IWK(LLPLN+NPLNS+1)-1 LLROW = LIPLN+NPLNS LIROW = LLROW+NROWS+1 LICOL = LIROW+NROWS LLLBND = LICOL+NPTS NBNDS = IWK(LLLBND) NBDPTS = IWK(LLLBND+NBNDS+1)-1 NBIPTS = IWK(LLLBND+NBNDS+2)-1 LILBND = LLLBND+NBNDS+3 LLBNDP = LILBND+NBNDS LISTRF = LLBNDP+NBIPTS LUN = LUNP1C+LENUC LUNP1 = LUN+LENU LUNM1 = LUNP1+LENU LX = LUNM1+LENU LY = LX+NPTS LZ = LY+NPTS LUIB = LZ+NPTS NIBPTS = NBIPTS-NBDPTS LRWK = LUIB+NIBPTS*NPDE LSGNP1(LEVEL+1) = LGNP1 LSSNP1(LEVEL+1) = LUNP1 DX = DX/2 DY = DY/2 DZ = DZ/2 C C Save initial solution at current grid level at end of workspace to C prevent overwriting CALL RCOPY (LENUC, RWK(LUNP1I), RWK(LENRWK-LENUC)) LUNP1I = LENRWK-LENUC C C Store grid values at Tn and Tn-1 in temporary storage LEVN = LSGN(0) .GE. LEVEL+1 LEVNM1 = LSGNM1(0) .GE. LEVEL+1 IF (FIRST) THEN C Store X- and Y- coordinates, and initial solution in Un = Un-1 LUNM1 = LUN LX = LUNP1+LENU LY = LX+NPTS LZ = LY+NPTS LUIB = LZ+NPTS LRWK = LUIB+NIBPTS*NPDE CALL SETXYZ (XL,YF,ZD, DX, DY, DZ, + IWK(LLPLN), IWK(LIPLN), IWK(LLROW), IWK(LIROW), IWK(LICOL), + RWK(LX), RWK(LY), RWK(LZ)) RWK(LUN) = 0.0 CALL PDEIV (T0, RWK(LX), RWK(LY), RWK(LZ), RWK(LUN+1), + NPTS, NPDE) C ELSE IF (SECOND) THEN C Get Un on refined grid CALL GETSOL (NPDE, RWK(LUNC), IWK(LGNP1C), + LEVN, RWK(LSUN(LEVEL+1)), IWK(LSGN(LEVEL+1)), + RWK(LUN), IWK(LGNP1), IWK(LIWK), RWK(LRWK)) C Store X- and Y- coordinates and initial solution in Un-1 CALL SETXYZ (XL,YF,ZD, DX, DY, DZ, + IWK(LLPLN), IWK(LIPLN), IWK(LLROW), IWK(LIROW), IWK(LICOL), + RWK(LX), RWK(LY), RWK(LZ)) RWK(LUNM1) = 0.0 CALL PDEIV (T0, RWK(LX), RWK(LY), RWK(LZ), RWK(LUNM1+1), + NPTS, NPDE) C ELSE C Get Un-1 and Un on refined grid LUNM1T = MAX(LUNM1,LXC) CALL GETSOL (NPDE, RWK(LUNM1C), IWK(LGNP1C), + LEVNM1, RWK(LSUNM1(LEVEL+1)), IWK(LSGNM1(LEVEL+1)), + RWK(LUNM1T), IWK(LGNP1), IWK(LIWK), RWK(LRWK)) IF (LUNM1T .GT. LUNM1) + CALL RCOPY (LENU, RWK(LUNM1T), RWK(LUNM1)) CALL GETSOL (NPDE, RWK(LUNC), IWK(LGNP1C), + LEVN, RWK(LSUN(LEVEL+1)), IWK(LSGN(LEVEL+1)), + RWK(LUN), IWK(LGNP1), IWK(LIWK), RWK(LRWK)) C Store X- and Y- coordinates CALL SETXYZ (XL,YF,ZD, DX, DY, DZ, + IWK(LLPLN), IWK(LIPLN), IWK(LLROW), IWK(LIROW), IWK(LICOL), + RWK(LX), RWK(LY), RWK(LZ)) C ENDIF C Get initial solution Un+1, store internal boundary values also in UIB C list CALL GETINI (NPDE, RWK(LUNP1I), RWK(LUNP1C), IWK(LGNP1C), + LEVN, RWK(LSSN(LEVEL+1)), IWK(LSGN(LEVEL+1)), + RWK(LUNP1), IWK(LGNP1), RWK(LUIB), IWK(LIWK), RWK(LRWK)) LUNP1I = LRWK LRWK = LUNP1I + LENU CALL RCOPY (LENU, RWK(LUNP1), RWK(LUNP1I)) LEVEL = LEVEL+1 GOTO 100 Ccc End Refinement Loop C 200 CONTINUE C Ccc Time step finished C Inject values from finest level LSGNP1(0) = LEVEL LSUNP1(LEVEL) = LSSNP1(LEVEL) DO 210 LEV = LEVEL, 2, -1 LSUNP1(LEV-1) = LSUNP1(LEV) + LENU CALL PUTSOL (NPDE, RWK(LSUNP1(LEV)), IWK(LSGNP1(LEV)), + RWK(LSSNP1(LEV-1)), IWK(LSGNP1(LEV-1)), + RWK(LSUNP1(LEV-1)), LENU) 210 CONTINUE LRWK = LSUNP1(1) + LENU C Ccc Check time-error LU = LSUNP1(1)+LENUB LUO = LSSNP1(1)-LENUB OK = CHKTIM (RWK, LU, LUO, NPDE, IWK, + LSGNP1, TIMWGT, RELTOL, ABSTOL, RWK(LRWK), DT, DTNEW, TIMMON) IF (LUNPDS .NE. 0) THEN WRITE(LUNPDS,'(''TN='',E10.2,'', DT='',E10.2, + '', DTNEW='',E10.2, '', TIMMON='',E10.2)') + TN, DT, DTNEW, TIMMON ENDIF C Restrict stepsize DTNEW = MIN(DTNEW, DTMAX) IF (.NOT. OK) THEN C Ccc Time step rejected NREJS = NREJS+1 IF (LUNPDS .NE. 0) THEN WRITE(LUNPDS,'(''Time step rejected'')') ENDIF DT = DTNEW GOTO 10 ELSE C Ccc Time step accepted NSTEPS = NSTEPS+1 C Ccc Time step accepted; move data saved for Tn to nm1-save and C data at Tn+1 to n-save. C C Move updated solution at Tn (Un) to Unm1 save, and gridstructure at Tn C to Gnm1 save C NB. For first step this is not necessary, but harmless MLVNM1 = LSGNM1(0) MLVN = LSGN(0) C Start of Unm1 data (= 2*NPTSB+1) LUNM1 = LSUNM1(MLVNM1) C Start of updated Un data LUN = LSUN(MLVN) C LSSNP1(1)-1: end of updated Un data LENUN = LSSNP1(1) - LUN CALL RCOPY (LENUN, RWK(LUN), RWK(LUNM1)) C Adjust pointers to Unm1 data DO 220 LEV = MLVN, 1, -1 LSUNM1(LEV) = LSUN(LEV) - (LUN-LUNM1) 220 CONTINUE C New start of not-updated Un data LSN = LUNM1 + LENUN C C New max. Gnm1-level LSGNM1(0) = MLVN IF (MLVNM1 .EQ. 1) THEN C Grids already in place, adjust pointers DO 230 LEV = 2, MLVN LSGNM1(LEV) = LSGN(LEV) 230 CONTINUE C New start of Gn data is old one LGN = LIWKB ELSE IF (MLVN .GT. 1) THEN C Both Gnm1 and Gn have more than 1 level, move Gn C Start of Gnm1 data (after base grid) LGNM1 = LSGNM1(2) C Start of Gn data LGN = LSGN(2) C LSGNP1(2)-1: end of Gn data LENGN = LSGNP1(2) - LGN CALL ICOPY (LENGN, IWK(LGN), IWK(LGNM1)) C Adjust pointers to Gnm1 data DO 240 LEV = 2, MLVN LSGNM1(LEV) = LSGN(LEV) - (LGN-LGNM1) 240 CONTINUE C New start of Gn data LGN = LSGNM1(2) + LENGN ELSE C At Tn only base grid, new start of Gn data is after base grid LGN = LSGNM1(2) ENDIF C C Move Tn+1 data, not_updated solution (Snp1) to Sn save, gridstructure C to Gn save, and injected solution to Un save MLVNP1 = LSGNP1(0) LSGN(0) = MLVNP1 C Move not-updated solution Snp1 on base grid CALL RCOPY (LENUB, RWK(LSSNP1(1)), RWK(LSN)) LSSN(1) = LSN LSN = LSN + LENUB C Move Snp1 and (LROW,IROW,ICOL) of higher levels, adjust pointers to C Sn and Gn data DO 250 LEV = 2, MLVNP1 LLPLN = LSGNP1(LEV) NPLNS = IWK(LLPLN) LIPLN = LLPLN+NPLNS+2 NROWS = IWK(LLPLN+NPLNS+1)-1 LLROW = LIPLN+NPLNS NPTS = IWK(LLROW+NROWS)-1 LENS = NPTS*NPDE+1 LENG = NPLNS+2 + NPLNS + NROWS+1 + NROWS + NPTS CALL RCOPY (LENS, RWK(LSSNP1(LEV)), RWK(LSN)) LSSN(LEV) = LSN LSN = LSN + LENS CALL ICOPY (LENG, IWK(LSGNP1(LEV)), IWK(LGN)) LSGN(LEV) = LGN LGN = LGN + LENG 250 CONTINUE C C Adjust pointer to solution on highest grid level LSUN(MLVNP1) = LSSN(MLVNP1) IF (MLVNP1 .GT. 1) THEN C Move updated solutions on grids (max.lev-1),...,2 and adjust C pointers to Un data LUNP1 = LSUNP1(MLVNP1-1) LEUNP1 = LSUNP1(1)+LENUB - LUNP1 CALL RCOPY (LEUNP1, RWK(LUNP1), RWK(LSN)) DO 260 LEV = 1, MLVNP1-1 LSUN(LEV) = LSUNP1(LEV) - (LUNP1-LSN) 260 CONTINUE ENDIF C Ccc Set pointer to not updated base grid solution at Tn+1 LSSNP1(1) = LSUN(1) + LENUB Ccc Set pointer to first free element after grid structure of max. C refinement level for Tn LIWKB = LGN C Ccc Adapt time variables CALL MONITR (TN+DT, DT, DTNEW, XL, YF, ZD, DXB, DYB, DZB, + LSGN, IWK, LSUN, RWK) TN = TN + DT DTO = DT DT = DTNEW IF (FIRST) THEN FIRST = .FALSE. SECOND = .TRUE. ELSE IF (SECOND) THEN SECOND = .FALSE. ENDIF IF (TN .GE. TE) THEN IF (LUNPDS .NE. 0) THEN WRITE(LUNPDS,'(''# steps accepted:'',I5, + '', # steps rejected:'',I5)') NSTEPS, NREJS ENDIF RETURN ELSE GOTO 10 ENDIF ENDIF RETURN END SUBROUTINE INIGRD (MAXPTS, XL, YF, ZD, XR, YB, ZU, DX, DY, DZ, + XYZ, IWK, NPTS, LIWK, IERR) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER MAXPTS, IWK(*), NPTS, LIWK, IERR DOUBLE PRECISION XL, YF, ZD, XR, YB, ZU, DX, DY, DZ, XYZ(*) C Ccc PURPOSE: C Stores datastructure and coordinate values of initial grid (rowwise). C A (virtual) rectangular box is placed around the irregular domain. The C intersection point of the left, front, and down plane of this box is C (XL,YF,ZD) in physical coordinates and (0,0,0) in column, row, resp. C plane coordinates. The intersection point of the right, back, and C upper plane is (XR,YB,ZU) resp. (Nx,Ny,Nz), where Nx = (XR-XL)/DX, C Ny = (YB-YF)/DY, and Nz = (ZU-ZD)/DZ. Only real grid points are stored C in the order: plane, row, column. C In the default case the domain is a rectangular prism and the user C has to specify only the (XL,YF,ZD)- and the (XR,YB,ZU)-point, and C the gridwidth in each direction. Otherwise the user has to write C the domain specifying routine INIDOM in which also the coordinate C values and the cellwidths can be specified. C Ccc PARAMETER DESCRIPTION: C MAXPTS : IN. Max. # grid points allowed by the available workspace C XL : INOUT. X-coordinate of left/front/down point of virtual box C YF : INOUT. Y-coordinate of left/front/down point of virtual box C ZD : INOUT. Z-coordinate of left/front/down point of virtual box C XR : INOUT. X-coordinate of right/back/upper point of virtual box C YB : INOUT. Y-coordinate of right/back/upper point of virtual box C ZU : INOUT. Z-coordinate of right/back/upper point of virtual box C DX : INOUT. Grid width in X-direction C DY : INOUT. Grid width in Y-direction C DZ : INOUT. Grid width in Z-direction C XYZ : OUT. Contains the X-, Y- and Z-coordinates for the base grid C IWK : OUT. Contains the following arrays: CcLPLN : (0:LPLN(0)+1) Cc LPLN(0) = NPLNS: Actual # planes in LROW Cc LPLN(1:NPLNS): pointers to the start of a plane in LROW Cc LPLN(NPLNS+1) = NROWS+1: Total # rows in grid + 1 CcIPLN : (NPLNS) Cc IPLN(IP): plane number of plane IP in virtual box CcLROW : (NROWS+1) Cc LROW(1:NROWS): pointers to the start of a row in the grid Cc LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 CcIROW : (NROWS) Cc IROW(IR): row number of row IR in virtual box CcICOL : (NPTS) Cc ICOL(IPT): column number of grid point IPT in virtual box CcLLBND : (0:LLBND(0)+2) Cc LLBND(0) = NBNDS: total # physical planes in actual domain. Cc NB. edges and corners are stored for each plane they Cc belong to. Cc LLBND(1:NBNDS): pointers to a specific boundary in LBND Cc LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points Cc in LBND + 1 Cc LLBND(NBNDS+1): pointer to internal boundary in LBND Cc LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 CcILBND : (NBNDS) Cc ILBND(IB): type of boundary: Cc 1: Left plane -I Cc 2: Down plane I Cc 3: Right plane I max. first order derivative Cc 4: Up plane I Cc 5: Front plane I Cc 6: Back plane -I CcLBND : (NBIPTS) Cc LBND(IBPT): pointer to boundary point in actual grid CcLBLWY : IN. (0:NPTS) Cc LBLWY(IPT): pointer to node below in Y-direction in Cc actual grid Cc 0, if index node is front-plane boundary point CcLABVY : IN. (0:NPTS) Cc LABVY(IPT): pointer to node above in Y-direction in Cc actual grid Cc 0, if index node is back-plane boundary point CcLBLWZ : IN. (0:NPTS) Cc LBLWZ(IPT): pointer to node below in Z-direction in Cc actual grid Cc 0, if index node is down-plane boundary point CcLABVZ : IN. (0:NPTS) Cc LABVZ(IPT): pointer to node above in Z-direction in Cc actual grid Cc 0, if index node is up-plane boundary point Cc (Even if LINSYS/=0, because of restart:) Cc The next 2 arrays are used for the Jacobian structure and its Cc ILU CcLLDG : (NPTS,-9:-2) Cc LLDG(IPT,-9): pointer to node Y-below Z-below Cc or to node Z-below Z-below Cc LLDG(IPT,-8): pointer to node left of Z-below Cc LLDG(IPT,-7): pointer to node Z-below Cc LLDG(IPT,-6): pointer to node right of Z-below Cc LLDG(IPT,-5): pointer to node Y-above Z-below Cc LLDG(IPT,-4): pointer to node left of Y-below Cc or to node Y-below Y-below Cc LLDG(IPT,-3): pointer to node Y-below Cc LLDG(IPT,-2): pointer to node right of Y-below Cc or to node left of the node left CcLUDG : (NPTS,2:9) Cc LUDG(IPT,2): pointer to node left of Y-above Cc or to node right of the node right Cc LUDG(IPT,3): pointer to node Y-above Cc LUDG(IPT,4): pointer to node right of node Y-above Cc or to node Y-above Y-above Cc LUDG(IPT,5): pointer to node Y-below Z-above Cc LUDG(IPT,6): pointer to node left of Z-above Cc LUDG(IPT,7): pointer to node Z-above Cc LUDG(IPT,8): pointer to node right of Z-above Cc LUDG(IPT,9): pointer to node Y-above Z-above Cc or to node Z-above Z-above Cc the next 4 arrays are used to hold the data dependency lists Cc for the ILU factorization and the forward, resp. backward Cc sweep of the backsolve CcLSL : LSL(NPTS) Cc LSL(ISLPT): pointer to node in actual grid CcLLSL : LLSL(0:LLSL(0)) Cc LLSL(0) = # independent data dependency lists in ILU Cc factorization and forward sweep Cc LLSL(1:LLSL(0)): pointers to the start of a list in LSL CcLSU : LSU(NPTS) Cc LSU(ISLPT): pointer to node in actual grid CcLLSU : LLSU(0:LLSU(0)) Cc LLSU(0) = # independent data dependency lists in backward C sweep Cc LLSU(1:LLSU(0)): pointers to the start of a list in LSU C NPTS : OUT. # grid points in base grid C LIWK : OUT. Pointer to first free element in IWK C IERR : OUT. Error return flag C 0: OK. C 1: workspace too small for required # gridpoints C Ccc EXTERNALS USED: LOGICAL INIDOM EXTERNAL ICOPY, INIDOM, JACSDP, JACSLP, JACSUP, SETBA, SETXYZ C C----------------------------------------------------------------------- C INTEGER I1, I2, I3, I4, I5, I6, I7, I8, + LLPLN, LIPLN, LLROW, LIROW, LICOL, + LLLBND, LILBND, LLBNDP, LLBLWY, LLABVY, LLBLWZ, LLABVZ, + NPLNS, NROWS, NBNDS, NBDPTS, + LLLDG, LLUDG, LLSLP, LLLSL, LLSUP, LLLSU LOGICAL OK C IERR = 0 C Ccc Get (user defined) initial domain I1 = 1 I2 = I1 + MAXPTS I3 = I2 + MAXPTS I4 = I3 + MAXPTS I5 = I4 + MAXPTS I6 = I5 + MAXPTS I7 = I6 + MAXPTS I8 = I7 + MAXPTS OK = INIDOM (MAXPTS, XL, YF, ZD, XR, YB, ZU, DX, DY, DZ, + IWK(I1), IWK(I2), IWK(I3), IWK(I4), IWK(I5), IWK(I6), IWK(I7), + IWK(I8)) IF (.NOT. OK) THEN IERR = 1 NPTS = MAXPTS RETURN ENDIF C Ccc Copy integer arrays to their correct position in the IWK array NPLNS = IWK(I1) NROWS = IWK(I1+NPLNS+1)-1 NPTS = IWK(I3+NROWS)-1 NBNDS = IWK(I6) NBDPTS = IWK(I6+NBNDS+1)-1 C LPLN at correct position LLPLN = 1 C Copy IPLN LIPLN = LLPLN+NPLNS+2 CALL ICOPY (NPLNS, IWK(I2), IWK(LIPLN)) C Copy LROW LLROW = LIPLN+NPLNS CALL ICOPY (NROWS+1, IWK(I3), IWK(LLROW)) C Copy IROW LIROW = LLROW+NROWS+1 CALL ICOPY (NROWS, IWK(I4), IWK(LIROW)) C Copy ICOL LICOL = LIROW+NROWS CALL ICOPY (NPTS, IWK(I5), IWK(LICOL)) C Copy LLBND LLLBND = LICOL+NPTS CALL ICOPY (NBNDS+2, IWK(I6), IWK(LLLBND)) C No internal boundaries IWK(LLLBND+NBNDS+2) = NBDPTS+1 C Copy ILBND LILBND = LLLBND+NBNDS+3 CALL ICOPY (NBNDS, IWK(I7), IWK(LILBND)) C Copy LBND LLBNDP = LILBND+NBNDS CALL ICOPY (NBDPTS, IWK(I8), IWK(LLBNDP)) C Ccc Store X-, Y-, and Z-coordinates CALL SETXYZ (XL, YF, ZD, DX, DY, DZ, + IWK(LLPLN), IWK(LIPLN), IWK(LLROW), IWK(LIROW), IWK(LICOL), + XYZ(1), XYZ(1+NPTS), XYZ(1+2*NPTS)) C Ccc Set pointers to nodes below and above a grid point LLBLWY = LLBNDP+NBDPTS LLABVY = LLBLWY+NPTS+1 LLBLWZ = LLABVY+NPTS+1 LLABVZ = LLBLWZ+NPTS+1 CALL SETBA (IWK(LLPLN), IWK(LIPLN), IWK(LLROW), IWK(LIROW), + IWK(LICOL), IWK(LLBLWY), IWK(LLABVY), IWK(LLBLWZ), IWK(LLABVZ)) LIWK = LLABVZ+NPTS+1 C Ccc Set pointers to lower and upper diagonals in Jacobian for base grid LLLDG = LIWK LLUDG = LLLDG + NPTS*8 CALL JACSDP (NPTS, IWK(LLLBND), IWK(LILBND), IWK(LLBNDP), + IWK(LLBLWY), IWK(LLABVY), IWK(LLBLWZ), IWK(LLABVZ), + IWK(LLLDG), IWK(LLUDG)) LIWK = LLUDG + NPTS*8 C Ccc Make data-dependency lists for ILU on base-grid Jacobian LLSLP = LIWK LLLSL = LLSLP + NPTS LIWK = LLLSL + NPTS CALL JACSLP (NPTS, IWK(LLLBND), IWK(LILBND), IWK(LLBNDP), + IWK(LLLDG), IWK(LIWK), IWK(LLLSL), IWK(LLSLP)) LLSUP = LLLSL + IWK(LLLSL)+1 LLLSU = LLSUP + NPTS LIWK = LLLSU + NPTS CALL JACSUP (NPTS, IWK(LLLBND), IWK(LILBND), IWK(LLBNDP), + IWK(LLUDG), IWK(LIWK), IWK(LLLSU), IWK(LLSUP)) LIWK = LLLSU + IWK(LLLSU)+1 RETURN END SUBROUTINE SETBA (LPLN, IPLN, LROW, IROW, ICOL, + LBLWY, LABVY, LBLWZ, LABVZ) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER LPLN(0:*), IPLN(*), LROW(*), IROW(*), ICOL(*), + LBLWY(0:*), LABVY(0:*), LBLWZ(0:*), LABVZ(0:*) C Ccc PURPOSE: C Set pointers to nodes below and above a grid point, if such a node C exists, otherwise the pointer is set to zero. C Ccc PARAMETER DESCRIPTION: C LPLN : IN. (0:LPLN(0)+1) C LPLN(0) = NPLNS: Actual # planes in LROW C LPLN(1:NPLNS): pointers to the start of a plane in LROW C LPLN(NPLNS+1) = NROWS+1: Total # rows in grid + 1 C IPLN : IN. (NPLNS) C IPLN(IP): plane number of plane IP in virtual box C LROW : IN. (NROWS+1) C LROW(1:NROWS): pointers to the start of a row in the grid C LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 C IROW : IN. (NROWS) C IROW(IR): row number of row IR in virtual box C ICOL : IN. (NPTS) C ICOL(IPT): column number of grid point IPT in virtual box C LBLWY : OUT. (0:NPTS) C LBLWY(IPT): pointer to node below in Y-direction in C actual grid C 0, if index node is front-plane boundary point C LABVY : OUT. (0:NPTS) C LABVY(IPT): pointer to node above in Y-direction in C actual grid C 0, if index node is back-plane boundary point C LBLWZ : OUT. (0:NPTS) C LBLWZ(IPT): pointer to node below in Z-direction in C actual grid C 0, if index node is down-plane boundary point C LABVZ : OUT. (0:NPTS) C LABVZ(IPT): pointer to node above in Z-direction in C actual grid C 0, if index node is up-plane boundary point C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER IP, IPT, IPTA, IR, IRA, NPLNS, NROWS, NPTS C NPLNS = LPLN(0) NROWS = LPLN(NPLNS+1)-1 NPTS = LROW(NROWS+1)-1 DO 10 IPT = 0, NPTS LBLWY(IPT) = 0 LABVY(IPT) = 0 LBLWZ(IPT) = 0 LABVZ(IPT) = 0 10 CONTINUE DO 20 IP = 1, NPLNS DO 30 IR = LPLN(IP), LPLN(IP+1)-2 C Check if next row in datastructure is next row in virtual plane IF (IROW(IR) .EQ. IROW(IR+1)-1) THEN C Compare column indices in row with those in row above, C until the two match or one of both rows is finished IPTA = LROW(IR+1) DO 40 IPT = LROW(IR), LROW(IR+1)-1 50 IF (ICOL(IPT) .LT. ICOL(IPTA)) THEN GOTO 40 ELSE IF (ICOL(IPT) .EQ. ICOL(IPTA)) THEN C Set above pointer in current row and below pointer in C next row LBLWY(IPTA) = IPT LABVY(IPT) = IPTA ELSE IPTA = IPTA + 1 IF (IPTA .GT. LROW(IR+2)-1) GOTO 30 GOTO 50 ENDIF 40 CONTINUE ENDIF 30 CONTINUE 20 CONTINUE DO 100 IP = 1, NPLNS-1 C Check if next plane in datastructure is next plane in virtual box IF (IPLN(IP) .EQ. IPLN(IP+1)-1) THEN C Compare row indices in plane with those in plane above, until C the two match or one of both planes is finished IRA = LPLN(IP+1) DO 110 IR = LPLN(IP), LPLN(IP+1)-1 120 IF (IROW(IR) .LT. IROW(IRA)) THEN GOTO 110 ELSE IF (IROW(IR) .EQ. IROW(IRA)) THEN C Compare column indices in row with those in row above, C until the two match or one of both rows is finished IPTA = LROW(IRA) DO 130 IPT = LROW(IR), LROW(IR+1)-1 140 IF (ICOL(IPT) .LT. ICOL(IPTA)) THEN GOTO 130 ELSE IF (ICOL(IPT) .EQ. ICOL(IPTA)) THEN C Set above pointer in current row and below pointer C in next row LBLWZ(IPTA) = IPT LABVZ(IPT) = IPTA ELSE IPTA = IPTA + 1 IF (IPTA .GT. LROW(IRA+1)-1) GOTO 110 GOTO 140 ENDIF 130 CONTINUE ELSE IRA = IRA + 1 IF (IRA .GT. LPLN(IP+2)-1) GOTO 100 GOTO 120 ENDIF 110 CONTINUE ENDIF 100 CONTINUE RETURN END LOGICAL FUNCTION CHKGRD (T, LEVEL, U, NPDE, X, Y, Z, SPCTOL, + TOLWGT, ISTRUC, WORK, REFFLG, SPCMON) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER LEVEL, NPDE, ISTRUC(0:*) LOGICAL REFFLG(0:*) DOUBLE PRECISION T, U(0:*), X(*), Y(*), Z(*), + SPCTOL(NPDE), TOLWGT, WORK(*), SPCMON C Ccc PURPOSE: C Check if grid needs to be refined. If so, CHKGRD = .FALSE. and C flags are set where the refinement is needed. C Ccc PARAMETER DESCRIPTION: C T : IN. Current time level C LEVEL : IN. Current grid level C U : IN. Solution on current grid C NPDE : IN. # PDE components C X,Y,Z : IN. Physical coordinates of grid points C SPCTOL : IN. User defined space tolerance for each PDE component C TOLWGT : IN. Weight factor for tolerance. If new level at previous C time existed TOLWGT < 1, else 1 C ISTRUC : IN. Datastructure for current grid C WORK : WORK. (3*NPTS*NPDE) C REFFLG : OUT. If one of the corners of a cell is flagged the cell C needs to be refined C SPCMON : OUT. Value of space monitor C Ccc EXTERNALS USED: LOGICAL CHKREF EXTERNAL CHKREF C C----------------------------------------------------------------------- C INTEGER LLPLN, NPLNS, LIPLN, LLROW, NROWS, NPTS, LIROW, LICOL, + LLLBND, NBNDS, NBIPTS, LILBND, LLBNDP, + LLBLWY, LLABVY, LLBLWZ, LLABVZ C LLPLN = 0 NPLNS = ISTRUC(LLPLN) LIPLN = LLPLN+NPLNS+2 LLROW = LIPLN+NPLNS NROWS = ISTRUC(LLPLN+NPLNS+1)-1 NPTS = ISTRUC(LLROW+NROWS)-1 LIROW = LLROW+NROWS+1 LICOL = LIROW+NROWS LLLBND = LICOL+NPTS NBNDS = ISTRUC(LLLBND) NBIPTS = ISTRUC(LLLBND+NBNDS+2)-1 LILBND = LLLBND+NBNDS+3 LLBNDP = LILBND+NBNDS LLBLWY = LLBNDP+NBIPTS LLABVY = LLBLWY+NPTS+1 LLBLWZ = LLABVY+NPTS+1 LLABVZ = LLBLWZ+NPTS+1 C Ccc Compute space monitor and check if grid needs to be refined CHKGRD = CHKREF (T, LEVEL, U, NPTS, NPDE, X, Y, Z, + ISTRUC(LLLBND), ISTRUC(LILBND), ISTRUC(LLBNDP), + ISTRUC(LLBLWY), ISTRUC(LLABVY), ISTRUC(LLBLWZ), ISTRUC(LLABVZ), + SPCTOL, TOLWGT, WORK(1),WORK(1+NPTS*NPDE),WORK(1+2*NPTS*NPDE), + REFFLG, SPCMON) RETURN END SUBROUTINE MKFGRD (REFFLG, IWK, LENIWK, LISTRC, LISTRF, LINSYS, + NPTSF, LIWK, IERR) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER LENIWK INTEGER IWK(LENIWK), LISTRC, LISTRF, LINSYS, NPTSF, LIWK, IERR LOGICAL REFFLG(0:*) C Ccc PURPOSE: C Make fine grid structure and store in IWK(LISTRF+...) C Ccc PARAMETER DESCRIPTION: C REFFLG : IN. If one of the corners of a cell is flagged the cell C needs to be refined C IWK : INOUTWORK. Integer workspace. C IN: Coarse grid structure C OUT: If coarse grid is base grid: coarse grid structure, C otherwise (LPLN,...,LBND) of coarse grid structure, and C fine grid structure (LPLN,...,LLLSU) C WORK: (NPTS+1+NPTSF+1) at end of IWK for domain flags C LENIWK : IN. Length of IWK C LISTRC : IN. Pointer to coarse grid structure in IWK C LISTRF : IN. Pointer to place where fine grid structure should be C stored in IWK C LINSYS : IN. Linear system solver in use C 0: BiCGStab + ILU C 1: Diagonally scaled GCRO C NPTSF : OUT. # grid points in fine grid C LIWK : OUT. Pointer to first free element in IWK after fine grid C structure C IERR : OUT. Error return flag C 0: OK C 1: workspace too small for required # fine gridpoints C Ccc EXTERNALS USED: EXTERNAL DOMFLG, ICOPY, JACSDP, JACSLP, JACSUP, MKBND, REFDOM, + SETBA C C----------------------------------------------------------------------- C INTEGER LLPLN, NPLNS, LIPLN, LLROW, NROWS, NPTS, LIROW, LICOL, + LLLBND, NBNDS, NBIPTS, LILBND, LLBNDP, + LLBLWY, LLABVY, LLBLWZ, LLABVZ, LLLDG, + LLPLNF, NPLNSF, LIPLNF, LLROWF, NROWSF, LIROWF, LICOLF, + LLLBDF, NBIPTF, LILBDF, LLBNDF, + LLBLYF, LLABYF, LLBLZF, LLABZF, + LLLDGF, LLUDGF, LLSLF, LLLSLF, LLSUF, LLLSUF, + LIDOM, LIDOMF, MAXPTS C IERR = 0 C LLPLN = LISTRC NPLNS = IWK(LLPLN) LIPLN = LLPLN+NPLNS+2 LLROW = LIPLN+NPLNS NROWS = IWK(LLPLN+NPLNS+1)-1 NPTS = IWK(LLROW+NROWS)-1 LIROW = LLROW+NROWS+1 LICOL = LIROW+NROWS LLLBND = LICOL+NPTS NBNDS = IWK(LLLBND) NBIPTS = IWK(LLLBND+NBNDS+2)-1 LILBND = LLLBND+NBNDS+3 LLBNDP = LILBND+NBNDS LLBLWY = LLBNDP+NBIPTS LLABVY = LLBLWY+NPTS+1 LLBLWZ = LLABVY+NPTS+1 LLABVZ = LLBLWZ+NPTS+1 LLLDG = LLABVZ+NPTS+1 LIDOM = LENIWK-NPTS C Ccc Make data structure fine grid MAXPTS = (LIDOM-MAX(LISTRF,LLLDG))/6 LIDOMF = LIDOM -MAXPTS-1 LICOLF = LIDOMF-MAXPTS LIROWF = LICOLF-MAXPTS+1 LLROWF = LIROWF-MAXPTS LIPLNF = LLROWF-MAXPTS LLPLNF = LIPLNF-MAXPTS C Set domain flags for coarse grid CALL DOMFLG (NPTS, IWK(LLLBND), IWK(LLBNDP), IWK(LIDOM)) CALL REFDOM (MAXPTS, REFFLG, NBNDS, + IWK(LLPLN), IWK(LIPLN), IWK(LLROW), IWK(LIROW), IWK(LICOL), + IWK(LLBLWY), IWK(LLABVY), IWK(LLBLWZ), IWK(LLABVZ), IWK(LIDOM), + IWK(LLPLNF), IWK(LIPLNF), IWK(LLROWF), IWK(LIROWF), + IWK(LICOLF), IWK(LIDOMF), NPTSF, IERR) IF (IERR .EQ. 1) THEN LIWK = LENIWK+1 RETURN ENDIF C Ccc Move fine grid structure to their correct position NPLNSF = IWK(LLPLNF) CALL ICOPY (NPLNSF+2, IWK(LLPLNF), IWK(LISTRF)) LLPLNF = LISTRF CALL ICOPY (NPLNSF, IWK(LIPLNF), IWK(LLPLNF+NPLNSF+2)) LIPLNF = LLPLNF+NPLNSF+2 NROWSF = IWK(LLPLNF+NPLNSF+1)-1 CALL ICOPY (NROWSF+1, IWK(LLROWF), IWK(LIPLNF+NPLNSF)) LLROWF = LIPLNF+NPLNSF CALL ICOPY (NROWSF, IWK(LIROWF), IWK(LLROWF+NROWSF+1)) LIROWF = LLROWF+NROWSF+1 CALL ICOPY (NPTSF, IWK(LICOLF), IWK(LIROWF+NROWSF)) LICOLF = LIROWF+NROWSF C Ccc Copy # physical boundaries and boundary types from coarse grid LLLBDF = LICOLF+NPTSF LILBDF = LLLBDF+NBNDS+3 LLBNDF = LILBDF+NBNDS IWK(LLLBDF) = NBNDS CALL ICOPY (NBNDS, IWK(LILBND), IWK(LILBDF)) C Ccc Set pointers below and above and new boundary lists LLBLYF = LLBNDF+NPTSF LLABYF = LLBLYF+NPTSF+1 LLBLZF = LLABYF+NPTSF+1 LLABZF = LLBLZF+NPTSF+1 LIWK = LLABZF+NPTSF+1 IF (LIWK .GT. LENIWK) THEN IERR = 1 RETURN ENDIF CALL SETBA (IWK(LLPLNF), IWK(LIPLNF), IWK(LLROWF), IWK(LIROWF), + IWK(LICOLF), IWK(LLBLYF),IWK(LLABYF), IWK(LLBLZF),IWK(LLABZF)) CALL MKBND (NPTSF, + IWK(LLPLNF),IWK(LIPLNF), IWK(LLROWF),IWK(LIROWF), IWK(LICOLF), + IWK(LLBLYF), IWK(LLABYF), IWK(LLBLZF),IWK(LLABZF), + IWK(LIDOMF), IWK(LLLBDF), IWK(LILBDF), IWK(LLBNDF)) C Ccc Move below/above pointers to their correct position NBIPTF = IWK(LLLBDF+NBNDS+2)-1 CALL ICOPY (NPTSF+1, IWK(LLBLYF), IWK(LLBNDF+NBIPTF)) LLBLYF = LLBNDF+NBIPTF CALL ICOPY (NPTSF+1, IWK(LLABYF), IWK(LLBLYF+NPTSF+1)) LLABYF = LLBLYF+NPTSF+1 CALL ICOPY (NPTSF+1, IWK(LLBLZF), IWK(LLABYF+NPTSF+1)) LLBLZF = LLABYF+NPTSF+1 CALL ICOPY (NPTSF+1, IWK(LLABZF), IWK(LLBLZF+NPTSF+1)) LLABZF = LLBLZF+NPTSF+1 LIWK = LLABZF+NPTSF+1 IF (LINSYS .NE. 0) RETURN C Ccc Set pointers to lower and upper diagonals in Jacobian for fine grid LLLDGF = LIWK LLUDGF = LLLDGF+NPTSF*8 LIWK = LLUDGF+NPTSF*8 IF (LIWK .GT. LENIWK) THEN IERR = 1 RETURN ENDIF CALL JACSDP (NPTSF, IWK(LLLBDF), IWK(LILBDF), IWK(LLBNDF), + IWK(LLBLYF), IWK(LLABYF), IWK(LLBLZF), IWK(LLABZF), + IWK(LLLDGF), IWK(LLUDGF)) C Ccc Make data-dependency lists for ILU on fine-grid Jacobian LLSLF = LIWK LLLSLF = LLSLF +NPTSF LIWK = LLLSLF+NPTSF IF (LIWK+NPTSF .GT. LENIWK) THEN IERR = 1 RETURN ENDIF CALL JACSLP (NPTSF, IWK(LLLBDF), IWK(LILBDF), IWK(LLBNDF), + IWK(LLLDGF), IWK(LIWK), IWK(LLLSLF), IWK(LLSLF)) LLSUF = LLLSLF+IWK(LLLSLF)+1 LLLSUF = LLSUF +NPTSF LIWK = LLLSUF+NPTSF IF (LIWK+NPTSF .GT. LENIWK) THEN LIWK = LIWK+NPTSF IERR = 1 RETURN ENDIF CALL JACSUP (NPTSF, IWK(LLLBDF), IWK(LILBDF), IWK(LLBNDF), + IWK(LLUDGF), IWK(LIWK), IWK(LLLSUF), IWK(LLSUF)) LIWK = LLLSUF+ IWK(LLLSUF)+1 RETURN END LOGICAL FUNCTION CHKREF (T, LEVEL, U, NPTS, NPDE, X, Y, Z, + LLBND, ILBND, LBND, LBLWY, LABVY, LBLWZ, LABVZ, + SPCTOL, TOLWGT, W1, W2, W3, REFFLG, SPCMON) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER LEVEL, NPTS, NPDE, LLBND(0:*), ILBND(*), LBND(*), + LBLWY(0:NPTS), LABVY(0:NPTS), LBLWZ(0:NPTS), LABVZ(0:NPTS) LOGICAL REFFLG(0:NPTS) DOUBLE PRECISION T, U(0:NPTS*NPDE), X(NPTS), Y(NPTS), Z(NPTS), + SPCTOL(NPDE), TOLWGT, + W1(NPTS*NPDE), W2(NPTS*NPDE), W3(NPTS*NPDE), SPCMON C Ccc PURPOSE: C Check if grid needs to be refined. If so, CHKREF = .FALSE. and C flags are set where the refinement is needed. C C Space monitor: C SPCMON(ipt) = max SPCTOL(ic).(|(dx)^2.Uxx(ipt)| + |(dy)^2.Uyy(ipt)| C (ic = 1, NPDE) + |(dz)^2.Uzz(ipt)|) C A user routine is called to eventually enforce refinement by setting C SPCMON. C If max SPCMON(ipt) < TOLWGT then no refinement is needed, C (ipt = 1, NPTS) C otherwise all gridpoints for which SPCMON(ipt) > 1/4 are flagged C plus their 26 neighbours. C On exit CHKREF = .TRUE. if no refinement is required C Ccc PARAMETER DESCRIPTION: C T : IN. Current time level C LEVEL : IN. Current grid level C U : IN. Array of solution values. C NPTS : IN. # grid points C NPDE : IN. # PDE components C X,Y,Z : IN. Physical coordinates of grid points C LLBND : (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C LBLWY : OUT. (0:NPTS) C LBLWY(IPT): pointer to node below in Y-direction in C actual grid C 0, if index node is back-plane boundary point C LABVY : OUT. (0:NPTS) C LABVY(IPT): pointer to node above in Y-direction in C actual grid C 0, if index node is down-plane boundary point C LBLWZ : OUT. (0:NPTS) C LBLWZ(IPT): pointer to node below in Z-direction in C actual grid C 0, if index node is down-plane boundary point C LABVZ : OUT. (0:NPTS) C LABVZ(IPT): pointer to node above in Z-direction in C actual grid C 0, if index node is up-plane boundary point C SPCTOL : IN. User defined space tolerance for the monitor values of C different components C TOLWGT : IN. Weight factor for tolerance. If new level at previous C time existed TOLWGT < 1, else 1 C W1,W2,W3 : WORK. C REFFLG : OUT. If the solution in a grid point violates the space C monitor condition, the gridpoint and its 26 neighbours are C flagged C SPCMON : OUT. Max SPCMON(ipt) C Ccc EXTERNALS USED: EXTERNAL CHSPCM C C----------------------------------------------------------------------- C INTEGER I, IB, IC, IPT, IM1, IM2, IP1, IP2, LB, NBNDS, NBIPTS C NBNDS = LLBND(0) NBIPTS = LLBND(NBNDS+2)-1 C Ccc Store (dx)^2.Uxx in W1, (dy)^2.Uyy in W2, and (dz)^2.Uzz in W3 C First interior points, boundary values will be rubbish DO 10 I = 2, NPTS*NPDE-1 W1(I) = U(I-1) - 2*U(I) + U(I+1) 10 CONTINUE DO 20 IC = 1, NPDE DO 20 IPT = 1, NPTS I = IPT + (IC-1)*NPTS IM1 = LBLWY(IPT) + (IC-1)*NPTS IP1 = LABVY(IPT) + (IC-1)*NPTS W2(I) = U(IM1) - 2*U(I) + U(IP1) IM1 = LBLWZ(IPT) + (IC-1)*NPTS IP1 = LABVZ(IPT) + (IC-1)*NPTS W3(I) = U(IM1) - 2*U(I) + U(IP1) 20 CONTINUE C C Correct boundaries, first the physical boundaries then the internal C ones DO 30 IB = 1, NBNDS IF (ILBND(IB) .EQ. 1) THEN C Left boundary plane, correct (dx)^2.Uxx in W1 DO 40 IC = 1, NPDE DO 40 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) I = IPT + (IC-1)*NPTS W1(I) = U(I) - 2*U(I+1) + U(I+2) 40 CONTINUE ELSE IF (ILBND(IB) .EQ. 2) THEN C Down boundary plane, correct (dz)^2.Uzz in W3 DO 50 IC = 1, NPDE DO 50 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) I = IPT + (IC-1)*NPTS IP1 = LABVZ(IPT) IP2 = LABVZ(IP1) + (IC-1)*NPTS IP1 = IP1 + (IC-1)*NPTS W3(I) = U(I) - 2*U(IP1) + U(IP2) 50 CONTINUE ELSE IF (ILBND(IB) .EQ. 3) THEN C Right boundary plane, correct (dx)^2.Uxx in W1 DO 60 IC = 1, NPDE DO 60 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) I = IPT + (IC-1)*NPTS W1(I) = U(I) - 2*U(I-1) + U(I-2) 60 CONTINUE ELSE IF (ILBND(IB) .EQ. 4) THEN C Up boundary plane, correct (dz)^2.Uzz in W3 DO 70 IC = 1, NPDE DO 70 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) I = IPT + (IC-1)*NPTS IM1 = LBLWZ(IPT) IM2 = LBLWZ(IM1) + (IC-1)*NPTS IM1 = IM1 + (IC-1)*NPTS W3(I) = U(I) - 2*U(IM1) + U(IM2) 70 CONTINUE ELSE IF (ILBND(IB) .EQ. 5) THEN C Front boundary plane, correct (dy)^2.Uyy in W2 DO 80 IC = 1, NPDE DO 80 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) I = IPT + (IC-1)*NPTS IP1 = LABVY(IPT) IP2 = LABVY(IP1) + (IC-1)*NPTS IP1 = IP1 + (IC-1)*NPTS W2(I) = U(I) - 2*U(IP1) + U(IP2) 80 CONTINUE ELSE IF (ILBND(IB) .EQ. 6) THEN C Back boundary plane, correct (dy)^2.Uyy in W2 DO 90 IC = 1, NPDE DO 90 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) I = IPT + (IC-1)*NPTS IM1 = LBLWY(IPT) IM2 = LBLWY(IM1) + (IC-1)*NPTS IM1 = IM1 + (IC-1)*NPTS W2(I) = U(I) - 2*U(IM1) + U(IM2) 90 CONTINUE ENDIF 30 CONTINUE IB = NBNDS + 1 C Internal boundary, Dirichlet condition, space error = 0 DO 210 IC = 1, NPDE DO 210 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) I = IPT + (IC-1)*NPTS W1(I) = 0.0 W2(I) = 0.0 W3(I) = 0.0 210 CONTINUE C Ccc Compute space monitor SPCMON, and its maximum IC = 1 DO 300 IPT = 1, NPTS W1(IPT) = SPCTOL(IC)*(ABS(W1(IPT)) + ABS(W2(IPT)) + + ABS(W3(IPT))) 300 CONTINUE DO 310 IC = 2, NPDE DO 310 IPT = 1, NPTS I = IPT + (IC-1)*NPTS W1(IPT) = MAX(W1(IPT),SPCTOL(IC)*(ABS(W1(I)) + ABS(W2(I)) + + ABS(W3(I)))) 310 CONTINUE C C Call user routine to possibly force refinement CALL CHSPCM (T, LEVEL, NPTS, X, Y, Z, NPDE, U(1), W1, TOLWGT) C C Compute maximum SPCMON = W1(1) DO 320 IPT = 2, NPTS SPCMON = MAX(SPCMON,W1(IPT)) 320 CONTINUE C Ccc Check if grid refinement is needed IF (SPCMON .LT. TOLWGT) THEN C No refinement needed CHKREF = .TRUE. RETURN ENDIF C Ccc Flag each node where space monitor is too large + its 26 neighbors. C Cells will be refined if a flag is set on 1 corner CHKREF = .FALSE. DO 400 IPT = 0, NPTS REFFLG(IPT) = .FALSE. 400 CONTINUE C C If neighbors in the grid datastructure are not physical neighbors in C the grid the former are wrongly flagged but since those points C are boundary points the flags will be unset later on DO 410 IPT = 1, NPTS IF (W1(IPT) .GE. 0.25) THEN IM1 = LBLWZ(IPT) IF (IM1 .GT. 0) THEN REFFLG(LABVY(IM1-1)) = .TRUE. REFFLG( IM1-1) = .TRUE. REFFLG(LBLWY(IM1-1)) = .TRUE. ENDIF REFFLG(LABVY(IM1)) = .TRUE. REFFLG( IM1) = .TRUE. REFFLG(LBLWY(IM1)) = .TRUE. REFFLG(LABVY(IM1+1)) = .TRUE. REFFLG( IM1+1) = .TRUE. REFFLG(LBLWY(IM1+1)) = .TRUE. C REFFLG(LABVY(IPT-1)) = .TRUE. REFFLG( IPT-1) = .TRUE. REFFLG(LBLWY(IPT-1)) = .TRUE. REFFLG(LABVY(IPT)) = .TRUE. REFFLG( IPT) = .TRUE. REFFLG(LBLWY(IPT)) = .TRUE. IF (IPT .LT. NPTS) THEN REFFLG(LABVY(IPT+1)) = .TRUE. REFFLG( IPT+1) = .TRUE. REFFLG(LBLWY(IPT+1)) = .TRUE. ENDIF C IP1 = LABVZ(IPT) IF (IP1 .GT. 0) THEN REFFLG(LABVY(IP1-1)) = .TRUE. REFFLG( IP1-1) = .TRUE. REFFLG(LBLWY(IP1-1)) = .TRUE. ENDIF REFFLG(LABVY(IP1)) = .TRUE. REFFLG( IP1) = .TRUE. REFFLG(LBLWY(IP1)) = .TRUE. IF (IP1 .LT. NPTS) THEN REFFLG(LABVY(IP1+1)) = .TRUE. REFFLG( IP1+1) = .TRUE. REFFLG(LBLWY(IP1+1)) = .TRUE. ENDIF ENDIF 410 CONTINUE REFFLG(0) = .FALSE. C Unset errorflags at (physical and internal) boundary DO 430 LB = 1, NBIPTS IPT = LBND(LB) REFFLG(IPT) = .FALSE. 430 CONTINUE RETURN END SUBROUTINE DOMFLG (NPTS, LLBND, LBND, IDOM) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, LLBND(0:*), LBND(*), IDOM(0:NPTS) C Ccc PURPOSE: C Set domain flags for determination of location of grid point in grid C Ccc PARAMETER DESCRIPTION: C NPTS : IN. # grid points C LLBND : (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary or corner in C LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C IDOM : OUT. IDOM(IPT): location in domain of node IPT C 0: interior point C IB: on boundary C if not on edge or corner, or if internal boundary C then IB, IB = 1, NBNDS+1 C else | IB4 | IB3 | IB2 | IBYTE | if point is part of C the boundary planes IBYTE, IB2, IB3, and IB4 C Ccc EXTERNALS USED: NONE C INTEGER BYTE PARAMETER (BYTE = 2**8) C C----------------------------------------------------------------------- C INTEGER IPT, IB, LB, NBNDS C NBNDS = LLBND(0) C C Set domain flags DO 10 IPT = 0, NPTS IDOM(IPT) = 0 10 CONTINUE DO 20 IB = 1, NBNDS DO 30 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) IF (IDOM(IPT) .EQ. 0) THEN IDOM(IPT) = IB ELSE IDOM(IPT) = IB+BYTE*IDOM(IPT) ENDIF 30 CONTINUE 20 CONTINUE IB = NBNDS+1 DO 40 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) IDOM(IPT) = IB 40 CONTINUE RETURN END SUBROUTINE REFDOM (MAXPTS, REFFLG, NBNDS, + LPLNC, IPLNC, LROWC, IROWC, ICOLC, + LBLWYC, LABVYC, LBLWZC, LABVZC, IDOMC, + LPLN, IPLN, LROW, IROW, ICOL, IDOM, NPTS, IERR) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER MAXPTS, NBNDS, + LPLNC(0:*), IPLNC(*), LROWC(*), IROWC(*), ICOLC(*), + LABVYC(0:*), LBLWYC(0:*), LABVZC(0:*), LBLWZC(0:*), IDOMC(0:*), + LPLN(0:*), IPLN(*), LROW(*), IROW(*), ICOL(*), IDOM(0:*), + NPTS, IERR LOGICAL REFFLG(0:*) C Ccc PURPOSE: C Create refined grid. If one of the corners of a cell is flagged, the C cell is divided in 8. The (LPLN,IPLN,LROW,IROW,ICOL) structure of the C fine grid will be stored and IDOM will contain domainflags (only for C rows corresponding with the coarse grid) to indicate the location of a C node in the fine grid. C Ccc PARAMETER DESCRIPTION: C MAXPTS : IN. Max. # grid points allowed on fine grid C REFFLG : IN. (0:NPTSC) C If the solution in a grid point violates the space monitor C condition, the gridpoint and its 26 neighbors are flagged. C Gridpoints at the boundaries are not flagged C LPLNC : IN. (0:LPLNC(0)+1) C LPLNC(0) = NPLNSC: Actual # planes in LROWC C LPLNC(1:NPLNSC): pointers to the start of a plane in LROWC C LPLNC(NPLNSC+1) = NROWSC+1: Total # rows in coarse grid + 1 C IPLNC : IN. (NPLNSC) C IPLNC(IP): plane number of plane IP in virtual box C LROWC : IN. (NROWSC+1) C LROWC(1:NROWSC): pointers to the start of a row in the grid C LROWC(NROWSC+1) = NPTSC+1: Actual # nodes in grid + 1 C IROWC : IN. (NROWSC) C IROWC(IR): row number of row IR in virtual box C ICOLC : IN. (NPTSC) C ICOLC(IPT): column number of grid point IPT in virtual box C LBLWYC : IN. (0:NPTSC) C LBLWYC(IPT): pointer to node below in Y-direction in C actual grid C 0, if index node is front-plane boundary point C LABVYC : IN. (0:NPTSC) C LABVYC(IPT): pointer to node above in Y-direction in C actual grid C 0, if index node is back-plane boundary point C LBLWZC : IN. (0:NPTSC) C LBLWZC(IPT): pointer to node below in Z-direction in C actual grid C 0, if index node is down-plane boundary point C LABVZC : IN. (0:NPTSC) C LABVZC(IPT): pointer to node above in Z-direction in C actual grid C 0, if index node is up-plane boundary point C IDOMC : IN. (0:NPTSC) C IDOMC(IPT): location in coarse grid of node IPT C 0: interior point C IB: on boundary C if not on edge or corner, or if internal boundary C then IB, IB = 1, NBNDS+1 C else | IB4 | IB3 | IB2 | IBYTE | if point is part of C the boundary planes IBYTE, IB2, IB3, and IB4 C LPLN : OUT. (0:LPLN(0)+1) C LPLN(0) = NPLNS: Actual # planes in LROW C LPLN(1:NPLNS): pointers to the start of a plane in LROW C LPLN(NPLNS+1) = NROWS+1: Total # rows in grid + 1 C IPLN : OUT. (NPLNS) C IPLN(IP): plane number of plane IP in virtual box C LROW : OUT. (NROWS+1) C LROW(1:NROWS): pointers to the start of a row in the grid C LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 C IROW : OUT. (NROWS) C IROW(IR): row number of row IR in virtual box C ICOL : OUT. (NPTS) C ICOL(IPT): column number of grid point IPT in virtual box C IDOM : OUT. (0:NPTS) C IDOM(IPT): location in coarse grid of node IPT (only set for C rows corresponding with coarse grid rows) C 0: interior point or new horizontal internal boundary C IB: on boundary C if not on edge or corner, or if internal boundary C then IB, IB = 1, NBNDS+1 C else | IB4 | IB3 | IB2 | IBYTE | if point is part of C the boundary planes IBYTE, IB2, IB3, and IB4 C NPTS : OUT. # grid points on fine grid or MAXPTS if IERR=1 C IERR : OUT. Error return flag C 0: OK. C 1: workspace too small for required # fine gridpoints C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER IPC, IP, IPTC, IPT, IPTO, IPTOLD, IRC, IR, IROLD, + NPLNSC, NPLNS, NROWS LOGICAL LEFT, MIDDLE, RIGHT C IERR = 0 IDOM(0) = 0 DO 1 IPT = 1, MAXPTS IDOM(IPT) = -1 1 CONTINUE C NPLNSC = LPLNC(0) C Ccc Create new grid level, all cells with at least one flagged corner C will be refined IP = 0 IR = 0 IPT = 0 DO 10 IPC = 1, NPLNSC C Ccc Make coarse grid plane of fine grid IROLD = IR DO 100 IRC = LPLNC(IPC), LPLNC(IPC+1)-1 C Ccc Make coarse grid row of fine grid IPTOLD = IPT IPTO = IPT LEFT = .FALSE. IPTC = LROWC(IRC) MIDDLE = REFFLG(LBLWYC(LBLWZC(IPTC))) .OR. + REFFLG(LBLWZC(IPTC)) .OR. REFFLG(LABVYC(LBLWZC(IPTC))) + .OR. REFFLG(LBLWYC(IPTC)) .OR. + REFFLG(IPTC) .OR. REFFLG(LABVYC(IPTC)) .OR. + REFFLG(LBLWYC(LABVZC(IPTC))) .OR. + REFFLG(LABVZC(IPTC)) .OR. REFFLG(LABVYC(LABVZC(IPTC))) DO 110 IPTC = LROWC(IRC)+1, LROWC(IRC+1)-1 RIGHT = REFFLG(LBLWYC(LBLWZC(IPTC))) .OR. + REFFLG(LBLWZC(IPTC)) .OR. REFFLG(LABVYC(LBLWZC(IPTC))) + .OR. REFFLG(LBLWYC(IPTC)) .OR. + REFFLG(IPTC) .OR. REFFLG(LABVYC(IPTC)) .OR. + REFFLG(LBLWYC(LABVZC(IPTC))) .OR. + REFFLG(LABVZC(IPTC)) .OR. REFFLG(LABVYC(LABVZC(IPTC))) IF (MIDDLE .OR. RIGHT) THEN C Refine cell IF (IPT+2 .GT. MAXPTS) GOTO 900 C Add node (ICOLC(IPTC-1),IROWC(IRC),IPLNC(IPC)) + C its right neighbor IPT = IPT + 1 ICOL(IPT) = 2*ICOLC(IPTC-1) IF (IDOMC(IPTC-1) .NE. 0) THEN C Coarse grid point is at (physical) boundary, so is new IDOM(IPT) = IDOMC(IPTC-1) ELSE IF (IPT .EQ. IPTO+1) THEN C First new point in this (sub)row: internal boundary IDOM(IPT) = NBNDS+1 ELSE C Internal point, or internal X-, or Z- boundary IDOM(IPT) = 0 ENDIF IPT = IPT + 1 ICOL(IPT) = ICOL(IPT-1)+1 C If one of both (coarse) neighbors is an internal point, so C is IPT; otherwise it lies on a X-, or Z- boundary and C only one of the neighbors can be a physical corner IF (IDOMC(IPTC-1) .EQ. 0 .OR. + IDOMC(IPTC) .EQ. 0) THEN IDOM(IPT) = 0 ELSE IF (IDOMC(IPTC-1) .EQ. NBNDS+1 .OR. + IDOMC(IPTC) .EQ. NBNDS+1) THEN IDOM(IPT) = NBNDS+1 ELSE IDOM(IPT) = MIN(IDOMC(IPTC-1),IDOMC(IPTC)) ENDIF ELSE IF (LEFT) THEN C Previous cell is refined, current not IF (IPT+1 .GT. MAXPTS) GOTO 900 C Add node (ICOLC(IPTC-1),IROWC(IRC),IPLNC(IPC)) IPT = IPT + 1 ICOL(IPT) = 2*ICOLC(IPTC-1) IF (IDOMC(IPTC-1) .NE. 0) THEN C Coarse grid point is at (physical) boundary, so is new IDOM(IPT) = IDOMC(IPTC-1) ELSE C Internal boundary IDOM(IPT) = NBNDS+1 ENDIF IPTO = IPT ENDIF LEFT = MIDDLE MIDDLE = RIGHT 110 CONTINUE IF (LEFT) THEN C Last cell in row has been refined IF (IPT+1 .GT. MAXPTS) GOTO 900 C Add last coarse node IPTC = LROWC(IRC+1)-1 IPT = IPT + 1 ICOL(IPT) = 2*ICOLC(IPTC) C Coarse grid point is at physical or internal boundary, so is new IDOM(IPT) = IDOMC(IPTC) ENDIF C IF (IPT .GT. IPTOLD) THEN C Current coarse grid row has been refined IR = IR + 1 LROW(IR) = IPTOLD + 1 IROW(IR) = 2*IROWC(IRC) ENDIF C IF (IRC .EQ. LPLNC(IPC+1)-1) GOTO 100 C Ccc Make intermediate row of fine grid IPTOLD = IPT LEFT = .FALSE. IPTC = LROWC(IRC) MIDDLE = + REFFLG(LBLWZC(IPTC)) .OR. REFFLG(LABVYC(LBLWZC(IPTC))) + .OR. REFFLG(IPTC) .OR. REFFLG(LABVYC(IPTC)) .OR. + REFFLG(LABVZC(IPTC)) .OR. REFFLG(LABVYC(LABVZC(IPTC))) DO 120 IPTC = LROWC(IRC)+1, LROWC(IRC+1)-1 RIGHT = + REFFLG(LBLWZC(IPTC)) .OR. REFFLG(LABVYC(LBLWZC(IPTC))) + .OR. REFFLG(IPTC) .OR. REFFLG(LABVYC(IPTC)) .OR. + REFFLG(LABVZC(IPTC)) .OR. REFFLG(LABVYC(LABVZC(IPTC))) IF (MIDDLE .OR. RIGHT) THEN C Refine cell IF (IPT+2 .GT. MAXPTS) GOTO 900 C Add node (ICOLC(IPTC-1),IROWC(IRC)+1/2,IPLNC(IPC)) + C its right neighbor IPT = IPT + 1 ICOL(IPT) = 2*ICOLC(IPTC-1) IPT = IPT + 1 ICOL(IPT) = ICOL(IPT-1)+1 ELSE IF (LEFT) THEN C Previous cell is refined, current not IF (IPT+1 .GT. MAXPTS) GOTO 900 C Add node (ICOLC(IPTC-1),IROWC(IRC)+1/2,IPLNC(IPC)) IPT = IPT + 1 ICOL(IPT) = 2*ICOLC(IPTC-1) ENDIF LEFT = MIDDLE MIDDLE = RIGHT 120 CONTINUE IF (LEFT) THEN C Last cell in row has been refined IF (IPT+1 .GT. MAXPTS) GOTO 900 C Add last coarse node IPTC = LROWC(IRC+1)-1 IPT = IPT + 1 ICOL(IPT) = 2*ICOLC(IPTC) ENDIF C IF (IPT .GT. IPTOLD) THEN C Current intermediate row has been refined IR = IR + 1 LROW(IR) = IPTOLD + 1 IROW(IR) = 2*IROWC(IRC)+1 ENDIF 100 CONTINUE C IF (IR .GT. IROLD) THEN C Current coarse grid plane has been refined IP = IP + 1 LPLN(IP) = IROLD + 1 IPLN(IP) = 2*IPLNC(IPC) ENDIF IF (IPC .EQ. NPLNSC) GOTO 10 C Ccc Make intermediate grid plane of fine grid IROLD = IR DO 200 IRC = LPLNC(IPC), LPLNC(IPC+1)-1 C Ccc Make coarse grid row of fine grid IPTOLD = IPT LEFT = .FALSE. IPTC = LROWC(IRC) MIDDLE = REFFLG(LBLWYC(IPTC)) .OR. + REFFLG(IPTC) .OR. REFFLG(LABVYC(IPTC)) .OR. + REFFLG(LBLWYC(LABVZC(IPTC))) .OR. + REFFLG(LABVZC(IPTC)) .OR. REFFLG(LABVYC(LABVZC(IPTC))) DO 210 IPTC = LROWC(IRC)+1, LROWC(IRC+1)-1 RIGHT = REFFLG(LBLWYC(IPTC)) .OR. + REFFLG(IPTC) .OR. REFFLG(LABVYC(IPTC)) .OR. + REFFLG(LBLWYC(LABVZC(IPTC))) .OR. + REFFLG(LABVZC(IPTC)) .OR. REFFLG(LABVYC(LABVZC(IPTC))) IF (MIDDLE .OR. RIGHT) THEN C Refine cell IF (IPT+2 .GT. MAXPTS) GOTO 900 C Add node (ICOLC(IPTC-1),IROWC(IRC),IPNC(IPC)+1/2) + C its right neighbor IPT = IPT + 1 ICOL(IPT) = 2*ICOLC(IPTC-1) IPT = IPT + 1 ICOL(IPT) = ICOL(IPT-1)+1 ELSE IF (LEFT) THEN C Previous cell is refined, current not IF (IPT+1 .GT. MAXPTS) GOTO 900 C Add node (ICOLC(IPTC-1),IROWC(IRC),IPNC(IPC)+1/2) IPT = IPT + 1 ICOL(IPT) = 2*ICOLC(IPTC-1) ENDIF LEFT = MIDDLE MIDDLE = RIGHT 210 CONTINUE IF (LEFT) THEN C Last cell in row has been refined IF (IPT+1 .GT. MAXPTS) GOTO 900 C Add last coarse node IPTC = LROWC(IRC+1)-1 IPT = IPT + 1 ICOL(IPT) = 2*ICOLC(IPTC) ENDIF C IF (IPT .GT. IPTOLD) THEN C Current coarse grid row has been refined IR = IR + 1 LROW(IR) = IPTOLD + 1 IROW(IR) = 2*IROWC(IRC) ENDIF C IF (IRC .EQ. LPLNC(IPC+1)-1) GOTO 200 C Ccc Make intermediate row of fine grid IPTOLD = IPT LEFT = .FALSE. IPTC = LROWC(IRC) MIDDLE = + REFFLG(IPTC) .OR. REFFLG(LABVYC(IPTC)) .OR. + REFFLG(LABVZC(IPTC)) .OR. REFFLG(LABVYC(LABVZC(IPTC))) DO 220 IPTC = LROWC(IRC)+1, LROWC(IRC+1)-1 RIGHT = + REFFLG(IPTC) .OR. REFFLG(LABVYC(IPTC)) .OR. + REFFLG(LABVZC(IPTC)) .OR. REFFLG(LABVYC(LABVZC(IPTC))) IF (MIDDLE .OR. RIGHT) THEN C Refine cell IF (IPT+2 .GT. MAXPTS) GOTO 900 C Add node (ICOLC(IPTC-1),IROWC(IRC)+1/2,IPNC(IPC)+1/2) + C its right neighbor IPT = IPT + 1 ICOL(IPT) = 2*ICOLC(IPTC-1) IPT = IPT + 1 ICOL(IPT) = ICOL(IPT-1)+1 ELSE IF (LEFT) THEN C Previous cell is refined, current not IF (IPT+1 .GT. MAXPTS) GOTO 900 C Add node (ICOLC(IPTC-1),IROWC(IRC)+1/2,IPNC(IPC)+1/2) IPT = IPT + 1 ICOL(IPT) = 2*ICOLC(IPTC-1) ENDIF LEFT = MIDDLE MIDDLE = RIGHT 220 CONTINUE IF (LEFT) THEN C Last cell in row has been refined IF (IPT+1 .GT. MAXPTS) GOTO 900 C Add last coarse node IPTC = LROWC(IRC+1)-1 IPT = IPT + 1 ICOL(IPT) = 2*ICOLC(IPTC) ENDIF C IF (IPT .GT. IPTOLD) THEN C Current intermediate row has been refined IR = IR + 1 LROW(IR) = IPTOLD + 1 IROW(IR) = 2*IROWC(IRC)+1 ENDIF 200 CONTINUE IF (IR .GT. IROLD) THEN C Current intermediate grid plane has been refined IP = IP + 1 LPLN(IP) = IROLD + 1 IPLN(IP) = 2*IPLNC(IPC)+1 ENDIF 10 CONTINUE C Ccc Store # find grid planes in LPLN(0) and # fine grid points in NPTS C and LROW(NROWS+1) NPLNS = IP NROWS = IR NPTS = IPT LPLN(0) = NPLNS LPLN(NPLNS+1) = NROWS + 1 LROW(NROWS+1) = NPTS + 1 C RETURN C Ccc Error return 900 CONTINUE NPTS = MAXPTS IERR = 1 C RETURN END SUBROUTINE MKBND (NPTSF, LPLN, IPLN, LROW, IROW, ICOL, + LBLWY, LABVY, LBLWZ, LABVZ, + IDOM, LLBND, ILBND, LBND) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTSF INTEGER LPLN(0:*), IPLN(*), LROW(*), IROW(*), ICOL(NPTSF), + LBLWY(0:NPTSF), LABVY(0:NPTSF), LBLWZ(0:NPTSF), LABVZ(0:NPTSF), + IDOM(0:NPTSF), LLBND(0:*), ILBND(*), LBND(*) C Ccc PURPOSE: C Make boundary list for refined grid using domain flags set on grid C points corresponding to coarse grid points C Ccc PARAMETER DESCRIPTION: C LPLN : IN. (0:LPLN(0)+1) C LPLN(0) = NPLNS: Actual # planes in LROW C LPLN(1:NPLNS): pointers to the start of a plane in LROW C LPLN(NPLNS+1) = NROWS+1: Total # rows in grid + 1 C IPLN : IN. (NPLNS) C IPLN(IP): plane number of plane IP in virtual box C LROW : IN. (NROWS+1) C LROW(1:NROWS): pointers to the start of a row in the grid C LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 C IROW : IN. (NROWS) C IROW(IR): row number of row IR in virtual box C ICOL : IN. (NPTS) C ICOL(IPT): column number of grid point IPT in virtual box C LBLWY : IN. (0:NPTS) C LBLWY(IPT): pointer to node below in Y-direction in C actual grid C 0, if index node is front-plane boundary point C LABVY : IN. (0:NPTS) C LABVY(IPT): pointer to node above in Y-direction in C actual grid C 0, if index node is back-plane boundary point C LBLWZ : IN. (0:NPTS) C LBLWZ(IPT): pointer to node below in Z-direction in C actual grid C 0, if index node is down-plane boundary point C LABVZ : IN. (0:NPTS) C LABVZ(IPT): pointer to node above in Z-direction in C actual grid C 0, if index node is up-plane boundary point C IDOM : INWORK. (0:NPTS) C IDOM(IPT): location in coarse grid of node IPT (only set for C rows corresponding with coarse grid rows) C 0: interior point or new horizontal internal boundary C IB: on boundary C if not on edge or corner, or if internal boundary C then IB, IB = 1, NBNDS+1 C else | IB4 | IB3 | IB2 | IBYTE | if point is part of C the boundary planes IBYTE, IB2, IB3, and IB4 C LLBND : OUT. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : OUT. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : OUT. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C Ccc EXTERNALS USED: NONE C INTEGER BYTE PARAMETER (BYTE = 2**8) C C----------------------------------------------------------------------- C INTEGER IB, ID, ID1, IDA, IDB, IP, IPT, IR, NPLNS, NROWS, + NPTS, NBNDS C NPLNS = LPLN(0) NROWS = LPLN(NPLNS+1)-1 NPTS = LROW(NROWS+1)-1 NBNDS = LLBND(0) C Ccc Domain flags have been set at nodes corresponding with coarse grid C nodes and their X-neighbors, but some internal boundaries parallel to C the X- or Z-axis can still be marked as internal points. Correct these C by checking if any neighbor is missing. These points have X-neighbors. C Correct the IDOM value for planes that do not longer exist in the C refinement DO 10 IP = 1, NPLNS IF (IPLN(IP)/2*2 .NE. IPLN(IP)) GOTO 10 DO 20 IR = LPLN(IP), LPLN(IP+1)-1 IF (IROW(IR)/2*2 .NE. IROW(IR)) GOTO 20 DO 30 IPT = LROW(IR), LROW(IR+1)-1 IF (IDOM(IPT) .EQ. 0) THEN IF (LBLWY(IPT-1)*LBLWY(IPT)*LBLWY(IPT+1) .EQ. 0 .OR. + LABVY(IPT-1)*LABVY(IPT)*LABVY(IPT+1) .EQ. 0 .OR. + LBLWZ(IPT-1)*LBLWZ(IPT)*LBLWZ(IPT+1) .EQ. 0 .OR. + LABVZ(IPT-1)*LABVZ(IPT)*LABVZ(IPT+1) .EQ. 0 .OR. + LBLWZ(LBLWY(IPT-1))*LBLWZ(LBLWY(IPT))* + LBLWZ(LBLWY(IPT+1)) .EQ. 0 .OR. + LABVZ(LBLWY(IPT-1))*LABVZ(LBLWY(IPT))* + LABVZ(LBLWY(IPT+1)) .EQ. 0 .OR. + LBLWZ(LABVY(IPT-1))*LBLWZ(LABVY(IPT))* + LBLWZ(LABVY(IPT+1)) .EQ. 0 .OR. + LABVZ(LABVY(IPT-1))*LABVZ(LABVY(IPT))* + LABVZ(LABVY(IPT+1)) .EQ. 0) + IDOM(IPT) = NBNDS+1 ELSE IF (IDOM(IPT) .GT. BYTE) THEN ID = 0 ID1 = MOD(IDOM(IPT),BYTE) IB = ILBND(ID1) IF (IB .EQ. 1 .AND. ICOL(IPT)+1 .EQ. ICOL(IPT+1)) THEN ID = ID1 ELSE IF (IB .EQ. 2 .AND. LABVZ(IPT) .NE. 0) THEN ID = ID1 ELSE IF (IB .EQ. 3 .AND. ICOL(IPT)-1 .EQ. ICOL(IPT-1)) + THEN ID = ID1 ELSE IF (IB .EQ. 4 .AND. LBLWZ(IPT) .NE. 0) THEN ID = ID1 ELSE IF (IB .EQ. 5 .AND. LABVY(IPT) .NE. 0) THEN ID = ID1 ELSE IF (IB .EQ. 6 .AND. LBLWY(IPT) .NE. 0) THEN ID = ID1 ENDIF IDOM(IPT) = IDOM(IPT)/BYTE ID1 = MOD(IDOM(IPT),BYTE) IB = ILBND(ID1) IF (IB .EQ. 1 .AND. ICOL(IPT)+1 .EQ. ICOL(IPT+1)) THEN ID = ID*BYTE+ID1 ELSE IF (IB .EQ. 2 .AND. LABVZ(IPT) .NE. 0) THEN ID = ID*BYTE+ID1 ELSE IF (IB .EQ. 3 .AND. ICOL(IPT)-1 .EQ. ICOL(IPT-1)) + THEN ID = ID*BYTE+ID1 ELSE IF (IB .EQ. 4 .AND. LBLWZ(IPT) .NE. 0) THEN ID = ID*BYTE+ID1 ELSE IF (IB .EQ. 5 .AND. LABVY(IPT) .NE. 0) THEN ID = ID*BYTE+ID1 ELSE IF (IB .EQ. 6 .AND. LBLWY(IPT) .NE. 0) THEN ID = ID*BYTE+ID1 ENDIF IDOM(IPT) = IDOM(IPT)/BYTE IF (IDOM(IPT) .EQ. 0) GOTO 40 ID1 = MOD(IDOM(IPT),BYTE) IB = ILBND(ID1) IF (IB .EQ. 1 .AND. ICOL(IPT)+1 .EQ. ICOL(IPT+1)) THEN ID = ID*BYTE+ID1 ELSE IF (IB .EQ. 2 .AND. LABVZ(IPT) .NE. 0) THEN ID = ID*BYTE+ID1 ELSE IF (IB .EQ. 3 .AND. ICOL(IPT)-1 .EQ. ICOL(IPT-1)) + THEN ID = ID*BYTE+ID1 ELSE IF (IB .EQ. 4 .AND. LBLWZ(IPT) .NE. 0) THEN ID = ID*BYTE+ID1 ELSE IF (IB .EQ. 5 .AND. LABVY(IPT) .NE. 0) THEN ID = ID*BYTE+ID1 ELSE IF (IB .EQ. 6 .AND. LBLWY(IPT) .NE. 0) THEN ID = ID*BYTE+ID1 ENDIF IDOM(IPT) = IDOM(IPT)/BYTE IF (IDOM(IPT) .EQ. 0) GOTO 40 ID1 = MOD(IDOM(IPT),BYTE) IB = ILBND(ID1) IF (IB .EQ. 1 .AND. ICOL(IPT)+1 .EQ. ICOL(IPT+1)) THEN ID = ID*BYTE+ID1 ELSE IF (IB .EQ. 2 .AND. LABVZ(IPT) .NE. 0) THEN ID = ID*BYTE+ID1 ELSE IF (IB .EQ. 3 .AND. ICOL(IPT)-1 .EQ. ICOL(IPT-1)) + THEN ID = ID*BYTE+ID1 ELSE IF (IB .EQ. 4 .AND. LBLWZ(IPT) .NE. 0) THEN ID = ID*BYTE+ID1 ELSE IF (IB .EQ. 5 .AND. LABVY(IPT) .NE. 0) THEN ID = ID*BYTE+ID1 ELSE IF (IB .EQ. 6 .AND. LBLWY(IPT) .NE. 0) THEN ID = ID*BYTE+ID1 ENDIF 40 IDOM(IPT) = ID ENDIF 30 CONTINUE 20 CONTINUE 10 CONTINUE C Ccc Set domain flags in intermediate rows of coarse grid planes DO 100 IP = 1, NPLNS IF (IPLN(IP)/2*2 .NE. IPLN(IP)) GOTO 100 DO 110 IR = LPLN(IP), LPLN(IP+1)-1 IF (IROW(IR)/2*2 .EQ. IROW(IR)) GOTO 110 DO 120 IPT = LROW(IR), LROW(IR+1)-1 IDA = IDOM(LABVY(IPT)) IDB = IDOM(LBLWY(IPT)) C If one of both neighbors is an internal point, so C is IPT; otherwise it lies on a Y- or Z-boundary, C if both Y-neighbors are lying on a plane only one can be a C physical edge, if both are lying on an edge only one can be a C physical corner IF (IDA .EQ. 0 .OR. IDB .EQ. 0) THEN IDOM(IPT) = 0 ELSE IF (IDA .EQ. NBNDS+1 .OR. IDB .EQ. NBNDS+1) THEN IDOM(IPT) = NBNDS+1 ELSE IDOM(IPT) = MIN(IDA,IDB) ENDIF 120 CONTINUE 110 CONTINUE 100 CONTINUE C Ccc Set domain flags in intermediate planes DO 150 IP = 1, NPLNS IF (IPLN(IP)/2*2 .EQ. IPLN(IP)) GOTO 150 DO 160 IR = LPLN(IP), LPLN(IP+1)-1 DO 170 IPT = LROW(IR), LROW(IR+1)-1 IDA = IDOM(LABVZ(IPT)) IDB = IDOM(LBLWZ(IPT)) C If one of both neighbors is an internal point, so C is IPT; otherwise it lies on a X- or Y-boundary, C if both Z-neighbors are lying on a plane only one can be a C physical edge, if both are lying on an edge only one can be a C physical corner IF (IDA .EQ. 0 .OR. IDB .EQ. 0) THEN IDOM(IPT) = 0 ELSE IF (IDA .EQ. NBNDS+1 .OR. IDB .EQ. NBNDS+1) THEN IDOM(IPT) = NBNDS+1 ELSE IDOM(IPT) = MIN(IDA,IDB) ENDIF 170 CONTINUE 160 CONTINUE 150 CONTINUE C Ccc Edges between physical and internal boundaries can still wrongly be C marked physical DO 200 IP = 1, NPLNS DO 210 IR = LPLN(IP), LPLN(IP+1)-1 DO 220 IPT = LROW(IR), LROW(IR+1)-1 ID = IDOM(IPT) IF (ID .EQ. 0 .OR. ID .EQ. NBNDS+1 .OR. + ID .GT. BYTE) GOTO 220 IB = ILBND(ID) IF (IB .EQ. 1) THEN ID1 = IDOM(IPT+1) IF (ID1 .EQ. NBNDS+1) IDOM(IPT) = NBNDS+1 ELSE IF (IB .EQ. 2) THEN ID1 = IDOM(LABVZ(IPT)) IF (ID1 .EQ. NBNDS+1) IDOM(IPT) = NBNDS+1 ELSE IF (IB .EQ. 3) THEN ID1 = IDOM(IPT-1) IF (ID1 .EQ. NBNDS+1) IDOM(IPT) = NBNDS+1 ELSE IF (IB .EQ. 4) THEN ID1 = IDOM(LBLWZ(IPT)) IF (ID1 .EQ. NBNDS+1) IDOM(IPT) = NBNDS+1 ELSE IF (IB .EQ. 5) THEN ID1 = IDOM(LABVY(IPT)) IF (ID1 .EQ. NBNDS+1) IDOM(IPT) = NBNDS+1 ELSE IF (IB .EQ. 6) THEN ID1 = IDOM(LBLWY(IPT)) IF (ID1 .EQ. NBNDS+1) IDOM(IPT) = NBNDS+1 ENDIF 220 CONTINUE 210 CONTINUE 200 CONTINUE C Ccc Corners can still wrongly be marked physical. If a point has at C least 2 neighbors that are internal boundary points, so is the C point itself DO 230 IP = 1, NPLNS DO 240 IR = LPLN(IP), LPLN(IP+1)-1 IPT = LROW(IR) IF (IDOM(IPT) .LT. BYTE) GOTO 249 IB = 0 IF (IDOM(IPT+1) .EQ. NBNDS+1) IB = IB+1 IF (IDOM(LBLWY(IPT)) .EQ. NBNDS+1) IB = IB+1 IF (IDOM(LABVY(IPT)) .EQ. NBNDS+1) IB = IB+1 IF (IDOM(LBLWZ(IPT)) .EQ. NBNDS+1) IB = IB+1 IF (IDOM(LABVZ(IPT)) .EQ. NBNDS+1) IB = IB+1 IF (IB .GE. 2) IDOM(IPT) = NBNDS+1 249 DO 250 IPT = LROW(IR)+1, LROW(IR+1)-2 IF (IDOM(IPT) .LT. BYTE) GOTO 250 IB = 0 IF (ICOL(IPT-1) .EQ. ICOL(IPT)-1 .AND. + IDOM(IPT-1) .EQ. NBNDS+1) IB = IB+1 IF (ICOL(IPT+1) .EQ. ICOL(IPT)+1 .AND. + IDOM(IPT+1) .EQ. NBNDS+1) IB = IB+1 IF (IDOM(LBLWY(IPT)) .EQ. NBNDS+1) IB = IB+1 IF (IDOM(LABVY(IPT)) .EQ. NBNDS+1) IB = IB+1 IF (IDOM(LBLWZ(IPT)) .EQ. NBNDS+1) IB = IB+1 IF (IDOM(LABVZ(IPT)) .EQ. NBNDS+1) IB = IB+1 IF (IB .GE. 2) IDOM(IPT) = NBNDS+1 250 CONTINUE IPT = LROW(IR+1)-1 IF (IDOM(IPT) .LT. BYTE) GOTO 240 IB = 0 IF (IDOM(IPT-1) .EQ. NBNDS+1) IB = IB+1 IF (IDOM(LBLWY(IPT)) .EQ. NBNDS+1) IB = IB+1 IF (IDOM(LABVY(IPT)) .EQ. NBNDS+1) IB = IB+1 IF (IDOM(LBLWZ(IPT)) .EQ. NBNDS+1) IB = IB+1 IF (IDOM(LABVZ(IPT)) .EQ. NBNDS+1) IB = IB+1 IF (IB .GE. 2) IDOM(IPT) = NBNDS+1 240 CONTINUE 230 CONTINUE Ccc Make boundary lists DO 300 IB = 0, NBNDS+1 LLBND(IB) = 0 300 CONTINUE DO 310 IPT = 1, NPTS ID = IDOM(IPT) ID1 = MOD(ID,BYTE) LLBND(ID1) = LLBND(ID1) + 1 IF (ID .EQ. ID1) GOTO 310 ID = ID/BYTE ID1 = MOD(ID,BYTE) LLBND(ID1) = LLBND(ID1) + 1 IF (ID .EQ. ID1) GOTO 310 ID = ID/BYTE ID1 = MOD(ID,BYTE) LLBND(ID1) = LLBND(ID1) + 1 IF (ID .EQ. ID1) GOTO 310 ID = ID/BYTE LLBND(ID) = LLBND(ID) + 1 310 CONTINUE LLBND(0) = 1 DO 320 IB = 1, NBNDS LLBND(IB) = LLBND(IB-1) + LLBND(IB) 320 CONTINUE DO 330 IB = NBNDS, 0, -1 LLBND(IB+2) = LLBND(IB) 330 CONTINUE DO 340 IPT = 1, NPTS IF (IDOM(IPT) .EQ. 0) GOTO 340 ID = IDOM(IPT) ID1 = MOD(ID,BYTE) LBND(LLBND(ID1+1)) = IPT LLBND(ID1+1) = LLBND(ID1+1) + 1 IF (ID .EQ. ID1) GOTO 340 ID = ID/BYTE ID1 = MOD(ID,BYTE) LBND(LLBND(ID1+1)) = IPT LLBND(ID1+1) = LLBND(ID1+1) + 1 IF (ID .EQ. ID1) GOTO 340 ID = ID/BYTE ID1 = MOD(ID,BYTE) LBND(LLBND(ID1+1)) = IPT LLBND(ID1+1) = LLBND(ID1+1) + 1 IF (ID .EQ. ID1) GOTO 340 ID = ID/BYTE LBND(LLBND(ID+1)) = IPT LLBND(ID+1) = LLBND(ID+1) + 1 340 CONTINUE LLBND(0) = NBNDS LLBND(1) = 1 RETURN END SUBROUTINE GETSOL (NPDE, UC, ISTRCN, LEVO, UO, ISTRFO, U, ISTRUC, + IWORK, RWORK) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPDE, ISTRCN(0:*), ISTRFO(0:*), ISTRUC(0:*), IWORK(*) LOGICAL LEVO DOUBLE PRECISION UC(0:*), UO(0:*), U(0:*), RWORK(*) C Ccc PURPOSE: C Store solution at a previous time level on a grid of the current time C level. C First copy the (embedded) coarser grid solution, then copy all C available values from the old time grid of the same grid level, and C finally calculate all non-initialized values by interpolation. C Ccc PARAMETER DESCRIPTION: C NPDE : IN. # PDE components C UC : IN. Solution at embedded coarse grid C ISTRCN : IN. Datastructure of the embedded coarse grid C LEVO : IN. .TRUE. if new grid level existed at previous time level C UO : IN. If LEVO the solution at grid ISTRFO C ISTRFO : IN. If LEVO the datastructure of the grid with the same level C as the new grid level but on a previous time level C U : OUT. Solution of previous time level on new grid level C ISTRUC : IN. Data structure of new grid level at current time level C IWORK : WORK. (NPTS) C RWORK : WORK. (0) C Ccc EXTERNALS USED: EXTERNAL INJCF, INJON, INTPOL C C----------------------------------------------------------------------- C INTEGER LLPLNC,NPLNSC,LIPLNC, LLROWC,NROWSC,NPTSC,LIROWC, LICOLC, + LLPLNO,NPLNSO,LIPLNO, LLROWO, NROWSO, NPTSO, LIROWO, LICOLO, + LLPLN,NPLNS,LIPLN, LLROW, NROWS, NPTS, LIROW, LICOL, + LLLBND, NBNDS, NBIPTS, LILBND, LLBNDP, + LLBLWY, LLABVY, LLBLWZ, LLABVZ C LLPLNC = 0 NPLNSC = ISTRCN(LLPLNC) NROWSC = ISTRCN(LLPLNC+NPLNSC+1)-1 LIPLNC = LLPLNC+NPLNSC+2 LLROWC = LIPLNC+NPLNSC NPTSC = ISTRCN(LLROWC+NROWSC)-1 LIROWC = LLROWC+NROWSC+1 LICOLC = LIROWC+NROWSC LLPLN = 0 NPLNS = ISTRUC(LLPLN) NROWS = ISTRUC(LLPLN+NPLNS+1)-1 LIPLN = LLPLN+NPLNS+2 LLROW = LIPLN+NPLNS NPTS = ISTRUC(LLROW+NROWS)-1 LIROW = LLROW+NROWS+1 LICOL = LIROW+NROWS LLLBND = LICOL+NPTS NBNDS = ISTRUC(LLLBND) NBIPTS = ISTRUC(LLLBND+NBNDS+2)-1 LILBND = LLLBND+NBNDS+3 LLBNDP = LILBND+NBNDS LLBLWY = LLBNDP+NBIPTS LLABVY = LLBLWY+NPTS+1 LLBLWZ = LLABVY+NPTS+1 LLABVZ = LLBLWZ+NPTS+1 C U(0) = 0.0 C C Copy embedded coarse grid solution CALL INJCF (NPDE, UC, U, IWORK, + ISTRCN(LLPLNC), ISTRCN(LIPLNC), + ISTRCN(LLROWC), ISTRCN(LIROWC), ISTRCN(LICOLC), + ISTRUC(LLPLN), ISTRUC(LIPLN), + ISTRUC(LLROW), ISTRUC(LIROW), ISTRUC(LICOL)) C IF (LEVO) THEN C Copy solution of grid with same level but on previous time level LLPLNO = 0 NPLNSO = ISTRFO(LLPLNO) NROWSO = ISTRFO(LLPLNO+NPLNSO+1)-1 LIPLNO = LLPLNO+NPLNSO+2 LLROWO = LIPLNO+NPLNSO NPTSO = ISTRFO(LLROWO+NROWSO)-1 LIROWO = LLROWO+NROWSO+1 LICOLO = LIROWO+NROWSO CALL INJON (NPDE, UO, U, IWORK, + ISTRFO(LLPLNO), ISTRFO(LIPLNO), + ISTRFO(LLROWO), ISTRFO(LIROWO), ISTRFO(LICOLO), + ISTRUC(LLPLN), ISTRUC(LIPLN), + ISTRUC(LLROW), ISTRUC(LIROW), ISTRUC(LICOL)) ENDIF C C Calculate all uninitialized values by interpolation CALL INTPOL (NPDE, U, IWORK, + ISTRUC(LLPLN), ISTRUC(LIPLN), + ISTRUC(LLROW), ISTRUC(LIROW), ISTRUC(LICOL), + ISTRUC(LLBLWY), ISTRUC(LLABVY), + ISTRUC(LLBLWZ), ISTRUC(LLABVZ), RWORK) C RETURN END SUBROUTINE GETINI (NPDE, UIC, UC, ISTRCC, LEVO, UO, ISTRFO, + U, ISTRUC, UIB, IWORK, RWORK) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPDE, ISTRCC(0:*), ISTRFO(0:*), ISTRUC(0:*), IWORK(*) LOGICAL LEVO DOUBLE PRECISION UIC(0:*), UC(0:*), UO(0:*), U(0:*), UIB(*), + RWORK(*) C Ccc PURPOSE: C Initialize solution at current time level on the next finer grid C level. Store (Dirichlet) internal boundary values in UIB. C First get the internal bounday values from interpolation of the C solution at the (embedded) coarser grid. C The initial solution is obtained by first copying the (embedded) C coarser grid initial solution, and then all available values from the C solution at the previous time level on the grid of the required grid C level. Finally all as yet non-initialized values are calculated by C interpolation. C Ccc PARAMETER DESCRIPTION: C NPDE : IN. # PDE components C UIC : IN. Initial solution at embedded coarse grid C UC : IN. Solution at embedded coarse grid C ISTRCC : IN. Datastructure of the embedded coarse grid C LEVO : IN. .TRUE. if new grid level existed at previous time level C UO : IN. If LEVO the solution at grid ISTRFO C ISTRFO : IN. If LEVO the datastructure of the grid with the same level C as the new grid level but on a previous time level C U : OUT. Solution of current time level on new grid level C ISTRUC : IN. Data structure of new grid level at current time level C UIB : OUT. List of internal boundary values C IWORK : WORK. (NPTS) C RWORK : WORK. (0) C Ccc EXTERNALS USED: EXTERNAL INJCF, INJCFB, INJON, INTPOL C C----------------------------------------------------------------------- C INTEGER LLPLNC,NPLNSC,LIPLNC, LLROWC,NROWSC,NPTSC,LIROWC, LICOLC, + LLPLNO, NPLNSO, LIPLNO, LLROWO, NROWSO, NPTSO, LIROWO, LICOLO, + LLPLN, NPLNS, LIPLN, LLROW, NROWS, NPTS, LIROW, LICOL, + LLLBND, NBNDS, NBDPTS, NBIPTS, LILBND, LLBNDP, + LLBLWY, LLABVY, LLBLWZ, LLABVZ, + NIBPTS, I, IB, IC, LB C LLPLNC = 0 NPLNSC = ISTRCC(LLPLNC) NROWSC = ISTRCC(LLPLNC+NPLNSC+1)-1 LIPLNC = LLPLNC+NPLNSC+2 LLROWC = LIPLNC+NPLNSC NPTSC = ISTRCC(LLROWC+NROWSC)-1 LIROWC = LLROWC+NROWSC+1 LICOLC = LIROWC+NROWSC LLPLN = 0 NPLNS = ISTRUC(LLPLN) NROWS = ISTRUC(LLPLN+NPLNS+1)-1 LIPLN = LLPLN+NPLNS+2 LLROW = LIPLN+NPLNS NPTS = ISTRUC(LLROW+NROWS)-1 LIROW = LLROW+NROWS+1 LICOL = LIROW+NROWS LLLBND = LICOL+NPTS NBNDS = ISTRUC(LLLBND) NBDPTS = ISTRUC(LLLBND+NBNDS+1)-1 NBIPTS = ISTRUC(LLLBND+NBNDS+2)-1 LILBND = LLLBND+NBNDS+3 LLBNDP = LILBND+NBNDS LLBLWY = LLBNDP+NBIPTS LLABVY = LLBLWY+NPTS+1 LLBLWZ = LLABVY+NPTS+1 LLABVZ = LLBLWZ+NPTS+1 NIBPTS = NBIPTS - NBDPTS C U(0) = 0.0 C Ccc Get internal boundary values C Copy embedded coarse grid solution CALL INJCFB (NPDE, UC, U, IWORK, + ISTRCC(LLPLNC), ISTRCC(LIPLNC), + ISTRCC(LLROWC), ISTRCC(LIROWC), ISTRCC(LICOLC), + ISTRUC(LLPLN), ISTRUC(LIPLN), + ISTRUC(LLROW), ISTRUC(LIROW), ISTRUC(LICOL), + ISTRUC(LLLBND), ISTRUC(LLBNDP)) C C Calculate all uninitialized values at the internal boundary by C interpolation CALL INTPOL (NPDE, U, IWORK, + ISTRUC(LLPLN), ISTRUC(LIPLN), + ISTRUC(LLROW), ISTRUC(LIROW), ISTRUC(LICOL), + ISTRUC(LLBLWY), ISTRUC(LLABVY), + ISTRUC(LLBLWZ), ISTRUC(LLABVZ), RWORK) C C Store internal boundary values in list DO 10 IC = 1, NPDE DO 10 LB = 1, NIBPTS I = ISTRUC(LLBNDP+NBDPTS-1+LB) + (IC-1)*NPTS IB = LB + (IC-1)*NIBPTS UIB(IB) = U(I) 10 CONTINUE C Ccc Get initial solution C Copy embedded coarse grid initial solution CALL INJCF (NPDE, UIC, U, IWORK, + ISTRCC(LLPLNC), ISTRCC(LIPLNC), + ISTRCC(LLROWC), ISTRCC(LIROWC), ISTRCC(LICOLC), + ISTRUC(LLPLN), ISTRUC(LIPLN), + ISTRUC(LLROW), ISTRUC(LIROW), ISTRUC(LICOL)) C IF (LEVO) THEN C C Copy solution of grid with same level but on previous time level LLPLNO = 0 NPLNSO = ISTRFO(LLPLNO) NROWSO = ISTRFO(LLPLNO+NPLNSO+1)-1 LIPLNO = LLPLNO+NPLNSO+2 LLROWO = LIPLNO+NPLNSO NPTSO = ISTRFO(LLROWO+NROWSO)-1 LIROWO = LLROWO+NROWSO+1 LICOLO = LIROWO+NROWSO CALL INJON (NPDE, UO, U, IWORK, + ISTRFO(LLPLNO), ISTRFO(LIPLNO), + ISTRFO(LLROWO), ISTRFO(LIROWO), ISTRFO(LICOLO), + ISTRUC(LLPLN), ISTRUC(LIPLN), + ISTRUC(LLROW), ISTRUC(LIROW), ISTRUC(LICOL)) C ENDIF C C Calculate all uninitialized values by interpolation CALL INTPOL (NPDE, U, IWORK, + ISTRUC(LLPLN), ISTRUC(LIPLN), + ISTRUC(LLROW), ISTRUC(LIROW), ISTRUC(LICOL), + ISTRUC(LLBLWY), ISTRUC(LLABVY), + ISTRUC(LLBLWZ), ISTRUC(LLABVZ), RWORK) C RETURN END SUBROUTINE INJCFB (NPDE, UC, U, IPDOM, + LPLNC, IPLNC, LROWC, IROWC, ICOLC, + LPLN, IPLN, LROW, IROW, ICOL, LLBND, LBND) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPDE, IPDOM(*), + LPLNC(0:*), IPLNC(*), LROWC(*), IROWC(*), ICOLC(*), + LPLN(0:*), IPLN(*), LROW(*), IROW(*), ICOL(*), + LLBND(0:*), LBND(*) DOUBLE PRECISION UC(0:*), U(0:*) C Ccc PURPOSE: C Inject solution from coarse grid into (embedded) fine grid C Ccc PARAMETER DESCRIPTION: C NPDE : IN. # PDE components C UC : IN. Solution at coarse grid C U : OUT. Solution at coarse gridpoints at internal boundary of C refined grid C IPDOM : OUT. Domain flags wrt to interpolation C 0: Injected point C -1: Otherwise C LPLNC : IN. -I C IPLNC : IN. I C LROWC : IN. I Data structure of the coarse grid C IROWC : IN. I see description for fine grid below C ICOLC : IN. -I C LPLN : IN. (0:LPLN(0)+1) C LPLN(0) = NPLNS: Actual # planes in LROW C LPLN(1:NPLNS): pointers to the start of a plane in LROW C LPLN(NPLNS+1) = NROWS+1: Total # rows in grid + 1 C IPLN : IN. (NPLNS) C IPLN(IP): plane number of plane IP in virtual box C LROW : IN. (NROWS+1) C LROW(1:NROWS): pointers to the start of a row in the grid C LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 C IROW : IN. (NROWS) C IROW(IR): row number of row IR in virtual box C ICOL : IN. (NPTS) C ICOL(IPT): column number of grid point IPT in virtual box C LLBND : (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary or corner in C LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C LBND : OUT. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER IB, IC, IPC, IP, IPTC, IPT, IRC, IR, + NBNDS, NPLNSC, NPLNS, NPTSC, NPTS, NROWSC, NROWS C NPLNS = LPLN(0) NROWS = LPLN(NPLNS+1)-1 NPTS = LROW(NROWS+1)-1 NBNDS = LLBND(0) NPLNSC = LPLNC(0) NROWSC = LPLNC(NPLNSC+1)-1 NPTSC = LROWC(NROWSC+1)-1 C Ccc Initialize interpolation flags DO 10 IPT = 1, NPTS IPDOM(IPT) = 0 10 CONTINUE DO 20 IB = LLBND(1), LLBND(NBNDS+2)-1 IPT = LBND(IB) IPDOM(IPT) = -1 20 CONTINUE C Ccc Inject values from coarse level into fine grid solution CDIR$ NOVECTOR IPC = 0 DO 30 IP = 1, NPLNS IF (IPLN(IP)/2*2 .NE. IPLN(IP)) GOTO 30 IPC = IPC + 1 40 IF (2*IPLNC(IPC) .NE. IPLN(IP)) THEN IPC = IPC + 1 GOTO 40 ENDIF IRC = LPLNC(IPC)-1 DO 50 IR = LPLN(IP), LPLN(IP+1)-1 IF (IROW(IR)/2*2 .NE. IROW(IR)) GOTO 50 IRC = IRC + 1 60 IF (2*IROWC(IRC) .NE. IROW(IR)) THEN IRC = IRC + 1 GOTO 60 ENDIF IPTC = LROWC(IRC)-1 DO 70 IPT = LROW(IR), LROW(IR+1)-1 IF (ICOL(IPT)/2*2 .NE. ICOL(IPT)) GOTO 70 IPTC = IPTC + 1 80 IF (2*ICOLC(IPTC) .NE. ICOL(IPT)) THEN IPTC = IPTC + 1 GOTO 80 ENDIF DO 90 IC = 1, NPDE U(IPT+(IC-1)*NPTS) = UC(IPTC+(IC-1)*NPTSC) 90 CONTINUE IPDOM(IPT) = 0 70 CONTINUE 50 CONTINUE 30 CONTINUE RETURN END SUBROUTINE INJCF (NPDE, UC, U, IPDOM, + LPLNC, IPLNC, LROWC, IROWC, ICOLC, + LPLN, IPLN, LROW, IROW, ICOL) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPDE, IPDOM(*), + LPLNC(0:*), IPLNC(*), LROWC(*), IROWC(*), ICOLC(*), + LPLN(0:*), IPLN(*), LROW(*), IROW(*), ICOL(*) DOUBLE PRECISION UC(0:*), U(0:*) C Ccc PURPOSE: C Inject solution from coarse grid into (embedded) fine grid C Ccc PARAMETER DESCRIPTION: C NPDE : IN. # PDE components C UC : IN. Solution at coarse grid C U : OUT. Solution at coarse gridpoints in refined grid C IPDOM : OUT. Domain flags wrt to interpolation C 0: Injected point C -1: Otherwise C LPLNC : IN. -I C IPLNC : IN. I C LROWC : IN. I Data structure of the coarse grid C IROWC : IN. I see description for fine grid below C ICOLC : IN. -I C LPLN : IN. (0:LPLN(0)+1) C LPLN(0) = NPLNS: Actual # planes in LROW C LPLN(1:NPLNS): pointers to the start of a plane in LROW C LPLN(NPLNS+1) = NROWS+1: Total # rows in grid + 1 C IPLN : IN. (NPLNS) C IPLN(IP): plane number of plane IP in virtual box C LROW : IN. (NROWS+1) C LROW(1:NROWS): pointers to the start of a row in the grid C LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 C IROW : IN. (NROWS) C IROW(IR): row number of row IR in virtual box C ICOL : IN. (NPTS) C ICOL(IPT): column number of grid point IPT in virtual box C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER IC, IPC, IP, IPTC, IPT, IRC, IR, + NPLNSC, NPLNS, NPTSC, NPTS, NROWSC, NROWS C NPLNS = LPLN(0) NROWS = LPLN(NPLNS+1)-1 NPTS = LROW(NROWS+1)-1 NPLNSC = LPLNC(0) NROWSC = LPLNC(NPLNSC+1)-1 NPTSC = LROWC(NROWSC+1)-1 C Ccc Initialize interpolation flags DO 10 IPT = 1, NPTS IPDOM(IPT) = -1 10 CONTINUE C Ccc Inject values from coarse level into fine grid solution CDIR$ NOVECTOR IPC = 0 DO 30 IP = 1, NPLNS IF (IPLN(IP)/2*2 .NE. IPLN(IP)) GOTO 30 IPC = IPC + 1 40 IF (2*IPLNC(IPC) .NE. IPLN(IP)) THEN IPC = IPC + 1 GOTO 40 ENDIF IRC = LPLNC(IPC)-1 DO 50 IR = LPLN(IP), LPLN(IP+1)-1 IF (IROW(IR)/2*2 .NE. IROW(IR)) GOTO 50 IRC = IRC + 1 60 IF (2*IROWC(IRC) .NE. IROW(IR)) THEN IRC = IRC + 1 GOTO 60 ENDIF IPTC = LROWC(IRC)-1 DO 70 IPT = LROW(IR), LROW(IR+1)-1 IF (ICOL(IPT)/2*2 .NE. ICOL(IPT)) GOTO 70 IPTC = IPTC + 1 80 IF (2*ICOLC(IPTC) .NE. ICOL(IPT)) THEN IPTC = IPTC + 1 GOTO 80 ENDIF DO 90 IC = 1, NPDE U(IPT+(IC-1)*NPTS) = UC(IPTC+(IC-1)*NPTSC) 90 CONTINUE IPDOM(IPT) = 0 70 CONTINUE 50 CONTINUE 30 CONTINUE RETURN END SUBROUTINE INJON (NPDE, UO, U, IPDOM, + LPLNO, IPLNO, LROWO, IROWO, ICOLO, + LPLN, IPLN, LROW, IROW, ICOL) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPDE, IPDOM(*), + LPLNO(0:*), IPLNO(*), LROWO(*), IROWO(*), ICOLO(*), + LPLN(0:*), IPLN(*), LROW(*), IROW(*), ICOL(*) DOUBLE PRECISION UO(0:*), U(0:*) C Ccc PURPOSE: C Inject solution from previous time at grid from same level into C solution at current time grid C Ccc PARAMETER DESCRIPTION: C NPDE : IN. # PDE components C UO : IN. Solution at previous time C U : INOUT. Solution at corresponding gridpoints injected from UO C IPDOM : INOUT. Domain flags wrt to interpolation C 0: Injected point C -1: Otherwise C LPLNO : IN. -I C IPLNO : IN. I C LROWO : IN. I Data structure of the old-time grid C IROWO : IN. I see description for current time grid below C ICOLO : IN. -I C LPLN : IN. (0:LPLN(0)+1) C LPLN(0) = NPLNS: Actual # planes in LROW C LPLN(1:NPLNS): pointers to the start of a plane in LROW C LPLN(NPLNS+1) = NROWS+1: Total # rows in grid + 1 C IPLN : IN. (NPLNS) C IPLN(IP): plane number of plane IP in virtual box C LROW : IN. (NROWS+1) C LROW(1:NROWS): pointers to the start of a row in the grid C LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 C IROW : IN. (NROWS) C IROW(IR): row number of row IR in virtual box C ICOL : IN. (NPTS) C ICOL(IPT): column number of grid point IPT in virtual box C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C CDIR$ NOVECTOR C INTEGER IC, IPO, IP, IPTO, IPT, IRO, IR, + NPLNSO, NPLNS, NPTSO, NPTS, NROWSO, NROWS C NPLNS = LPLN(0) NROWS = LPLN(NPLNS+1)-1 NPTS = LROW(NROWS+1)-1 NPLNSO = LPLNO(0) NROWSO = LPLNO(NPLNSO+1)-1 NPTSO = LROWO(NROWSO+1)-1 C Ccc Inject values from old time level into current-time solution IPO = 1 DO 10 IP = 1, NPLNS 20 IF (IPLNO(IPO) .LT. IPLN(IP)) THEN IPO = IPO + 1 IF (IPO .LE. NPLNSO) GOTO 20 RETURN ELSE IF (IPLNO(IPO) .GT. IPLN(IP)) THEN GOTO 10 ENDIF IRO = LPLNO(IPO) DO 30 IR = LPLN(IP), LPLN(IP+1)-1 40 IF (IROWO(IRO) .LT. IROW(IR)) THEN IRO = IRO + 1 IF (IRO .LE. NROWSO) GOTO 40 GOTO 10 ELSE IF (IROWO(IRO) .GT. IROW(IR)) THEN GOTO 30 ENDIF IPTO = LROWO(IRO) DO 50 IPT = LROW(IR), LROW(IR+1)-1 60 IF (ICOLO(IPTO) .LT. ICOL(IPT)) THEN IPTO = IPTO + 1 IF (IPTO .LE. LROWO(IRO+1)-1) GOTO 60 GOTO 30 ELSE IF (ICOLO(IPTO) .GT. ICOL(IPT)) THEN GOTO 50 ENDIF DO 70 IC = 1, NPDE U(IPT+(IC-1)*NPTS) = UO(IPTO+(IC-1)*NPTSO) 70 CONTINUE IPDOM(IPT) = 0 50 CONTINUE 30 CONTINUE 10 CONTINUE RETURN END SUBROUTINE PUTSOL (NPDE, U, ISTRUC, UC, ISTRCC, UI, LENUC) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPDE, ISTRUC(0:*), ISTRCC(0:*), LENUC DOUBLE PRECISION U(0:*), UC(0:*), UI(0:*) C Ccc PURPOSE: C Copy coarse grid solution UC to UI and inject fine grid solution U C Ccc PARAMETER DESCRIPTION: C NPDE : IN. # PDE components C U : IN. Solution at fine grid C ISTRUC : IN. Datastructure of the fine grid C UC : IN. Solution at coarse grid C ISTRCC : IN. Datastructure of the coarse grid C UI : OUT.Injected solution at coarse grid C LENUC : OUT.Dimension of coarse grid solution array C Ccc EXTERNALS USED: EXTERNAL INJFC, RCOPY C C----------------------------------------------------------------------- C INTEGER LLPLN, NPLNS, LIPLN, NROWS, LLROW, NPTS, LIROW, LICOL, + LLPLNC, NPLNSC, LIPLNC, NROWSC, LLROWC, NPTSC, LIROWC, LICOLC C LLPLN = 0 NPLNS = ISTRUC(LLPLN) LIPLN = LLPLN+NPLNS+2 NROWS = ISTRUC(LLPLN+NPLNS+1)-1 LLROW = LIPLN+NPLNS NPTS = ISTRUC(LLROW+NROWS)-1 LIROW = LLROW+NROWS+1 LICOL = LIROW+NROWS LLPLNC = 0 NPLNSC = ISTRCC(LLPLNC) LIPLNC = LLPLNC+NPLNSC+2 NROWSC = ISTRCC(LLPLNC+NPLNSC+1)-1 LLROWC = LIPLNC+NPLNSC NPTSC = ISTRCC(LLROWC+NROWSC)-1 LIROWC = LLROWC+NROWSC+1 LICOLC = LIROWC+NROWSC LENUC = NPTSC*NPDE + 1 C C Copy coarse grid solution to UI CALL RCOPY (LENUC, UC, UI) C C Inject fine grid solution into UI CALL INJFC (NPDE, U, UI, + ISTRUC(LLPLN), ISTRUC(LIPLN), + ISTRUC(LLROW), ISTRUC(LIROW), ISTRUC(LICOL), + ISTRCC(LLPLNC), ISTRCC(LIPLNC), + ISTRCC(LLROWC), ISTRCC(LIROWC), ISTRCC(LICOLC)) RETURN END SUBROUTINE INJFC (NPDE, U, UC, + LPLN, IPLN, LROW, IROW, ICOL, + LPLNC, IPLNC, LROWC, IROWC, ICOLC) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPDE, LPLN(0:*), IPLN(*), LROW(*), IROW(*), ICOL(*), + LPLNC(0:*), IPLNC(*), LROWC(*), IROWC(*), ICOLC(*) DOUBLE PRECISION U(0:*), UC(0:*) C Ccc PURPOSE: C Inject solution from (embedded) fine grid into coarser grid C Ccc PARAMETER DESCRIPTION: C NPDE : IN. # PDE components C U : IN. Fine grid solution C UC : INOUT. C IN: Coarse grid solution C OUT: Injected solution at coarse grid C LPLN : IN. (0:LPLN(0)+1) C LPLN(0) = NPLNS: Actual # planes in LROW C LPLN(1:NPLNS): pointers to the start of a plane in LROW C LPLN(NPLNS+1) = NROWS+1: Total # rows in grid + 1 C IPLN : IN. (NPLNS) C IPLN(IP): plane number of plane IP in virtual box C LROW : IN. (NROWS+1) C LROW(1:NROWS): pointers to the start of a row in the grid C LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 C IROW : IN. (NROWS) C IROW(IR): row number of row IR in virtual box C ICOL : IN. (NPTS) C ICOL(IPT): column number of grid point IPT in virtual box C LPLNC : IN. -I C IPLNC : IN. I C LROWC : IN. I Data structure of the coarse grid C IROWC : IN. I see description for fine grid above C ICOLC : IN. -I C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C CDIR$ NOVECTOR C INTEGER IC, IPC, IP, IPTC, IPT, IRC, IR, + NPLNSC, NPLNS, NPTSC, NPTS, NROWSC, NROWS C NPLNS = LPLN(0) NROWS = LPLN(NPLNS+1)-1 NPTS = LROW(NROWS+1)-1 NPLNSC = LPLNC(0) NROWSC = LPLNC(NPLNSC+1)-1 NPTSC = LROWC(NROWSC+1)-1 C Ccc Inject values from fine level into coarse grid solution IPC = 0 DO 10 IP = 1, NPLNS IF (IPLN(IP)/2*2 .NE. IPLN(IP)) GOTO 10 IPC = IPC + 1 20 IF (2*IPLNC(IPC) .NE. IPLN(IP)) THEN IPC = IPC + 1 GOTO 20 ENDIF IRC = LPLNC(IPC)-1 DO 30 IR = LPLN(IP), LPLN(IP+1)-1 IF (IROW(IR)/2*2 .NE. IROW(IR)) GOTO 30 IRC = IRC + 1 40 IF (2*IROWC(IRC) .NE. IROW(IR)) THEN IRC = IRC + 1 GOTO 40 ENDIF IPTC = LROWC(IRC)-1 DO 50 IPT = LROW(IR), LROW(IR+1)-1 IF (ICOL(IPT)/2*2 .NE. ICOL(IPT)) GOTO 50 IPTC = IPTC + 1 60 IF (2*ICOLC(IPTC) .NE. ICOL(IPT)) THEN IPTC = IPTC + 1 GOTO 60 ENDIF DO 70 IC = 1, NPDE UC(IPTC+(IC-1)*NPTSC) = U(IPT+(IC-1)*NPTS) 70 CONTINUE 50 CONTINUE 30 CONTINUE 10 CONTINUE C RETURN END SUBROUTINE INTPOL (NPDE, U, IPDOM, + LPLN, IPLN, LROW, IROW, ICOL, LBLWY, LABVY, LBLWZ, LABVZ, WORK) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPDE, IPDOM(*), + LPLN(0:*), IPLN(*), LROW(*), IROW(*), ICOL(*), + LBLWY(0:*), LABVY(0:*), LBLWZ(0:*), LABVZ(0:*) DOUBLE PRECISION U(0:*), WORK(*) C Ccc PURPOSE: C Interpolate where necessary solution C Ccc PARAMETER DESCRIPTION: C NPDE : IN. # PDE components C U : INOUT. C IN: Solution values at injected points C OUT: Interpolated solution values at other points C IPDOM : IN. Domain flags wrt to interpolation C 0: Injected point C -1: Otherwise C LPLN : IN. (0:LPLN(0)+1) C LPLN(0) = NPLNS: Actual # planes in LROW C LPLN(1:NPLNS): pointers to the start of a plane in LROW C LPLN(NPLNS+1) = NROWS+1: Total # rows in grid + 1 C IPLN : IN. (NPLNS) C IPLN(IP): plane number of plane IP in virtual box C LROW : IN. (NROWS+1) C LROW(1:NROWS): pointers to the start of a row in the grid C LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 C IROW : IN. (NROWS) C IROW(IR): row number of row IR in virtual box C ICOL : IN. (NPTS) C ICOL(IPT): column number of grid point IPT in virtual box C LBLWY : IN. (0:NPTS) C LBLWY(IPT): pointer to node below in Y-direction in C actual grid C 0, if index node is front-plane boundary point C LABVY : IN. (0:NPTS) C LABVY(IPT): pointer to node above in Y-direction in C actual grid C 0, if index node is back-plane boundary point C LBLWZ : IN. (0:NPTS) C LBLWZ(IPT): pointer to node below in Z-direction in C actual grid C 0, if index node is down-plane boundary point C LABVZ : IN. (0:NPTS) C LABVZ(IPT): pointer to node above in Z-direction in C actual grid C 0, if index node is up-plane boundary point C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C CDIR$ NOVECTOR C INTEGER IC, IP, IPT, IR, NPLNS, NPTS, NROWS C NPLNS = LPLN(0) NROWS = LPLN(NPLNS+1)-1 NPTS = LROW(NROWS+1)-1 C DO 10 IP = 1, NPLNS IF (IPLN(IP)/2*2 .NE. IPLN(IP)) GOTO 10 C Ccc Interpolation in coarse grid planes C C Interpolation in X-direction DO 20 IR = LPLN(IP), LPLN(IP+1)-1 IF (IROW(IR)/2*2 .NE. IROW(IR)) GOTO 20 DO 30 IPT = LROW(IR)+1, LROW(IR+1)-2 IF (IPDOM(IPT) .NE. 0) THEN DO 40 IC = 1, NPDE U(IPT+(IC-1)*NPTS) = + (U(IPT-1+(IC-1)*NPTS) + U(IPT+1+(IC-1)*NPTS))/2 40 CONTINUE ENDIF 30 CONTINUE 20 CONTINUE C C Interpolation in Y-direction DO 50 IR = LPLN(IP)+1, LPLN(IP+1)-2 IF (IROW(IR)/2*2 .EQ. IROW(IR)) GOTO 50 DO 60 IPT = LROW(IR), LROW(IR+1)-1 IF (IPDOM(IPT) .NE. 0) THEN DO 70 IC = 1, NPDE U(IPT+(IC-1)*NPTS) = + (U(LBLWY(IPT)+(IC-1)*NPTS) + + U(LABVY(IPT)+(IC-1)*NPTS))/2 70 CONTINUE ENDIF 60 CONTINUE 50 CONTINUE 10 CONTINUE DO 100 IP = 2, NPLNS-1 IF (IPLN(IP)/2*2 .EQ. IPLN(IP)) GOTO 100 C Ccc Interpolation in other then coarse grid planes C C Interpolation in Z-direction DO 110 IR = LPLN(IP), LPLN(IP+1)-1 DO 120 IPT = LROW(IR), LROW(IR+1)-1 IF (IPDOM(IPT) .NE. 0) THEN DO 130 IC = 1, NPDE U(IPT+(IC-1)*NPTS) = + (U(LBLWZ(IPT)+(IC-1)*NPTS) + + U(LABVZ(IPT)+(IC-1)*NPTS))/2 130 CONTINUE ENDIF 120 CONTINUE 110 CONTINUE 100 CONTINUE RETURN END SUBROUTINE RESID (T, X, Y, Z, NPTS, NPDE, UNP1, UN, UNM1, + DT, DTRAT, UIB, LLBND, ILBND, LBND, LBLWY, LABVY, LBLWZ, LABVZ, + DX, DY, DZ, UT, UX, UY, UZ, UXX, UYY, UZZ, UXY, UXZ, UYZ, F) C C----------------------------------------------------------------------- C C PARAMETER SPECIFICATION: INTEGER NPTS, NPDE, LLBND(0:*), ILBND(*), LBND(*), + LBLWY(0:*), LABVY(0:*), LBLWZ(0:*), LABVZ(0:*) DOUBLE PRECISION T, X(*), Y(*), Z(*), UNP1(0:*), UN(0:*), + UNM1(0:*), + DT, DTRAT, UIB(*), DX, DY, DZ, UT(*), UX(*), UY(*), UZ(*), + UXX(*), UYY(*), UZZ(*), UXY(*), UXZ(*), UYZ(*), F(*) C C PURPOSE: C Compute time and space derivatives of U and residual F(t,Un+1,Udot) C C PARAMETER DESCRIPTION: C T : IN. Current time C X,Y,Z : IN. Physical coordinates of gridpoints C NPTS : IN. # grid points C NPDE : IN. # PDE components C UNP1 : IN. Solution at Tn+1 on current grid C UN : IN. Solution at Tn on current grid C UNM1 : IN. Solution at Tn-1 on current grid C DT : IN. Current time stepsize C DTRAT : IN. 0 or DT/DT_old C UIB : IN. Solution at T on internal boundaries C LLBND : IN. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C LBLWY : IN. (0:NPTS) C LBLWY(IPT): pointer to node below in Y-direction in C actual grid C 0, if index node is front-plane boundary point C LABVY : IN. (0:NPTS) C LABVY(IPT): pointer to node above in Y-direction in C actual grid C 0, if index node is back-plane boundary point C LBLWZ : IN. (0:NPTS) C LBLWZ(IPT): pointer to node below in Z-direction in C actual grid C 0, if index node is down-plane boundary point C LABVZ : IN. (0:NPTS) C LABVZ(IPT): pointer to node above in Z-direction in C actual grid C 0, if index node is up-plane boundary point C DX : IN. Current grid width in X-direction C DY : IN. Current grid width in Y-direction C DZ : IN. Current grid width in Z-direction C UT : OUT. Time derivative of U on current grid C UX : OUT. -I C UY : OUT. I C UZ : OUT. I C UXX : OUT. I Space derivatives of U on current grid C UYY : OUT. I C UZZ : OUT. I C UXY : OUT. I C UXZ : OUT. I C UYZ : OUT. -I C F : OUT. Residual C Ccc EXTERNALS USED: EXTERNAL DERIVS, DERIVT, RES C C----------------------------------------------------------------------- C Ccc Compute derivatives CALL DERIVT (NPTS, NPDE, UNP1(1), UN(1), UNM1(1), DT, DTRAT, UT) CALL DERIVS (NPTS, NPDE, UNP1, LLBND, ILBND, LBND, + LBLWY, LABVY, LBLWZ, LABVZ, DX, DY, DZ, + UX, UY, UZ, UXX, UYY, UZZ, UXY, UXZ, UYZ) C Ccc Compute residual CALL RES (T, X, Y, Z, NPTS, NPDE, UNP1(1), LLBND, ILBND, LBND, + UIB, UT, UX, UY, UZ, UXX, UYY, UZZ, UXY, UXZ, UYZ, F) C RETURN END SUBROUTINE DERIVT (NPTS, NPDE, UNP1, UN, UNM1, DT, DTRAT, UT) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE DOUBLE PRECISION UNP1(NPTS,NPDE), UN(NPTS,NPDE), UNM1(NPTS,NPDE), + DT, DTRAT, + UT(NPTS,NPDE) C Ccc PURPOSE: C Compute time derivative. If DTRAT = 0 first order results, C if DTRAT = DT/DT_old second order. C Ccc PARAMETER DESCRIPTION: C NPTS : IN. # grid points of current grid C NPDE : IN. # PDE components C UNP1 : IN. Solution at Tn+1 on current grid C UN : IN. Solution at Tn on current grid C UNM1 : IN. Solution at Tn-1 on current grid C DT : IN. Current time stepsize C DTRAT : IN. 0 or DT/DT_old C UT : OUT. Time derivative of U on current grid C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER I, IC DOUBLE PRECISION A0, A1, A2 A0 = (1+2*DTRAT) / ((1+DTRAT)*DT) A1 = -(1+DTRAT)**2 / ((1+DTRAT)*DT) A2 = DTRAT**2 / ((1+DTRAT)*DT) DO 10 IC = 1, NPDE DO 10 I = 1, NPTS UT(I,IC) = A0*UNP1(I,IC) + A1*UN(I,IC) + A2*UNM1(I,IC) 10 CONTINUE RETURN END SUBROUTINE DERIVS (NPTS, NPDE, U, + LLBND, ILBND, LBND, LBLWY, LABVY, LBLWZ, LABVZ, + DX, DY, DZ, UX, UY, UZ, UXX, UYY, UZZ, UXY, UXZ, UYZ) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE, LLBND(0:*), ILBND(*), LBND(*), + LBLWY(0:NPTS), LABVY(0:NPTS), LBLWZ(0:NPTS), LABVZ(0:NPTS) DOUBLE PRECISION U(0:NPTS*NPDE), DX, DY, DZ, + UX(NPTS*NPDE), UY(NPTS*NPDE), UZ(NPTS*NPDE), + UXX(NPTS*NPDE), UYY(NPTS*NPDE), UZZ(NPTS*NPDE), + UXY(NPTS*NPDE), UXZ(NPTS*NPDE), UYZ(NPTS*NPDE) C Ccc PURPOSE: C Compute space derivatives with second order approximation. Second C order derivatives are required only in the interior of the domain. C Ccc PARAMETER DESCRIPTION: C NPTS : IN. # grid points of current grid C NPDE : IN. # PDE components C U : IN. Solution on current grid C LLBND : IN. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C LBLWY : IN. (0:NPTS) C LBLWY(IPT): pointer to node below in Y-direction in C actual grid C 0, if index node is front-plane boundary point C LABVY : IN. (0:NPTS) C LABVY(IPT): pointer to node above in Y-direction in C actual grid C 0, if index node is back-plane boundary point C LBLWZ : IN. (0:NPTS) C LBLWZ(IPT): pointer to node below in Z-direction in C actual grid C 0, if index node is down-plane boundary point C LABVZ : IN. (0:NPTS) C LABVZ(IPT): pointer to node above in Z-direction in C actual grid C 0, if index node is up-plane boundary point C DX : IN. Current grid width in X-direction C DY : IN. Current grid width in Y-direction C DZ : IN. Current grid width in Z-direction C UX : OUT. -I C UY : OUT. I C UZ : OUT. I C UXX : OUT. I Space derivatives of U on current grid C UYY : OUT. I C UZZ : OUT. I C UXY : OUT. I C UXZ : OUT. I C UYZ : OUT. -I C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER I, IB, IC, IPT, LB, IM1, IM2, IP1, IP2, I1, I2, I3, I4 DOUBLE PRECISION FACX, FACY, FACZ, FACXX, FACYY, FACZZ, FACXY, + FACXZ, FACYZ C Ccc Zero derivative arrays in first and last point C (will possibly not be initialized) CDIR$ NEXTSCALAR DO 10 IC = 1, NPDE IPT = 1 I = IPT + (IC-1)*NPTS UX (I) = 0.0 UY (I) = 0.0 UZ (I) = 0.0 UXX(I) = 0.0 UYY(I) = 0.0 UZZ(I) = 0.0 UXY(I) = 0.0 UXZ(I) = 0.0 UYZ(I) = 0.0 IPT = NPTS I = IPT + (IC-1)*NPTS UX (I) = 0.0 UY (I) = 0.0 UZ (I) = 0.0 UXX(I) = 0.0 UYY(I) = 0.0 UZZ(I) = 0.0 UXY(I) = 0.0 UXZ(I) = 0.0 UYZ(I) = 0.0 10 CONTINUE C Ccc Compute derivatives in interior points, boundary values will be C rubbish FACX = 1/(2*DX) FACY = 1/(2*DY) FACZ = 1/(2*DZ) FACXX = 1/DX**2 FACYY = 1/DY**2 FACZZ = 1/DZ**2 FACXY = 1/(2*DX*2*DY) FACXZ = 1/(2*DX*2*DZ) FACYZ = 1/(2*DY*2*DZ) C DO 20 I = 2, NPTS*NPDE-1 UX (I) = (U(I+1)-U(I-1))*FACX UXX(I) = (U(I+1)-2*U(I)+U(I-1))*FACXX 20 CONTINUE C DO 30 IC = 1, NPDE DO 30 IPT = 2, NPTS-1 IM1 = LBLWY(IPT) + (IC-1)*NPTS I = IPT + (IC-1)*NPTS IP1 = LABVY(IPT) + (IC-1)*NPTS UY (I) = (U(IP1)-U(IM1))*FACY UYY(I) = (U(IP1)-2*U(I)+U(IM1))*FACYY IM1 = LBLWZ(IPT) + (IC-1)*NPTS I = IPT + (IC-1)*NPTS IP1 = LABVZ(IPT) + (IC-1)*NPTS UZ (I) = (U(IP1)-U(IM1))*FACZ UZZ(I) = (U(IP1)-2*U(I)+U(IM1))*FACZZ C I1 = LABVY(IPT-1) + (IC-1)*NPTS I2 = LABVY(IPT+1) + (IC-1)*NPTS I3 = LBLWY(IPT-1) + (IC-1)*NPTS I4 = LBLWY(IPT+1) + (IC-1)*NPTS UXY(I) = (U(I2)-U(I1)-U(I4)+U(I3))*FACXY I1 = LABVZ(IPT-1) + (IC-1)*NPTS I2 = LABVZ(IPT+1) + (IC-1)*NPTS I3 = LBLWZ(IPT-1) + (IC-1)*NPTS I4 = LBLWZ(IPT+1) + (IC-1)*NPTS UXZ(I) = (U(I2)-U(I1)-U(I4)+U(I3))*FACXZ I1 = LABVZ(LBLWY(IPT)) + (IC-1)*NPTS I2 = LABVZ(LABVY(IPT)) + (IC-1)*NPTS I3 = LBLWZ(LBLWY(IPT)) + (IC-1)*NPTS I4 = LBLWZ(LABVY(IPT)) + (IC-1)*NPTS UYZ(I) = (U(I2)-U(I1)-U(I4)+U(I3))*FACYZ 30 CONTINUE C Ccc Correct physical boundaries DO 40 IB = 1, LLBND(0) IF (ILBND(IB) .EQ. 1) THEN C Left plane, correct Ux DO 50 IC = 1, NPDE DO 50 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) I = IPT + (IC-1)*NPTS UX(I) = (-3*U(I)+4*U(I+1)-U(I+2))*FACX 50 CONTINUE ELSE IF (ILBND(IB) .EQ. 2) THEN C Down plane, correct Uz DO 60 IC = 1, NPDE DO 60 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) I = IPT + (IC-1)*NPTS IP1 = LABVZ(IPT) IP2 = LABVZ(IP1) + (IC-1)*NPTS IP1 = IP1 + (IC-1)*NPTS UZ(I) = (-3*U(I)+4*U(IP1)-U(IP2))*FACZ 60 CONTINUE ELSE IF (ILBND(IB) .EQ. 3) THEN C Right plane, correct Ux DO 70 IC = 1, NPDE DO 70 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) I = IPT + (IC-1)*NPTS UX(I) = (+3*U(I)-4*U(I-1)+U(I-2))*FACX 70 CONTINUE ELSE IF (ILBND(IB) .EQ. 4) THEN C Up plane, correct Uz DO 80 IC = 1, NPDE DO 80 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) I = IPT + (IC-1)*NPTS IM1 = LBLWZ(IPT) IM2 = LBLWZ(IM1) + (IC-1)*NPTS IM1 = IM1 + (IC-1)*NPTS UZ(I) = (+3*U(I)-4*U(IM1)+U(IM2))*FACZ 80 CONTINUE ELSE IF (ILBND(IB) .EQ. 5) THEN C Front plane, correct Uy DO 90 IC = 1, NPDE DO 90 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) I = IPT + (IC-1)*NPTS IP1 = LABVY(IPT) IP2 = LABVY(IP1) + (IC-1)*NPTS IP1 = IP1 + (IC-1)*NPTS UY(I) = (-3*U(I)+4*U(IP1)-U(IP2))*FACY 90 CONTINUE ELSE IF (ILBND(IB) .EQ. 6) THEN C Back boundary, correct Uy DO 100 IC = 1, NPDE DO 100 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) I = IPT + (IC-1)*NPTS IM1 = LBLWY(IPT) IM2 = LBLWY(IM1) + (IC-1)*NPTS IM1 = IM1 + (IC-1)*NPTS UY(I) = (+3*U(I)-4*U(IM1)+U(IM2))*FACY 100 CONTINUE ENDIF 40 CONTINUE C RETURN END SUBROUTINE RES (T, X, Y, Z, NPTS, NPDE, U, + LLBND, ILBND, LBND, UIB, + UT, UX, UY, UZ, UXX, UYY, UZZ, UXY, UXZ, UYZ, F) C C----------------------------------------------------------------------- C C PARAMETER SPECIFICATION: INTEGER NPTS, NPDE, LLBND(0:*), ILBND(*), LBND(*) DOUBLE PRECISION T, X(*), Y(*), Z(*), U(NPTS*NPDE), UIB(*), + UT(*), UX(*), UY(*), UZ(*), + UXX(*), UYY(*), UZZ(*), UXY(*), UXZ(*), UYZ(*), F(NPTS*NPDE) C Ccc PURPOSE: C Compute residual F(t,U,Ut) C C PARAMETER DESCRIPTION: C T : IN. Current time C X,Y,Z : IN. Physical coordinates of gridpoints C NPTS : IN. # grid points C NPDE : IN. # PDE components C U : IN. Solution at T on current grid C LLBND : IN. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C UIB : IN. Solution at T on internal boundaries C UT : IN. Time derivative of U on current grid C UX : IN. -I C UY : IN. I C UZ : IN. I C UXX : IN. I C UYY : IN. I Space derivatives of U on current grid C UZZ : IN. I C UXY : IN. I C UXZ : IN. I C UYZ : IN. -I C F : OUT. Residual C Ccc EXTERNALS USED: EXTERNAL PDEBC, PDEF C C----------------------------------------------------------------------- C INTEGER I, IB, IC, LB, NBNDS, NIBPTS, IBS, IBE C Ccc Get residual on internal domain CALL PDEF (T, X, Y, Z, U, + UT, UX, UY, UZ, UXX, UYY, UZZ, UXY, UXZ, UYZ, F, NPTS, NPDE) C Ccc Correct residual on physical boundaries CALL PDEBC (T, X, Y, Z, U, UT, UX, UY, UZ, F, NPTS, NPDE, + LLBND, ILBND, LBND) C Ccc Correct residual on internal boundaries NBNDS = LLBND(0) IBS = LLBND(NBNDS+1) IBE = LLBND(NBNDS+2)-1 NIBPTS = IBE-IBS+1 DO 10 IC = 1, NPDE DO 10 LB = IBS, IBE I = LBND(LB) + (IC-1)*NPTS IB = LB-IBS+1 + (IC-1)*NIBPTS F(I) = U(I) - UIB(IB) 10 CONTINUE RETURN END LOGICAL FUNCTION CHKTIM (RWK, LU, LUO, NPDE, IWK, LSG, + TIMWGT, RELTOL, ABSTOL, WORK, DT, DTNEW, TIMON) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER LU, LUO, NPDE, IWK(*), LSG(0:*) DOUBLE PRECISION RWK(*), TIMWGT(NPDE), RELTOL(NPDE), ABSTOL(NPDE), + WORK(*), DT, DTNEW, TIMON C Ccc PURPOSE: C Check if time step was OK. If so, CHKTIM = .TRUE. and DTNEW is set C to the stepsize for the next time step. If not CHKTIM = .FALSE. and C DTNEW is the stepsize for the next try. C Ccc PARAMETER DESCRIPTION: C RWK : IN. Work array containing both U and U_old on all grids of C this time level C LU : IN. Pointer after last element of U on base grid C LUO : IN. Pointer to first element of U_old on base grid C NPDE : IN. Number of PDE components C IWK : IN. Work array containing the datastructures for the C different grids on this level C LSG : IN. (0:LSG(0)) C LSG(0): # grid levels for this time step C LSG(I): pointer in IWK to datastructure for grid of level I C TIMWGT : IN. User defined time weight for each PDE component C used in check if time stepsize can be accepted C RELTOL : IN. (NPDE) C Relative time tolerance used to determine if time stepsize C can be accepted and to determine the new step size C ABSTOL : IN. (NPDE) C Absolute time tolerance used to determine if time stepsize C can be accepted and to determine the new step size C WORK : WORK. (max. # grid points on a level) C DT : IN. Current time stepsize C DTNEW : OUT. Stepsize for, new or retry of, timestep C Ccc EXTERNALS USED: DOUBLE PRECISION TIMMON EXTERNAL TIMMON C C----------------------------------------------------------------------- C INTEGER LEVEL, LLPLN, NPLNS, LIPLN, LLROW, NROWS, NPTS, LIROW, + LICOL, LLLBND, NBNDS, NBDPTS, NBIPTS, LILBND, LLBNDP, LENU DOUBLE PRECISION TIMONL C TIMON = 0.0 DO 10 LEVEL = 1, LSG(0) LLPLN = LSG(LEVEL) NPLNS = IWK(LLPLN) LIPLN = LLPLN+NPLNS+2 LLROW = LIPLN+NPLNS NROWS = IWK(LLPLN+NPLNS+1)-1 NPTS = IWK(LLROW+NROWS)-1 LIROW = LLROW+NROWS+1 LICOL = LIROW+NROWS LLLBND = LICOL+NPTS NBNDS = IWK(LLLBND) NBDPTS = IWK(LLLBND+NBNDS+1)-1 NBIPTS = IWK(LLLBND+NBNDS+2)-1 LILBND = LLLBND+NBNDS+3 LLBNDP = LILBND+NBNDS LENU = NPTS*NPDE+1 LU = LU - LENU C Compute time monitor for this grid level TIMONL = TIMMON (RWK(LU+1), RWK(LUO+1), NPTS, NPDE, + IWK(LLBNDP), NBIPTS, TIMWGT, RELTOL, ABSTOL, WORK) LUO = LUO + LENU*2 C Compute maximum of monitor values for all levels TIMON = MAX(TIMON,TIMONL) 10 CONTINUE C Ccc Compute new stepsize and check if current step can be accepted C Compute new stepsize such that prediction of next time monitor is 0.5 IF (TIMON .GT. 1.0) THEN C Reject step CHKTIM = .FALSE. DTNEW = 0.5 / TIMON * DT C restrict time step variance DTNEW = MAX(DTNEW, DT/4) ELSE C Accept step CHKTIM = .TRUE. C restrict time step variance DTNEW = 2*DT IF (TIMON .GT. 0.25) DTNEW = 0.5 / TIMON * DT ENDIF RETURN END DOUBLE PRECISION FUNCTION TIMMON (U, UO, NPTS, NPDE, LBND, NBIPTS, + TIMWGT, + RELTOL, ABSTOL, DTUT) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NBIPTS INTEGER NPTS, NPDE, LBND(NBIPTS) DOUBLE PRECISION U(NPTS,NPDE), UO(NPTS,NPDE), TIMWGT(NPDE), + RELTOL(NPDE), ABSTOL(NPDE), DTUT(NPTS) C Ccc PURPOSE: C Compute time monitor for a specific grid level. C C Time monitor: C TIMMON = C sqrt{ sum TIMWGT(ic)/N sum [dt.Ut(ipt,ic) / w(ipt,ic)] ** 2 } C (ic=1,NPDE) (ipt=1,NPTS) C with N = NPTS*NPDE and w(ipt,ic) = ABSTOL(ic) + RELTOL(ic).|U(ipt,ic)| C On the boundaries Ut is set to zero. C Ccc PARAMETER DESCRIPTION: C U : IN. Array of solution values at Tn+1 on current grid C UO : IN. Array of solution values at Tn on current grid C NPTS : IN. # grid points C NPDE : IN. # PDE components C LBND : IN. Array containing pointers to boundary points in the grid C NBIPTS : IN. Total # boundary points C TIMWGT : IN. User defined time weight for each PDE component C used in check if time stepsize can be accepted C RELTOL : IN. (NPDE) C Relative time tolerance used to determine if time stepsize C can be accepted and to determine the new step size C ABSTOL : IN. (NPDE) C Absolute time tolerance used to determine if time stepsize C can be accepted and to determine the new step size C DTUT : WORK. (NPTS) C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER IC, IPT, LB, N DOUBLE PRECISION TMIC, W2 C N = NPTS*NPDE C TIMMON = 0.0 DO 10 IC = 1, NPDE IF (TIMWGT(IC) .EQ. 0.0) GOTO 10 DO 20 IPT = 1, NPTS DTUT(IPT) = U(IPT,IC)-UO(IPT,IC) 20 CONTINUE DO 30 LB = 1, NBIPTS IPT = LBND(LB) DTUT(IPT) = 0.0 30 CONTINUE TMIC = 0.0 DO 40 IPT = 1, NPTS W2 = ABSTOL(IC) + RELTOL(IC)*ABS(U(IPT,IC)) TMIC = TMIC + (DTUT(IPT) / W2) ** 2 40 CONTINUE TIMMON = TIMMON + TIMWGT(IC)*TMIC/N 10 CONTINUE TIMMON = SQRT(TIMMON) RETURN END SUBROUTINE INTGRB (ISTRUC, X, Y, Z, NPDE, UIB, UNP1, UN, UNM1, + RELTOL, ABSTOL, TN, DT, DTRAT, DX, DY, DZ, WT, F, CORR, RWORK, + IERR) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER ISTRUC(0:*), NPDE, IERR DOUBLE PRECISION X(*), Y(*), Z(*), UIB(*), UNP1(0:*), UN(0:*), + UNM1(0:*), + RELTOL(NPDE), ABSTOL(NPDE), + TN, DT, DTRAT, DX, DY, DZ, + WT(*), F(*), CORR(*), RWORK(*) C Ccc PURPOSE: C Integration in time with BDF2 (first timestep BE). C Solve nonlinear system F(Tn+1, Un+1, Udot) = 0 with modified Newton. C Solve linear systems with ILU-preconditioned BiCGStab. C Ccc PARAMETER DESCRIPTION: C ISTRUC : IN. Data structure Un+1 grid. C X,Y,Z : IN. Physical coordinates grid. C NPDE : IN. # PDE components C UIB : IN. Dirichlet boundary values on internal boundary. C UNP1 : INOUT. On entry: Initial solution, on exit final solution C Newton converged C UN : IN. Solution at Tn on Un+1 grid C UNM1 : IN. Solution at Tn-1 on Un+1 grid C RELTOL : IN. Relative tolerance for Newton process C ABSTOL : IN. Absolute tolerance for Newton process C TN : IN. Previous time C DT : IN. Current time step C DX : IN. Current grid spacing in X-direction C DY : IN. Current grid spacing in Y-direction C DZ : IN. Current grid spacing in Z-direction C DTRAT : IN. If BE: 0, if BDF2: DT/DT_old C WT : WORK. (NPTS*NPDE) C Weight function for norm computation C F : WORK. (NPTS*NPDE) C Residual C CORR : WORK. (NPTS*NPDE) C Correction in Newton iteration C RWORK : WORK. (JACILU+max(RESWRK,LSSWRK)) C JACILU: 2.19.NPDE.LENU C RESWRK: LENU.10 C LSSWRK: LENU.5 C LENU : NPTS*NPDE C IERR : OUT. C 0: OK. C 10: Newton process did not converge C C Ccc EXTERNALS USED: DOUBLE PRECISION MAXNRM, WDNRM2 EXTERNAL ERRWGT, BICGST, JAC, JACPB, MAXNRM, RESID, WDNRM2 C C Ccc INCLUDE 'PARNEWTON' C C PARNEWTON C C Parameters for Newton process C MAXNIT : Max. number of Newton iterations C MAXJAC : Max. number of Jacobian / preconditioner evaluations during C a Newton process C TOLNEW : Tolerance for Newton process: C rho/(1-rho)*|| corr.||_w < TOLNEW INTEGER MAXNIT, MAXJAC DOUBLE PRECISION TOLNEW PARAMETER (MAXNIT = 10, MAXJAC = 2, TOLNEW = 1.0) C C end INCLUDE 'PARNEWTON' C C Ccc INCLUDE 'PARBICGSTAB' C C PARBICGSTAB C C Parameters for linear system solver BiCGStab C MAXLIT : Max. number of BiCGStab iterations C TOLLSB : Tolerance for linear system solver INTEGER MAXLIT DOUBLE PRECISION TOLLSB PARAMETER (MAXLIT = 100, TOLLSB = TOLNEW/10) C C end INCLUDE 'PARBICGSTAB' C C Ccc INCLUDE 'CMNCMMACH' C C CMNCMMACH C C COMMON with `machine numbers' C LUNOUT : Logical unit # standard output -I C LUNERR : Logical unit # standard error I Set in the routine C UROUND : Smallest machine number such that I MACNUM C 1.0+UROUND > 1.0 and 1.0-UROUND < 1.0 I C XMIN : Smallest floating-point number -I INTEGER LUNOUT, LUNERR DOUBLE PRECISION UROUND, XMIN COMMON /IMACH/ LUNOUT, LUNERR COMMON /RMACH/ UROUND, XMIN SAVE /IMACH/, /RMACH/ C C end INCLUDE 'CMNCMMACH' C C Ccc INCLUDE 'CMNSTATS' C C CMNSTATS C C COMMON with integration statistics INTEGER MXCLEV, MXCNIT PARAMETER (MXCLEV = 10, MXCNIT = 20) INTEGER LUNPDS, LUNNLS, LUNLSS, LEVEL, NSTEPS, NREJS, + NJACS(MXCLEV), NRESID(MXCLEV), NNIT(MXCLEV), + NLSIT(MXCLEV,MXCNIT) COMMON /STATS/ LUNPDS, LUNNLS, LUNLSS, LEVEL, NSTEPS, NREJS, + NJACS, NRESID, NNIT, NLSIT SAVE /STATS/ C C end INCLUDE 'CMNSTATS' C C C----------------------------------------------------------------------- C INTEGER LLPLN, NPLNS, LIPLN, LLROW, NROWS, NPTS, LIROW, LICOL, + LLLBND, NBNDS, NBDPTS, NBIPTS, LILBND, LLBNDP, + LLBLWY, LLABVY, LLBLWZ, LLABVZ, + LLLDG, LLUDG, LLSLP, LLLSL, LLSUP, LLLSU, LENU, LENGLU, + LUT, LUX, LUY, LUZ, LUXX, LUYY, LUZZ, LUXY, LUXZ, LUYZ, + LBCG1, LBCG2, LBCG3, LBCG4, LBCG5, LG, LGLU, LJACWK, + NJAC, NRES, I, NIT, ITER LOGICAL NEWJAC DOUBLE PRECISION ERR, CORNRM, OLDNRM, RATE, TOL, UNRM C IERR = 0 C IF (LUNNLS .NE. 0) THEN WRITE(LUNNLS,'(''Nonlinear system solver at T ='',E16.7)') + TN+DT ENDIF C LLPLN = 0 NPLNS = ISTRUC(LLPLN) LIPLN = LLPLN+NPLNS+2 LLROW = LIPLN+NPLNS NROWS = ISTRUC(LLPLN+NPLNS+1)-1 NPTS = ISTRUC(LLROW+NROWS)-1 LIROW = LLROW+NROWS+1 LICOL = LIROW+NROWS LLLBND = LICOL+NPTS NBNDS = ISTRUC(LLLBND) NBDPTS = ISTRUC(LLLBND+NBNDS+1)-1 NBIPTS = ISTRUC(LLLBND+NBNDS+2)-1 LILBND = LLLBND+NBNDS+3 LLBNDP = LILBND+NBNDS LLBLWY = LLBNDP+NBIPTS LLABVY = LLBLWY+NPTS+1 LLBLWZ = LLABVY+NPTS+1 LLABVZ = LLBLWZ+NPTS+1 C LLLDG = LLABVZ+NPTS+1 LLUDG = LLLDG+NPTS*8 LLSLP = LLUDG+NPTS*8 LLLSL = LLSLP+NPTS LLSUP = LLLSL+ISTRUC(LLLSL)+1 LLLSU = LLSUP+NPTS C LENU = NPTS*NPDE LENGLU = LENU*NPDE*19 C LUT = 1 LUX = LUT + LENU LUY = LUX + LENU LUZ = LUY + LENU LUXX = LUZ + LENU LUYY = LUXX + LENU LUZZ = LUYY + LENU LUXY = LUZZ + LENU LUXZ = LUXY + LENU LUYZ = LUXZ + LENU C LBCG1 = LUX LBCG2 = LBCG1 + LENU LBCG3 = LBCG2 + LENU LBCG4 = LBCG3 + LENU LBCG5 = LBCG4 + LENU C LG = MAX (LUYZ+LENU, LBCG5+LENU) LGLU = LG+LENGLU LJACWK = LGLU C Ccc Set error weights for use in Newton process CALL ERRWGT (NPTS, NPDE, UNP1(1), RELTOL, ABSTOL, WT) C Ccc Compute weighted norm of initial solution for convergence check UNRM = WDNRM2 (LENU, UNP1(1), WT) C Ccc Compute derivatives and residual CALL RESID (TN+DT, X, Y, Z, NPTS, NPDE, UNP1, UN, UNM1, DT, DTRAT, + UIB, ISTRUC(LLLBND), ISTRUC(LILBND), ISTRUC(LLBNDP), + ISTRUC(LLBLWY), ISTRUC(LLABVY), ISTRUC(LLBLWZ), ISTRUC(LLABVZ), + DX, DY, DZ, + RWORK(LUT), RWORK(LUX), RWORK(LUY), RWORK(LUZ), + RWORK(LUXX), RWORK(LUYY), RWORK(LUZZ), + RWORK(LUXY), RWORK(LUXZ), RWORK(LUYZ), F) NRES = 1 IF (LUNNLS .NE. 0) THEN WRITE(LUNNLS,'('' Max. and WRMS norm residual='',2E16.7)') + MAXNRM(LENU, F), WDNRM2 (LENU, F, WT) ENDIF C Ccc Compute Jacobian G = dF/dU and its incomplete factorization GLU CALL JAC (NPTS, NPDE, F, TN+DT, X, Y, Z, DT, DTRAT, DX, DY, DZ, + UNP1(1), ISTRUC(LLLBND), ISTRUC(LILBND), ISTRUC(LLBNDP), UIB, + RWORK(LUT), RWORK(LUX), RWORK(LUY), RWORK(LUZ), + RWORK(LUXX), RWORK(LUYY), RWORK(LUZZ), + RWORK(LUXY), RWORK(LUXZ), RWORK(LUYZ), + ABSTOL, RWORK(LJACWK), RWORK(LG)) C Copy Jacobian for factorization CALL RCOPY (LENGLU, RWORK(LG), RWORK(LGLU)) C Compute ILU CALL JACPB (NPTS, NPDE, RWORK(LGLU), ISTRUC(LLLDG), + ISTRUC(LLLBND), ISTRUC(LILBND), ISTRUC(LLBNDP), + ISTRUC(LLSLP), ISTRUC(LLLSL)) NEWJAC = .TRUE. NJAC = 1 C Ccc Newton iteration loop 9 CONTINUE DO 10 NIT = 1, MAXNIT C Cccccc Solve G.corr = F. Store the residual in F. TOL = TOLLSB / (2**NIT) CALL BICGST (NPTS, NPDE, RWORK(LG), CORR, F, WT, TOL, + MAXLIT, RWORK(LGLU), ISTRUC(LLLDG), ISTRUC(LLUDG), + ISTRUC(LLSLP), ISTRUC(LLLSL), ISTRUC(LLSUP), ISTRUC(LLLSU), + LUNLSS, RWORK(LBCG1), RWORK(LBCG2), RWORK(LBCG3), + RWORK(LBCG4), RWORK(LBCG5), ITER, ERR, IERR) NLSIT(LEVEL,NIT) = NLSIT(LEVEL,NIT)+ ITER IF (IERR .NE. 0) GOTO 100 C Cccccc Test for convergence CORNRM = WDNRM2 (LENU, CORR, WT) IF (LUNNLS .NE. 0) THEN WRITE(LUNNLS,'('' NI:'',I3,'', NLI:'',I4,'', ERLI'':,E16.7, + '', ERNI:'',E16.7)') NIT, ITER, ERR, CORNRM ENDIF IF (CORNRM .LE. 100*UROUND*UNRM) GOTO 900 IF (.NOT. NEWJAC) THEN RATE = SQRT(CORNRM/OLDNRM) IF (RATE .GT. 0.9) THEN C Divergence GOTO 100 ELSE IF (RATE/(1-RATE)*CORNRM .LE. TOLNEW) THEN C Convergence GOTO 900 ENDIF ENDIF OLDNRM = CORNRM C Ccccc Update solution DO 20 I = 1, LENU UNP1(I) = UNP1(I) - CORR(I) 20 CONTINUE C Ccc Compute derivatives and residual and start next iteration CALL RESID (TN+DT, X, Y, Z, NPTS, NPDE, UNP1, UN, UNM1, + DT, DTRAT, UIB, + ISTRUC(LLLBND), ISTRUC(LILBND), ISTRUC(LLBNDP), + ISTRUC(LLBLWY), ISTRUC(LLABVY), + ISTRUC(LLBLWZ), ISTRUC(LLABVZ), + DX, DY, DZ, + RWORK(LUT), RWORK(LUX), RWORK(LUY), RWORK(LUZ), + RWORK(LUXX), RWORK(LUYY), RWORK(LUZZ), + RWORK(LUXY), RWORK(LUXZ), RWORK(LUYZ), F) NRES = NRES+1 NEWJAC = .FALSE. IF (LUNNLS .NE. 0) THEN WRITE(LUNNLS,'('' Max. and WRMS norm residual='',2E16.7)') + MAXNRM(LENU, F), WDNRM2 (LENU, F, WT) ENDIF 10 CONTINUE Ccc End Newton iteration loop C Ccc No convergence in max. # iterations C Ccccc Check if Jacobian is recent 100 CONTINUE IF (.NOT. NEWJAC .AND. NJAC .LT. MAXJAC) THEN IF (LUNNLS .NE. 0) THEN WRITE(LUNNLS,'('' New Jacobian, NIT='',I4)') NIT ENDIF C Compute new Jacobian and retry CALL DERIVS (NPTS, NPDE, UNP1, + ISTRUC(LLLBND), ISTRUC(LILBND), ISTRUC(LLBNDP), + ISTRUC(LLBLWY), ISTRUC(LLABVY), + ISTRUC(LLBLWZ), ISTRUC(LLABVZ), + DX, DY, DZ, + RWORK(LUX), RWORK(LUY), RWORK(LUZ), + RWORK(LUXX), RWORK(LUYY), RWORK(LUZZ), + RWORK(LUXY), RWORK(LUXZ), RWORK(LUYZ)) CALL JAC (NPTS, NPDE, F, TN+DT, X, Y, Z, DT, DTRAT, + DX, DY, DZ, UNP1(1), + ISTRUC(LLLBND),ISTRUC(LILBND),ISTRUC(LLBNDP), UIB, + RWORK(LUT), RWORK(LUX), RWORK(LUY), RWORK(LUZ), + RWORK(LUXX), RWORK(LUYY), RWORK(LUZZ), + RWORK(LUXY), RWORK(LUXZ), RWORK(LUYZ), + ABSTOL, RWORK(LJACWK), RWORK(LG)) C Copy Jacobian for factorization CALL RCOPY (LENGLU, RWORK(LG), RWORK(LGLU)) C Compute ILU CALL JACPB (NPTS, NPDE, RWORK(LGLU), ISTRUC(LLLDG), + ISTRUC(LLLBND), ISTRUC(LILBND), ISTRUC(LLBNDP), + ISTRUC(LLSLP), ISTRUC(LLLSL)) C NEWJAC = .TRUE. NJAC = NJAC + 1 GOTO 9 ELSE C Newton failure IERR = 10 NNIT(LEVEL) = NNIT(LEVEL)+NIT NRESID(LEVEL) = NRESID(LEVEL)+NRES NJACS(LEVEL) = NJACS(LEVEL)+NJAC IF (LUNNLS .NE. 0) THEN WRITE(LUNNLS,'(''Newton failure, NIT='',I4)') NIT ENDIF RETURN ENDIF C Ccc Nonlinear proces has been solved 900 CONTINUE C Update solution DO 30 I = 1, LENU UNP1(I) = UNP1(I) - CORR(I) 30 CONTINUE C NNIT(LEVEL) = NNIT(LEVEL)+NIT NRESID(LEVEL) = NRESID(LEVEL)+NRES NJACS(LEVEL) = NJACS(LEVEL)+NJAC C RETURN END SUBROUTINE JAC (NPTS, NPDE, F, T, X, Y, Z, DT, DTRAT, + DX, DY, DZ, U, LLBND, ILBND, LBND, UIB, + UT, UX, UY, UZ, UXX, UYY, UZZ, UXY, UXZ, UYZ, ABSTOL, WORK, G) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE, LLBND(0:*), ILBND(*), LBND(*) DOUBLE PRECISION F(*), T, X(*), Y(*), Z(*), DT, DTRAT, DX, DY, DZ, + U(*), UIB(*), UT(*), UX(*), UY(*), UZ(*), + UXX(*), UYY(*), UZZ(*), UXY(*), UXZ(*), UYZ(*), + ABSTOL(*), WORK(*), G(*) C Ccc PURPOSE: C Compute Jacobian G = dF/dU and store in block 19-diagonal mode. C C PARAMETER DESCRIPTION: C NPTS : IN. # grid points C NPDE : IN. # PDE components C F : IN. Residual F(t,U,Ut) C T : IN. Current time C X,Y,Z : IN. Physical coordinates of gridpoints C DT : IN. Current time stepsize C DTRAT : IN. 0 or DT/DT_old C DX : IN. Current grid width in X-direction C DY : IN. Current grid width in Y-direction C DZ : IN. Current grid width in Z-direction C U : IN. Solution at T on current grid C LLBND : IN. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C UIB : IN. Solution at T on internal boundaries C UT : OUT. Time derivative of U on current grid C UX : OUT. -I C UY : OUT. I C UZ : OUT. I C UXX : OUT. I Space derivatives of U on current grid C UYY : OUT. I C UZZ : OUT. I C UXY : OUT. I C UXZ : OUT. I C UYZ : OUT. - C ABSTOL : IN. Absolute tolerance for Newton process C WORK : WORK. (10*LENFU+2*LENU+NPTS) C G : OUT. Jacobian stored in block 19-diagonal mode C Ccc EXTERNALS USED: EXTERNAL DERIVF, JACG C C----------------------------------------------------------------------- C INTEGER LENU, LENFU, LFU, LFUX, LFUY, LFUZ, LFUXX, LFUYY, LFUZZ, + LFUXY, LFUXZ, LFUYZ, LDEL, LRWK DOUBLE PRECISION A0 C LENU = NPTS*NPDE LENFU = LENU*NPDE C LFU = 1 LFUX = LFU + LENFU LFUY = LFUX + LENFU LFUZ = LFUY + LENFU LFUXX = LFUZ + LENFU LFUYY = LFUXX + LENFU LFUZZ = LFUYY + LENFU LFUXY = LFUZZ + LENFU LFUXZ = LFUXY + LENFU LFUYZ = LFUXZ + LENFU LDEL = LFUYZ + LENFU LRWK = LDEL + NPTS C Ccc Compute dF/dU, dF/dUx, dF/dUy, dF/dUz, dF/dUxx, dF/dUyy, dF/dUzz, C dF/dUxy, dF/dUxz, dF/dUyz A0 = (1+2*DTRAT) / ((1+DTRAT)*DT) CALL DERIVF (F, T, X, Y, Z, NPTS, NPDE, U, A0, DT, DX, DY, DZ, + LLBND, ILBND, LBND, UIB, UT, UX, UY, UZ, UXX, UYY, UZZ, + UXY, UXZ, UYZ, ABSTOL, WORK(LDEL), WORK(LRWK), + WORK(LFU), WORK(LFUX), WORK(LFUY), WORK(LFUZ), + WORK(LFUXX), WORK(LFUYY), WORK(LFUZZ), + WORK(LFUXY), WORK(LFUXZ), WORK(LFUYZ)) C Ccc Compute G = dF/dU + dF/dUx.dUx/dU + ... CALL JACG (NPTS, NPDE, DX, DY, DZ, LLBND, ILBND, LBND, + WORK(LFU), WORK(LFUX), WORK(LFUY), WORK(LFUZ), + WORK(LFUXX), WORK(LFUYY), WORK(LFUZZ), + WORK(LFUXY), WORK(LFUXZ), WORK(LFUYZ), G) C RETURN END SUBROUTINE PRTRBU (ICPTB, NPTS, NPDE, U, A0, DT, UT, TOL, DEL, + UBAR, UTBAR) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER ICPTB, NPTS, NPDE DOUBLE PRECISION U(NPTS,NPDE), A0, DT, UT(NPTS,NPDE), TOL, + DEL(NPTS), + UBAR(NPTS,NPDE), UTBAR(NPTS,NPDE) C Ccc PURPOSE: C Perturb the ICPTB-th component of U. Return perturbance in DEL and C perturbed U in UBAR. C Ccc PARAMETER DESCRIPTION: C ICPTB : IN. Component of U to be perturbed C NPTS : IN. # gridpoints C NPDE : IN. # PDE components C U : IN. Solution or derivative of solution to be perturbed C TOL : IN. Threshold for perturbation C DEL : OUT. Perturbation values C UBAR : OUT. Perturbed values of U C Ccc EXTERNALS USED: EXTERNAL RCOPY C C Ccc INCLUDE 'CMNCMMACH' C C CMNCMMACH C C COMMON with `machine numbers' C LUNOUT : Logical unit # standard output -I C LUNERR : Logical unit # standard error I Set in the routine C UROUND : Smallest machine number such that I MACNUM C 1.0+UROUND > 1.0 and 1.0-UROUND < 1.0 I C XMIN : Smallest floating-point number -I INTEGER LUNOUT, LUNERR DOUBLE PRECISION UROUND, XMIN COMMON /IMACH/ LUNOUT, LUNERR COMMON /RMACH/ UROUND, XMIN SAVE /IMACH/, /RMACH/ C C end INCLUDE 'CMNCMMACH' C C C----------------------------------------------------------------------- C INTEGER IPT DOUBLE PRECISION DELI, EPS CALL RCOPY (NPTS*NPDE, U, UBAR) CALL RCOPY (NPTS*NPDE, UT, UTBAR) EPS = SQRT(UROUND) DO 10 IPT = 1, NPTS C Compute perturbance, if U=0, U(T+dt)=dtUt, if both are zero take C threshold DELI = EPS*MAX(ABS(U(IPT,ICPTB)),ABS(DT*UT(IPT,ICPTB)),TOL) DELI = SIGN(DELI,DT*UT(IPT,ICPTB)) C To ensure that the perturbance is the same machine number as the C denominator DEL(IPT) = (U(IPT,ICPTB)+DELI)-U(IPT,ICPTB) UBAR(IPT,ICPTB) = U(IPT,ICPTB) + DEL(IPT) UTBAR(IPT,ICPTB) = UT(IPT,ICPTB) + A0*DEL(IPT) 10 CONTINUE RETURN END SUBROUTINE PERTRB (ICPTB, NPTS, NPDE, U, TOL, DEL, UBAR) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER ICPTB, NPTS, NPDE DOUBLE PRECISION U(NPTS,NPDE), TOL, DEL(NPTS), UBAR(NPTS,NPDE) C Ccc PURPOSE: C Perturb the ICPTB-th component of U. Return perturbance in DEL and C perturbed U in UBAR. C Ccc PARAMETER DESCRIPTION: C ICPTB : IN. Component of U to be perturbed C NPTS : IN. # gridpoints C NPDE : IN. # PDE components C U : IN. Solution or derivative of solution to be perturbed C TOL : IN. Threshold for perturbation C DEL : OUT. Perturbation values C UBAR : OUT. Perturbed values of U C Ccc EXTERNALS USED: EXTERNAL RCOPY C C Ccc INCLUDE 'CMNCMMACH' C C CMNCMMACH C C COMMON with `machine numbers' C LUNOUT : Logical unit # standard output -I C LUNERR : Logical unit # standard error I Set in the routine C UROUND : Smallest machine number such that I MACNUM C 1.0+UROUND > 1.0 and 1.0-UROUND < 1.0 I C XMIN : Smallest floating-point number -I INTEGER LUNOUT, LUNERR DOUBLE PRECISION UROUND, XMIN COMMON /IMACH/ LUNOUT, LUNERR COMMON /RMACH/ UROUND, XMIN SAVE /IMACH/, /RMACH/ C C end INCLUDE 'CMNCMMACH' C C C----------------------------------------------------------------------- C INTEGER IPT DOUBLE PRECISION DELI, EPS CALL RCOPY (NPTS*NPDE, U, UBAR) EPS = SQRT(UROUND) DO 10 IPT = 1, NPTS C Compute perturbance DELI = EPS*MAX(ABS(U(IPT,ICPTB)),TOL) C To ensure that UBAR has the same sign as U DELI = SIGN(DELI,U(IPT,ICPTB)) C To ensure that the perturbance is the same machine number as the C denominator DEL(IPT) = (U(IPT,ICPTB)+DELI)-U(IPT,ICPTB) UBAR(IPT,ICPTB) = U(IPT,ICPTB) + DEL(IPT) 10 CONTINUE RETURN END SUBROUTINE JACG (NPTS, NPDE, DX, DY, DZ, LLBND, ILBND, LBND, + FU, FUX, FUY, FUZ, FUXX, FUYY, FUZZ, FUXY, FUXZ, FUYZ, G) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE, LLBND(0:*), ILBND(*), LBND(*) DOUBLE PRECISION DX, DY, DZ, + FU(NPTS*NPDE,NPDE), + FUX(NPTS*NPDE,NPDE), FUY(NPTS*NPDE,NPDE), FUZ(NPTS*NPDE,NPDE), + FUXX(NPTS*NPDE,NPDE),FUYY(NPTS*NPDE,NPDE),FUZZ(NPTS*NPDE,NPDE), + FUXY(NPTS*NPDE,NPDE),FUXZ(NPTS*NPDE,NPDE),FUYZ(NPTS*NPDE,NPDE), + G(NPTS*NPDE,NPDE,-9:9) C Ccc PURPOSE: C Compute Jacobian G = dF/dU using derivatives of residual wrt C (derivatives of) U C C PARAMETER DESCRIPTION: C NPTS : IN. # grid points C NPDE : IN. # PDE components C DX : IN. Current grid width in X-direction C DY : IN. Current grid width in Y-direction C DZ : IN. Current grid width in Z-direction C LLBND : IN. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C FU : IN. Derivative residual F(.,U,Ut,.) wrt U C FUX : IN. Derivative residual F(.,Ux,.) wrt Ux C FUY : IN. Derivative residual F(.,Uy,.) wrt Uy C FUZ : IN. Derivative residual F(.,Uz,.) wrt Uz C FUXX : IN. Derivative residual F(.,Uxx,.) wrt Uxx C FUYY : IN. Derivative residual F(.,Uyy,.) wrt Uyy C FUZZ : IN. Derivative residual F(.,Uzz,.) wrt Uzz C FUXY : IN. Derivative residual F(.,Uxy,.) wrt Uxy C FUXZ : IN. Derivative residual F(.,Uxz,.) wrt Uxz C FUYZ : IN. Derivative residual F(.,Uyz,.) wrt Uyz C G : OUT. Jacobian stored in block 19-diagonal mode C Ccc EXTERNALS USED: EXTERNAL JACGBD C C----------------------------------------------------------------------- C INTEGER I, JC, LENU DOUBLE PRECISION FACX, FACY, FACZ, FACXX, FACYY, FACZZ, FACXY, + FACXZ, FACYZ C LENU = NPTS*NPDE C FACX = 1/(2*DX) FACY = 1/(2*DY) FACZ = 1/(2*DZ) FACXX = 1/DX**2 FACYY = 1/DY**2 FACZZ = 1/DZ**2 FACXY = 1/(2*DX*2*DY) FACXZ = 1/(2*DX*2*DZ) FACYZ = 1/(2*DY*2*DZ) C Ccc First internal domain DO 10 JC = 1, NPDE DO 10 I = 1, LENU C dF(ipt,ic)/dU(blwz(blwy(ipt)),jc) G(I,JC,-9) = FUYZ(I,JC)*(+FACYZ) C dF(ipt,ic)/dU(blwz(ipt-1),jc) G(I,JC,-8) = FUXZ(I,JC)*(+FACXZ) C dF(ipt,ic)/dU(blwz(ipt),jc) G(I,JC,-7) = + FUZ(I,JC)*(-FACZ) + FUZZ(I,JC)*(+FACZZ) C dF(ipt,ic)/dU(blwz(ipt+1),jc) G(I,JC,-6) = FUXZ(I,JC)*(-FACXZ) C dF(ipt,ic)/dU(blwz(abvy(ipt)),jc) G(I,JC,-5) = FUYZ(I,JC)*(-FACYZ) C dF(ipt,ic)/dU(blwy(ipt)-1,jc) G(I,JC,-4) = FUXY(I,JC)*(+FACXY) C dF(ipt,ic)/dU(blwy(ipt),jc) G(I,JC,-3) = + FUY(I,JC)*(-FACY) + FUYY(I,JC)*(+FACYY) C dF(ipt,ic)/dU(blwy(ipt)+1,jc) G(I,JC,-2) = FUXY(I,JC)*(-FACXY) C dF(ipt,ic)/dU(ipt-1,jc) G(I,JC,-1) = + FUX(I,JC)*(-FACX) + FUXX(I,JC)*(+FACXX) C dF(ipt,ic)/dU(ipt,jc) G(I,JC, 0) = FU(I,JC) + + FUXX(I,JC)*(-2*FACXX) + FUYY(I,JC)*(-2*FACYY) + + FUZZ(I,JC)*(-2*FACZZ) C dF(ipt,ic)/dU(ipt+1,jc) G(I,JC,+1) = + FUX(I,JC)*(+FACX) + FUXX(I,JC)*(+FACXX) C dF(ipt,ic)/dU(abvy(ipt)-1,jc) G(I,JC,+2) = FUXY(I,JC)*(-FACXY) C dF(ipt,ic)/dU(abvy(ipt),jc) G(I,JC,+3) = + FUY(I,JC)*(+FACY) + FUYY(I,JC)*(+FACYY) C dF(ipt,ic)/dU(abvy(ipt)+1,jc) G(I,JC,+4) = FUXY(I,JC)*(+FACXY) C dF(ipt,ic)/dU(abvz(blwy(ipt)),jc) G(I,JC,+5) = FUYZ(I,JC)*(-FACYZ) C dF(ipt,ic)/dU(abvz(ipt-1),jc) G(I,JC,+6) = FUXZ(I,JC)*(-FACXZ) C dF(ipt,ic)/dU(abvz(ipt),jc) G(I,JC,+7) = + FUZ(I,JC)*(+FACZ) + FUZZ(I,JC)*(+FACZZ) C dF(ipt,ic)/dU(abvz(ipt+1),jc) G(I,JC,+8) = FUXZ(I,JC)*(+FACXZ) C dF(ipt,ic)/dU(abvz(abvy(ipt)),jc) G(I,JC,+9) = FUYZ(I,JC)*(+FACYZ) 10 CONTINUE C C Correct boundaries CALL JACGBD (NPTS, NPDE, FACX, FACY, FACZ, + LLBND, ILBND, LBND, FUX, FUY, FUZ, G) C RETURN END SUBROUTINE JACGBD (NPTS, NPDE, FACX, FACY, FACZ, + LLBND, ILBND, LBND, FUX, FUY, FUZ, G) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE, LLBND(0:*), ILBND(*), LBND(*) DOUBLE PRECISION FACX, FACY, FACZ, + FUX(NPTS,NPDE,NPDE), FUY(NPTS,NPDE,NPDE), FUZ(NPTS,NPDE,NPDE), + G(NPTS,NPDE,NPDE,-9:9) C Ccc PURPOSE: C Correct Jacobian G = dF/dU for second order approximation of C first order derivatives at boundaries C C PARAMETER DESCRIPTION: C NPTS : IN. # grid points C NPDE : IN. # PDE components C FACX : IN. 1/(2*DX) C FACY : IN. 1/(2*DY) C FACZ : IN. 1/(2*DZ) C LLBND : IN. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C FUX : IN. Derivative residual C F(t,U,Ut,Ux,Uy,Uz,Uxx,Uyy,Uzz,Uxy,Uxz,Uyz) wrt Ux C FUY : IN. Derivative residual C F(t,U,Ut,Ux,Uy,Uz,Uxx,Uyy,Uzz,Uxy,Uxz,Uyz) wrt Uy C FUZ : IN. Derivative residual C F(t,U,Ut,Ux,Uy,Uz,Uxx,Uyy,Uzz,Uxy,Uxz,Uyz) wrt Uz C G : INOUT. C IN: Jacobian stored in block 19-diagonal mode C OUT: Jacobian corrected for first order derivatives at C boundaries C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER IPT, IC, JC, IB, LB C Ccc Boundary corrections, no corrections needed for internal boundaries DO 10 IB = 1, LLBND(0) IF (ILBND(IB) .EQ. 1) THEN C Left plane, correction needed for dF/dUx DO 20 JC = 1, NPDE DO 20 IC = 1, NPDE CDIR$ IVDEP DO 25 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) G(IPT,IC,JC,-1) = 0.0 G(IPT,IC,JC, 0) = G(IPT,IC,JC,0) + + FUX(IPT,IC,JC)*(-3*FACX) G(IPT,IC,JC,+1) = FUX(IPT,IC,JC)*(+4*FACX) C dF(ipt,ic)/dU(ipt+2),jc) G(IPT,IC,JC,+2) = FUX(IPT,IC,JC)*(-FACX) 25 CONTINUE 20 CONTINUE ELSE IF (ILBND(IB) .EQ. 2) THEN C Down plane, correction needed for dF/dUz DO 30 JC = 1, NPDE DO 30 IC = 1, NPDE CDIR$ IVDEP DO 35 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) G(IPT,IC,JC,-7) = 0.0 G(IPT,IC,JC, 0) = G(IPT,IC,JC,0) + + FUZ(IPT,IC,JC)*(-3*FACZ) G(IPT,IC,JC,+7) = FUZ(IPT,IC,JC)*(+4*FACZ) C dF(ipt,ic)/dU(above(above(ipt)),jc) G(IPT,IC,JC,+9) = FUZ(IPT,IC,JC)*(-FACZ) 35 CONTINUE 30 CONTINUE ELSE IF (ILBND(IB) .EQ. 3) THEN C Right plane, correction needed for dF/dUx DO 40 JC = 1, NPDE DO 40 IC = 1, NPDE CDIR$ IVDEP DO 45 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) C dF(ipt,ic)/dU(ipt-2),jc) G(IPT,IC,JC,-2) = FUX(IPT,IC,JC)*(+FACX) G(IPT,IC,JC,-1) = FUX(IPT,IC,JC)*(-4*FACX) G(IPT,IC,JC, 0) = G(IPT,IC,JC,0) + + FUX(IPT,IC,JC)*(+3*FACX) G(IPT,IC,JC,+1) = 0.0 45 CONTINUE 40 CONTINUE ELSE IF (ILBND(IB) .EQ. 4) THEN C Up plane, correction needed for dF/dUz DO 50 JC = 1, NPDE DO 50 IC = 1, NPDE CDIR$ IVDEP DO 55 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) C dF(ipt,ic)/dU(below(below(ipt)),jc) G(IPT,IC,JC,-9) = FUZ(IPT,IC,JC)*(+FACZ) G(IPT,IC,JC,-7) = FUZ(IPT,IC,JC)*(-4*FACZ) G(IPT,IC,JC, 0) = G(IPT,IC,JC,0) + + FUZ(IPT,IC,JC)*(+3*FACZ) G(IPT,IC,JC,+7) = 0.0 55 CONTINUE 50 CONTINUE ELSE IF (ILBND(IB) .EQ. 5) THEN C Front plane, correction needed for dF/dUy DO 60 JC = 1, NPDE DO 60 IC = 1, NPDE CDIR$ IVDEP DO 65 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) G(IPT,IC,JC,-3) = 0.0 G(IPT,IC,JC, 0) = G(IPT,IC,JC,0) + + FUY(IPT,IC,JC)*(-3*FACY) G(IPT,IC,JC,+3) = FUY(IPT,IC,JC)*(+4*FACY) C dF(ipt,ic)/dU(above(above(ipt)),jc) G(IPT,IC,JC,+4) = FUY(IPT,IC,JC)*(-FACY) 65 CONTINUE 60 CONTINUE ELSE IF (ILBND(IB) .EQ. 6) THEN C Back plane, correction needed for dF/dUy DO 70 JC = 1, NPDE DO 70 IC = 1, NPDE CDIR$ IVDEP DO 75 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) C dF(ipt,ic)/dU(below(below(ipt)),jc) G(IPT,IC,JC,-4) = FUY(IPT,IC,JC)*(+FACY) G(IPT,IC,JC,-3) = FUY(IPT,IC,JC)*(-4*FACY) G(IPT,IC,JC, 0) = G(IPT,IC,JC,0) + + FUY(IPT,IC,JC)*(+3*FACY) G(IPT,IC,JC,+3) = 0.0 75 CONTINUE 70 CONTINUE ENDIF 10 CONTINUE C RETURN END SUBROUTINE JACSDP (NPTS, LLBND, ILBND, LBND, + LBLWY, LABVY, LBLWZ, LABVZ, LLDG, LUDG) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, LLBND(0:*), ILBND(*), LBND(*), + LBLWY(0:NPTS), LABVY(0:NPTS), LBLWZ(0:NPTS), LABVZ(0:NPTS), + LLDG(NPTS,-9:-2), LUDG(NPTS,2:9) C Ccc PURPOSE: C Set pointers to nodes of lower 8 subdiagonals of Jacobian in LLDG and C to nodes of upper 8 superdiagonals in LUDG. All nonexisting diagonals C should point to the main diagonal nodes. C C PARAMETER DESCRIPTION: C NPTS : IN. # grid points C LLBND : IN. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C LBLWY : IN. (0:NPTS) C LBLWY(IPT): pointer to node below in Y-direction in C actual grid C 0, if index node is front-plane boundary point C LABVY : IN. (0:NPTS) C LABVY(IPT): pointer to node above in Y-direction in C actual grid C 0, if index node is back-plane boundary point C LBLWZ : IN. (0:NPTS) C LBLWZ(IPT): pointer to node below in Z-direction in C actual grid C 0, if index node is down-plane boundary point C LABVZ : IN. (0:NPTS) C LABVZ(IPT): pointer to node above in Z-direction in C actual grid C 0, if index node is up-plane boundary point C LLDG : OUT. (NPTS,-9:-2) C LLDG(IPT,-9): pointer to node Y-below Z-below C or to node Z-below Z-below C LLDG(IPT,-8): pointer to node left of Z-below C LLDG(IPT,-7): pointer to node Z-below C LLDG(IPT,-6): pointer to node right of Z-below C LLDG(IPT,-5): pointer to node Y-above Z-below C LLDG(IPT,-4): pointer to node left of Y-below C or to node Y-below Y-below C LLDG(IPT,-3): pointer to node Y-below C LLDG(IPT,-2): pointer to node right of Y-below C or to node left of the node left C LUDG : OUT. (NPTS,2:9) C LUDG(IPT,2): pointer to node left of Y-above C or to node right of the node right C LUDG(IPT,3): pointer to node Y-above C LUDG(IPT,4): pointer to node right of node Y-above C or to node Y-above Y-above C LUDG(IPT,5): pointer to node Y-below Z-above C LUDG(IPT,6): pointer to node left of Z-above C LUDG(IPT,7): pointer to node Z-above C LUDG(IPT,8): pointer to node right of Z-above C LUDG(IPT,9): pointer to node Y-above Z-above C or to node Z-above Z-above C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER IPT, NBNDS, IB, LB C Ccc First internal domain DO 10 IPT = 1, NPTS-1 LLDG(IPT,-9) = LBLWZ(LBLWY(IPT)) LLDG(IPT,-8) = LBLWZ(IPT-1) LLDG(IPT,-7) = LBLWZ(IPT) LLDG(IPT,-6) = LBLWZ(IPT+1) LLDG(IPT,-5) = LBLWZ(LABVY(IPT)) LLDG(IPT,-4) = LBLWY(IPT-1) LLDG(IPT,-3) = LBLWY(IPT) LLDG(IPT,-2) = LBLWY(IPT+1) LUDG(IPT,+2) = LABVY(IPT-1) LUDG(IPT,+3) = LABVY(IPT) LUDG(IPT,+4) = LABVY(IPT+1) LUDG(IPT,+5) = LABVZ(LBLWY(IPT)) LUDG(IPT,+6) = LABVZ(IPT-1) LUDG(IPT,+7) = LABVZ(IPT) LUDG(IPT,+8) = LABVZ(IPT+1) LUDG(IPT,+9) = LABVZ(LABVY(IPT)) 10 CONTINUE IPT = NPTS LLDG(IPT,-9) = LBLWZ(LBLWY(IPT)) LLDG(IPT,-8) = LBLWZ(IPT-1) LLDG(IPT,-7) = LBLWZ(IPT) LLDG(IPT,-5) = LBLWZ(LABVY(IPT)) LLDG(IPT,-4) = LBLWY(IPT-1) LLDG(IPT,-3) = LBLWY(IPT) LUDG(IPT,+2) = LABVY(IPT-1) LUDG(IPT,+3) = LABVY(IPT) LUDG(IPT,+5) = LABVZ(LBLWY(IPT)) LUDG(IPT,+6) = LABVZ(IPT-1) LUDG(IPT,+7) = LABVZ(IPT) LUDG(IPT,+9) = LABVZ(LABVY(IPT)) C Ccc Correct boundaries NBNDS = LLBND(0) DO 20 IB = 1, NBNDS IF (ILBND(IB) .EQ. 1) THEN C Left plane C I / C O - - C / I DO 30 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) LLDG(IPT,-8) = IPT IF (LLDG(IPT,-4) .EQ. LBLWY(IPT-1)) LLDG(IPT,-4) = IPT LUDG(IPT,+2) = IPT+2 LUDG(IPT,+6) = IPT 30 CONTINUE ELSE IF (ILBND(IB) .EQ. 2) THEN C Down plane C I C I / C - O - C / DO 40 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) LLDG(IPT,-9) = IPT LLDG(IPT,-8) = IPT LLDG(IPT,-7) = IPT LLDG(IPT,-6) = IPT LLDG(IPT,-5) = IPT LUDG(IPT,+9) = LABVZ(LABVZ(IPT)) 40 CONTINUE ELSE IF (ILBND(IB) .EQ. 3) THEN C Right plane C I / C - - O C / I DO 50 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) LLDG(IPT,-6) = IPT LLDG(IPT,-2) = IPT-2 IF (IPT .EQ. NPTS) THEN LUDG(IPT,+4) = IPT ELSE IF (LUDG(IPT,+4) .EQ. LABVY(IPT+1)) THEN LUDG(IPT,+4) = IPT ENDIF LUDG(IPT,+8) = IPT 50 CONTINUE ELSE IF (ILBND(IB) .EQ. 4) THEN C Up plane C / C - O - C / I C I DO 60 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) LLDG(IPT,-9) = LBLWZ(LBLWZ(IPT)) LUDG(IPT,+5) = IPT LUDG(IPT,+6) = IPT LUDG(IPT,+7) = IPT LUDG(IPT,+8) = IPT LUDG(IPT,+9) = IPT 60 CONTINUE ELSE IF (ILBND(IB) .EQ. 5) THEN C Front plane C / C I / C - O - C I DO 70 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) IF (LLDG(IPT,-9) .EQ. LBLWZ(LBLWY(IPT))) + LLDG(IPT,-9) = IPT LLDG(IPT,-4) = IPT LLDG(IPT,-3) = IPT IF (LLDG(IPT,-2) .EQ. LBLWY(IPT+1)) LLDG(IPT,-2) = IPT LUDG(IPT,+4) = LABVY(LABVY(IPT)) LUDG(IPT,+5) = IPT 70 CONTINUE ELSE IF (ILBND(IB) .EQ. 6) THEN C Back plane C I C - O - C / I C / DO 80 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) LLDG(IPT,-5) = IPT LLDG(IPT,-4) = LBLWY(LBLWY(IPT)) IF (LUDG(IPT,+2) .EQ. LABVY(IPT-1)) LUDG(IPT,+2) = IPT LUDG(IPT,+3) = IPT LUDG(IPT,+4) = IPT IF (LUDG(IPT,+9) .EQ. LABVZ(LABVY(IPT))) + LUDG(IPT,+9) = IPT 80 CONTINUE ENDIF 20 CONTINUE C IB = NBNDS+1 CDIR$ VECTOR C Internal boundary, Dirichlet condition, no off diagonals C . . . C . O . C . . . DO 200 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) LLDG(IPT,-9) = IPT LLDG(IPT,-8) = IPT LLDG(IPT,-7) = IPT LLDG(IPT,-6) = IPT LLDG(IPT,-5) = IPT LLDG(IPT,-4) = IPT LLDG(IPT,-3) = IPT LLDG(IPT,-2) = IPT LUDG(IPT,+2) = IPT LUDG(IPT,+3) = IPT LUDG(IPT,+4) = IPT LUDG(IPT,+5) = IPT LUDG(IPT,+6) = IPT LUDG(IPT,+7) = IPT LUDG(IPT,+8) = IPT LUDG(IPT,+9) = IPT 200 CONTINUE C RETURN END SUBROUTINE JACPB (NPTS, NPDE, GLU, LLDG, + LLBND, ILBND, LBND, LSL, LLSL) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE, LLDG(*), + LLBND(0:*), ILBND(*), LBND(*), LSL(*), LLSL(0:*) DOUBLE PRECISION GLU(*) C Ccc PURPOSE: C Compute ILU factorization of the Jacobian in block 19-diagonal mode. C C PARAMETER DESCRIPTION: C NPTS : IN. # grid points C NPDE : IN. # PDE components C GLU : INOUT. C IN: Jacobian stored in block 19-diagonal mode C OUT: ILU factorization of Jacobian stored in block C 19-diagonal mode C LLDG : IN. (NPTS,-9:-2) C LLDG(IPT,-9): pointer to node Y-below Z-below C or to node Z-below Z-below C LLDG(IPT,-8): pointer to node left of Z-below C LLDG(IPT,-7): pointer to node Z-below C LLDG(IPT,-6): pointer to node right of Z-below C LLDG(IPT,-5): pointer to node Y-above Z-below C LLDG(IPT,-4): pointer to node left of Y-below C or to node Y-below Y-below C LLDG(IPT,-3): pointer to node Y-below C LLDG(IPT,-2): pointer to node right of Y-below C or to node left of the node left C LLBND : IN. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C LSL : IN. (NPTS) C LSL(ISLPT): pointer to node in actual grid C LLSL : IN. (0:LLSL(0)) C LLSL(0) = # independent data dependency lists in ILU C factorization and forward sweep C LLSL(1:LLSL(0)): pointers to the start of a list in LSL C Ccc EXTERNALS USED: EXTERNAL ILU, JAC19 C C----------------------------------------------------------------------- C Ccc Adapt Jacobian to real block 19-diagonal structure by replacing C second-order boundary discretization by first-order CALL JAC19 (NPTS, NPDE, GLU, LLBND, ILBND, LBND) C Ccc Incomplete LU factorization CALL ILU (NPTS, NPDE, GLU, LLDG, LSL, LLSL) C RETURN END SUBROUTINE JAC19 (NPTS, NPDE, A, LLBND, ILBND, LBND) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE, LLBND(0:*), ILBND(*), LBND(*) DOUBLE PRECISION A(NPTS,NPDE,NPDE,-9:9) C Ccc PURPOSE: C Replace second-order boundary discretization by first-order in C Jacobian to get real block 19-diagonal structure C C PARAMETER DESCRIPTION: C NPTS : IN. # grid points C NPDE : IN. # PDE components C A : INOUT. C IN: Jacobian C OUT: Jacobian with second-order boundary discretization C replaced by first-order C LLBND : IN. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER IPT, IC, JC, IB, LB C DO 10 IB = 1, LLBND(0) IF (ILBND(IB) .EQ. 1) THEN C Left plane, correction needed for dF/dUx DO 20 IC = 1, NPDE DO 20 JC = 1, NPDE CDIR$ IVDEP DO 25 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) A(IPT,IC,JC,0) = A(IPT,IC,JC,0) + A(IPT,IC,JC,2) A(IPT,IC,JC,2) = 0.0 25 CONTINUE 20 CONTINUE ELSE IF (ILBND(IB) .EQ. 2) THEN C Down plane, correction needed for dF/dUz DO 30 IC = 1, NPDE DO 30 JC = 1, NPDE CDIR$ IVDEP DO 35 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) A(IPT,IC,JC,0) = A(IPT,IC,JC,0) + A(IPT,IC,JC,9) A(IPT,IC,JC,9) = 0.0 35 CONTINUE 30 CONTINUE ELSE IF (ILBND(IB) .EQ. 3) THEN C Right plane, correction needed for dF/dUx DO 40 IC = 1, NPDE DO 40 JC = 1, NPDE CDIR$ IVDEP DO 45 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) A(IPT,IC,JC,0) = A(IPT,IC,JC,0) + A(IPT,IC,JC,-2) A(IPT,IC,JC,-2) = 0.0 45 CONTINUE 40 CONTINUE ELSE IF (ILBND(IB) .EQ. 4) THEN C Up plane, correction needed for dF/dUz DO 50 IC = 1, NPDE DO 50 JC = 1, NPDE CDIR$ IVDEP DO 55 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) A(IPT,IC,JC,0) = A(IPT,IC,JC,0) + A(IPT,IC,JC,-9) A(IPT,IC,JC,-9) = 0.0 55 CONTINUE 50 CONTINUE ELSE IF (ILBND(IB) .EQ. 5) THEN C Front plane, correction needed for dF/dUy DO 60 IC = 1, NPDE DO 60 JC = 1, NPDE DO 65 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) A(IPT,IC,JC,0) = A(IPT,IC,JC,0) + A(IPT,IC,JC,4) A(IPT,IC,JC,4) = 0.0 65 CONTINUE 60 CONTINUE ELSE IF (ILBND(IB) .EQ. 6) THEN C Back plane, correction needed for dF/dUy DO 70 IC = 1, NPDE DO 70 JC = 1, NPDE DO 75 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) A(IPT,IC,JC,0) = A(IPT,IC,JC,0) + A(IPT,IC,JC,-4) A(IPT,IC,JC,-4) = 0.0 75 CONTINUE 70 CONTINUE ENDIF 10 CONTINUE C RETURN END SUBROUTINE JACSLP (NPTS, LLBND, ILBND, LBND, LLDG, M, LLS, LS) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, LLBND(0:*), ILBND(*), LBND(*), LLDG(NPTS,-9:-2), + M(NPTS), LLS(0:*), LS(NPTS) C Ccc PURPOSE: C Make data-dependency list for ILU factorization and forward sweep of C backsolve. C C C PARAMETER DESCRIPTION: C NPTS : IN. # grid points C LLBND : IN. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C LLDG : IN. (NPTS,-9:-2) C LLDG(IPT,-9): pointer to node Y-below Z-below C or to node Z-below Z-below C LLDG(IPT,-8): pointer to node left of Z-below C LLDG(IPT,-7): pointer to node Z-below C LLDG(IPT,-6): pointer to node right of Z-below C LLDG(IPT,-5): pointer to node Y-above Z-below C LLDG(IPT,-4): pointer to node left of Y-below C or to node Y-below Y-below C LLDG(IPT,-3): pointer to node Y-below C LLDG(IPT,-2): pointer to node right of Y-below C or to node left of the node left C M : WORK. (NPTS) C M(IPT) contains list # of node IPT C LLS : OUT. (0:LLS(0)) C LLS(0) = # independent data dependency lists in ILU C factorization and forward sweep C LLS(1:LLS(0)): pointers to the start of a list in LS C LS : OUT. (NPTS) C LS(ISPT): pointer to node in actual grid C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER IBP, IPT, NBNDS, IB, LB, IDS, IDW, ID, IDE, IDN, + IW, ISW, IS, ISE, LDF, MAXM, MI C Ccc Determine for each grid point the # of its data dependency list. C LLS(MI) contains # nodes in list MI C M(IPT) contains list # of node IPT C C Initialize LLS and M DO 1 IPT = 1, NPTS LLS(IPT-1) = 0 M(IPT) = 0 1 CONTINUE C C First list contains independent points, i.e., left/down/front corners C and internal boundary points. C For first list the pointers to the nodes in the grid can already be C stored in LS NBNDS = LLBND(0) DO 10 IB = 1, NBNDS C Store boundary info into work array M IBP = 8**ILBND(IB) DO 20 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) M(IPT) = M(IPT)+IBP 20 CONTINUE 10 CONTINUE LDF = 8**1+8**2+8**5 DO 30 IPT = 1, NPTS IF (M(IPT) .EQ. LDF) THEN C left/down/front corner, node in starting list LLS(1) = LLS(1)+1 LS(LLS(1)) = IPT M(IPT) = 1 ELSE IF (MOD(INT(M(IPT)/8),8) .EQ. 1) THEN C Left boundary, mark node M(IPT) = -1 ELSE M(IPT) = 0 ENDIF 30 CONTINUE IB = NBNDS+1 C Internal boundary, Dirichlet condition, node in starting list DO 40 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) LLS(1) = LLS(1)+1 LS(LLS(1)) = IPT M(IPT) = 1 40 CONTINUE C C C Compute for rest of nodes their list #; a node is dependent from C its neighbors at compass points W, SW, S and SE in the same plane and C in the plane below the point directly below and the points C S, W, E, and N of it. MAXM = 0 DO 50 IPT = 1, NPTS IF (M(IPT) .GT. 0) THEN C Node already in list GOTO 50 ELSE IF (M(IPT) .LT. 0) THEN C Left boundary IW = IPT M(IPT) = 0 ELSE IW = IPT-1 ENDIF IDS = LLDG(IPT,-9) IDW = LLDG(IPT,-8) ID = LLDG(IPT,-7) IDE = LLDG(IPT,-6) IDN = LLDG(IPT,-5) ISW = LLDG(IPT,-4) IS = LLDG(IPT,-3) ISE = LLDG(IPT,-2) MI = MAX(M(IDS),M(IDW),M(ID),M(IDE),M(IDN), + M(IW),M(ISW),M(IS),M(ISE)) + 1 M(IPT) = MI LLS(MI) = LLS(MI) + 1 MAXM = MAX(MAXM,MI) 50 CONTINUE C Ccc Store list pointers in LLS and grid pointers in LS C C LLS(i):=SUM (# nodes in list_j) C j=1,i DO 60 IS = 2, MAXM LLS(IS) = LLS(IS) + LLS(IS-1) 60 CONTINUE C C Store grid pointers C LLS(i-1) is pointer to next free place in list i-1 in LS LLS(0) = LLS(1) DO 70 IPT = 2, NPTS IF (M(IPT) .NE. 1) THEN MI = M(IPT) LLS(MI-1) = LLS(MI-1) + 1 LS(LLS(MI-1)) = IPT ENDIF 70 CONTINUE C LLS(i-1) points to list i in LS, should be i-1 DO 80 IS = MAXM, 1, -1 LLS(IS) = LLS(IS-1) 80 CONTINUE C Ccc Store # lists in LLS(0) LLS(0) = MAXM RETURN END SUBROUTINE JACSUP (NPTS, LLBND, ILBND, LBND, LUDG, M, LLS, LS) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, LLBND(0:*), ILBND(*), LBND(*), LUDG(NPTS,2:9), + M(NPTS), LLS(0:*), LS(NPTS) C Ccc PURPOSE: C Make data-dependency list for backward sweep of backsolve. C C PARAMETER DESCRIPTION: C NPTS : IN. # grid points C LLBND : IN. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C LUDG : IN. (NPTS,2:9) C LUDG(IPT,2): pointer to node left of Y-above C or to node right of the node right C LUDG(IPT,3): pointer to node Y-above C LUDG(IPT,4): pointer to node right of node Y-above C or to node Y-above Y-above C LUDG(IPT,5): pointer to node Y-below Z-above C LUDG(IPT,6): pointer to node left of Z-above C LUDG(IPT,7): pointer to node Z-above C LUDG(IPT,8): pointer to node right of Z-above C LUDG(IPT,9): pointer to node Y-above Z-above C or to node Z-above Z-above C M : WORK. (NPTS) C M(IPT) contains list # of node IPT C LLS : OUT. (0:LLS(0)) C LLS(0) = # independent data dependency lists in C backward sweep C LLS(1:LLS(0)): pointers to the start of a list in LS C LS : OUT. (NPTS) C LS(ISPT): pointer to node in actual grid C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER IBP, IPT, NBNDS, IB, LB, IUS, IUW, IU, IUE, IUN, + IE, INW, IN, INE, IS, RUB, MAXM, MI C Ccc Determine for each grid point the # of its data dependency list. C LLS(MI) contains # nodes in list MI C M(IPT) contains list # of node IPT C C Initialize LLS and M DO 1 IPT = 1, NPTS LLS(IPT-1) = 0 M(IPT) = 0 1 CONTINUE C C First list contains independent points, i.e., right/up/back corners C and internal boundary points. C For first list the pointers to the nodes in the grid can already be C stored in LS NBNDS = LLBND(0) DO 10 IB = 1, NBNDS C Store boundary info into work array M IBP = 8**ILBND(IB) DO 20 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) M(IPT) = M(IPT)+IBP 20 CONTINUE 10 CONTINUE RUB = 8**3+8**4+8**6 DO 30 IPT = 1, NPTS IF (M(IPT) .EQ. RUB) THEN C right/up/back corner, node in starting list LLS(1) = LLS(1)+1 LS(LLS(1)) = IPT M(IPT) = 1 ELSE IF (MOD(INT(M(IPT)/8**3),8) .EQ. 1) THEN C Right plane, mark node M(IPT) = -1 ELSE M(IPT) = 0 ENDIF 30 CONTINUE IB = NBNDS+1 C Internal boundary, Dirichlet condition, node in starting list DO 40 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) LLS(1) = LLS(1)+1 LS(LLS(1)) = IPT M(IPT) = 1 40 CONTINUE C C C Compute for rest of nodes their list #; a node is dependent from C its neighbors at compass points E, NW, N and NE in the same plane and C in the plane above the point directly below and the points C S, W, E, and N of it. MAXM = 0 DO 50 IPT = NPTS, 1, -1 IF (M(IPT) .GT. 0) THEN C Node already in list GOTO 50 ELSE IF (M(IPT) .LT. 0) THEN C Right boundary IE = IPT M(IPT) = 0 ELSE IE = IPT+1 ENDIF INW = LUDG(IPT,2) IN = LUDG(IPT,3) INE = LUDG(IPT,4) IUS = LUDG(IPT,5) IUW = LUDG(IPT,6) IU = LUDG(IPT,7) IUE = LUDG(IPT,8) IUN = LUDG(IPT,9) MI = MAX(M(IE),M(INW),M(IN),M(INE), + M(IUS),M(IUW),M(IU),M(IUE),M(IUN)) + 1 M(IPT) = MI LLS(MI) = LLS(MI) + 1 MAXM = MAX(MAXM,MI) 50 CONTINUE C Ccc Store list pointers in LLS and grid pointers in LS C C LLS(i):=SUM (# nodes in list_j) C j=1,i DO 60 IS = 2, MAXM LLS(IS) = LLS(IS) + LLS(IS-1) 60 CONTINUE C C Store grid pointers C LLS(i-1) is pointer to next free place in list i-1 in LS LLS(0) = LLS(1) DO 70 IPT = NPTS-1, 1, -1 IF (M(IPT) .NE. 1) THEN MI = M(IPT) LLS(MI-1) = LLS(MI-1) + 1 LS(LLS(MI-1)) = IPT ENDIF 70 CONTINUE C LLS(i-1) points to list i in LS, should be i-1 DO 80 IS = MAXM, 1, -1 LLS(IS) = LLS(IS-1) 80 CONTINUE C Ccc Store # lists in LLS(0) LLS(0) = MAXM RETURN END SUBROUTINE BICGST (NPTS, NPDE, A, X, B, WT, TOL, ITMAX, + ALU, LLDG, LUDG, LSL, LLSL, LSU, LLSU, + LUN, R, R0, P, T, V, ITER, ERR, IERR) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE, ITMAX, + LLDG(*), LUDG(*), LSL(*), LLSL(*), LSU(*), LLSU(*), + LUN, ITER, IERR DOUBLE PRECISION A(*), X(NPTS*NPDE), B(NPTS*NPDE), WT(NPTS*NPDE), + TOL, ALU(*), + R(NPTS*NPDE), R0(NPTS*NPDE), P(NPTS*NPDE), + T(NPTS*NPDE), V(NPTS*NPDE), ERR C Ccc PURPOSE: C Solve a Non-Symmetric linear system Ax = b using the Preconditioned C BiConjugate Gradient STAB method. Preconditioning is done with an C Incomplete LU factorization of A. C Actually solved is the system [P^(-1).A].x = [P^(-1).b] C until ||residual||_WRMS < TOL. C Ccc PARAMETER DESCRIPTION: C NPTS : IN. # grid points C NPDE : IN. # PDE components C A : IN. -I C LLDG : IN I These arrays hold the matrix A in block diagonal C LUDG : IN -I storage mode (see description in MVDIAG) C X : OUT. Final approximate solution. C B : IN. Right-hand side vector. C WT : IN. Contains weight factors to compute weighted norm. C TOL : IN. System is considered to be solved if C weighted max. norm < TOL C ITMAX : IN. Maximum number of iterations. C ALU : IN. -I C LSL : IN I These arrays should hold the ILU factorization of A in C LLSL : IN I diagonal storage mode and the data dependency lists C LSU : IN I for the forward and the backward solve C LLSU : IN. -I (see description in BCKSLV) C LUN : IN. Logical unit # of file on which to write the error at C each iteration, if this is desired for monitoring convergence C If LUN = 0, no writing will occur. C R : WORK. (NPTS*NPDE) C R0 : WORK. (NPTS*NPDE) C P : WORK. (NPTS*NPDE) C T : WORK. (NPTS*NPDE) C V : WORK. (NPTS*NPDE) C ITER : OUT. Number of iterations required to reach convergence, or C ITMAX+1 if convergence criterion could not be achieved in C ITMAX iterations. C ERR : OUT. Weighted max. norm of error estimate in final C approximate solution C IERR : OUT. Error return flag C 0: OK C 1: Method failed to converge in ITMAX steps C 2: Breakdown of the method detected ( ~ 0.0) C Ccc EXTERNALS USED: DOUBLE PRECISION WDNRM2, DDOT EXTERNAL MVDIAG, BCKSLV, RCOPY, WDNRM2, DDOT, DAXPY C C Ccc INCLUDE 'CMNCMMACH' C C CMNCMMACH C C COMMON with `machine numbers' C LUNOUT : Logical unit # standard output -I C LUNERR : Logical unit # standard error I Set in the routine C UROUND : Smallest machine number such that I MACNUM C 1.0+UROUND > 1.0 and 1.0-UROUND < 1.0 I C XMIN : Smallest floating-point number -I INTEGER LUNOUT, LUNERR DOUBLE PRECISION UROUND, XMIN COMMON /IMACH/ LUNOUT, LUNERR COMMON /RMACH/ UROUND, XMIN SAVE /IMACH/, /RMACH/ C C end INCLUDE 'CMNCMMACH' C C C----------------------------------------------------------------------- C INTEGER I, N DOUBLE PRECISION ALPHA, BETA, OMEGA, RHOIM1, RHOI, SXMIN, TNRM2 C N = NPTS*NPDE ITER = 0 IERR = 0 SXMIN = SQRT(XMIN) C Ccc Initialize X and set initial residual to B CALL ZERO (N, X) DO 10 I = 1, N R0(I) = B(I) 10 CONTINUE CALL BCKSLV (NPTS, NPDE, ALU, LLDG, LUDG, LSL, LLSL, LSU, LLSU, + R0) C Ccc Check stopping criterion ERR = WDNRM2 (N, R0, WT) IF (LUN .NE. 0) THEN WRITE(LUN,'(''ILU preconditioned BiCGStab for N ='',I6)') N WRITE(LUN,'('' ITER Error Estimate Alpha'', + '' Beta Omega'')') WRITE(LUN,'(I5,E16.7)') ITER, ERR ENDIF IF (ERR .LT. TOL) RETURN C Ccc BiCGStab loop CALL RCOPY (N, R0, R) DO 100 ITER = 1, ITMAX C Compute innerproduct original residual with previous residual RHOI = DDOT(N, R0, 1, R, 1) C Calculate coefficient Beta and direction vector Pi IF( ITER.EQ.1 ) THEN DO 110 I = 1, N BETA = 0.0 P(I) = R(I) 110 CONTINUE ELSE BETA = RHOI/RHOIM1*ALPHA/OMEGA DO 120 I = 1, N P(I) = R(I) + BETA*(P(I)-OMEGA*V(I)) 120 CONTINUE ENDIF C Calculate Vi and coefficient Alfa CALL MVDIAG (NPTS, NPDE, A, P, LLDG, LUDG, V) CALL BCKSLV (NPTS, NPDE, ALU, LLDG, LUDG, LSL, LLSL, LSU, LLSU, + V) ALPHA = RHOI / DDOT(N, R0, 1, V, 1) C Calculate polynomial coefficient Omega_i C store intermediate vector S in R DO 130 I = 1, N R(I) = R(I) - ALPHA*V(I) 130 CONTINUE CALL MVDIAG (NPTS, NPDE, A, R, LLDG, LUDG, T) CALL BCKSLV (NPTS, NPDE, ALU, LLDG, LUDG, LSL, LLSL, LSU, LLSU, + T) TNRM2 = DDOT(N,T,1,T,1) IF (TNRM2 .LT. SXMIN) THEN C Lucky breakdown OMEGA = 0.0 ELSE OMEGA = DDOT(N,T,1,R,1) / TNRM2 ENDIF C Adapt Xi = Xi-1 + Alfa*Pi + Omega_i*S. CALL DAXPY (N, ALPHA, P, 1, X, 1) CALL DAXPY (N, OMEGA, R, 1, X, 1) C Compute residual R = S - Omega_i*T DO 140 I = 1, N R(I) = R(I) - OMEGA*T(I) 140 CONTINUE C C Check stopping criterion. ERR = WDNRM2 (N, R, WT) IF(LUN .NE. 0) + WRITE(LUN,'(I5,4E16.7)') ITER, ERR, ALPHA, BETA, OMEGA IF (ERR .LT. TOL) RETURN C C Check if last residual is not parallel to original residual IF (ABS(RHOI) .LT. SXMIN) GOTO 990 RHOIM1 = RHOI 100 CONTINUE C Ccc end of BiCGStab loop C Ccc Stopping criterion not satisfied ITER = ITMAX + 1 IERR = 1 RETURN C Ccc Breakdown of method detected. 990 IERR = 2 RETURN C END SUBROUTINE MVDIAG (NPTS, NPDE, AD, X, LLDG, LUDG, Y) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE, LLDG(NPTS,-9:-2), LUDG(NPTS,2:9) DOUBLE PRECISION AD(NPTS,NPDE,NPDE,-9:9), X(NPTS,NPDE), + Y(NPTS,NPDE) C Ccc PURPOSE: C Compute y = Ax where A is stored in block 19-diagonal mode. C Ccc PARAMETER DESCRIPTION: C NPTS : IN. # grid points C NPDE : IN. # PDE components C AD : IN. A(.,1:NPDE,1:NPDE,-9:-1) : lower block diagonals C A(.,1:NPDE,1:NPDE,0) : main block diagonal C A(.,1:NPDE,1:NPDE, 1: 9) : upper block diagonals C X : IN. Multiplying vector C LLDG : IN. (NPTS,-9:-2) C LLDG(IPT,-4): pointer to node left of node below C or to node below the node below C LLDG(IPT,-3): pointer to node below C LLDG(IPT,-2): pointer to node right of node below C or to node left of the node left C LUDG : IN. (NPTS,2:4) C LUDG(IPT,2): pointer to node left of node above C or to node right of the node right C LUDG(IPT,3): pointer to node above C LUDG(IPT,4): pointer to node right of node above C or to node above the node above C If one of the above nodes does not exist, the pointer is C to the node itself. C Y : OUT. Result vector C Ccc EXTERNALS USED: EXTERNAL ZERO C C ---------------------------------------------------------------------- C INTEGER IC, JC, IPT, JD C CALL ZERO (NPTS*NPDE, Y) C DO 10 JC = 1, NPDE DO 10 IC = 1, NPDE DO 20 IPT = 1, NPTS Y(IPT,IC) = Y(IPT,IC) + AD(IPT,IC,JC, 0)*X(IPT,JC) 20 CONTINUE DO 30 IPT = 1, NPTS-1 Y(IPT,IC) = Y(IPT,IC) + AD(IPT,IC,JC,+1)*X(IPT+1,JC) 30 CONTINUE DO 40 IPT = 2, NPTS Y(IPT,IC) = Y(IPT,IC) + AD(IPT,IC,JC,-1)*X(IPT-1,JC) 40 CONTINUE C C The next loops can be done for all points, because if an entry C in the Jacobian does not exist in reality the value in AD is zero C and the pointer in LUDG or LLDG points to the node itself. DO 60 JD = 2, 9 DO 60 IPT = 1, NPTS Y(IPT,IC) = Y(IPT,IC) + AD(IPT,IC,JC,JD)*X(LUDG(IPT,JD),JC) 60 CONTINUE DO 70 JD = -2, -9, -1 DO 70 IPT = 1, NPTS Y(IPT,IC) = Y(IPT,IC) + AD(IPT,IC,JC,JD)*X(LLDG(IPT,JD),JC) 70 CONTINUE 10 CONTINUE RETURN END SUBROUTINE INTGRC (ISTRUC, X, Y, Z, NPDE, UIB, UNP1, UN, UNM1, + RELTOL, ABSTOL, TN, DT, DTRAT, DX, DY, DZ, WT, F, CORR, RWORK, + IERR) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER ISTRUC(0:*), NPDE, IERR DOUBLE PRECISION X(*), Y(*), Z(*), UIB(*), UNP1(0:*), UN(0:*), + UNM1(0:*), + RELTOL(NPDE), ABSTOL(NPDE), + TN, DT, DTRAT, DX, DY, DZ, + WT(*), F(*), CORR(*), RWORK(*) C Ccc PURPOSE: C Integration in time with BDF2 (first timestep BE). C Solve nonlinear system F(Tn+1, Un+1, Udot) = 0 with matrix-free C Newton. C Solve linear systems with (block) diagonally scaled GCRO. C Ccc PARAMETER DESCRIPTION: C ISTRUC : IN. Data structure Un+1 grid. C X,Y,Z : IN. Physical coordinates grid. C NPDE : IN. # PDE components C UIB : IN. Dirichlet boundary values on internal boundary. C UNP1 : INOUT. On entry: Initial solution, on exit final solution C Newton converged C UN : IN. Solution at Tn on Un+1 grid C UNM1 : IN. Solution at Tn-1 on Un+1 grid C RELTOL : IN. Relative tolerance for Newton process C ABSTOL : IN. Absolute tolerance for Newton process C TN : IN. Previous time C DT : IN. Current time step C DX : IN. Current grid spacing in X-direction C DY : IN. Current grid spacing in Y-direction C DZ : IN. Current grid spacing in Z-direction C DTRAT : IN. If BE: 0, if BDF2: DT/DT_old C WT : WORK. (NPTS*NPDE) C Weight function for norm computation C F : WORK. (NPTS*NPDE) C Residual C CORR : WORK. (NPTS*NPDE) C Correction in Newton iteration C RWORK : WORK. (RESWRK+LSSWRK) C RESWRK: LENU.10 C LSSWRK: MAX(LENPWK,LENU.(2.MAXLR+MAXL+6))+LENPRE+ C MAXLR.MAXLR+(MAXL+3).MAXL+1 C LENPRE: ( IDIAGP <= 1 ! LENU.NPDE ! LENU ) C LENPWK: ( IDIAGP = 0 ! LENU.(NPDE.7+2)+NPTS C |:IDIAGP = 1 ! LENU.(NPDE.4+2)+NPTS C |:IDIAGP = 2 ! LENU.10 C |:IDIAGP = 3 ! LENU.7 ) C LENU : NPTS.NPDE C IERR : OUT. C 0: OK. C 10: Newton process did not converge C C Ccc EXTERNALS USED: DOUBLE PRECISION MAXNRM, WDNRM2 EXTERNAL ERRWGT, GCRO, PINIT, MAXNRM, RESID, WDNRM2 C C Ccc INCLUDE 'PARNEWTON' C C PARNEWTON C C Parameters for Newton process C MAXNIT : Max. number of Newton iterations C MAXJAC : Max. number of Jacobian / preconditioner evaluations during C a Newton process C TOLNEW : Tolerance for Newton process: C rho/(1-rho)*|| corr.||_w < TOLNEW INTEGER MAXNIT, MAXJAC DOUBLE PRECISION TOLNEW PARAMETER (MAXNIT = 10, MAXJAC = 2, TOLNEW = 1.0) C C end INCLUDE 'PARNEWTON' C C Ccc INCLUDE 'PARGCRO' C C PARGCRO C C Parameters for linear system solver GCRO + (block-)diagonal C preconditioner C IDIAGP : 0: block-diagonal + first order derivatives C 1: block-diagonal neglecting first order derivatives C 2: diagonal + first order derivatives C 3: diagonal neglecting first order derivatives C NRRMAX : Max. number of restarts of outer loop C MAXLR : Max. number of iterations in outer loop C MAXL : Max. number of iterations in GMRES inner loop C TOLLSC : Tolerance for linear system solver INTEGER IDIAGP, NRRMAX, MAXLR, MAXL DOUBLE PRECISION TOLLSC PARAMETER (NRRMAX = 1, MAXLR = 5, MAXL = 20) C PARAMETER (NRRMAX = 1, MAXLR = 3, MAXL = 15) PARAMETER (TOLLSC = TOLNEW/10) COMMON /IGCRO/ IDIAGP SAVE /IGCRO/ C C end INCLUDE 'PARGCRO' C C Ccc INCLUDE 'CMNCMMACH' C C CMNCMMACH C C COMMON with `machine numbers' C LUNOUT : Logical unit # standard output -I C LUNERR : Logical unit # standard error I Set in the routine C UROUND : Smallest machine number such that I MACNUM C 1.0+UROUND > 1.0 and 1.0-UROUND < 1.0 I C XMIN : Smallest floating-point number -I INTEGER LUNOUT, LUNERR DOUBLE PRECISION UROUND, XMIN COMMON /IMACH/ LUNOUT, LUNERR COMMON /RMACH/ UROUND, XMIN SAVE /IMACH/, /RMACH/ C C end INCLUDE 'CMNCMMACH' C C Ccc INCLUDE 'CMNSTATS' C C CMNSTATS C C COMMON with integration statistics INTEGER MXCLEV, MXCNIT PARAMETER (MXCLEV = 10, MXCNIT = 20) INTEGER LUNPDS, LUNNLS, LUNLSS, LEVEL, NSTEPS, NREJS, + NJACS(MXCLEV), NRESID(MXCLEV), NNIT(MXCLEV), + NLSIT(MXCLEV,MXCNIT) COMMON /STATS/ LUNPDS, LUNNLS, LUNLSS, LEVEL, NSTEPS, NREJS, + NJACS, NRESID, NNIT, NLSIT SAVE /STATS/ C C end INCLUDE 'CMNSTATS' C C C----------------------------------------------------------------------- C INTEGER LLPLN, NPLNS, LIPLN, LLROW, NROWS, NPTS, LIROW, LICOL, + LLLBND, NBNDS, NBDPTS, NBIPTS, LILBND, LLBNDP, + LLBLWY, LLABVY, LLBLWZ, LLABVZ, + LIWK, LENU, + LUT, LUX, LUY, LUZ, LUXX, LUYY, LUZZ, LUXY, LUXZ, LUYZ, + LPREC, LR, LU, LC, LZW, LRWK, + NPRE, NRES, I, NIT, ITER LOGICAL BDPREC, NEWPRE DOUBLE PRECISION A0, ERR, CORNRM, OLDNRM, RATE, TOL, UNRM C IERR = 0 C A0 = (1+2*DTRAT) / ((1+DTRAT)*DT) BDPREC = IDIAGP .LE. 1 C IF (LUNNLS .NE. 0) THEN WRITE(LUNNLS,'(''Nonlinear system solver at T ='',E16.7)') + TN+DT ENDIF C LLPLN = 0 NPLNS = ISTRUC(LLPLN) LIPLN = LLPLN+NPLNS+2 LLROW = LIPLN+NPLNS NROWS = ISTRUC(LLPLN+NPLNS+1)-1 NPTS = ISTRUC(LLROW+NROWS)-1 LIROW = LLROW+NROWS+1 LICOL = LIROW+NROWS LLLBND = LICOL+NPTS NBNDS = ISTRUC(LLLBND) NBDPTS = ISTRUC(LLLBND+NBNDS+1)-1 NBIPTS = ISTRUC(LLLBND+NBNDS+2)-1 LILBND = LLLBND+NBNDS+3 LLBNDP = LILBND+NBNDS LLBLWY = LLBNDP+NBIPTS LLABVY = LLBLWY+NPTS+1 LLBLWZ = LLABVY+NPTS+1 LLABVZ = LLBLWZ+NPTS+1 C LIWK = LLABVZ+NPTS+1 C LENU = NPTS*NPDE C LUT = 1 LUX = LUT + LENU LUY = LUX + LENU LUZ = LUY + LENU LUXX = LUZ + LENU LUYY = LUXX + LENU LUZZ = LUYY + LENU LUXY = LUZZ + LENU LUXZ = LUXY + LENU LUYZ = LUXZ + LENU C LPREC = LUYZ+LENU IF (BDPREC) THEN C Block-diagonal preconditioner LR = LPREC + LENU*NPDE ELSE C Diagonal preconditioner LR = LPREC + LENU ENDIF LU = LR + LENU LC = LU + (LENU*MAXLR) LZW = LC + (LENU*MAXLR) LRWK = LZW+ (MAXLR*MAXLR) C Ccc Set error weights for use in Newton process CALL ERRWGT (NPTS, NPDE, UNP1(1), RELTOL, ABSTOL, WT) C Ccc Compute weighted norm of initial solution for convergence check UNRM = WDNRM2 (LENU, UNP1(1), WT) C Ccc Compute derivatives and residual CALL RESID (TN+DT, X, Y, Z, NPTS, NPDE, UNP1, UN, UNM1, DT, DTRAT, + UIB, ISTRUC(LLLBND), ISTRUC(LILBND), ISTRUC(LLBNDP), + ISTRUC(LLBLWY), ISTRUC(LLABVY), ISTRUC(LLBLWZ), ISTRUC(LLABVZ), + DX, DY, DZ, + RWORK(LUT), RWORK(LUX), RWORK(LUY), RWORK(LUZ), + RWORK(LUXX), RWORK(LUYY), RWORK(LUZZ), + RWORK(LUXY), RWORK(LUXZ), RWORK(LUYZ), F) NRES = 1 IF (LUNNLS .NE. 0) THEN WRITE(LUNNLS,'('' Max. and WRMS norm residual='',2E16.7)') + MAXNRM(LENU, F), WDNRM2 (LENU, F, WT) ENDIF C Ccc Compute preconditioner: (block-)diagonal of Jacobian G = dF/dU. C Store LU-decomposition in PREC, main diagonal inverted. CALL PINIT (NPTS, NPDE, F, TN+DT, X, Y, Z, DT, DTRAT, DX, DY, DZ, + UNP1(1), ISTRUC(LLLBND), ISTRUC(LILBND), ISTRUC(LLBNDP), UIB, + RWORK(LUT), RWORK(LUX), RWORK(LUY), RWORK(LUZ), + RWORK(LUXX), RWORK(LUYY), RWORK(LUZZ), + RWORK(LUXY), RWORK(LUXZ), RWORK(LUYZ), + ABSTOL, RWORK(LR), IDIAGP, RWORK(LPREC)) NEWPRE = .TRUE. NPRE = 1 C Ccc Newton iteration loop 9 CONTINUE DO 10 NIT = 1, MAXNIT C Cccccc Solve G.corr = F. Store the residual in F. TOL = TOLLSC / (2**NIT) CALL GCRO (LENU, CORR, F, WT, TOL, BDPREC, RWORK(LPREC), + ISTRUC, X, Y, Z, NPDE, UIB, UNP1, + TN+DT, A0, DX, DY, DZ, RWORK, + NRRMAX, MAXLR, MAXL, LUNLSS, + RWORK(LR), RWORK(LU), RWORK(LC), RWORK(LZW), RWORK(LRWK), + ITER, ERR, IERR) NLSIT(LEVEL,NIT) = NLSIT(LEVEL,NIT)+ ITER IF (IERR .NE. 0) GOTO 100 C Cccccc Test for convergence CORNRM = WDNRM2 (LENU, CORR, WT) IF (LUNNLS .NE. 0) THEN WRITE(LUNNLS,'('' NI:'',I3,'', NLI:'',I4,'', ERLI'':,E16.7, + '', ERNI:'',E16.7)') NIT, ITER, ERR, CORNRM ENDIF IF (CORNRM .LE. 100*UROUND*UNRM) GOTO 900 IF (.NOT. NEWPRE) THEN RATE = SQRT(CORNRM/OLDNRM) IF (RATE .GT. 0.9) THEN C Divergence GOTO 100 ELSE IF (RATE/(1-RATE)*CORNRM .LE. TOLNEW) THEN C Convergence GOTO 900 ENDIF ENDIF OLDNRM = CORNRM C Ccccc Update solution DO 20 I = 1, LENU UNP1(I) = UNP1(I) - CORR(I) 20 CONTINUE C Ccc Compute derivatives and residual and start next iteration CALL RESID (TN+DT, X, Y, Z, NPTS, NPDE, UNP1, UN, UNM1, + DT, DTRAT, UIB, + ISTRUC(LLLBND), ISTRUC(LILBND), ISTRUC(LLBNDP), + ISTRUC(LLBLWY), ISTRUC(LLABVY), + ISTRUC(LLBLWZ), ISTRUC(LLABVZ), + DX, DY, DZ, + RWORK(LUT), RWORK(LUX), RWORK(LUY), RWORK(LUZ), + RWORK(LUXX), RWORK(LUYY), RWORK(LUZZ), + RWORK(LUXY), RWORK(LUXZ), RWORK(LUYZ), F) NRES = NRES+1 NEWPRE = .FALSE. IF (LUNNLS .NE. 0) THEN WRITE(LUNNLS,'('' Max. and WRMS norm residual='',2E16.7)') + MAXNRM(LENU, F), WDNRM2 (LENU, F, WT) ENDIF 10 CONTINUE Ccc End Newton iteration loop C Ccc No convergence in max. # iterations C Ccccc Check if preconditioner is recent 100 CONTINUE IF (.NOT. NEWPRE .AND. NPRE .LT. MAXJAC) THEN IF (LUNNLS .NE. 0) THEN WRITE(LUNNLS,'('' New preconditioner, NIT='',I4)') NIT ENDIF C Compute new preconditioner and retry C Compute space derivatives anew since they are disturbed by C MVDIFF CALL DERIVS (NPTS, NPDE, UNP1, + ISTRUC(LLLBND), ISTRUC(LILBND), ISTRUC(LLBNDP), + ISTRUC(LLBLWY), ISTRUC(LLABVY), + ISTRUC(LLBLWZ), ISTRUC(LLABVZ), + DX, DY, DZ, + RWORK(LUX), RWORK(LUY), RWORK(LUZ), + RWORK(LUXX), RWORK(LUYY), RWORK(LUZZ), + RWORK(LUXY), RWORK(LUXZ), RWORK(LUYZ)) CALL PINIT (NPTS, NPDE, F, TN+DT, X, Y, Z, DT, DTRAT, + DX, DY, DZ, UNP1(1), + ISTRUC(LLLBND), ISTRUC(LILBND), ISTRUC(LLBNDP), UIB, + RWORK(LUT), RWORK(LUX), RWORK(LUY), RWORK(LUZ), + RWORK(LUXX), RWORK(LUYY), RWORK(LUZZ), + RWORK(LUXY), RWORK(LUXZ), RWORK(LUYZ), + ABSTOL, RWORK(LR), IDIAGP, RWORK(LPREC)) NEWPRE = .TRUE. NPRE = NPRE + 1 GOTO 9 ELSE C Newton failure IERR = 10 NNIT(LEVEL) = NNIT(LEVEL)+NIT NRESID(LEVEL) = NRESID(LEVEL)+NRES NJACS(LEVEL) = NJACS(LEVEL)+NPRE IF (LUNNLS .NE. 0) THEN WRITE(LUNNLS,'(''Newton failure, NIT='',I4)') NIT ENDIF RETURN ENDIF C Ccc Nonlinear proces has been solved 900 CONTINUE C Update solution DO 30 I = 1, LENU UNP1(I) = UNP1(I) - CORR(I) 30 CONTINUE C NNIT(LEVEL) = NNIT(LEVEL)+NIT NRESID(LEVEL) = NRESID(LEVEL)+NRES NJACS(LEVEL) = NJACS(LEVEL)+NPRE C RETURN END SUBROUTINE PINIT (NPTS, NPDE, F, T, X, Y, Z, DT, DTRAT, + DX, DY, DZ, U, LLBND, ILBND, LBND, UIB, + UT, UX, UY, UZ, UXX, UYY, UZZ, UXY, UXZ, UYZ, ABSTOL, WORK, + IDIAGP, PREC) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE, LLBND(0:*), ILBND(*), LBND(*), IDIAGP DOUBLE PRECISION F(*), T, X(*), Y(*), Z(*), DT, DTRAT, DX, DY, DZ, + U(*), UIB(*), UT(*), UX(*), UY(*), UZ(*), + UXX(*), UYY(*), UZZ(*), UXY(*), UXZ(*), UYZ(*), + ABSTOL(*), WORK(*), PREC(NPTS,NPDE,*) C Ccc PURPOSE: C Store the LU-decomposition of the (block-)diagonal of the Jacobian C G = dF/dU in PREC, main diagonal inverted. C C PARAMETER DESCRIPTION: C NPTS : IN. # grid points C NPDE : IN. # PDE components C F : IN. Residual F(t,U,Ut) C T : IN. Current time C X,Y,Z : IN. Physical coordinates of gridpoints C DT : IN. Current time stepsize C DTRAT : IN. 0 or DT/DT_old C DX : IN. Current grid width in X-direction C DY : IN. Current grid width in Y-direction C DZ : IN. Current grid width in Z-direction C U : IN. Solution at T on current grid C LLBND : IN. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C UIB : IN. Solution at T on internal boundaries C LBLWY : IN. (0:NPTS) C LBLWY(IPT): pointer to node below in Y-direction in C actual grid C 0, if index node is front-plane boundary point C LABVY : IN. (0:NPTS) C LABVY(IPT): pointer to node above in Y-direction in C actual grid C 0, if index node is back-plane boundary point C LBLWZ : IN. (0:NPTS) C LBLWZ(IPT): pointer to node below in Z-direction in C actual grid C 0, if index node is down-plane boundary point C LABVZ : IN. (0:NPTS) C LABVZ(IPT): pointer to node above in Z-direction in C actual grid C 0, if index node is up-plane boundary point C UT : IN. Time derivative of U on current grid C UX : IN. -I C UY : IN. I C UZ : IN. I C UXX : IN. I C UYY : IN. I Space derivatives of U on current grid C UZZ : IN. I C UXY : IN. I C UXZ : IN. I C UYZ : IN. -I C ABSTOL : IN. Absolute tolerance for Newton process C WORK : WORK. ( ( IDIAGP = 0 ! LENU.(NPDE.7+2)+NPTS C |:IDIAGP = 1 ! LENU.(NPDE.4+2)+NPTS C |:IDIAGP = 2 ! LENU.10 C |:IDIAGP = 3 ! LENU.7 ) ) C IDIAGP : IN. Type of preconditioner C 0: block-diagonal + first order derivatives C 1: block-diagonal neglecting first order derivatives C 2: diagonal + first order derivatives C 3: diagonal neglecting first order derivatives C PREC : OUT. LU-decomposition of the (block-)diagonal of the Jacobian C G = dF/dU in PREC, main diagonal inverted. C Ccc EXTERNALS USED: EXTERNAL BLU, DERVF, DERVFB, PREG, PREGB C C----------------------------------------------------------------------- C INTEGER LENDEL, LENU, LENFU, LENFU1, + LFU, LFUX, LFUY, LFUZ, LFUXX, LFUYY, LFUZZ, LDEL, LRWK LOGICAL PRECFO DOUBLE PRECISION A0 C PRECFO = IDIAGP .EQ. 0 .OR. IDIAGP .EQ. 2 LENU = NPTS*NPDE IF (IDIAGP .LE. 1) THEN LENDEL = NPTS LENFU = LENU*NPDE ELSE LENDEL = LENU LENFU = LENU ENDIF IF (PRECFO) THEN LENFU1 = LENFU ELSE LENFU1 = 0 ENDIF C LFU = 1 LFUX = LFU + LENFU LFUY = LFUX + LENFU1 LFUZ = LFUY + LENFU1 LFUXX = LFUZ + LENFU1 LFUYY = LFUXX + LENFU LFUZZ = LFUYY + LENFU LDEL = LFUZZ + LENFU LRWK = LDEL + LENDEL A0 = (1+2*DTRAT) / ((1+DTRAT)*DT) IF (IDIAGP .LE. 1) THEN C Ccc Compute dF/dU, (dF/dUx, dF/dUy, dF/dUz,) dF/dUxx, dF/dUyy, dF/dUzz CALL DERVFB (F, T, X, Y, Z, NPTS, NPDE, U, A0, DT, DX, DY, DZ, + LLBND, ILBND, LBND, UIB, UT, UX, UY, UZ, UXX, UYY, UZZ, + UXY, UXZ, UYZ, ABSTOL, WORK(LDEL), WORK(LRWK), + PRECFO, WORK(LFU), WORK(LFUX), WORK(LFUY), WORK(LFUZ), + WORK(LFUXX), WORK(LFUYY), WORK(LFUZZ)) C Ccc Compute block-diagonal C G = dF/dU + (dF/dUx.dUx/dU + ...) + dF/dUxx.dUxx/dU + ... CALL PREGB (NPTS, NPDE, DX, DY, DZ, + LLBND, ILBND, LBND, + WORK(LFU), WORK(LFUX), WORK(LFUY), WORK(LFUZ), + WORK(LFUXX), WORK(LFUYY), WORK(LFUZZ), + PRECFO, PREC) C Ccc Store LU of G in PREC, invert main diagonal CALL BLU (NPTS, NPDE, PREC) ELSE C Ccc Compute dF/dU, (dF/dUx, dF/dUy, dF/dUz,) dF/dUxx, dF/dUyy, dF/dUzz CALL DERVF (F, T, X, Y, Z, NPTS, NPDE, U, A0, DT, DX, DY, DZ, + LLBND, ILBND, LBND, UIB, UT, UX, UY, UZ, UXX, UYY, UZZ, + UXY, UXZ, UYZ, ABSTOL, WORK(LDEL), WORK(LRWK), + PRECFO, WORK(LFU), WORK(LFUX), WORK(LFUY), WORK(LFUZ), + WORK(LFUXX), WORK(LFUYY), WORK(LFUZZ)) C Ccc Compute G = dF/dU + (dF/dUx.dUx/dU + ...) + dF/dUxx.dUxx/dU + ... C Store inverted in PREC CALL PREG (NPTS, NPDE, DX, DY, DZ, + LLBND, ILBND, LBND, + WORK(LFU), WORK(LFUX), WORK(LFUY), WORK(LFUZ), + WORK(LFUXX), WORK(LFUYY), WORK(LFUZZ), + PRECFO, PREC) ENDIF C RETURN END SUBROUTINE DERVFB (F, T, X, Y, Z, NPTS, NPDE, U, + A0, DT, DX, DY, DZ, + LLBND, ILBND, LBND, UIB, UT, UX, UY, UZ, UXX, UYY, UZZ, + UXY, UXZ, UYZ, ABSTOL, DEL, WORK, + PRECFO, FU, FUX, FUY, FUZ, FUXX, FUYY, FUZZ) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE, LLBND(0:*), ILBND(*), LBND(*) LOGICAL PRECFO DOUBLE PRECISION F(NPTS*NPDE), T, X(*), Y(*), Z(*), U(*), A0, DT, + DX, DY, DZ, + UIB(*), UT(*), UX(*), UY(*), UZ(*), UXX(*), UYY(*), UZZ(*), + UXY(*), UXZ(*), UYZ(*), ABSTOL(*), + DEL(NPTS), WORK(2*NPTS*NPDE), + FU(NPTS*NPDE,NPDE), + FUX(NPTS*NPDE,NPDE), FUY(NPTS*NPDE,NPDE), FUZ(NPTS*NPDE,NPDE), + FUXX(NPTS*NPDE,NPDE), FUYY(NPTS*NPDE,NPDE), + FUZZ(NPTS*NPDE,NPDE) C Ccc PURPOSE: C Compute derivatives of residual wrt (derivatives of) U by numerical C differencing C C PARAMETER DESCRIPTION: C F : IN. Residual F(t,U,Ut) C T : IN. Current time C X,Y,Z : IN. Physical coordinates of gridpoints C NPTS : IN. # grid points C NPDE : IN. # PDE components C U : IN. Solution at T on current grid C A0 : IN. Coefficient of U_n+1 in time derivative C DT : IN. Current time step size C DX : IN. Cell width in X-direction for current grid C DY : IN. Cell width in Y-direction for current grid C DZ : IN. Cell width in Z-direction for current grid C LLBND : IN. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C UIB : IN. Solution at T on internal boundaries C UT : IN. Time derivative of U on current grid C UX : IN. -I C UY : IN. I C UZ : IN. I C UXX : IN. I C UYY : IN. I Space derivatives of U on current grid C UZZ : IN. I C UXY : IN. I C UXZ : IN. I C UYZ : IN. -I C ABSTOL : IN. Absolute tolerance for Newton process C DEL : WORK. (NPTS) C WORK : WORK. (2.LENU) C PRECFO : IN. If FALSE first order derivatives may be neglected C FU : OUT. dF(U,Ut)dU C FUX : OUT. dF(Ux)dUx C FUY : OUT. dF(Uy)dUy C FUZ : OUT. dF(Uz)dUz C FUXX : OUT. dF(Uxx)dUxx C FUYY : OUT. dF(Uyy)dUyy C FUZZ : OUT. dF(Uzz)dUzz C Ccc EXTERNALS USED: EXTERNAL PERTRB, PRTRBU, RES C C----------------------------------------------------------------------- C INTEGER I, IC, ICPTB, IPT, LUTBAR DOUBLE PRECISION FACX, FACY, FACZ, FACXX, FACYY, FACZZ, TOL LUTBAR = 1 + NPTS*NPDE C Ccc How to decide if derivatives are `zero'? C Take `zero'-value of U divided by the grid width FACX = 1/(2*DX) FACY = 1/(2*DY) FACZ = 1/(2*DZ) FACXX = 1/DX**2 FACYY = 1/DY**2 FACZZ = 1/DZ**2 C Ccc Loop over the components of the (derivatives of) U DO 10 ICPTB = 1, NPDE C C dF(U,Ut)/dU TOL = ABSTOL(ICPTB) CALL PRTRBU (ICPTB, NPTS, NPDE, U, A0, DT, UT, TOL, DEL, + WORK, WORK(LUTBAR)) CALL RES (T, X, Y, Z, NPTS, NPDE, WORK, + LLBND, ILBND, LBND, UIB, + WORK(LUTBAR), UX, UY, UZ, + UXX, UYY, UZZ, UXY, UXZ, UYZ, FU(1,ICPTB)) DO 20 IC = 1, NPDE DO 20 IPT = 1, NPTS I = IPT + (IC-1)*NPTS FU(I,ICPTB) = (FU(I,ICPTB) - F(I)) / DEL(IPT) 20 CONTINUE IF (PRECFO) THEN C C dF(Ux)/dUx TOL = ABSTOL(ICPTB)*FACX CALL PERTRB (ICPTB, NPTS, NPDE, UX, TOL, DEL, WORK) CALL RES (T, X, Y, Z, NPTS, NPDE, U, + LLBND, ILBND, LBND, UIB, + UT, WORK, UY, UZ, + UXX, UYY, UZZ, UXY, UXZ, UYZ, FUX(1,ICPTB)) DO 21 IC = 1, NPDE DO 21 IPT = 1, NPTS I = IPT + (IC-1)*NPTS FUX(I,ICPTB) = (FUX(I,ICPTB) - F(I)) / DEL(IPT) 21 CONTINUE C C dF(Uy)/dUy TOL = ABSTOL(ICPTB)*FACY CALL PERTRB (ICPTB, NPTS, NPDE, UY, TOL, DEL, WORK) CALL RES (T, X, Y, Z, NPTS, NPDE, U, + LLBND, ILBND, LBND, UIB, + UT, UX, WORK, UZ, + UXX, UYY, UZZ, UXY, UXZ, UYZ, FUY(1,ICPTB)) DO 22 IC = 1, NPDE DO 22 IPT = 1, NPTS I = IPT + (IC-1)*NPTS FUY(I,ICPTB) = (FUY(I,ICPTB) - F(I)) / DEL(IPT) 22 CONTINUE C C dF(Uz)/dUz TOL = ABSTOL(ICPTB)*FACZ CALL PERTRB (ICPTB, NPTS, NPDE, UZ, TOL, DEL, WORK) CALL RES (T, X, Y, Z, NPTS, NPDE, U, + LLBND, ILBND, LBND, UIB, + UT, UX, UY, WORK, + UXX, UYY, UZZ, UXY, UXZ, UYZ, FUZ(1,ICPTB)) DO 23 IC = 1, NPDE DO 23 IPT = 1, NPTS I = IPT + (IC-1)*NPTS FUZ(I,ICPTB) = (FUZ(I,ICPTB) - F(I)) / DEL(IPT) 23 CONTINUE ENDIF C C dF(Uxx)/dUxx TOL = ABSTOL(ICPTB)*FACXX CALL PERTRB (ICPTB, NPTS, NPDE, UXX, TOL, DEL, WORK) CALL RES (T, X, Y, Z, NPTS, NPDE, U, + LLBND, ILBND, LBND, UIB, + UT, UX, UY, UZ, + WORK, UYY, UZZ, UXY, UXZ, UYZ, FUXX(1,ICPTB)) DO 70 IC = 1, NPDE DO 70 IPT = 1, NPTS I = IPT + (IC-1)*NPTS FUXX(I,ICPTB) = (FUXX(I,ICPTB) - F(I)) / DEL(IPT) 70 CONTINUE C C dF(Uyy)/dUyy TOL = ABSTOL(ICPTB)*FACYY CALL PERTRB (ICPTB, NPTS, NPDE, UYY, TOL, DEL, WORK) CALL RES (T, X, Y, Z, NPTS, NPDE, U, + LLBND, ILBND, LBND, UIB, + UT, UX, UY, UZ, + UXX, WORK, UZZ, UXY, UXZ, UYZ, FUYY(1,ICPTB)) DO 80 IC = 1, NPDE DO 80 IPT = 1, NPTS I = IPT + (IC-1)*NPTS FUYY(I,ICPTB) = (FUYY(I,ICPTB) - F(I)) / DEL(IPT) 80 CONTINUE C C dF(Uzz)/dUzz TOL = ABSTOL(ICPTB)*FACZZ CALL PERTRB (ICPTB, NPTS, NPDE, UZZ, TOL, DEL, WORK) CALL RES (T, X, Y, Z, NPTS, NPDE, U, + LLBND, ILBND, LBND, UIB, + UT, UX, UY, UZ, + UXX, UYY, WORK, UXY, UXZ, UYZ, FUZZ(1,ICPTB)) DO 90 IC = 1, NPDE DO 90 IPT = 1, NPTS I = IPT + (IC-1)*NPTS FUZZ(I,ICPTB) = (FUZZ(I,ICPTB) - F(I)) / DEL(IPT) 90 CONTINUE 10 CONTINUE RETURN END SUBROUTINE PREGB (NPTS, NPDE, DX, DY, DZ, + LLBND, ILBND, LBND, + FU, FUX, FUY, FUZ, FUXX, FUYY, FUZZ, PRECFO, PREC) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE, LLBND(0:*), ILBND(*), LBND(*) LOGICAL PRECFO DOUBLE PRECISION DX, DY, DZ, + FU(NPTS*NPDE,NPDE), + FUX(NPTS*NPDE,NPDE), FUY(NPTS*NPDE,NPDE), FUZ(NPTS*NPDE,NPDE), + FUXX(NPTS*NPDE,NPDE), FUYY(NPTS*NPDE,NPDE), + FUZZ(NPTS*NPDE,NPDE), PREC(NPTS*NPDE,NPDE) C Ccc PURPOSE: C Compute block-diagonal of Jacobian G = dF/dU using derivatives C of residual wrt (derivatives of) U. C C PARAMETER DESCRIPTION: C NPTS : IN. # grid points C NPDE : IN. # PDE components C DX : IN. Current grid width in X-direction C DY : IN. Current grid width in Y-direction C DZ : IN. Current grid width in Z-direction C LLBND : IN. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C FU : IN. Derivative residual F(.,U,Ut,.) wrt U C FUX : IN. Derivative residual F(.,Ux,.) wrt Ux C FUY : IN. Derivative residual F(.,Uy,.) wrt Uy C FUZ : IN. Derivative residual F(.,Uz,.) wrt Uz C FUXX : IN. Derivative residual F(.,Uxx,.) wrt Uxx C FUYY : IN. Derivative residual F(.,Uyy,.) wrt Uyy C FUZZ : IN. Derivative residual F(.,Uzz,.) wrt Uzz C PRECFO : IN. If FALSE first order derivatives may be neglected C PREC : OUT. Block-diagonal of Jacobian. C Ccc EXTERNALS USED: EXTERNAL PRGBBD C C Ccc INCLUDE 'CMNCMMACH' C C CMNCMMACH C C COMMON with `machine numbers' C LUNOUT : Logical unit # standard output -I C LUNERR : Logical unit # standard error I Set in the routine C UROUND : Smallest machine number such that I MACNUM C 1.0+UROUND > 1.0 and 1.0-UROUND < 1.0 I C XMIN : Smallest floating-point number -I INTEGER LUNOUT, LUNERR DOUBLE PRECISION UROUND, XMIN COMMON /IMACH/ LUNOUT, LUNERR COMMON /RMACH/ UROUND, XMIN SAVE /IMACH/, /RMACH/ C C end INCLUDE 'CMNCMMACH' C C C----------------------------------------------------------------------- C INTEGER I, JC, LENU DOUBLE PRECISION FACX, FACY, FACZ, FACXX, FACYY, FACZZ C LENU = NPTS*NPDE C FACXX = 1/DX**2 FACYY = 1/DY**2 FACZZ = 1/DZ**2 C DO 10 JC = 1, NPDE DO 10 I = 1, LENU C dF(ipt,ic)/dU(ipt,ic) PREC(I,JC) = FU(I,JC) + + FUXX(I,JC)*(-2*FACXX) + FUYY(I,JC)*(-2*FACYY) + + FUZZ(I,JC)*(-2*FACZZ) 10 CONTINUE C IF (PRECFO) THEN FACX = 1/(2*DX) FACY = 1/(2*DY) FACZ = 1/(2*DZ) CALL PRGBBD (NPTS, NPDE, FACX, FACY, FACZ, + LLBND, ILBND, LBND, FUX, FUY, FUZ, PREC) ENDIF C RETURN END SUBROUTINE PRGBBD (NPTS, NPDE, FACX, FACY, FACZ, + LLBND, ILBND, LBND, FUX, FUY, FUZ, G) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE, LLBND(0:*), ILBND(*), LBND(*) DOUBLE PRECISION FACX, FACY, FACZ, + FUX(NPTS,NPDE,NPDE), FUY(NPTS,NPDE,NPDE), FUZ(NPTS,NPDE,NPDE), + G(NPTS,NPDE,NPDE) C Ccc PURPOSE: C Correct Jacobian G = dF/dU for second order approximation of C first order derivatives at boundaries C C PARAMETER DESCRIPTION: C NPTS : IN. # grid points C NPDE : IN. # PDE components C FACX : IN. 1/(2*DX) C FACY : IN. 1/(2*DY) C FACZ : IN. 1/(2*DZ) C LLBND : IN. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C FUX : IN. Derivative residual C F(t,U,Ut,Ux,Uy,Uz,Uxx,Uyy,Uzz,Uxy,Uxz,Uyz) wrt Ux C FUY : IN. Derivative residual C F(t,U,Ut,Ux,Uy,Uz,Uxx,Uyy,Uzz,Uxy,Uxz,Uyz) wrt Uy C FUZ : IN. Derivative residual C F(t,U,Ut,Ux,Uy,Uz,Uxx,Uyy,Uzz,Uxy,Uxz,Uyz) wrt Uz C G : INOUT. C IN: block-diagonal of Jacobian C OUT: corrected for first order derivatives at boundaries C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER IPT, IC, JC, IB, LB C Ccc Boundary corrections, no corrections needed for internal boundaries DO 10 IB = 1, LLBND(0) IF (ILBND(IB) .EQ. 1) THEN C Left plane, correction needed for dF/dUx DO 20 JC = 1, NPDE DO 20 IC = 1, NPDE CDIR$ IVDEP DO 25 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) G(IPT,IC,JC) = G(IPT,IC,JC) + + FUX(IPT,IC,JC)*(-3*FACX) 25 CONTINUE 20 CONTINUE ELSE IF (ILBND(IB) .EQ. 2) THEN C Down plane, correction needed for dF/dUz DO 30 JC = 1, NPDE DO 30 IC = 1, NPDE CDIR$ IVDEP DO 35 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) G(IPT,IC,JC) = G(IPT,IC,JC) + + FUZ(IPT,IC,JC)*(-3*FACZ) 35 CONTINUE 30 CONTINUE ELSE IF (ILBND(IB) .EQ. 3) THEN C Right plane, correction needed for dF/dUx DO 40 JC = 1, NPDE DO 40 IC = 1, NPDE CDIR$ IVDEP DO 45 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) G(IPT,IC,JC) = G(IPT,IC,JC) + + FUX(IPT,IC,JC)*(+3*FACX) 45 CONTINUE 40 CONTINUE ELSE IF (ILBND(IB) .EQ. 4) THEN C Up plane, correction needed for dF/dUz DO 50 JC = 1, NPDE DO 50 IC = 1, NPDE CDIR$ IVDEP DO 55 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) C dF(ipt,ic)/dU(below(below(ipt)),jc) G(IPT,IC,JC) = G(IPT,IC,JC) + + FUZ(IPT,IC,JC)*(+3*FACZ) 55 CONTINUE 50 CONTINUE ELSE IF (ILBND(IB) .EQ. 5) THEN C Front plane, correction needed for dF/dUy DO 60 JC = 1, NPDE DO 60 IC = 1, NPDE CDIR$ IVDEP DO 65 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) G(IPT,IC,JC) = G(IPT,IC,JC) + + FUY(IPT,IC,JC)*(-3*FACY) 65 CONTINUE 60 CONTINUE ELSE IF (ILBND(IB) .EQ. 6) THEN C Back plane, correction needed for dF/dUy DO 70 JC = 1, NPDE DO 70 IC = 1, NPDE CDIR$ IVDEP DO 75 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) G(IPT,IC,JC) = G(IPT,IC,JC) + + FUY(IPT,IC,JC)*(+3*FACY) 75 CONTINUE 70 CONTINUE ENDIF 10 CONTINUE C RETURN END SUBROUTINE BLU (NPTS, NPDE, A) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE DOUBLE PRECISION A(NPTS,NPDE,NPDE) C Ccc PURPOSE: C LU decomposition of block-diagonal A C Ccc PARAMETER DESCRIPTION: C NPTS : IN. # gridpoints C NPDE : IN. # components of the PDE C A : INOUT. C IN: main block diagonal C OUT: A(.,ic,jc): jc < ic: block diagonal of L C diagonal L == I C jc >=ic: block diagonal of U C diagonal U inverted C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER IC, JC, LC, N DOUBLE PRECISION D C DO 550 IC = 1, NPDE DO 554 LC = 1, IC-1 DO 555 JC = IC, NPDE CDIR$ IVDEP DO 551 N = 1, NPTS A(N,IC,JC) = A(N,IC,JC) + - A(N,IC,LC)*A(N,LC,JC) 551 CONTINUE 555 CONTINUE DO 556 JC = IC+1, NPDE CDIR$ IVDEP DO 552 N = 1, NPTS A(N,JC,IC) = A(N,JC,IC) + - A(N,JC,LC)*A(N,LC,IC) 552 CONTINUE 556 CONTINUE 554 CONTINUE CDIR$ IVDEP DO 553 N = 1, NPTS D = A(N,IC,IC) IF (ABS(D) .LT. 1D-7) THEN A(N,IC,IC) = 1.0 ELSE A(N,IC,IC) = 1.0 / D ENDIF 553 CONTINUE DO 557 JC = IC+1, NPDE CDIR$ IVDEP DO 559 N = 1, NPTS A(N,JC,IC) = A(N,JC,IC) * A(N,IC,IC) 559 CONTINUE 557 CONTINUE 550 CONTINUE C RETURN END SUBROUTINE BCKBDI (NPTS, NPDE, A, B, X) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE DOUBLE PRECISION A(NPTS,NPDE,NPDE), X(NPTS,NPDE), B(NPTS,NPDE) C Ccc PURPOSE: C Solve LUx = b C A is a block-diagonal matrix C A((i,j,k),1:NPDE,1:NPDE) contains a block of NPDE.NPDE elements C corresponding with node (i,j,k) C Ccc PARAMETER DESCRIPTION: C NPTS : IN. # gridpoints C NPDE : IN. # components of the PDE C A : IN. A(.,ic,jc): jc < ic: block diagonal of L C diagonal L == I C jc >=ic: block diagonal of U C diagonal U inverted C X : OUT: solution vector x C B : IN: right-hand side vector b C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER IC, JC, N C CALL RCOPY (NPTS*NPDE, B, X) C CCC Ly = b C DO 100 IC = 2, NPDE DO 101 JC = 1, IC-1 CDIR$ IVDEP DO 1 N = 1, NPTS X(N,IC) = X(N,IC) - A(N,IC,JC)*X(N,JC) 1 CONTINUE 101 CONTINUE 100 CONTINUE C CCC Ux = y C DO 130 IC = NPDE, 1, -1 DO 131 JC = NPDE, IC+1, -1 CDIR$ IVDEP DO 132 N = 1, NPTS X(N,IC) = X(N,IC) - A(N,IC,JC)*X(N,JC) 132 CONTINUE 131 CONTINUE CDIR$ IVDEP DO 133 N = 1, NPTS X(N,IC) = X(N,IC) * A(N,IC,IC) 133 CONTINUE 130 CONTINUE C RETURN END SUBROUTINE DERVF (F, T, X, Y, Z, NPTS, NPDE, U, + A0, DT, DX, DY, DZ, + LLBND, ILBND, LBND, UIB, UT, UX, UY, UZ, UXX, UYY, UZZ, + UXY, UXZ, UYZ, ABSTOL, DEL, WORK, + PRECFO, FU, FUX, FUY, FUZ, FUXX, FUYY, FUZZ) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE, LLBND(0:*), ILBND(*), LBND(*) LOGICAL PRECFO DOUBLE PRECISION F(NPTS*NPDE), T, X(*), Y(*), Z(*), U(*), A0, DT, + DX, DY, DZ, + UIB(*), UT(*), UX(*), UY(*), UZ(*), UXX(*), UYY(*), UZZ(*), + UXY(*), UXZ(*), UYZ(*), ABSTOL(*), + DEL(NPTS*NPDE), WORK(2*NPTS*NPDE), + FU(NPTS*NPDE), + FUX(NPTS*NPDE), FUY(NPTS*NPDE), FUZ(NPTS*NPDE), + FUXX(NPTS*NPDE), FUYY(NPTS*NPDE), FUZZ(NPTS*NPDE) C Ccc PURPOSE: C Compute derivatives of residual wrt (derivatives of) U by numerical C differencing C C PARAMETER DESCRIPTION: C F : IN. Residual F(t,U,Ut) C T : IN. Current time C X,Y,Z : IN. Physical coordinates of gridpoints C NPTS : IN. # grid points C NPDE : IN. # PDE components C U : IN. Solution at T on current grid C A0 : IN. Coefficient of U_n+1 in time derivative C DT : IN. Current time step size C DX : IN. Cell width in X-direction for current grid C DY : IN. Cell width in Y-direction for current grid C DZ : IN. Cell width in Z-direction for current grid C LLBND : IN. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C UIB : IN. Solution at T on internal boundaries C UT : IN. Time derivative of U on current grid C UX : IN. -I C UY : IN. I C UZ : IN. I C UXX : IN. I C UYY : IN. I Space derivatives of U on current grid C UZZ : IN. I C UXY : IN. I C UXZ : IN. I C UYZ : IN. -I C ABSTOL : IN. Absolute tolerance for Newton process C DEL : WORK. (LENU) C WORK : WORK. (2.LENU) C PRECFO : IN. If FALSE first order derivatives may be neglected C FU : OUT. dF(U,Ut)dU C FUX : OUT. dF(Ux)dUx C FUY : OUT. dF(Uy)dUy C FUZ : OUT. dF(Uz)dUz C FUXX : OUT. dF(Uxx)dUxx C FUYY : OUT. dF(Uyy)dUyy C FUZZ : OUT. dF(Uzz)dUzz C Ccc EXTERNALS USED: EXTERNAL PERTRG, PRTRGU, RES C C----------------------------------------------------------------------- C INTEGER I, LENU, LUTBAR DOUBLE PRECISION FACX, FACY, FACZ, FACXX, FACYY, FACZZ LENU = NPTS*NPDE LUTBAR = 1 + LENU C Ccc How to decide if derivatives are `zero'? C Take `zero'-value of U divided by the grid width FACXX = 1/DX**2 FACYY = 1/DY**2 FACZZ = 1/DZ**2 C C dF(U,Ut)/dU CALL PRTRGU (NPTS, NPDE, U, A0, DT, UT, ABSTOL, DEL, + WORK, WORK(LUTBAR)) CALL RES (T, X, Y, Z, NPTS, NPDE, WORK, + LLBND, ILBND, LBND, UIB, + WORK(LUTBAR), UX, UY, UZ, + UXX, UYY, UZZ, UXY, UXZ, UYZ, FU) DO 10 I = 1, LENU FU(I) = (FU(I) - F(I)) / DEL(I) 10 CONTINUE IF (PRECFO) THEN C FACX = 1/(2*DX) FACY = 1/(2*DY) FACZ = 1/(2*DZ) C C dF(Ux)/dUx CALL PERTRG (NPTS, NPDE, UX, ABSTOL, FACX, DEL, WORK) CALL RES (T, X, Y, Z, NPTS, NPDE, U, + LLBND, ILBND, LBND, UIB, + UT, WORK, UY, UZ, + UXX, UYY, UZZ, UXY, UXZ, UYZ, FUX) DO 11 I = 1, LENU FUX(I) = (FUX(I) - F(I)) / DEL(I) 11 CONTINUE C C dF(Uy)/dUy CALL PERTRG (NPTS, NPDE, UY, ABSTOL, FACY, DEL, WORK) CALL RES (T, X, Y, Z, NPTS, NPDE, U, + LLBND, ILBND, LBND, UIB, + UT, UX, WORK, UZ, + UXX, UYY, UZZ, UXY, UXZ, UYZ, FUY) DO 12 I = 1, LENU FUY(I) = (FUY(I) - F(I)) / DEL(I) 12 CONTINUE C C dF(Uz)/dUz CALL PERTRG (NPTS, NPDE, UZ, ABSTOL, FACZ, DEL, WORK) CALL RES (T, X, Y, Z, NPTS, NPDE, U, + LLBND, ILBND, LBND, UIB, + UT, UX, UY, WORK, + UXX, UYY, UZZ, UXY, UXZ, UYZ, FUZ) DO 13 I = 1, LENU FUZ(I) = (FUZ(I) - F(I)) / DEL(I) 13 CONTINUE ENDIF C C dF(Uxx)/dUxx CALL PERTRG (NPTS, NPDE, UXX, ABSTOL, FACXX, DEL, WORK) CALL RES (T, X, Y, Z, NPTS, NPDE, U, + LLBND, ILBND, LBND, UIB, + UT, UX, UY, UZ, + WORK, UYY, UZZ, UXY, UXZ, UYZ, FUXX) DO 20 I = 1, LENU FUXX(I) = (FUXX(I) - F(I)) / DEL(I) 20 CONTINUE C C dF(Uyy)/dUyy CALL PERTRG (NPTS, NPDE, UYY, ABSTOL, FACYY, DEL, WORK) CALL RES (T, X, Y, Z, NPTS, NPDE, U, + LLBND, ILBND, LBND, UIB, + UT, UX, UY, UZ, + UXX, WORK, UZZ, UXY, UXZ, UYZ, FUYY) DO 30 I = 1, LENU FUYY(I) = (FUYY(I) - F(I)) / DEL(I) 30 CONTINUE C C dF(Uzz)/dUzz CALL PERTRG (NPTS, NPDE, UZZ, ABSTOL, FACZZ, DEL, WORK) CALL RES (T, X, Y, Z, NPTS, NPDE, U, + LLBND, ILBND, LBND, UIB, + UT, UX, UY, UZ, + UXX, UYY, WORK, UXY, UXZ, UYZ, FUZZ) DO 40 I = 1, LENU FUZZ(I) = (FUZZ(I) - F(I)) / DEL(I) 40 CONTINUE RETURN END SUBROUTINE PRTRGU (NPTS, NPDE, U, A0, DT, UT, ABSTOL, DEL, + UBAR, UTBAR) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE DOUBLE PRECISION U(NPTS,NPDE), A0, DT, UT(NPTS,NPDE), + ABSTOL(NPDE), + DEL(NPTS,NPDE), UBAR(NPTS,NPDE), UTBAR(NPTS,NPDE) C Ccc PURPOSE: C Perturb U. Return perturbance in DEL and perturbed U in UBAR. C Ccc PARAMETER DESCRIPTION: C NPTS : IN. # gridpoints C NPDE : IN. # PDE components C U : IN. Solution or derivative of solution to be perturbed C A0 : IN. Coefficient of U_n+1 in time derivative C DT : IN. Current time step size C UT : IN. Time derivative of U on current grid C ABSTOL : IN. Absolute tolerance for Newton process C DEL : OUT. Perturbation values C UBAR : OUT. Perturbed values of U C UTBAR : OUT. Perturbed values of UT C Ccc EXTERNALS USED: EXTERNAL RCOPY C C Ccc INCLUDE 'CMNCMMACH' C C CMNCMMACH C C COMMON with `machine numbers' C LUNOUT : Logical unit # standard output -I C LUNERR : Logical unit # standard error I Set in the routine C UROUND : Smallest machine number such that I MACNUM C 1.0+UROUND > 1.0 and 1.0-UROUND < 1.0 I C XMIN : Smallest floating-point number -I INTEGER LUNOUT, LUNERR DOUBLE PRECISION UROUND, XMIN COMMON /IMACH/ LUNOUT, LUNERR COMMON /RMACH/ UROUND, XMIN SAVE /IMACH/, /RMACH/ C C end INCLUDE 'CMNCMMACH' C C C----------------------------------------------------------------------- C INTEGER IC, IPT DOUBLE PRECISION DELI, EPS, TOL CALL RCOPY (NPTS*NPDE, U, UBAR) CALL RCOPY (NPTS*NPDE, UT, UTBAR) EPS = SQRT(UROUND) DO 10 IC = 1, NPDE TOL = ABSTOL(IC) DO 20 IPT = 1, NPTS C Compute perturbance, if U=0, U(T+dt)=dtUt, if both are zero take C threshold DELI = EPS*MAX(ABS(U(IPT,IC)),ABS(DT*UT(IPT,IC)),TOL) DELI = SIGN(DELI,DT*UT(IPT,IC)) C To ensure that the perturbance is the same machine number as the C denominator DEL(IPT,IC) = (U(IPT,IC)+DELI)-U(IPT,IC) UBAR(IPT,IC) = U(IPT,IC) + DEL(IPT,IC) UTBAR(IPT,IC) = UT(IPT,IC) + A0*DEL(IPT,IC) 20 CONTINUE 10 CONTINUE RETURN END SUBROUTINE PERTRG (NPTS, NPDE, U, ABSTOL, FAC, DEL, UBAR) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE DOUBLE PRECISION U(NPTS,NPDE), ABSTOL(NPDE), FAC, DEL(NPTS,NPDE), + UBAR(NPTS,NPDE) C Ccc PURPOSE: C Perturb U. Return perturbance in DEL and perturbed U in UBAR. C Ccc PARAMETER DESCRIPTION: C NPTS : IN. # gridpoints C NPDE : IN. # PDE components C U : IN. Derivative of solution to be perturbed C ABSTOL : IN. Absolute tolerance for Newton process C FAC : IN. Grid factor for tolerance to get threshold C DEL : OUT. Perturbation values C UBAR : OUT. Perturbed values of U C Ccc EXTERNALS USED: EXTERNAL RCOPY C C Ccc INCLUDE 'CMNCMMACH' C C CMNCMMACH C C COMMON with `machine numbers' C LUNOUT : Logical unit # standard output -I C LUNERR : Logical unit # standard error I Set in the routine C UROUND : Smallest machine number such that I MACNUM C 1.0+UROUND > 1.0 and 1.0-UROUND < 1.0 I C XMIN : Smallest floating-point number -I INTEGER LUNOUT, LUNERR DOUBLE PRECISION UROUND, XMIN COMMON /IMACH/ LUNOUT, LUNERR COMMON /RMACH/ UROUND, XMIN SAVE /IMACH/, /RMACH/ C C end INCLUDE 'CMNCMMACH' C C C----------------------------------------------------------------------- C INTEGER IC, IPT DOUBLE PRECISION DELI, EPS, TOL CALL RCOPY (NPTS*NPDE, U, UBAR) EPS = SQRT(UROUND) DO 10 IC = 1, NPDE TOL = ABSTOL(IC)*FAC DO 20 IPT = 1, NPTS C Compute perturbance DELI = EPS*MAX(ABS(U(IPT,IC)),TOL) C To ensure that UBAR has the same sign as U DELI = SIGN(DELI,U(IPT,IC)) C To ensure that the perturbance is the same machine number as the C denominator DEL(IPT,IC) = (U(IPT,IC)+DELI)-U(IPT,IC) UBAR(IPT,IC) = U(IPT,IC) + DEL(IPT,IC) 20 CONTINUE 10 CONTINUE RETURN END SUBROUTINE PREG (NPTS, NPDE, DX, DY, DZ, + LLBND, ILBND, LBND, + FU, FUX, FUY, FUZ, FUXX, FUYY, FUZZ, PRECFO, DGINV) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE, LLBND(0:*), ILBND(*), LBND(*) LOGICAL PRECFO DOUBLE PRECISION DX, DY, DZ, + FU(NPTS*NPDE), + FUX(NPTS*NPDE), FUY(NPTS*NPDE), FUZ(NPTS*NPDE), + FUXX(NPTS*NPDE), FUYY(NPTS*NPDE), FUZZ(NPTS*NPDE), + DGINV(NPTS*NPDE) C Ccc PURPOSE: C Compute inverse of diagonal of Jacobian G = dF/dU using derivatives C of residual wrt (derivatives of) U. C C PARAMETER DESCRIPTION: C NPTS : IN. # grid points C NPDE : IN. # PDE components C DX : IN. Current grid width in X-direction C DY : IN. Current grid width in Y-direction C DZ : IN. Current grid width in Z-direction C LLBND : IN. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C FU : IN. Derivative residual F(.,U,Ut,.) wrt U C FUXX : IN. Derivative residual F(.,Uxx,.) wrt Uxx C FUYY : IN. Derivative residual F(.,Uyy,.) wrt Uyy C FUZZ : IN. Derivative residual F(.,Uzz,.) wrt Uzz C PRECFO : IN. If FALSE first order derivatives may be neglected C DGINV : OUT. Inverse of diagonal of Jacobian. C Ccc EXTERNALS USED: EXTERNAL PREGBD C C Ccc INCLUDE 'CMNCMMACH' C C CMNCMMACH C C COMMON with `machine numbers' C LUNOUT : Logical unit # standard output -I C LUNERR : Logical unit # standard error I Set in the routine C UROUND : Smallest machine number such that I MACNUM C 1.0+UROUND > 1.0 and 1.0-UROUND < 1.0 I C XMIN : Smallest floating-point number -I INTEGER LUNOUT, LUNERR DOUBLE PRECISION UROUND, XMIN COMMON /IMACH/ LUNOUT, LUNERR COMMON /RMACH/ UROUND, XMIN SAVE /IMACH/, /RMACH/ C C end INCLUDE 'CMNCMMACH' C C C----------------------------------------------------------------------- C INTEGER I, LENU DOUBLE PRECISION DG, EPS, FACX, FACY, FACZ, FACXX, FACYY, FACZZ C EPS = SQRT(UROUND) C LENU = NPTS*NPDE C FACXX = 1/DX**2 FACYY = 1/DY**2 FACZZ = 1/DZ**2 C DO 10 I = 1, LENU C dF(ipt,ic)/dU(ipt,ic) DGINV(I) = FU(I) + + FUXX(I)*(-2*FACXX) + FUYY(I)*(-2*FACYY) + + FUZZ(I)*(-2*FACZZ) 10 CONTINUE IF (PRECFO) THEN FACX = 1/(2*DX) FACY = 1/(2*DY) FACZ = 1/(2*DZ) CALL PREGBD (NPTS, NPDE, FACX, FACY, FACZ, + LLBND, ILBND, LBND, FUX, FUY, FUZ, DGINV) ENDIF DO 20 I = 1, LENU DG = DGINV(I) IF (ABS(DG) .LT. EPS) THEN DGINV(I) = 1.0 ELSE DGINV(I) = 1.0/DG ENDIF 20 CONTINUE C RETURN END SUBROUTINE PREGBD (NPTS, NPDE, FACX, FACY, FACZ, + LLBND, ILBND, LBND, FUX, FUY, FUZ, G) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE, LLBND(0:*), ILBND(*), LBND(*) DOUBLE PRECISION FACX, FACY, FACZ, + FUX(NPTS,NPDE), FUY(NPTS,NPDE), FUZ(NPTS,NPDE), + G(NPTS,NPDE) C Ccc PURPOSE: C Correct Jacobian G = dF/dU for second order approximation of C first order derivatives at boundaries C C PARAMETER DESCRIPTION: C NPTS : IN. # grid points C NPDE : IN. # PDE components C FACX : IN. 1/(2*DX) C FACY : IN. 1/(2*DY) C FACZ : IN. 1/(2*DZ) C LLBND : IN. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C FUX : IN. Derivative residual C F(t,U,Ut,Ux,Uy,Uz,Uxx,Uyy,Uzz,Uxy,Uxz,Uyz) wrt Ux C FUY : IN. Derivative residual C F(t,U,Ut,Ux,Uy,Uz,Uxx,Uyy,Uzz,Uxy,Uxz,Uyz) wrt Uy C FUZ : IN. Derivative residual C F(t,U,Ut,Ux,Uy,Uz,Uxx,Uyy,Uzz,Uxy,Uxz,Uyz) wrt Uz C G : INOUT. C IN: Main diagonal of Jacobian C OUT: G corrected for first order derivatives at C boundaries C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER IPT, IC, IB, LB C Ccc Boundary corrections, no corrections needed for internal boundaries DO 10 IB = 1, LLBND(0) IF (ILBND(IB) .EQ. 1) THEN C Left plane, correction needed for dF/dUx DO 20 IC = 1, NPDE CDIR$ IVDEP DO 25 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) G(IPT,IC) = G(IPT,IC) + FUX(IPT,IC)*(-3*FACX) 25 CONTINUE 20 CONTINUE ELSE IF (ILBND(IB) .EQ. 2) THEN C Down plane, correction needed for dF/dUz DO 30 IC = 1, NPDE CDIR$ IVDEP DO 35 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) G(IPT,IC) = G(IPT,IC) + FUZ(IPT,IC)*(-3*FACZ) 35 CONTINUE 30 CONTINUE ELSE IF (ILBND(IB) .EQ. 3) THEN C Right plane, correction needed for dF/dUx DO 40 IC = 1, NPDE CDIR$ IVDEP DO 45 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) G(IPT,IC) = G(IPT,IC) + FUX(IPT,IC)*(+3*FACX) 45 CONTINUE 40 CONTINUE ELSE IF (ILBND(IB) .EQ. 4) THEN C Up plane, correction needed for dF/dUz DO 50 IC = 1, NPDE CDIR$ IVDEP DO 55 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) G(IPT,IC) = G(IPT,IC) + FUZ(IPT,IC)*(+3*FACZ) 55 CONTINUE 50 CONTINUE ELSE IF (ILBND(IB) .EQ. 5) THEN C Front plane, correction needed for dF/dUy DO 60 IC = 1, NPDE CDIR$ IVDEP DO 65 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) G(IPT,IC) = G(IPT,IC) + FUY(IPT,IC)*(-3*FACY) 65 CONTINUE 60 CONTINUE ELSE IF (ILBND(IB) .EQ. 6) THEN C Back plane, correction needed for dF/dUy DO 70 IC = 1, NPDE CDIR$ IVDEP DO 75 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) G(IPT,IC) = G(IPT,IC) + FUY(IPT,IC)*(+3*FACY) 75 CONTINUE 70 CONTINUE ENDIF 10 CONTINUE C RETURN END SUBROUTINE GCRO (N, XV, F, WT, TOL, BDPREC, PREC, + ISTRUC, X, Y, Z, NPDE, UIB, UNP1, + TNP1, A0, DX, DY, DZ, RWORK, + NRRMAX, MAXLR, MAXL, LUN, + R, U, C, ZW, WORK, ITER, ERR, IERR) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER N, ISTRUC(0:*), NPDE, NRRMAX, MAXLR, MAXL, LUN, + ITER, IERR LOGICAL BDPREC DOUBLE PRECISION XV(N), F(N), WT(N), TOL, PREC(N), + X(*), Y(*), Z(*), UIB(*), UNP1(0:*), + TNP1, A0, DX, DY, DZ, RWORK(*), + R(N), U(N,0:MAXLR-1), C(N,0:MAXLR-1), ZW(0:MAXLR-1,0:MAXLR-1), + WORK(*), ERR C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: C Ccc PURPOSE: C Solve a Non-Symmetric linear system Gx = F using the matrix-free C (block)-diagonally scaled GCRO(NRRMAX+1,MAXLR,(MAXL)) method. C Actually solved is the system [W.D^(-1).G.W^(-1)].[W.x] = [W.D^(-1).F] C where W = diag(WT(i)) and D is the (block) diagonal of G C until max(||residual||_2,||GM^(-1).residual||_2) < TOL, C with GM the projection of the matrix unto the Krylov base obtained C with the GMRES inner iteration. C Ccc PARAMETER DESCRIPTION: C N : IN. Dimension of the system C XV : OUT. Final approximate solution. C F : IN. Right-hand side vector. C WT : IN. Contains weight factors to compute weighted norm. C TOL : IN. System is considered to be solved if C weighted 2-norm < TOL C BDPREC : IN. if true a block-diagonal preconditioner is used C PREC : IN. LU decomposition of (block-)diagonal of G. main diagonal C inverted C ISTRUC : IN. -I Parameters C ... I for C RWORK : IN. -I residual evaluation C NRRMAX : IN. # restarts outer loop C MAXLR : IN. max. iterations outer loop C MAXL : IN. max. iterations GMRES (no restarts) C LUN : IN. Logical unit # of file on which to write the error at C each iteration, if this is desired for monitoring convergence C If LUN = 0, no writing will occur. C R : WORK. C U : WORK. C C : WORK. C ZW : WORK. C WORK : WORK. (N.(MAXL+1)+(MAXL+3).MAXL+4.N+1) C ITER : OUT. Number of iterations required to reach convergence, or C until (NRRMAX+1).MAXLR. outer loop iterations have been C performed. ITER is the sum of the number of outerloop C iterations + number of GMRES (preconditioner) iterations. C ERR : OUT. Weighted 2-norm of error estimate in final C approximate solution C IERR : OUT. Error return flag C 0: OK C 1: Method failed to converge in (NRRMAX+1).MAXLR. outer loop C iterations C 2: Break down in outer loop C Ccc EXTERNALS USED: DOUBLE PRECISION DDOT, DNRM2 EXTERNAL BCKBDI, GMRESO, MVDIFF, RCOPY, DAXPY, DDOT, DNRM2, ZERO C C Ccc INCLUDE 'CMNCMMACH' C C CMNCMMACH C C COMMON with `machine numbers' C LUNOUT : Logical unit # standard output -I C LUNERR : Logical unit # standard error I Set in the routine C UROUND : Smallest machine number such that I MACNUM C 1.0+UROUND > 1.0 and 1.0-UROUND < 1.0 I C XMIN : Smallest floating-point number -I INTEGER LUNOUT, LUNERR DOUBLE PRECISION UROUND, XMIN COMMON /IMACH/ LUNOUT, LUNERR COMMON /RMACH/ UROUND, XMIN SAVE /IMACH/, /RMACH/ C C end INCLUDE 'CMNCMMACH' C C C----------------------------------------------------------------------- C INTEGER I, IR, J, K, GRITER, PRITER, GMITER, + LV, LHES, LQ, LRWRK DOUBLE PRECISION RNRM, UNRM C Ccc Distribute workspace for GMRES LV = 1 LHES = LV + N*(MAXL+1) LQ = LHES + (MAXL+1)*MAXL LRWRK= LQ + 2*MAXL C ITER = 0 IERR = 0 GRITER = 0 PRITER = 0 C Ccc Initialize X and set initial residual to r_0 = W.D^(-1).F CALL ZERO (N, XV) IF (BDPREC) THEN CALL BCKBDI (N/NPDE, NPDE, PREC, F, R) DO 10 I = 1, N R(I) = WT(I)*R(I) 10 CONTINUE ELSE DO 11 I = 1, N R(I) = WT(I)*PREC(I)*F(I) 11 CONTINUE ENDIF C C Ccc Check stopping criterion ERR = DNRM2 (N, R, 1) IF (LUN .NE. 0) THEN WRITE(LUN,*) + 'Diag. scaled GCRO(NRRMAX,MAXLR))' WRITE(LUN,'(''NRRMAX, MAXLR, N:'',3I10)') + NRRMAX, MAXLR, N WRITE(LUN,*) '# it. GCRO # it.GMRES Error Estimate' WRITE(LUN,'(2I10,E20.7)') GRITER, PRITER, ERR ENDIF IF (ERR .LT. SQRT(UROUND)*TOL) RETURN C Ccc Restart loop DO 150 IR = 0, NRRMAX IERR = 0 C Ccc Outer loop DO 200 K = 0, MAXLR-1 C C Perform the diagonally scaled GMRES algorithm to solve C (I-C_k-1C_k-1^T).[W.D^(-1).G.W^(-1)].u_k = A_k-1.u_k = r_k-1, C r_k = r_k-1 - A_k-1.u_k C c_k = (r_k-1 - r_k)/ C to compute the initial preconditioner for the E-N process C If u_k is solved accurately enough ||u_k = H_k.r_k||_2 is a good C measure for the error when solving DAE systems. CALL GMRESO (N, U(1,K), R, WT, BDPREC, PREC, C, K, TOL, MAXL, + F, ISTRUC, X, Y, Z, NPDE, UIB, UNP1, + TNP1, A0, DX, DY, DZ, RWORK, + WORK(LV), WORK(LHES), WORK(LQ), WORK(LRWRK), + LUN, GMITER, ERR, IERR) PRITER = PRITER + GMITER IF (LUN .GT. 0) THEN WRITE(LUN,*) 'Result GMRES:', GMITER, TOL, ERR, IERR ENDIF IF (IERR .GT. 1) THEN PRINT *, 'wat nu?' STOP ENDIF IERR = 0 C Ccc Check stopping criterion UNRM = DNRM2 (N, U(1,K), 1) C C Compute v = [W.D^(-1).G.W^(-1)].u_k DO 210 I = 1, N WORK(LV+N-1+I) = U(I,K)/WT(I)/UNRM 210 CONTINUE CALL MVDIFF (N, F, WORK(LV+N), + ISTRUC, X, Y, Z, NPDE, UIB, UNP1, + TNP1, A0, DX, DY, DZ, RWORK, + WORK(LHES), WORK(LV)) IF (BDPREC) THEN CALL BCKBDI (N/NPDE, NPDE, PREC, WORK(LV), WORK(LV+N)) DO 220 I = 1, N WORK(LV-1+I) = WT(I)*WORK(LV+N-1+I)*UNRM 220 CONTINUE ELSE DO 221 I = 1, N WORK(LV-1+I) = WT(I)*PREC(I)*WORK(LV-1+I)*UNRM 221 CONTINUE ENDIF C C C Compute ZW[0:k-1,k] = C_k^T.v DO 300 I = 0, K-1 ZW(I,K) = DDOT(N, C(1,I),1, WORK(LV),1) 300 CONTINUE C GRITER = GRITER + 1 C Ccc Check stopping criterion RNRM = DNRM2 (N, R, 1) IF (LUN .NE. 0) THEN WRITE(LUN,'(2I10,2E20.7)') GRITER, PRITER, RNRM, UNRM ENDIF IF (MAX(RNRM,UNRM) .LT. TOL) THEN C Compute x = x + U_k.Z_k^(-1).1 DO 310 I = K, 0, -1 WORK(LV+I) = 1 DO 320 J = I+1, K WORK(LV+I) = WORK(LV+I) - ZW(I,J)*WORK(LV+J) 320 CONTINUE CALL DAXPY (N, WORK(LV+I), U(1,I), 1, XV, 1) 310 CONTINUE ITER = GRITER + PRITER GOTO 900 ENDIF 200 CONTINUE Ccc End outer loop C Compute x = x + U_k.Z_k^(-1).1 K = MAXLR-1 DO 330 I = K, 0, -1 WORK(LV+I) = 1 DO 340 J = I+1, K WORK(LV+I) = WORK(LV+I) - ZW(I,J)*WORK(LV+J) 340 CONTINUE CALL DAXPY (N, WORK(LV+I), U(1,I), 1, XV, 1) 330 CONTINUE C 150 CONTINUE Ccc End Restart loop C IERR = 1 ITER = GRITER + PRITER C 900 CONTINUE C Unscale x DO 910 I = 1, N XV(I) = XV(I) / WT(I) 910 CONTINUE RETURN END SUBROUTINE GMRESO (N, XV, BV, WT, BDPREC, PREC, CO, M, TOL, MAXL, + F, ISTRUC, X, Y, Z, NPDE, UIB, UNP1, + TNP1, A0, DX, DY, DZ, RWORK, + V, HES, Q, WORK, + LUN, ITER, ERR, IERR) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER N, M, ISTRUC(0:*), NPDE, MAXL, LUN, + ITER, IERR LOGICAL BDPREC DOUBLE PRECISION XV(N), BV(N), WT(N), PREC(N), CO(N,0:M), TOL, + F(*), X(*), Y(*), Z(*), UIB(*), UNP1(0:*), + TNP1, A0, DX, DY, DZ, RWORK(*), + V(N,MAXL+1), HES(MAXL+1,MAXL), + Q(2*MAXL), WORK(*), ERR C Ccc PURPOSE: C Solve a Non-Symmetric linear system C [W.D^(-1).G.W^(-1)].[Wx] = [W.D^(-1).b] C using the (block)-diagonally scaled GMRES(MAXL) method, orthogonalize C new V_k not only against previous ones but also against C's from C outer iteration. C W = diag(WT(i)) and D is the (block) diagonal of G. C The right hand-side W.D^(-1).b is stored in B, C the matrix G and the preconditioner are stored in RWORK and IWORK. C (Dx) is returned in X. C The routine MVDIFF (N, RWORK, IWORK, X, Y) should perform y = Gx C Ccc PARAMETER DESCRIPTION: C N : IN. # grid points C XV : OUT. Final approximate solution. C BV : IN. Preconditioned right-hand side vector. C OUT. Residual vector. C WT : IN. Contains weight factors to compute weighted norm. C BDPREC : IN. if true a block-diagonal preconditioner is used C PREC : IN. LU decomposition of (block-)diagonal of G. main diagonal C inverted C CO : IN. (.,0:M-1): vectors from outer iteration against which C V's should be orthogonalized. C OUT. (.,M) = Residual_outer_old - Residual C M : IN. Outer loop iteration count C TOL : IN. System is considered to be solved if C 2-norm < TOL C F : IN. -I Parameters C ... I for C RWORK : IN. -I residual evaluation C MAXL : IN. max. iterations GMRES (no restarts) C V : WORK. C HES : WORK. C Q : WORK. C WORK : WORK. 4.N+1 C LUN : IN. Logical unit # of file on which to write the error at C each iteration, if this is desired for monitoring convergence C If LUN = 0, no writing will occur. C ITER : OUT. Number of iterations required to reach convergence, or C MAXL+1 if convergence criterion could not be achieved in C MAXL iterations. C ERR : OUT. Weighted max. norm of error estimate in final C approximate solution C IERR : OUT. Error return flag C 0: OK C 1: Method failed to converge in MAXL iterations C Ccc EXTERNALS USED: DOUBLE PRECISION DDOT, DNRM2 EXTERNAL BCKBDI, MVDIFF, RCOPY, DAXPY, DDOT, DNRM2, ZERO C C----------------------------------------------------------------------- C INTEGER I, J, K DOUBLE PRECISION C, CNM2, R0NRM, PROD, RHO, S, TEM, T1, T2, T, + VNRM C IERR = 0 ITER = 0 C Ccc Initialize solution on zero, the initial residual R0 is the C left preconditioned vector B CALL ZERO (N, XV) CALL RCOPY (N, BV, V(1,1)) R0NRM = DNRM2(N, V(1,1),1) C Ccc Check stopping criterion ERR = R0NRM IF (LUN .NE. 0) THEN WRITE(LUN,'(''Diagonally scaled GMRESO(MAXL)'',I5)') + MAXL WRITE(LUN, + '('' ITER Error Estimate'')') WRITE(LUN,'(I5,E20.7)') ITER, ERR ENDIF C Ccc Rescale so that the norm of V(1,1) is one DO 80 I = 1, N V(I,1) = V(I,1)/R0NRM 80 CONTINUE C Ccc Initialize HES array. CALL ZERO (MAXL*(MAXL+1), HES) C Ccc Main loop to compute the vectors V(*,2) to V(*,MAXL). C The running product PROD is needed for the convergence test. PROD = 1.0 DO 10 K = 1, MAXL ITER = K C C V(*,K+1) = [W.D^(-1).G.W^(-1)] . V(*,K) DO 11 I = 1, N WORK(I) = V(I,K)/WT(I) 11 CONTINUE CALL MVDIFF (N, F, WORK, + ISTRUC, X, Y, Z, NPDE, UIB, UNP1, + TNP1, A0, DX, DY, DZ, RWORK, + WORK(1+N), V(1,K+1)) IF (BDPREC) THEN CALL BCKBDI (N/NPDE, NPDE, PREC, V(1,K+1), WORK) DO 12 I = 1, N V(I,K+1) = WT(I)*WORK(I) 12 CONTINUE ELSE DO 13 I = 1, N V(I,K+1) = WT(I)*PREC(I)*V(I,K+1) 13 CONTINUE ENDIF C C Orthogonalize V(*,K+1) first against the previous C using C modified Gram-Schmidt DO 801 I = 0, M-1 TEM = DDOT (N, CO(1,I), 1, V(1,K+1), 1) / + DDOT (N, CO(1,I), 1, CO(1,I), 1) CALL DAXPY (N, -TEM, CO(1,I), 1, V(1,K+1), 1) 801 CONTINUE C C Orthogonalize V(*,K+1) against the previous V using C modified Gram-Schmidt DO 81 I = 1, K HES(I,K) = DDOT (N, V(1,I), 1, V(1,K+1), 1) CALL DAXPY (N, -HES(I,K), V(1,I), 1, V(1,K+1), 1) 81 CONTINUE VNRM = DNRM2(N, V(1,K+1), 1) HES(K+1,K) = VNRM C C Update the QR factors of HES (Q.HES = R) using Givens rotations C First, multiply new column by previous Givens rotations DO 82 I = 1, K-1 T1 = HES(I,K) T2 = HES(I+1,K) C = Q(2*I-1) S = Q(2*I) HES(I ,K) = C*T1 - S*T2 HES(I+1,K) = S*T1 + C*T2 82 CONTINUE C Form last Givens rotation and multiply it with last 2 elements of HES T1 = HES(K,K) T2 = HES(K+1,K) IF (T2 .EQ. 0.0) THEN C = 1.0 S = 0.0 ELSE IF (ABS(T2) .GE. ABS(T1)) THEN T = T1/T2 S = -1.0/SQRT(1.0+T*T) C = -S*T ELSE T = T2/T1 C = 1.0/SQRT(1.0+T*T) S = -C*T ENDIF Q(2*K-1) = C Q(2*K ) = S HES(K,K) = C*T1 - S*T2 IF (HES(K,K) .EQ. 0.0) THEN IERR = 2 RETURN ENDIF C C Update RHO, the estimate of the norm of the residual R0-A*XL. PROD = PROD*Q(2*K) RHO = ABS(PROD*R0NRM) C Ccc Check stopping criterion ERR = RHO IF (LUN .NE. 0) THEN WRITE(LUN,'(I5,2E20.7)') ITER, ERR, ERR/R0NRM ENDIF IF (ERR/R0NRM .LT. 0.001 .AND. ERR .LT. TOL) GOTO 100 IF (K .EQ. MAXL) GOTO 20 C C Rescale so that the norm of V(1,K+1) is one. DO 83 I = 1, N V(I,K+1) = V(I,K+1)/VNRM 83 CONTINUE 10 CONTINUE C 20 CONTINUE IF (RHO .GT. R0NRM) THEN IERR = 2 RETURN ELSE IERR = 1 ENDIF C Ccc Compute the approximation XL to the solution. C Min. ||beta.e1 - Hk+1k.y||_2 C X = X + Vk.y 100 CONTINUE K = ITER WORK(1) = R0NRM DO 110 I = 2, K+1 WORK(I) = 0.0 110 CONTINUE C Q.beta.e1 DO 84 I = 1, K C = Q(2*I-1) S = Q(2*I) T1 = WORK(I) T2 = WORK(I+1) WORK(I ) = C*T1 - S*T2 WORK(I+1) = S*T1 + C*T2 84 CONTINUE C Solve R.y = Q.beta.e1 DO 85 I = 1, K J = K+1-I WORK(J) = WORK(J) / HES(J,J) CALL DAXPY (J-1, -WORK(J), HES(1,J),1, WORK,1) 85 CONTINUE C C X = X + Vk.y DO 120 I = 1,K CALL DAXPY(N, WORK(I), V(1,I), 1, XV, 1) 120 CONTINUE C C Calculate the residual vector CALL RCOPY (N, V(1,1), WORK(K+1)) DO 86 I = 1, K-1 S = Q(2*I) C = Q(2*I-1) DO 87 J = 1, N WORK(K+J) = S*WORK(K+J) + C*V(J,I+1) 87 CONTINUE 86 CONTINUE I = K S = Q(2*I) C = Q(2*I-1)/VNRM DO 88 J = 1, N WORK(K+J) = S*WORK(K+J) + C*V(J,I+1) 88 CONTINUE DO 89 J = 1, N WORK(K+J) = WORK(K+J)*R0NRM*PROD 89 CONTINUE C C Compute c_m = (b - r) / DO 130 J = 1, N CO(J,M) = BV(J) - WORK(K+J) 130 CONTINUE CNM2 = 1 / DDOT (N, CO(1,M), 1, CO(1,M), 1) DO 140 J = 1, N CO(J,M) = CO(J,M) * CNM2 140 CONTINUE C C Inner residual = outer residual CALL RCOPY (N, WORK(K+1), BV) C RETURN END SUBROUTINE MVDIFF (N, F, XV, + ISTRUC, X, Y, Z, NPDE, UIB, UNP1, + TNP1, A0, DX, DY, DZ, RWORK, + WORK, YV) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER N, ISTRUC(0:*), NPDE DOUBLE PRECISION F(N), XV(N), + X(*), Y(*), Z(*), UIB(*), UNP1(0:*), + TNP1, A0, DX, DY, DZ, RWORK(*), + WORK(*), YV(N) C Ccc PURPOSE: C Compute y = Gx where Gx ~ F(t,U+x,(U+x)_t)-F(t,U,(U+x)_t) C Ccc PARAMETER DESCRIPTION: C N : IN. Dimension of x C F : IN. Residual F(t,U,Udot), U=UNP1, Udot = A0.U+UH C XV : IN. Multiplying vector C ISTRUC : IN. -I Parameters C ... I for C RWORK : IN. -I residual evaluation C WORK : WORK. (N+1 + 2N) C YV : OUT. Result vector C Ccc EXTERNALS USED: EXTERNAL RESID C C----------------------------------------------------------------------- C INTEGER LLPLN, NPLNS, LIPLN, LLROW, NROWS, NPTS, LIROW, LICOL, + LLLBND, NBNDS, NBDPTS, NBIPTS, LILBND, LLBNDP, + LLBLWY, LLABVY, LLBLWZ, LLABVZ, + LUT, LUX, LUY, LUZ, LUXX, LUYY, LUZZ, LUXY, LUXZ, LUYZ, + LUBAR, LUTBAR, LFBAR, I C LLPLN = 0 NPLNS = ISTRUC(LLPLN) LIPLN = LLPLN+NPLNS+2 LLROW = LIPLN+NPLNS NROWS = ISTRUC(LLPLN+NPLNS+1)-1 NPTS = ISTRUC(LLROW+NROWS)-1 LIROW = LLROW+NROWS+1 LICOL = LIROW+NROWS LLLBND = LICOL+NPTS NBNDS = ISTRUC(LLLBND) NBDPTS = ISTRUC(LLLBND+NBNDS+1)-1 NBIPTS = ISTRUC(LLLBND+NBNDS+2)-1 LILBND = LLLBND+NBNDS+3 LLBNDP = LILBND+NBNDS LLBLWY = LLBNDP+NBIPTS LLABVY = LLBLWY+NPTS+1 LLBLWZ = LLABVY+NPTS+1 LLABVZ = LLBLWZ+NPTS+1 C LUT = 1 LUX = LUT + N LUY = LUX + N LUZ = LUY + N LUXX = LUZ + N LUYY = LUXX + N LUZZ = LUYY + N LUXY = LUZZ + N LUXZ = LUXY + N LUYZ = LUXZ + N C LUBAR = 1 LUTBAR = LUBAR + 1+N LFBAR = LUTBAR + N C Ccc Store U+x in WORK(LUBAR), and d(U+x)/dt in WORK(LUTBAR) WORK(LUBAR) = 0.0 DO 10 I = 1, N WORK(LUBAR+I) = UNP1(I) + XV(I) WORK(LUTBAR-1+I) = RWORK(LUT-1+I) + A0*XV(I) 10 CONTINUE C Ccc Compute space derivatives and residual CALL DERIVS (NPTS, NPDE, WORK(LUBAR), + ISTRUC(LLLBND), ISTRUC(LILBND), ISTRUC(LLBNDP), + ISTRUC(LLBLWY), ISTRUC(LLABVY), ISTRUC(LLBLWZ), ISTRUC(LLABVZ), + DX, DY, DZ, + RWORK(LUX), RWORK(LUY), RWORK(LUZ), + RWORK(LUXX), RWORK(LUYY), RWORK(LUZZ), + RWORK(LUXY), RWORK(LUXZ), RWORK(LUYZ)) CALL RES (TNP1, X, Y, Z, NPTS, NPDE, WORK(LUBAR+1), + ISTRUC(LLLBND), ISTRUC(LILBND), ISTRUC(LLBNDP), UIB, + WORK(LUTBAR), RWORK(LUX), RWORK(LUY), RWORK(LUZ), + RWORK(LUXX), RWORK(LUYY), RWORK(LUZZ), + RWORK(LUXY), RWORK(LUXZ), RWORK(LUYZ), WORK(LFBAR)) C DO 20 I = 1, N YV(I) = WORK(LFBAR-1+I) - F(I) 20 CONTINUE RETURN END SUBROUTINE PRDOM (LPLN, IPLN, LROW, IROW, ICOL, + LLBND, ILBND, LBND, IDOM, NX, NY, NZ) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER LPLN(0:*), IPLN(*), LROW(*), IROW(*), ICOL(*), + LLBND(0:*), ILBND(*), LBND(*), IDOM(0:*), NX, NY, NZ C Ccc PURPOSE: C Print domain plane-wise. Internal points are .., external points XX, C physical plane-boundary points their ILBND value. Edges are given C both ILBND values, corners an explicated 2-character value, and C internal boundary values II. C Ccc PARAMETER DESCRIPTION: C LPLN : IN. (0:LPLN(0)+1) C LPLN(0) = NPLNS: Actual # planes in LROW C LPLN(1:NPLNS): pointers to the start of a plane in LROW C LPLN(NPLNS+1) = NROWS+1: Total # rows in grid + 1 C IPLN : IN. (NPLNS) C IPLN(IP): plane number of plane IP in virtual box C LROW : IN. (NROWS+1) C LROW(1:NROWS): pointers to the start of a row in the grid C LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 C IROW : IN. (NROWS) C IROW(IR): row number of row IR in virtual box C ICOL : IN. (NPTS) C ICOL(IPT): column number of grid point IPT in virtual box C LLBND : OUT. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : OUT. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C IDOM : OUT. IDOM(IPT): location in domain of node IPT C 0: interior point C IB: on boundary C if not on edge or corner, or if internal boundary C then IB, IB = 1, NBNDS+1 C else | IB4 | IB3 | IB2 | IBYTE | if point is part of C the boundary planes IBYTE, IB2, IB3, and IB4 C Ccc EXTERNALS USED: EXTERNAL DOMFLG C INTEGER BYTE1, BYTE2 PARAMETER (BYTE1 = 2**8, BYTE2 = 2**16) C C----------------------------------------------------------------------- C INTEGER MAXC, MAXN PARAMETER (MAXC = 100, MAXN = 25) CHARACTER*80 LINE(0:MAXN) INTEGER I, J, K, L, IB, IP, IR, IPT, NPLNS, NROWS, NPTS, NBNDS INTEGER IA, IE, IEVAL(0:MAXC) C IF (NX .GE. MAXN .OR. NY .GE. MAXN) THEN PRINT *, 'Sorry, Nx, Ny should be < MAXN; adapt PRDOM' RETURN ENDIF C NPLNS = LPLN(0) NROWS = LPLN(NPLNS+1)-1 NPTS = LROW(NROWS+1)-1 NBNDS = LLBND(0) C C Set domain values CALL DOMFLG (NPTS, LLBND, LBND, IDOM) IA = ICHAR('a') IE = -1 DO 10 IP = 1, NPLNS K = IPLN(IP) LINE(0) = ' ' DO 20 I = 1, NX+1 WRITE(LINE(0)(3*I-2:3*I),'('' XX'')') 20 CONTINUE DO 30 J = 1, NY LINE(J) = LINE(0) 30 CONTINUE DO 40 IR = LPLN(IP), LPLN(IP+1)-1 J = IROW(IR) DO 50 IPT = LROW(IR), LROW(IR+1)-1 I = ICOL(IPT)+1 IF (IDOM(IPT) .EQ. 0) THEN WRITE(LINE(J)(3*I-2:3*I),'('' ..'')') ELSE IF (IDOM(IPT) .EQ. NBNDS+1) THEN WRITE(LINE(J)(3*I-2:3*I),'('' II'')') ELSE IB = IDOM(IPT) IF (IB .LT. BYTE1) THEN WRITE(LINE(J)(3*I-2:3*I),'(I3)') ILBND(IB) ELSE IF (IB .LT. BYTE2) THEN WRITE(LINE(J)(3*I-1:3*I),'(2I1)') + ILBND(IB/BYTE1), ILBND(MOD(IB,BYTE1)) ELSE DO 55 L = 0, IE IF (IB .EQ. IEVAL(L)) GOTO 56 55 CONTINUE IE = IE+1 IF (IE .GT. MAXC) THEN PRINT *, 'Sorry, # corners > MAXC; adapt PRDOM' RETURN ENDIF IEVAL(IE) = IB L = IE 56 WRITE(LINE(J)(3*I-1:3*I),'(2A)') + CHAR(MOD(L,26)+IA), CHAR(L/26+IA) ENDIF ENDIF 50 CONTINUE 40 CONTINUE PRINT '(/,''Plane:'',I3)', K DO 60 J = NY, 0, -1 PRINT '(A)', LINE(J) PRINT * 60 CONTINUE 10 CONTINUE IF (IE .EQ. -1) RETURN PRINT '(///,''Legenda corners:'')' DO 100 L = 0, IE LINE(0) = ' ' IB = MOD(IEVAL(L),BYTE1) WRITE(LINE(0)(1:2),'(I2.1)') ILBND(IB) IEVAL(L) = IEVAL(L)/BYTE1 IB = MOD(IEVAL(L),BYTE1) WRITE(LINE(0)(3:4),'(I2.1)') ILBND(IB) IF (IB .EQ. IEVAL(L)) GOTO 110 IEVAL(L) = IEVAL(L)/BYTE1 IB = MOD(IEVAL(L),BYTE1) WRITE(LINE(0)(5:6),'(I2.1)') ILBND(IB) IF (IB .EQ. IEVAL(L)) GOTO 110 IEVAL(L) = IEVAL(L)/BYTE1 IB = MOD(IEVAL(L),BYTE1) WRITE(LINE(0)(7:8),'(I2.1)') ILBND(IB) 110 PRINT '(X,2A,'':'',A8)', CHAR(MOD(L,26)+IA), CHAR(L/26+IA), + LINE(0)(1:8) 100 CONTINUE RETURN END SUBROUTINE SETXYZ (XL, YF, ZD, DX, DY, DZ, + LPLN, IPLN, LROW, IROW, ICOL, X, Y, Z) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER LPLN(0:*), IPLN(*), LROW(*), IROW(*), ICOL(*) DOUBLE PRECISION XL, YF, ZD, DX, DY, DZ, X(*), Y(*), Z(*) C Ccc PURPOSE: C Store X-, Y- and Z-coordinates of the grid points. C Ccc PARAMETER DESCRIPTION: C XL : IN. X-coordinate of left/front/down point of virtual box C YF : IN. Y-coordinate of left/front/down point of virtual box C ZD : IN. Z-coordinate of left/front/down point of virtual box C DX : IN. Grid width in X-direction C DY : IN. Grid width in Y-direction C DZ : IN. Grid width in Z-direction C LPLN : IN. (0:LPLN(0)+1) C LPLN(0) = NPLNS: Actual # planes in LROW C LPLN(1:NPLNS): pointers to the start of a plane in LROW C LPLN(NPLNS+1) = NROWS+1: Total # rows in grid + 1 C IPLN : IN. (NPLNS) C IPLN(IP): plane number of plane IP in virtual box C LROW : IN. (NROWS+1) C LROW(1:NROWS): pointers to the start of a row in the grid C LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 C IROW : IN. (NROWS) C IROW(IR): row number of row IR in virtual box C ICOL : IN. (NPTS) C ICOL(IPT): column number of grid point IPT in virtual box C X : OUT. Contains the X-coordinates for the grid C Y : OUT. Contains the Y-coordinates for the grid C Z : OUT. Contains the Z-coordinates for the grid C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER IP, IPT, IR, NPLNS DOUBLE PRECISION YIR, ZIP C NPLNS = LPLN(0) DO 10 IP = 1, NPLNS ZIP = ZD + IPLN(IP)*DZ DO 20 IR = LPLN(IP), LPLN(IP+1)-1 YIR = YF + IROW(IR)*DY DO 30 IPT = LROW(IR), LROW(IR+1)-1 X(IPT) = XL + ICOL(IPT)*DX Y(IPT) = YIR Z(IPT) = ZIP 30 CONTINUE 20 CONTINUE 10 CONTINUE RETURN END SUBROUTINE PRSOL (LUN, T, NPDE, XL, YF, ZD, DXB, DYB, DZB, + LGRID, ISTRUC, LSOL, SOL) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER LUN, NPDE, LGRID(0:*), ISTRUC(*), LSOL(*) DOUBLE PRECISION T, XL, YF, ZD, DXB, DYB, DZB, SOL(*) C Ccc PURPOSE: C Print solution and coordinate values at all grid levels. C Ccc PARAMETER DESCRIPTION: C LUN : IN. Logical unit number of print file C T : IN. Current value of time variable C NPDE : IN. # PDE components C XL : IN. X-coordinate of left/front/down point of virtual box C YF : IN. Y-coordinate of left/front/down point of virtual box C ZD : IN. Z-coordinate of left/front/down point of virtual box C DXB : IN. Cell width in X-direction of base grid C DYB : IN. Cell width in Y-direction of base grid C DZB : IN. Cell width in Z-direction of base grid C LGRID : IN. (0:*) C LGRID(0) = max. grid level used at T C LGRID(1): pointer to base grid structure ISTRUC C LGRID(LEVEL): pointer to grid structure C (LPLN,IPLN,LROW,IROW,ICOL) C of refinement level LEVEL for time T C ISTRUC : IN. (*) C ISTRUC(LGRID(LEVEL):.) contains (LPLN,IPLN,LROW,IROW,ICOL) C of grid level LEVEL, C LPLN : (0:LPLN(0)+1) C LPLN(0) = NPLNS: Actual # planes in grid C LPLN(1:NPLNS): pointers to the start of a plane in LROW C LPLN(NPLNS+1) = NROWS+1: Actual # rows in grid + 1 C IPLN : (NPLNS) C IPLN(IP): plane number of plane IP in virtual box C LROW : (NROWS+1) C LROW(1:NROWS): pointers to the start of a row in the grid C LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 C IROW : (NROWS) C IROW(IR): row number of row IR in virtual box C ICOL : (NPTS) C ICOL(IPT): column number of grid point IPT in virtual box C LSOL : IN. (*) C LSOL(LEVEL): pointer to (injected) solution at grid C of refinement level LEVEL for time T C SOL : IN. (*) C SOL(LSOL(LEVEL)+1:LSOL(LEVEL)+NPTS(LEVEL)*NPDE) contains C U_LEVEL(NPTS,NPDE) C Ccc EXTERNALS USED: EXTERNAL PRSOLL C C----------------------------------------------------------------------- C INTEGER MAXLEV, LEVEL, LLPLN, LIPLN, LLROW, LIROW, LICOL, + NPLNS, NROWS, NPTS DOUBLE PRECISION DX, DY, DZ MAXLEV = LGRID(0) DX = DXB DY = DYB DZ = DZB DO 10 LEVEL = 1, MAXLEV LLPLN = LGRID(LEVEL) NPLNS = ISTRUC(LLPLN) NROWS = ISTRUC(LLPLN+NPLNS+1)-1 LIPLN = LLPLN+NPLNS+2 LLROW = LIPLN+NPLNS NPTS = ISTRUC(LLROW+NROWS)-1 LIROW = LLROW+NROWS+1 LICOL = LIROW+NROWS CALL PRSOLL (LUN, LEVEL, T, NPTS, NPDE, XL, YF, ZD, DX, DY, DZ, + ISTRUC(LLPLN), ISTRUC(LIPLN), ISTRUC(LLROW), ISTRUC(LIROW), + ISTRUC(LICOL), SOL(LSOL(LEVEL)+1)) DX = DX/2 DY = DY/2 DZ = DZ/2 10 CONTINUE RETURN END SUBROUTINE PRSOLL (LUN, LEVEL, T, NPTS, NPDE, XL, YF, ZD, + DX, DY, DZ, LPLN, IPLN, LROW, IROW, ICOL, U) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER LUN, LEVEL, NPTS, NPDE, LPLN(0:*), IPLN(*), + LROW(*), IROW(*), ICOL(*) DOUBLE PRECISION T, XL, YF, ZD, DX, DY, DZ, U(NPTS,NPDE) C Ccc PURPOSE: C Print solution and X-, Y- and Z-coordinates of gridlevel LEVEL. C Ccc PARAMETER DESCRIPTION: C LUN : IN. Logical unit number of print file C LEVEL : IN. Grid level corresponding with solution U. C T : IN. Current value of time variable C NPTS : IN. # grid points at this level C NPDE : IN. # PDE components C XL : IN. X-coordinate of left/front/down point of virtual box C YF : IN. Y-coordinate of left/front/down point of virtual box C ZD : IN. Z-coordinate of left/front/down point of virtual box C DX : IN. Grid width in X-direction C DY : IN. Grid width in Y-direction C DZ : IN. Grid width in Z-direction C LPLN : IN. (0:LPLN(0)+1) C LPLN(0) = NPLNS: Actual # planes in LROW C LPLN(1:NPLNS): pointers to the start of a plane in LROW C LPLN(NPLNS+1) = NROWS+1: Total # rows in grid + 1 C IPLN : IN. (NPLNS) C IPLN(IP): plane number of plane IP in virtual box C LROW : IN. (NROWS+1) C LROW(1:NROWS): pointers to the start of a row in the grid C LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 C IROW : IN. (NROWS) C IROW(IR): row number of row IR in virtual box C ICOL : IN. (NPTS) C ICOL(IPT): column number of grid point IPT in virtual box C U : IN. Solution on this grid level C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER IC, IP, IPT, IR, NPLNS DOUBLE PRECISION X, Y, Z C NPLNS = LPLN(0) WRITE(LUN,'(//// A,T14,A,T30,A,T46,A,T62,A,T71,A //)') + 'Lev', 't', 'Z', 'Y', 'X', 'Solution' IP = 1 Z = ZD + IPLN(IP)*DZ IR = LPLN(IP) Y = YF + IROW(IR)*DY IPT = LROW(IR) X = XL + ICOL(IPT)*DX WRITE(LUN, + '(I3,T5,E12.5,T21,E12.5,T37,E12.5,T53,E12.5,T69,E12.5)') + LEVEL, T, Z, Y, X, U(IPT,1) DO 10 IC = 2, NPDE WRITE(LUN,'(T69,E12.5)') U(IPT,IC) 10 CONTINUE DO 14 IPT = LROW(IR)+1, LROW(IR+1)-1 X = XL + ICOL(IPT)*DX WRITE(LUN, + '(T53,E12.5,T69,E12.5)') + X, U(IPT,1) DO 15 IC = 2, NPDE WRITE(LUN,'(T69,E12.5)') U(IPT,IC) 15 CONTINUE 14 CONTINUE DO 20 IR = LPLN(IP)+1, LPLN(IP+1)-1 Y = YF + IROW(IR)*DY IPT = LROW(IR) X = XL + ICOL(IPT)*DX WRITE(LUN, + '(T37,E12.5,T53,E12.5,T69,E12.5)') + Y, X, U(IPT,1) DO 30 IC = 2, NPDE WRITE(LUN,'(T69,E12.5)') U(IPT,IC) 30 CONTINUE DO 40 IPT = LROW(IR)+1, LROW(IR+1)-1 X = XL + ICOL(IPT)*DX WRITE(LUN, + '(T53,E12.5,T69,E12.5)') + X, U(IPT,1) DO 50 IC = 2, NPDE WRITE(LUN,'(T69,E12.5)') U(IPT,IC) 50 CONTINUE 40 CONTINUE 20 CONTINUE DO 100 IP = 2, NPLNS Z = ZD + IPLN(IP)*DZ IR = LPLN(IP) Y = YF + IROW(IR)*DY IPT = LROW(IR) X = XL + ICOL(IPT)*DX WRITE(LUN, + '(T21,E12.5,T37,E12.5,T53,E12.5,T69,E12.5)') + Z, Y, X, U(IPT,1) DO 110 IC = 2, NPDE WRITE(LUN,'(T69,E12.5)') U(IPT,IC) 110 CONTINUE DO 114 IPT = LROW(IR)+1, LROW(IR+1)-1 X = XL + ICOL(IPT)*DX WRITE(LUN, + '(T53,E12.5,T69,E12.5)') + X, U(IPT,1) DO 115 IC = 2, NPDE WRITE(LUN,'(T69,E12.5)') U(IPT,IC) 115 CONTINUE 114 CONTINUE DO 120 IR = LPLN(IP)+1, LPLN(IP+1)-1 Y = YF + IROW(IR)*DY IPT = LROW(IR) X = XL + ICOL(IPT)*DX WRITE(LUN, + '(T37,E12.5,T53,E12.5,T69,E12.5)') + Y, X, U(IPT,1) DO 130 IC = 2, NPDE WRITE(LUN,'(T69,E12.5)') U(IPT,IC) 130 CONTINUE DO 140 IPT = LROW(IR)+1, LROW(IR+1)-1 X = XL + ICOL(IPT)*DX WRITE(LUN, + '(T53,E12.5,T69,E12.5)') + X, U(IPT,1) DO 150 IC = 2, NPDE WRITE(LUN,'(T69,E12.5)') U(IPT,IC) 150 CONTINUE 140 CONTINUE 120 CONTINUE 100 CONTINUE RETURN END SUBROUTINE WRUNI (LUNS, LUNG, UNILEV, + T, NPDE, XL, YF, ZD, DXB, DYB, DZB, NXB, NYB, NZB, + LGRID, ISTRUC, LSOL, SOL, UNIFRM, NX, NY, NZ) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER LUNS, LUNG, UNILEV, + NPDE, NXB, NYB, NZB, LGRID(0:*), ISTRUC(*), LSOL(*), NX, NY, NZ DOUBLE PRECISION T, XL, YF, ZD, DXB, DYB, DZB, SOL(*), + UNIFRM(0:NX,0:NY,0:NZ,NPDE) C Ccc PURPOSE: C Write (interpolated) solution values at grid level UNILEV to file C LUNS. C Write maximum gridlevel used in each point to file LUNG. C NB. The data will not be correct for a domain with holes in it with C a size of the width of the base grid. C Ccc PARAMETER DESCRIPTION: C LUNS : IN. Logical unit number of solution file C LUNG : IN. Logical unit number of grid level file C UNILEV : IN. Maximum grid level to be used to generate the data C T : IN. Value of time variable C NPDE : IN. # PDE components C XL : IN. X-coordinate of left/front/down point of virtual box C YF : IN. Y-coordinate of left/front/down point of virtual box C ZD : IN. Z-coordinate of left/front/down point of virtual box C DXB : IN. Cell width in X-direction of base grid C DYB : IN. Cell width in Y-direction of base grid C DZB : IN. Cell width in Z-direction of base grid C NXB,NYB,NZB: IN. # gridcells in X-, Y- and Z-direction, resp., on grid C of base level C LGRID : IN. (0:*) C LGRID(0) = max. grid level used at T C LGRID(1): pointer to base grid structure ISTRUC C LGRID(LEVEL): pointer to grid structure C (LPLN,IPLN,LROW,IROW,ICOL) C of refinement level LEVEL for time T C ISTRUC : IN. (*) C ISTRUC(LGRID(LEVEL):.) contains (LPLN,IPLN,LROW,IROW,ICOL) C of grid level LEVEL, C LPLN : (0:LPLN(0)+1) C LPLN(0) = NPLNS: Actual # planes in grid C LPLN(1:NPLNS): pointers to the start of a plane in LROW C LPLN(NPLNS+1) = NROWS+1: Actual # rows in grid + 1 C IPLN : (NPLNS) C IPLN(IP): plane number of plane IP in virtual box C LROW : (NROWS+1) C LROW(1:NROWS): pointers to the start of a row in the grid C LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 C IROW : (NROWS) C IROW(IR): row number of row IR in virtual box C ICOL : (NPTS) C ICOL(IPT): column number of grid point IPT in virtual box C LSOL : IN. (*) C LSOL(LEVEL): pointer to (injected) solution at grid C of refinement level LEVEL for time T C SOL : IN. (*) C SOL(LSOL(LEVEL)+1:LSOL(LEVEL)+NPTS(LEVEL)*NPDE) contains C U_LEVEL(NPTS,NPDE) C UNIFRM : WORK. (Interpolated) solution on level UNILEV / max. grid C level used. C NX,NY,NZ: IN. # gridcells in X-, Y- and Z-direction, resp., on grid C of level UNILEV C C----------------------------------------------------------------------- C C !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! C !!! !!! C !!! In subroutine WRUNI the constant NONVAL should be adjusted to !!! C !!! the data (NONVAL = impossible value for the first componenent) !!! C !!! !!! DOUBLE PRECISION NONVAL PARAMETER (NONVAL = -999.999) C !!! !!! C !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! C C----------------------------------------------------------------------- C INTEGER I, IC, ICOL, IMUL, IP, IPLN, IPT, IR, IROW, J, K, + LEVEL, LLPLN, LIPLN, LLROW, LIROW, LICOL, MAXLEV, + NPLNS, NROWS, NPTS DO 1 IC = 1, NPDE DO 1 IPLN = 0, NZ DO 1 IROW = 0, NY DO 1 ICOL = 0, NX UNIFRM(ICOL,IROW,IPLN,IC) = NONVAL 1 CONTINUE MAXLEV = LGRID(0) DO 10 LEVEL = 1, UNILEV IMUL = 2**(UNILEV-LEVEL) LLPLN = LGRID(LEVEL) NPLNS = ISTRUC(LLPLN) NROWS = ISTRUC(LLPLN+NPLNS+1)-1 LIPLN = LLPLN+NPLNS+2 LLROW = LIPLN+NPLNS NPTS = ISTRUC(LLROW+NROWS)-1 LIROW = LLROW+NROWS+1 LICOL = LIROW+NROWS DO 20 IP = 1, NPLNS IPLN = ISTRUC(LIPLN-1+IP)*IMUL DO 30 IR = ISTRUC(LLPLN+IP), ISTRUC(LLPLN+IP+1)-1 IROW = ISTRUC(LIROW-1+IR)*IMUL DO 40 IPT = ISTRUC(LLROW-1+IR), ISTRUC(LLROW+IR)-1 ICOL = ISTRUC(LICOL-1+IPT)*IMUL DO 50 IC = 1, NPDE UNIFRM(ICOL,IROW,IPLN,IC) = + SOL(LSOL(LEVEL)+(IC-1)*NPTS+IPT) 50 CONTINUE 40 CONTINUE 30 CONTINUE 20 CONTINUE 10 CONTINUE DO 100 LEVEL = 2, UNILEV IMUL = 2**(UNILEV-LEVEL) DO 110 K = IMUL, NZ, IMUL*2 DO 110 J = 0, NY, IMUL*2 DO 110 I = 0, NX, IMUL*2 IF (UNIFRM(I,J,K,1) .EQ. NONVAL) THEN DO 120 IC = 1, NPDE UNIFRM(I,J,K,IC) = + (UNIFRM(I,J,K-IMUL,IC)+UNIFRM(I,J,K+IMUL,IC))/2 120 CONTINUE ENDIF 110 CONTINUE DO 130 K = 0, NZ, IMUL DO 130 J = IMUL, NY, IMUL*2 DO 130 I = 0, NX, IMUL*2 IF (UNIFRM(I,J,K,1) .EQ. NONVAL) THEN DO 140 IC = 1, NPDE UNIFRM(I,J,K,IC) = + (UNIFRM(I,J-IMUL,K,IC)+UNIFRM(I,J+IMUL,K,IC))/2 140 CONTINUE ENDIF 130 CONTINUE DO 150 K = 0, NZ, IMUL DO 150 J = 0, NY, IMUL DO 150 I = IMUL, NX, IMUL*2 IF (UNIFRM(I,J,K,1) .EQ. NONVAL) THEN DO 160 IC = 1, NPDE UNIFRM(I,J,K,IC) = + (UNIFRM(I-IMUL,J,K,IC)+UNIFRM(I+IMUL,J,K,IC))/2 160 CONTINUE ENDIF 150 CONTINUE 100 CONTINUE DO 170 K = 0, NZ DO 170 J = 0, NY DO 170 I = 0, NX WRITE(LUNS,'(100E13.3)') (UNIFRM(I,J,K,IC), IC = 1, NPDE) 170 CONTINUE C C Grids DO 201 IPLN = 0, NZ DO 201 IROW = 0, NY DO 201 ICOL = 0, NX UNIFRM(ICOL,IROW,IPLN,1) = 0 201 CONTINUE DO 210 LEVEL = 1, UNILEV IMUL = 2**(UNILEV-LEVEL) LLPLN = LGRID(LEVEL) NPLNS = ISTRUC(LLPLN) NROWS = ISTRUC(LLPLN+NPLNS+1)-1 LIPLN = LLPLN+NPLNS+2 LLROW = LIPLN+NPLNS NPTS = ISTRUC(LLROW+NROWS)-1 LIROW = LLROW+NROWS+1 LICOL = LIROW+NROWS DO 220 IP = 1, NPLNS IPLN = ISTRUC(LIPLN-1+IP)*IMUL DO 230 IR = ISTRUC(LLPLN+IP), ISTRUC(LLPLN+IP+1)-1 IROW = ISTRUC(LIROW-1+IR)*IMUL DO 240 IPT = ISTRUC(LLROW-1+IR), ISTRUC(LLROW+IR)-1 ICOL = ISTRUC(LICOL-1+IPT)*IMUL UNIFRM(ICOL,IROW,IPLN,1) = LEVEL 240 CONTINUE 230 CONTINUE 220 CONTINUE 210 CONTINUE DO 300 LEVEL = 2, UNILEV IMUL = 2**(UNILEV-LEVEL) DO 310 K = IMUL, NZ, IMUL*2 DO 310 J = 0, NY, IMUL*2 DO 310 I = 0, NX, IMUL*2 IF (UNIFRM(I,J,K,1) .LT. LEVEL) THEN UNIFRM(I,J,K,1) = + MIN(UNIFRM(I,J,K-IMUL,1),UNIFRM(I,J,K+IMUL,1)) ENDIF 310 CONTINUE DO 320 K = 0, NZ, IMUL DO 320 J = IMUL, NY, IMUL*2 DO 320 I = 0, NX, IMUL*2 IF (UNIFRM(I,J,K,1) .LT. LEVEL) THEN UNIFRM(I,J,K,1) = + MIN(UNIFRM(I,J-IMUL,K,1),UNIFRM(I,J+IMUL,K,1)) ENDIF 320 CONTINUE DO 330 K = 0, NZ, IMUL DO 330 J = 0, NY, IMUL DO 330 I = IMUL, NX, IMUL*2 IF (UNIFRM(I,J,K,1) .LT. LEVEL) THEN UNIFRM(I,J,K,1) = + MIN(UNIFRM(I-IMUL,J,K,1),UNIFRM(I+IMUL,J,K,1)) ENDIF 330 CONTINUE 300 CONTINUE DO 350 K = 0, NZ DO 350 J = 0, NY DO 350 I = 0, NX WRITE(LUNG,'(I2)') NINT(UNIFRM(I,J,K,1)) 350 CONTINUE RETURN END SUBROUTINE DUMP (LUNDMP, RWK, IWK) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER LUNDMP, IWK(*) DOUBLE PRECISION RWK(*) C Ccc PURPOSE: C Dump all information necessary for a restart of VLUGR3 on file C Ccc PARAMETER DESCRIPTION: C LUNDMP : IN. Logical unit number of dumpfile. Should be opened as an C unformatted file. C RWK : IN. Real workstorage as returned from VLUGR3 C IWK : IN. Integer workstorage as returned from VLUGR3 C Ccc EXTERNALS USED: NONE C C Ccc INCLUDE 'CMNSTATS' C C CMNSTATS C C COMMON with integration statistics INTEGER MXCLEV, MXCNIT PARAMETER (MXCLEV = 10, MXCNIT = 20) INTEGER LUNPDS, LUNNLS, LUNLSS, LEVEL, NSTEPS, NREJS, + NJACS(MXCLEV), NRESID(MXCLEV), NNIT(MXCLEV), + NLSIT(MXCLEV,MXCNIT) COMMON /STATS/ LUNPDS, LUNNLS, LUNLSS, LEVEL, NSTEPS, NREJS, + NJACS, NRESID, NNIT, NLSIT SAVE /STATS/ C C end INCLUDE 'CMNSTATS' C C Ccc INCLUDE 'CMNWRITEF' C C CMNWRITEF C C COMMON needed for continuation calls INTEGER MAXLVW, NPDEW, LRWKPS, LIWKPS, LRWKB, LIWKB LOGICAL FIRST, SECOND DOUBLE PRECISION T0,TW,TEW,DTW, XLW,YFW,ZDW, XRW,YBW,ZUW, DXB,DYB, + DZB, DTO COMMON /WRITIF/ MAXLVW, NPDEW, LRWKPS, LIWKPS, LRWKB, LIWKB COMMON /WRITLF/ FIRST, SECOND COMMON /WRITRF/ T0,TW,TEW,DTW, XLW,YFW,ZDW, XRW,YBW,ZUW, + DXB,DYB,DZB, DTO SAVE /WRITIF/, /WRITLF/, /WRITRF/ C C end INCLUDE 'CMNWRITEF' C C C----------------------------------------------------------------------- C INTEGER I, J WRITE(LUNDMP) MAXLVW, NPDEW, LRWKPS, LIWKPS, LRWKB, LIWKB, + FIRST, SECOND, + T0,TW,TEW,DTW, XLW,YFW,ZDW, XRW,YBW,ZUW, DXB,DYB,DZB, DTO WRITE(LUNDMP) LUNPDS, LUNNLS, LUNLSS, LEVEL, NSTEPS, NREJS, + (NJACS(I), I=1,MXCLEV), (NRESID(I), I=1,MXCLEV), + (NNIT(I), I=1,MXCLEV), ((NLSIT(I,J), I=1,MXCLEV), J=1,MXCNIT) WRITE(LUNDMP) (RWK(I), I=1,LRWKPS+LRWKB) WRITE(LUNDMP) (IWK(I), I=1,LIWKPS+LIWKB) RETURN END SUBROUTINE RDDUMP (LUNDMP, RWK, LENRWK, IWK, LENIWK) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER LENIWK INTEGER LUNDMP, LENRWK, IWK(LENIWK) DOUBLE PRECISION RWK(LENRWK) C Ccc PURPOSE: C Read all information necessary for a restart of VLUGR3 from file C Ccc PARAMETER DESCRIPTION: C LUNDMP : IN. Logical unit number of dumpfile. Should be opened as an C unformatted file. C RWK : OUT. Real workstorage intended to pass to VLUGR3 C LENRWK : IN. Dimension of RWK. C IWK : OUT. Integer workstorage intended to pass to VLUGR3 C LENIWK : IN. Dimension of IWK. C Ccc EXTERNALS USED: NONE C C Ccc INCLUDE 'CMNSTATS' C C CMNSTATS C C COMMON with integration statistics INTEGER MXCLEV, MXCNIT PARAMETER (MXCLEV = 10, MXCNIT = 20) INTEGER LUNPDS, LUNNLS, LUNLSS, LEVEL, NSTEPS, NREJS, + NJACS(MXCLEV), NRESID(MXCLEV), NNIT(MXCLEV), + NLSIT(MXCLEV,MXCNIT) COMMON /STATS/ LUNPDS, LUNNLS, LUNLSS, LEVEL, NSTEPS, NREJS, + NJACS, NRESID, NNIT, NLSIT SAVE /STATS/ C C end INCLUDE 'CMNSTATS' C C Ccc INCLUDE 'CMNWRITEF' C C CMNWRITEF C C COMMON needed for continuation calls INTEGER MAXLVW, NPDEW, LRWKPS, LIWKPS, LRWKB, LIWKB LOGICAL FIRST, SECOND DOUBLE PRECISION T0,TW,TEW,DTW, XLW,YFW,ZDW, XRW,YBW,ZUW, DXB,DYB, + DZB, DTO COMMON /WRITIF/ MAXLVW, NPDEW, LRWKPS, LIWKPS, LRWKB, LIWKB COMMON /WRITLF/ FIRST, SECOND COMMON /WRITRF/ T0,TW,TEW,DTW, XLW,YFW,ZDW, XRW,YBW,ZUW, + DXB,DYB,DZB, DTO SAVE /WRITIF/, /WRITLF/, /WRITRF/ C C end INCLUDE 'CMNWRITEF' C C C----------------------------------------------------------------------- C INTEGER I, J READ(LUNDMP) MAXLVW, NPDEW, LRWKPS, LIWKPS, LRWKB, LIWKB, + FIRST, SECOND, + T0,TW,TEW,DTW, XLW,YFW,ZDW, XRW,YBW,ZUW, DXB,DYB,DZB, DTO IF (LENRWK .LT. LRWKPS+LRWKB .OR. LENIWK .LT. LIWKPS+LIWKB) THEN PRINT *, LENRWK, LRWKPS+LRWKB, LENIWK, LIWKPS+LIWKB STOP 'work space too small' ENDIF READ(LUNDMP) LUNPDS, LUNNLS, LUNLSS, LEVEL, NSTEPS, NREJS, + (NJACS(I), I=1,MXCLEV), (NRESID(I), I=1,MXCLEV), + (NNIT(I), I=1,MXCLEV), ((NLSIT(I,J), I=1,MXCLEV), J=1,MXCNIT) READ(LUNDMP) (RWK(I), I=1,LRWKPS+LRWKB) READ(LUNDMP) (IWK(I), I=1,LIWKPS+LIWKB) C RETURN END LOGICAL FUNCTION CHKWRK (LRWKN, LENRWK, LIWKN, LENIWK, + LLWKN, LENLWK) C----------------------------------------------------------------------- INTEGER LRWKN, LENRWK, LIWKN, LENIWK, LLWKN, LENLWK C C Ccc INCLUDE 'CMNCMMACH' C C CMNCMMACH C C COMMON with `machine numbers' C LUNOUT : Logical unit # standard output -I C LUNERR : Logical unit # standard error I Set in the routine C UROUND : Smallest machine number such that I MACNUM C 1.0+UROUND > 1.0 and 1.0-UROUND < 1.0 I C XMIN : Smallest floating-point number -I INTEGER LUNOUT, LUNERR DOUBLE PRECISION UROUND, XMIN COMMON /IMACH/ LUNOUT, LUNERR COMMON /RMACH/ UROUND, XMIN SAVE /IMACH/, /RMACH/ C C end INCLUDE 'CMNCMMACH' C C----------------------------------------------------------------------- CHKWRK = .TRUE. IF (LRWKN .GT. LENRWK) THEN WRITE(LUNERR, + '(''Real workspace too small, required at least:'',I10)') + LRWKN CHKWRK = .FALSE. ENDIF IF (LIWKN .GT. LENIWK) THEN WRITE(LUNERR, + '(''Integer workspace too small, required at least:'',I10)') + LIWKN CHKWRK = .FALSE. ENDIF IF (LLWKN .GT. LENLWK) THEN WRITE(LUNERR, + '(''Logical workspace too small, required at least:'',I10)') + LLWKN CHKWRK = .FALSE. ENDIF RETURN END SUBROUTINE ERRWGT (NPTS, NPDE, U, RELTOL, ABSTOL, WT) C----------------------------------------------------------------------- INTEGER NPTS, NPDE DOUBLE PRECISION U(NPTS,NPDE), RELTOL(NPDE), ABSTOL(NPDE), + WT(NPTS,NPDE) C----------------------------------------------------------------------- INTEGER IC, IPT DOUBLE PRECISION SN SN = 1.0/SQRT(DBLE(NPTS*NPDE)) DO 10 IC = 1, NPDE DO 20 IPT = 1, NPTS WT(IPT,IC) = SN/(RELTOL(IC)*ABS(U(IPT,IC)) + ABSTOL(IC)) 20 CONTINUE 10 CONTINUE RETURN END DOUBLE PRECISION FUNCTION MAXNRM (N, V) C----------------------------------------------------------------------- INTEGER N DOUBLE PRECISION V(N) C----------------------------------------------------------------------- INTEGER I MAXNRM = 0.0 DO 10 I = 1, N MAXNRM = MAX(MAXNRM, ABS(V(I))) 10 CONTINUE RETURN END DOUBLE PRECISION FUNCTION WMXNRM (N, V, W) C----------------------------------------------------------------------- INTEGER N DOUBLE PRECISION V(N), W(N) C----------------------------------------------------------------------- INTEGER I WMXNRM = 0.0 DO 10 I = 1, N WMXNRM = MAX(WMXNRM, ABS(V(I)*W(I))) 10 CONTINUE WMXNRM = WMXNRM*SQRT(DBLE(N)) RETURN END DOUBLE PRECISION FUNCTION WDNRM2 (N, V, W) C----------------------------------------------------------------------- INTEGER N DOUBLE PRECISION V(N), W(N) C----------------------------------------------------------------------- INTEGER I WDNRM2 = 0.0 DO 10 I = 1, N WDNRM2 = WDNRM2 + (V(I)*W(I))**2 10 CONTINUE WDNRM2 = SQRT(WDNRM2) RETURN END SUBROUTINE ICOPY (LEN, A, B) C----------------------------------------------------------------------- INTEGER LEN INTEGER A(LEN), B(LEN) C----------------------------------------------------------------------- INTEGER I DO 10 I = 1, LEN B(I) = A(I) 10 CONTINUE RETURN END SUBROUTINE IYPOC (LEN, A, B) C----------------------------------------------------------------------- INTEGER LEN INTEGER A(LEN), B(LEN) C----------------------------------------------------------------------- INTEGER I DO 10 I = LEN, 1, -1 B(I) = A(I) 10 CONTINUE RETURN END SUBROUTINE RCOPY (LEN, A, B) C----------------------------------------------------------------------- INTEGER LEN DOUBLE PRECISION A(LEN), B(LEN) C----------------------------------------------------------------------- INTEGER I DO 10 I = 1, LEN B(I) = A(I) 10 CONTINUE RETURN END SUBROUTINE ZERO (LEN, A) C----------------------------------------------------------------------- INTEGER LEN DOUBLE PRECISION A(LEN) C----------------------------------------------------------------------- INTEGER I DO 10 I = 1, LEN A(I) = 0.0 10 CONTINUE RETURN END SUBROUTINE MACNUM C----------------------------------------------------------------------- C Ccc INCLUDE 'CMNCMMACH' C C CMNCMMACH C C COMMON with `machine numbers' C LUNOUT : Logical unit # standard output -I C LUNERR : Logical unit # standard error I Set in the routine C UROUND : Smallest machine number such that I MACNUM C 1.0+UROUND > 1.0 and 1.0-UROUND < 1.0 I C XMIN : Smallest floating-point number -I INTEGER LUNOUT, LUNERR DOUBLE PRECISION UROUND, XMIN COMMON /IMACH/ LUNOUT, LUNERR COMMON /RMACH/ UROUND, XMIN SAVE /IMACH/, /RMACH/ C C end INCLUDE 'CMNCMMACH' C Ccc EXTERNALS USED: INTEGER I1MACH DOUBLE PRECISION D1MACH EXTERNAL D1MACH, I1MACH C----------------------------------------------------------------------- C LUNOUT = I1MACH(2) LUNERR = I1MACH(4) UROUND = D1MACH(4) XMIN = D1MACH(1) RETURN END SHAR_EOF fi # end of overwriting check if test -f 'port.f' then echo shar: will not over-write existing file "'port.f'" else cat << \SHAR_EOF > 'port.f' INTEGER FUNCTION I1MACH(I) INTEGER I C C I/O UNIT NUMBERS. C C I1MACH( 1) = THE STANDARD INPUT UNIT. C C I1MACH( 2) = THE STANDARD OUTPUT UNIT. C C I1MACH( 3) = THE STANDARD PUNCH UNIT. C C I1MACH( 4) = THE STANDARD ERROR MESSAGE UNIT. C C WORDS. C C I1MACH( 5) = THE NUMBER OF BITS PER INTEGER STORAGE UNIT. C C I1MACH( 6) = THE NUMBER OF CHARACTERS PER CHARACTER STORAGE UNIT. C FOR FORTRAN 77, THIS IS ALWAYS 1. FOR FORTRAN 66, C CHARACTER STORAGE UNIT = INTEGER STORAGE UNIT. C C INTEGERS. C C ASSUME INTEGERS ARE REPRESENTED IN THE S-DIGIT, BASE-A FORM C C SIGN ( X(S-1)*A**(S-1) + ... + X(1)*A + X(0) ) C C WHERE 0 .LE. X(I) .LT. A FOR I=0,...,S-1. C C I1MACH( 7) = A, THE BASE. C C I1MACH( 8) = S, THE NUMBER OF BASE-A DIGITS. C C I1MACH( 9) = A**S - 1, THE LARGEST MAGNITUDE. C C FLOATING-POINT NUMBERS. C C ASSUME FLOATING-POINT NUMBERS ARE REPRESENTED IN THE T-DIGIT, C BASE-B FORM C C SIGN (B**E)*( (X(1)/B) + ... + (X(T)/B**T) ) C C WHERE 0 .LE. X(I) .LT. B FOR I=1,...,T, C 0 .LT. X(1), AND EMIN .LE. E .LE. EMAX. C C I1MACH(10) = B, THE BASE. C C SINGLE-PRECISION C C I1MACH(11) = T, THE NUMBER OF BASE-B DIGITS. C C I1MACH(12) = EMIN, THE SMALLEST EXPONENT E. C C I1MACH(13) = EMAX, THE LARGEST EXPONENT E. C C DOUBLE-PRECISION C C I1MACH(14) = T, THE NUMBER OF BASE-B DIGITS. C C I1MACH(15) = EMIN, THE SMALLEST EXPONENT E. C C I1MACH(16) = EMAX, THE LARGEST EXPONENT E. C C TO ALTER THIS FUNCTION FOR A PARTICULAR ENVIRONMENT, C THE DESIRED SET OF DATA STATEMENTS SHOULD BE ACTIVATED BY C REMOVING THE C FROM COLUMN 1. ALSO, THE VALUES OF C I1MACH(1) - I1MACH(4) SHOULD BE CHECKED FOR CONSISTENCY C WITH THE LOCAL OPERATING SYSTEM. FOR FORTRAN 77, YOU MAY WISH C TO ADJUST THE DATA STATEMENT SO IMACH(6) IS SET TO 1, AND C THEN TO COMMENT OUT THE EXECUTABLE TEST ON I .EQ. 6 BELOW. C C FOR IEEE-ARITHMETIC MACHINES (BINARY STANDARD), THE FIRST C SET OF CONSTANTS BELOW SHOULD BE APPROPRIATE, EXCEPT PERHAPS C FOR IMACH(1) - IMACH(4). C C COMMENTS JUST BEFORE THE END STATEMENT (LINES STARTING WITH *) C GIVE C SOURCE FOR I1MACH. C INTEGER CRAY1, IMACH(16), OUTPUT, SANITY, SMALL(2) COMMON /D8MACH/ CRAY1 C/6S C/7S SAVE IMACH, SANITY C/ REAL RMACH C EQUIVALENCE (IMACH(4),OUTPUT), (RMACH,SMALL(1)) C C MACHINE CONSTANTS FOR IEEE ARITHMETIC MACHINES, SUCH AS THE AT&T C 3B SERIES, MOTOROLA 68000 BASED MACHINES (E.G. SUN 3 AND AT&T C PC 7300), AND 8087 BASED MICROS (E.G. IBM PC AND AT&T 6300). C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 32 / C DATA IMACH( 6) / 4 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 31 / C DATA IMACH( 9) / 2147483647 / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 24 / C DATA IMACH(12) / -125 / C DATA IMACH(13) / 128 / C DATA IMACH(14) / 53 / C DATA IMACH(15) / -1021 / C DATA IMACH(16) / 1024 /, SANITY/987/ C C MACHINE CONSTANTS FOR AMDAHL MACHINES. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 32 / C DATA IMACH( 6) / 4 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 31 / C DATA IMACH( 9) / 2147483647 / C DATA IMACH(10) / 16 / C DATA IMACH(11) / 6 / C DATA IMACH(12) / -64 / C DATA IMACH(13) / 63 / C DATA IMACH(14) / 14 / C DATA IMACH(15) / -64 / C DATA IMACH(16) / 63 /, SANITY/987/ C C MACHINE CONSTANTS FOR THE BURROUGHS 1700 SYSTEM. C C DATA IMACH( 1) / 7 / C DATA IMACH( 2) / 2 / C DATA IMACH( 3) / 2 / C DATA IMACH( 4) / 2 / C DATA IMACH( 5) / 36 / C DATA IMACH( 6) / 4 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 33 / C DATA IMACH( 9) / Z1FFFFFFFF / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 24 / C DATA IMACH(12) / -256 / C DATA IMACH(13) / 255 / C DATA IMACH(14) / 60 / C DATA IMACH(15) / -256 / C DATA IMACH(16) / 255 /, SANITY/987/ C C MACHINE CONSTANTS FOR THE BURROUGHS 5700 SYSTEM. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 48 / C DATA IMACH( 6) / 6 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 39 / C DATA IMACH( 9) / O0007777777777777 / C DATA IMACH(10) / 8 / C DATA IMACH(11) / 13 / C DATA IMACH(12) / -50 / C DATA IMACH(13) / 76 / C DATA IMACH(14) / 26 / C DATA IMACH(15) / -50 / C DATA IMACH(16) / 76 /, SANITY/987/ C C MACHINE CONSTANTS FOR THE BURROUGHS 6700/7700 SYSTEMS. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 48 / C DATA IMACH( 6) / 6 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 39 / C DATA IMACH( 9) / O0007777777777777 / C DATA IMACH(10) / 8 / C DATA IMACH(11) / 13 / C DATA IMACH(12) / -50 / C DATA IMACH(13) / 76 / C DATA IMACH(14) / 26 / C DATA IMACH(15) / -32754 / C DATA IMACH(16) / 32780 /, SANITY/987/ C C MACHINE CONSTANTS FOR FTN4 ON THE CDC 6000/7000 SERIES. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 60 / C DATA IMACH( 6) / 10 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 48 / C DATA IMACH( 9) / 00007777777777777777B / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 47 / C DATA IMACH(12) / -929 / C DATA IMACH(13) / 1070 / C DATA IMACH(14) / 94 / C DATA IMACH(15) / -929 / C DATA IMACH(16) / 1069 /, SANITY/987/ C C MACHINE CONSTANTS FOR FTN5 ON THE CDC 6000/7000 SERIES. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 60 / C DATA IMACH( 6) / 10 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 48 / C DATA IMACH( 9) / O"00007777777777777777" / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 47 / C DATA IMACH(12) / -929 / C DATA IMACH(13) / 1070 / C DATA IMACH(14) / 94 / C DATA IMACH(15) / -929 / C DATA IMACH(16) / 1069 /, SANITY/987/ C C MACHINE CONSTANTS FOR CONVEX C-1. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 32 / C DATA IMACH( 6) / 4 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 31 / C DATA IMACH( 9) / 2147483647 / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 24 / C DATA IMACH(12) / -128 / C DATA IMACH(13) / 127 / C DATA IMACH(14) / 53 / C DATA IMACH(15) /-1024 / C DATA IMACH(16) / 1023 /, SANITY/987/ C C MACHINE CONSTANTS FOR THE CRAY 1, XMP, 2, AND 3. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 102 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 64 / C DATA IMACH( 6) / 8 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 63 / C DATA IMACH( 9) / 777777777777777777777B / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 47 / C DATA IMACH(12) / -8189 / C DATA IMACH(13) / 8190 / C DATA IMACH(14) / 94 / C DATA IMACH(15) / -8099 / C DATA IMACH(16) / 8190 /, SANITY/987/ C C MACHINE CONSTANTS FOR THE DATA GENERAL ECLIPSE S/200. C C DATA IMACH( 1) / 11 / C DATA IMACH( 2) / 12 / C DATA IMACH( 3) / 8 / C DATA IMACH( 4) / 10 / C DATA IMACH( 5) / 16 / C DATA IMACH( 6) / 2 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 15 / C DATA IMACH( 9) /32767 / C DATA IMACH(10) / 16 / C DATA IMACH(11) / 6 / C DATA IMACH(12) / -64 / C DATA IMACH(13) / 63 / C DATA IMACH(14) / 14 / C DATA IMACH(15) / -64 / C DATA IMACH(16) / 63 /, SANITY/987/ C C MACHINE CONSTANTS FOR THE HARRIS SLASH 6 AND SLASH 7. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 0 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 24 / C DATA IMACH( 6) / 3 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 23 / C DATA IMACH( 9) / 8388607 / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 23 / C DATA IMACH(12) / -127 / C DATA IMACH(13) / 127 / C DATA IMACH(14) / 38 / C DATA IMACH(15) / -127 / C DATA IMACH(16) / 127 /, SANITY/987/ C C MACHINE CONSTANTS FOR THE HONEYWELL DPS 8/70 SERIES. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 43 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 36 / C DATA IMACH( 6) / 4 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 35 / C DATA IMACH( 9) / O377777777777 / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 27 / C DATA IMACH(12) / -127 / C DATA IMACH(13) / 127 / C DATA IMACH(14) / 63 / C DATA IMACH(15) / -127 / C DATA IMACH(16) / 127 /, SANITY/987/ C C MACHINE CONSTANTS FOR THE IBM 360/370 SERIES, C THE XEROX SIGMA 5/7/9 AND THE SEL SYSTEMS 85/86. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 32 / C DATA IMACH( 6) / 4 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 31 / C DATA IMACH( 9) / Z7FFFFFFF / C DATA IMACH(10) / 16 / C DATA IMACH(11) / 6 / C DATA IMACH(12) / -64 / C DATA IMACH(13) / 63 / C DATA IMACH(14) / 14 / C DATA IMACH(15) / -64 / C DATA IMACH(16) / 63 /, SANITY/987/ C C MACHINE CONSTANTS FOR THE INTERDATA 8/32 C WITH THE UNIX SYSTEM FORTRAN 77 COMPILER. C C FOR THE INTERDATA FORTRAN VII COMPILER REPLACE C THE Z'S SPECIFYING HEX CONSTANTS WITH Y'S. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 6 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 32 / C DATA IMACH( 6) / 4 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 31 / C DATA IMACH( 9) / Z'7FFFFFFF' / C DATA IMACH(10) / 16 / C DATA IMACH(11) / 6 / C DATA IMACH(12) / -64 / C DATA IMACH(13) / 62 / C DATA IMACH(14) / 14 / C DATA IMACH(15) / -64 / C DATA IMACH(16) / 62 /, SANITY/987/ C C MACHINE CONSTANTS FOR THE PDP-10 (KA PROCESSOR). C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 36 / C DATA IMACH( 6) / 5 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 35 / C DATA IMACH( 9) / "377777777777 / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 27 / C DATA IMACH(12) / -128 / C DATA IMACH(13) / 127 / C DATA IMACH(14) / 54 / C DATA IMACH(15) / -101 / C DATA IMACH(16) / 127 /, SANITY/987/ C C MACHINE CONSTANTS FOR THE PDP-10 (KI PROCESSOR). C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 36 / C DATA IMACH( 6) / 5 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 35 / C DATA IMACH( 9) / "377777777777 / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 27 / C DATA IMACH(12) / -128 / C DATA IMACH(13) / 127 / C DATA IMACH(14) / 62 / C DATA IMACH(15) / -128 / C DATA IMACH(16) / 127 /, SANITY/987/ C C MACHINE CONSTANTS FOR PDP-11 FORTRANS SUPPORTING C 32-BIT INTEGER ARITHMETIC. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 32 / C DATA IMACH( 6) / 4 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 31 / C DATA IMACH( 9) / 2147483647 / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 24 / C DATA IMACH(12) / -127 / C DATA IMACH(13) / 127 / C DATA IMACH(14) / 56 / C DATA IMACH(15) / -127 / C DATA IMACH(16) / 127 /, SANITY/987/ C C MACHINE CONSTANTS FOR PDP-11 FORTRANS SUPPORTING C 16-BIT INTEGER ARITHMETIC. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 16 / C DATA IMACH( 6) / 2 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 15 / C DATA IMACH( 9) / 32767 / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 24 / C DATA IMACH(12) / -127 / C DATA IMACH(13) / 127 / C DATA IMACH(14) / 56 / C DATA IMACH(15) / -127 / C DATA IMACH(16) / 127 /, SANITY/987/ C C MACHINE CONSTANTS FOR THE PRIME 50 SERIES SYSTEMS C WTIH 32-BIT INTEGERS AND 64V MODE INSTRUCTIONS, C SUPPLIED BY IGOR BRAY. C C DATA IMACH( 1) / 1 / C DATA IMACH( 2) / 1 / C DATA IMACH( 3) / 2 / C DATA IMACH( 4) / 1 / C DATA IMACH( 5) / 32 / C DATA IMACH( 6) / 4 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 31 / C DATA IMACH( 9) / :17777777777 / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 23 / C DATA IMACH(12) / -127 / C DATA IMACH(13) / +127 / C DATA IMACH(14) / 47 / C DATA IMACH(15) / -32895 / C DATA IMACH(16) / +32637 /, SANITY/987/ C C MACHINE CONSTANTS FOR THE SEQUENT BALANCE 8000. C C DATA IMACH( 1) / 0 / C DATA IMACH( 2) / 0 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 0 / C DATA IMACH( 5) / 32 / C DATA IMACH( 6) / 1 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 31 / C DATA IMACH( 9) / 2147483647 / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 24 / C DATA IMACH(12) / -125 / C DATA IMACH(13) / 128 / C DATA IMACH(14) / 53 / C DATA IMACH(15) / -1021 / C DATA IMACH(16) / 1024 /, SANITY/987/ C C MACHINE CONSTANTS FOR THE UNIVAC 1100 SERIES. C C NOTE THAT THE PUNCH UNIT, I1MACH(3), HAS BEEN SET TO 7 C WHICH IS APPROPRIATE FOR THE UNIVAC-FOR SYSTEM. C IF YOU HAVE THE UNIVAC-FTN SYSTEM, SET IT TO 1. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 36 / C DATA IMACH( 6) / 6 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 35 / C DATA IMACH( 9) / O377777777777 / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 27 / C DATA IMACH(12) / -128 / C DATA IMACH(13) / 127 / C DATA IMACH(14) / 60 / C DATA IMACH(15) /-1024 / C DATA IMACH(16) / 1023 /, SANITY/987/ C C MACHINE CONSTANTS FOR VAX. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 32 / C DATA IMACH( 6) / 4 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 31 / C DATA IMACH( 9) / 2147483647 / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 24 / C DATA IMACH(12) / -127 / C DATA IMACH(13) / 127 / C DATA IMACH(14) / 56 / C DATA IMACH(15) / -127 / C DATA IMACH(16) / 127 /, SANITY/987/ C C *** ISSUE STOP 775 IF ALL DATA STATEMENTS ARE COMMENTED... IF (SANITY .NE. 987) THEN * *** CHECK FOR AUTODOUBLE *** SMALL(2) = 0 RMACH = 1E13 IF (SMALL(2) .NE. 0) THEN * *** AUTODOUBLED *** IF ( (SMALL(1) .EQ. 1117925532 * .AND. SMALL(2) .EQ. -448790528) * .OR. (SMALL(2) .EQ. 1117925532 * .AND. SMALL(1) .EQ. -448790528)) THEN * *** IEEE *** IMACH(10) = 2 IMACH(14) = 53 IMACH(15) = -1021 IMACH(16) = 1024 ELSE IF ( SMALL(1) .EQ. -2065213935 * .AND. SMALL(2) .EQ. 10752) THEN * *** VAX WITH D_FLOATING *** IMACH(10) = 2 IMACH(14) = 56 IMACH(15) = -127 IMACH(16) = 127 ELSE IF ( SMALL(1) .EQ. 1267827943 * .AND. SMALL(2) .EQ. 704643072) THEN * *** IBM MAINFRAME *** IMACH(10) = 16 IMACH(14) = 14 IMACH(15) = -64 IMACH(16) = 63 ELSE WRITE(*,9010) STOP 777 END IF IMACH(11) = IMACH(14) IMACH(12) = IMACH(15) IMACH(13) = IMACH(16) ELSE RMACH = 1234567. IF (SMALL(1) .EQ. 1234613304) THEN * *** IEEE *** IMACH(10) = 2 IMACH(11) = 24 IMACH(12) = -125 IMACH(13) = 128 IMACH(14) = 53 IMACH(15) = -1021 IMACH(16) = 1024 SANITY = 987 ELSE IF (SMALL(1) .EQ. -1271379306) THEN * *** VAX *** IMACH(10) = 2 IMACH(11) = 24 IMACH(12) = -127 IMACH(13) = 127 IMACH(14) = 56 IMACH(15) = -127 IMACH(16) = 127 SANITY = 987 ELSE IF (SMALL(1) .EQ. 1175639687) THEN * *** IBM MAINFRAME *** IMACH(10) = 16 IMACH(11) = 6 IMACH(12) = -64 IMACH(13) = 63 IMACH(14) = 14 IMACH(15) = -64 IMACH(16) = 63 SANITY = 987 ELSE IF (SMALL(1) .EQ. 1251390520) THEN * *** CONVEX C-1 *** IMACH(10) = 2 IMACH(11) = 24 IMACH(12) = -128 IMACH(13) = 127 IMACH(14) = 53 IMACH(15) = -1024 IMACH(16) = 1023 SANITY = 987 ELSE * CRAY1 = 4617762693716115456 CRAY1 = 4617762 CRAY1 = 1000000*CRAY1 + 693716 CRAY1 = 1000000*CRAY1 + 115456 IF (SMALL(1) .NE. CRAY1) THEN WRITE(*,9020) STOP 777 END IF * *** CRAY 1, XMP, 2, AND 3 *** IMACH(1) = 5 IMACH(2) = 6 IMACH(3) = 102 IMACH(4) = 6 IMACH(5) = 64 IMACH(6) = 8 IMACH(7) = 2 IMACH(8) = 63 * IMACH(9) = 9223372036854775807 IMACH(9) = 9223372 IMACH(9) = 1000000*IMACH(9) + 36854 IMACH(9) = 1000000*IMACH(9) + 775807 IMACH(10) = 2 IMACH(11) = 47 IMACH(12) = -8189 IMACH(13) = 8190 IMACH(14) = 94 IMACH(15) = -8099 IMACH(16) = 8190 SANITY = 987 GO TO 10 END IF END IF IMACH( 1) = 5 IMACH( 2) = 6 IMACH( 3) = 7 IMACH( 4) = 6 IMACH( 5) = 32 IMACH( 6) = 4 IMACH( 7) = 2 IMACH( 8) = 31 IMACH( 9) = 2147483647 SANITY = 987 END IF C/6S C9010 FORMAT(/47H Adjust autodoubled I1MACH by uncommenting data/ C * 52H statements appropriate for your machine and setting/ C * 46H IMACH(I) = IMACH(I+3) for I = 11, 12, and 13.) C9020 FORMAT(/46H Adjust I1MACH by uncommenting data statements/ C * 30H appropriate for your machine.) C/7S 9010 FORMAT(/' Adjust autodoubled I1MACH by uncommenting data'/ * ' statements appropriate for your machine and setting'/ * ' IMACH(I) = IMACH(I+3) for I = 11, 12, and 13.') 9020 FORMAT(/' Adjust I1MACH by uncommenting data statements'/ * ' appropriate for your machine.') C/ 10 IF (I .LT. 1 .OR. I .GT. 16) GO TO 30 C I1MACH = IMACH(I) C/6S C/7S IF (I .EQ. 6) I1MACH = 1 C/ RETURN C 30 WRITE(*,*) 'I1MACH(I): I =',I,' is out of bounds.' C * CALL FDUMP C STOP C * /* C source for I1MACH -- remove the * in column 1 */ * /* Note that some values may need changing -- see the comments below. */ *#include *#include *#include *#include * *long i1mach_(long *i) *{ * switch(*i){ * case 1: return 5; /* standard input unit -- may need changing */ * case 2: return 6; /* standard output unit -- may need changing */ * case 3: return 7; /* standard punch unit -- may need changing */ * case 4: return 0; /* standard error unit -- may need changing */ * case 5: return 32; /* bits per integer -- may need changing */ * case 6: return 1; /* Fortran 77 value: 1 character */ * /* per character storage unit */ * case 7: return 2; /* base for integers -- may need changing */ * case 8: return 31; /* digits of integer base -- may need changing */ * case 9: return LONG_MAX; * case 10: return FLT_RADIX; * case 11: return FLT_MANT_DIG; * case 12: return FLT_MIN_EXP; * case 13: return FLT_MAX_EXP; * case 14: return DBL_MANT_DIG; * case 15: return DBL_MIN_EXP; * case 16: return DBL_MAX_EXP; * } * * fprintf(stderr, "invalid argument: i1mach(%ld)\n", *i); * exit(1); * return 0; /* for compilers that complain of missing return values */ * } END DOUBLE PRECISION FUNCTION D1MACH(I) INTEGER I C C DOUBLE-PRECISION MACHINE CONSTANTS C C D1MACH( 1) = B**(EMIN-1), THE SMALLEST POSITIVE MAGNITUDE. C C D1MACH( 2) = B**EMAX*(1 - B**(-T)), THE LARGEST MAGNITUDE. C C D1MACH( 3) = B**(-T), THE SMALLEST RELATIVE SPACING. C C D1MACH( 4) = B**(1-T), THE LARGEST RELATIVE SPACING. C C D1MACH( 5) = LOG10(B) C C TO ALTER THIS FUNCTION FOR A PARTICULAR ENVIRONMENT, C THE DESIRED SET OF DATA STATEMENTS SHOULD BE ACTIVATED BY C REMOVING THE C FROM COLUMN 1. C ON RARE MACHINES A STATIC STATEMENT MAY NEED TO BE ADDED. C (BUT PROBABLY MORE SYSTEMS PROHIBIT IT THAN REQUIRE IT.) C C FOR IEEE-ARITHMETIC MACHINES (BINARY STANDARD), ONE OF THE FIRST C TWO SETS OF CONSTANTS BELOW SHOULD BE APPROPRIATE. IF YOU DO NOT C KNOW WHICH SET TO USE, TRY BOTH AND SEE WHICH GIVES PLAUSIBLE C VALUES. C C WHERE POSSIBLE, DECIMAL, OCTAL OR HEXADECIMAL CONSTANTS ARE USED C TO SPECIFY THE CONSTANTS EXACTLY. SOMETIMES THIS REQUIRES USING C EQUIVALENT INTEGER ARRAYS. IF YOUR COMPILER USES HALF-WORD C INTEGERS BY DEFAULT (SOMETIMES CALLED INTEGER*2), YOU MAY NEED TO C CHANGE INTEGER TO INTEGER*4 OR OTHERWISE INSTRUCT YOUR COMPILER C TO USE FULL-WORD INTEGERS IN THE NEXT 5 DECLARATIONS. C C COMMENTS JUST BEFORE THE END STATEMENT (LINES STARTING WITH *) C GIVE C SOURCE FOR D1MACH. C INTEGER SMALL(2) INTEGER LARGE(2) INTEGER RIGHT(2) INTEGER DIVER(2) INTEGER LOG10(2) INTEGER SC, CRAY1(38), J COMMON /D9MACH/ CRAY1 C/6S C/7S SAVE SMALL, LARGE, RIGHT, DIVER, LOG10, SC C/ DOUBLE PRECISION DMACH(5) C EQUIVALENCE (DMACH(1),SMALL(1)) EQUIVALENCE (DMACH(2),LARGE(1)) EQUIVALENCE (DMACH(3),RIGHT(1)) EQUIVALENCE (DMACH(4),DIVER(1)) EQUIVALENCE (DMACH(5),LOG10(1)) C C MACHINE CONSTANTS FOR BIG-ENDIAN IEEE ARITHMETIC (BINARY FORMAT) C MACHINES IN WHICH THE MOST SIGNIFICANT BYTE IS STORED FIRST, C SUCH AS THE AT&T 3B SERIES, MOTOROLA 68000 BASED MACHINES (E.G. C SUN 3), AND MACHINES THAT USE SPARC, HP, OR IBM RISC CHIPS. C C DATA SMALL(1),SMALL(2) / 1048576, 0 / C DATA LARGE(1),LARGE(2) / 2146435071, -1 / C DATA RIGHT(1),RIGHT(2) / 1017118720, 0 / C DATA DIVER(1),DIVER(2) / 1018167296, 0 / C DATA LOG10(1),LOG10(2) / 1070810131, 1352628735 /, SC/987/ C C MACHINE CONSTANTS FOR LITTLE-ENDIAN (BINARY) IEEE ARITHMETIC C MACHINES IN WHICH THE LEAST SIGNIFICANT BYTE IS STORED FIRST, C E.G. IBM PCS AND OTHER MACHINES THAT USE INTEL 80X87 OR DEC C ALPHA CHIPS. C C DATA SMALL(1),SMALL(2) / 0, 1048576 / C DATA LARGE(1),LARGE(2) / -1, 2146435071 / C DATA RIGHT(1),RIGHT(2) / 0, 1017118720 / C DATA DIVER(1),DIVER(2) / 0, 1018167296 / C DATA LOG10(1),LOG10(2) / 1352628735, 1070810131 /, SC/987/ C C MACHINE CONSTANTS FOR AMDAHL MACHINES. C C DATA SMALL(1),SMALL(2) / 1048576, 0 / C DATA LARGE(1),LARGE(2) / 2147483647, -1 / C DATA RIGHT(1),RIGHT(2) / 856686592, 0 / C DATA DIVER(1),DIVER(2) / 873463808, 0 / C DATA LOG10(1),LOG10(2) / 1091781651, 1352628735 /, SC/987/ C C MACHINE CONSTANTS FOR THE BURROUGHS 1700 SYSTEM. C C DATA SMALL(1) / ZC00800000 / C DATA SMALL(2) / Z000000000 / C C DATA LARGE(1) / ZDFFFFFFFF / C DATA LARGE(2) / ZFFFFFFFFF / C C DATA RIGHT(1) / ZCC5800000 / C DATA RIGHT(2) / Z000000000 / C C DATA DIVER(1) / ZCC6800000 / C DATA DIVER(2) / Z000000000 / C C DATA LOG10(1) / ZD00E730E7 / C DATA LOG10(2) / ZC77800DC0 /, SC/987/ C C MACHINE CONSTANTS FOR THE BURROUGHS 5700 SYSTEM. C C DATA SMALL(1) / O1771000000000000 / C DATA SMALL(2) / O0000000000000000 / C C DATA LARGE(1) / O0777777777777777 / C DATA LARGE(2) / O0007777777777777 / C C DATA RIGHT(1) / O1461000000000000 / C DATA RIGHT(2) / O0000000000000000 / C C DATA DIVER(1) / O1451000000000000 / C DATA DIVER(2) / O0000000000000000 / C C DATA LOG10(1) / O1157163034761674 / C DATA LOG10(2) / O0006677466732724 /, SC/987/ C C MACHINE CONSTANTS FOR THE BURROUGHS 6700/7700 SYSTEMS. C C DATA SMALL(1) / O1771000000000000 / C DATA SMALL(2) / O7770000000000000 / C C DATA LARGE(1) / O0777777777777777 / C DATA LARGE(2) / O7777777777777777 / C C DATA RIGHT(1) / O1461000000000000 / C DATA RIGHT(2) / O0000000000000000 / C C DATA DIVER(1) / O1451000000000000 / C DATA DIVER(2) / O0000000000000000 / C C DATA LOG10(1) / O1157163034761674 / C DATA LOG10(2) / O0006677466732724 /, SC/987/ C C MACHINE CONSTANTS FOR FTN4 ON THE CDC 6000/7000 SERIES. C C DATA SMALL(1) / 00564000000000000000B / C DATA SMALL(2) / 00000000000000000000B / C C DATA LARGE(1) / 37757777777777777777B / C DATA LARGE(2) / 37157777777777777774B / C C DATA RIGHT(1) / 15624000000000000000B / C DATA RIGHT(2) / 00000000000000000000B / C C DATA DIVER(1) / 15634000000000000000B / C DATA DIVER(2) / 00000000000000000000B / C C DATA LOG10(1) / 17164642023241175717B / C DATA LOG10(2) / 16367571421742254654B /, SC/987/ C C MACHINE CONSTANTS FOR FTN5 ON THE CDC 6000/7000 SERIES. C C DATA SMALL(1) / O"00564000000000000000" / C DATA SMALL(2) / O"00000000000000000000" / C C DATA LARGE(1) / O"37757777777777777777" / C DATA LARGE(2) / O"37157777777777777774" / C C DATA RIGHT(1) / O"15624000000000000000" / C DATA RIGHT(2) / O"00000000000000000000" / C C DATA DIVER(1) / O"15634000000000000000" / C DATA DIVER(2) / O"00000000000000000000" / C C DATA LOG10(1) / O"17164642023241175717" / C DATA LOG10(2) / O"16367571421742254654" /, SC/987/ C C MACHINE CONSTANTS FOR CONVEX C-1 C C DATA SMALL(1),SMALL(2) / '00100000'X, '00000000'X / C DATA LARGE(1),LARGE(2) / '7FFFFFFF'X, 'FFFFFFFF'X / C DATA RIGHT(1),RIGHT(2) / '3CC00000'X, '00000000'X / C DATA DIVER(1),DIVER(2) / '3CD00000'X, '00000000'X / C DATA LOG10(1),LOG10(2) / '3FF34413'X, '509F79FF'X /, SC/987/ C C MACHINE CONSTANTS FOR THE CRAY 1, XMP, 2, AND 3. C C DATA SMALL(1) / 201354000000000000000B / C DATA SMALL(2) / 000000000000000000000B / C C DATA LARGE(1) / 577767777777777777777B / C DATA LARGE(2) / 000007777777777777776B / C C DATA RIGHT(1) / 376434000000000000000B / C DATA RIGHT(2) / 000000000000000000000B / C C DATA DIVER(1) / 376444000000000000000B / C DATA DIVER(2) / 000000000000000000000B / C C DATA LOG10(1) / 377774642023241175717B / C DATA LOG10(2) / 000007571421742254654B /, SC/987/ C C MACHINE CONSTANTS FOR THE DATA GENERAL ECLIPSE S/200 C C SMALL, LARGE, RIGHT, DIVER, LOG10 SHOULD BE DECLARED C INTEGER SMALL(4), LARGE(4), RIGHT(4), DIVER(4), LOG10(4) C C NOTE - IT MAY BE APPROPRIATE TO INCLUDE THE FOLLOWING LINE - C STATIC DMACH(5) C C DATA SMALL/20K,3*0/,LARGE/77777K,3*177777K/ C DATA RIGHT/31420K,3*0/,DIVER/32020K,3*0/ C DATA LOG10/40423K,42023K,50237K,74776K/, SC/987/ C C MACHINE CONSTANTS FOR THE HARRIS SLASH 6 AND SLASH 7 C C DATA SMALL(1),SMALL(2) / '20000000, '00000201 / C DATA LARGE(1),LARGE(2) / '37777777, '37777577 / C DATA RIGHT(1),RIGHT(2) / '20000000, '00000333 / C DATA DIVER(1),DIVER(2) / '20000000, '00000334 / C DATA LOG10(1),LOG10(2) / '23210115, '10237777 /, SC/987/ C C MACHINE CONSTANTS FOR THE HONEYWELL DPS 8/70 SERIES. C C DATA SMALL(1),SMALL(2) / O402400000000, O000000000000 / C DATA LARGE(1),LARGE(2) / O376777777777, O777777777777 / C DATA RIGHT(1),RIGHT(2) / O604400000000, O000000000000 / C DATA DIVER(1),DIVER(2) / O606400000000, O000000000000 / C DATA LOG10(1),LOG10(2) / O776464202324, O117571775714 /, SC/987/ C C MACHINE CONSTANTS FOR THE IBM 360/370 SERIES, C THE XEROX SIGMA 5/7/9 AND THE SEL SYSTEMS 85/86. C C DATA SMALL(1),SMALL(2) / Z00100000, Z00000000 / C DATA LARGE(1),LARGE(2) / Z7FFFFFFF, ZFFFFFFFF / C DATA RIGHT(1),RIGHT(2) / Z33100000, Z00000000 / C DATA DIVER(1),DIVER(2) / Z34100000, Z00000000 / C DATA LOG10(1),LOG10(2) / Z41134413, Z509F79FF /, SC/987/ C C MACHINE CONSTANTS FOR THE INTERDATA 8/32 C WITH THE UNIX SYSTEM FORTRAN 77 COMPILER. C C FOR THE INTERDATA FORTRAN VII COMPILER REPLACE C THE Z'S SPECIFYING HEX CONSTANTS WITH Y'S. C C DATA SMALL(1),SMALL(2) / Z'00100000', Z'00000000' / C DATA LARGE(1),LARGE(2) / Z'7EFFFFFF', Z'FFFFFFFF' / C DATA RIGHT(1),RIGHT(2) / Z'33100000', Z'00000000' / C DATA DIVER(1),DIVER(2) / Z'34100000', Z'00000000' / C DATA LOG10(1),LOG10(2) / Z'41134413', Z'509F79FF' /, SC/987/ C C MACHINE CONSTANTS FOR THE PDP-10 (KA PROCESSOR). C C DATA SMALL(1),SMALL(2) / "033400000000, "000000000000 / C DATA LARGE(1),LARGE(2) / "377777777777, "344777777777 / C DATA RIGHT(1),RIGHT(2) / "113400000000, "000000000000 / C DATA DIVER(1),DIVER(2) / "114400000000, "000000000000 / C DATA LOG10(1),LOG10(2) / "177464202324, "144117571776 /, SC/987/ C C MACHINE CONSTANTS FOR THE PDP-10 (KI PROCESSOR). C C DATA SMALL(1),SMALL(2) / "000400000000, "000000000000 / C DATA LARGE(1),LARGE(2) / "377777777777, "377777777777 / C DATA RIGHT(1),RIGHT(2) / "103400000000, "000000000000 / C DATA DIVER(1),DIVER(2) / "104400000000, "000000000000 / C DATA LOG10(1),LOG10(2) / "177464202324, "047674776746 /, SC/987/ C C MACHINE CONSTANTS FOR PDP-11 FORTRANS SUPPORTING C 32-BIT INTEGERS (EXPRESSED IN INTEGER AND OCTAL). C C DATA SMALL(1),SMALL(2) / 8388608, 0 / C DATA LARGE(1),LARGE(2) / 2147483647, -1 / C DATA RIGHT(1),RIGHT(2) / 612368384, 0 / C DATA DIVER(1),DIVER(2) / 620756992, 0 / C DATA LOG10(1),LOG10(2) / 1067065498, -2063872008 /, SC/987/ C C DATA SMALL(1),SMALL(2) / O00040000000, O00000000000 / C DATA LARGE(1),LARGE(2) / O17777777777, O37777777777 / C DATA RIGHT(1),RIGHT(2) / O04440000000, O00000000000 / C DATA DIVER(1),DIVER(2) / O04500000000, O00000000000 / C DATA LOG10(1),LOG10(2) / O07746420232, O20476747770 /, SC/987/ C C MACHINE CONSTANTS FOR PDP-11 FORTRANS SUPPORTING C 16-BIT INTEGERS (EXPRESSED IN INTEGER AND OCTAL). C C SMALL, LARGE, RIGHT, DIVER, LOG10 SHOULD BE DECLARED C INTEGER SMALL(4), LARGE(4), RIGHT(4), DIVER(4), LOG10(4) C C DATA SMALL(1),SMALL(2) / 128, 0 / C DATA SMALL(3),SMALL(4) / 0, 0 / C C DATA LARGE(1),LARGE(2) / 32767, -1 / C DATA LARGE(3),LARGE(4) / -1, -1 / C C DATA RIGHT(1),RIGHT(2) / 9344, 0 / C DATA RIGHT(3),RIGHT(4) / 0, 0 / C C DATA DIVER(1),DIVER(2) / 9472, 0 / C DATA DIVER(3),DIVER(4) / 0, 0 / C C DATA LOG10(1),LOG10(2) / 16282, 8346 / C DATA LOG10(3),LOG10(4) / -31493, -12296 /, SC/987/ C C DATA SMALL(1),SMALL(2) / O000200, O000000 / C DATA SMALL(3),SMALL(4) / O000000, O000000 / C C DATA LARGE(1),LARGE(2) / O077777, O177777 / C DATA LARGE(3),LARGE(4) / O177777, O177777 / C C DATA RIGHT(1),RIGHT(2) / O022200, O000000 / C DATA RIGHT(3),RIGHT(4) / O000000, O000000 / C C DATA DIVER(1),DIVER(2) / O022400, O000000 / C DATA DIVER(3),DIVER(4) / O000000, O000000 / C C DATA LOG10(1),LOG10(2) / O037632, O020232 / C DATA LOG10(3),LOG10(4) / O102373, O147770 /, SC/987/ C C MACHINE CONSTANTS FOR THE PRIME 50 SERIES SYSTEMS C WITH 32-BIT INTEGERS AND 64V MODE INSTRUCTIONS, C SUPPLIED BY IGOR BRAY. C C DATA SMALL(1),SMALL(2) / :10000000000, :00000100001 / C DATA LARGE(1),LARGE(2) / :17777777777, :37777677775 / C DATA RIGHT(1),RIGHT(2) / :10000000000, :00000000122 / C DATA DIVER(1),DIVER(2) / :10000000000, :00000000123 / C DATA LOG10(1),LOG10(2) / :11504046501, :07674600177 /, SC/987/ C C MACHINE CONSTANTS FOR THE SEQUENT BALANCE 8000 C C DATA SMALL(1),SMALL(2) / $00000000, $00100000 / C DATA LARGE(1),LARGE(2) / $FFFFFFFF, $7FEFFFFF / C DATA RIGHT(1),RIGHT(2) / $00000000, $3CA00000 / C DATA DIVER(1),DIVER(2) / $00000000, $3CB00000 / C DATA LOG10(1),LOG10(2) / $509F79FF, $3FD34413 /, SC/987/ C C MACHINE CONSTANTS FOR THE UNIVAC 1100 SERIES. C C DATA SMALL(1),SMALL(2) / O000040000000, O000000000000 / C DATA LARGE(1),LARGE(2) / O377777777777, O777777777777 / C DATA RIGHT(1),RIGHT(2) / O170540000000, O000000000000 / C DATA DIVER(1),DIVER(2) / O170640000000, O000000000000 / C DATA LOG10(1),LOG10(2) / O177746420232, O411757177572 /, SC/987/ C C MACHINE CONSTANTS FOR THE VAX UNIX F77 COMPILER C C DATA SMALL(1),SMALL(2) / 128, 0 / C DATA LARGE(1),LARGE(2) / -32769, -1 / C DATA RIGHT(1),RIGHT(2) / 9344, 0 / C DATA DIVER(1),DIVER(2) / 9472, 0 / C DATA LOG10(1),LOG10(2) / 546979738, -805796613 /, SC/987/ C C MACHINE CONSTANTS FOR THE VAX-11 WITH C FORTRAN IV-PLUS COMPILER C C DATA SMALL(1),SMALL(2) / Z00000080, Z00000000 / C DATA LARGE(1),LARGE(2) / ZFFFF7FFF, ZFFFFFFFF / C DATA RIGHT(1),RIGHT(2) / Z00002480, Z00000000 / C DATA DIVER(1),DIVER(2) / Z00002500, Z00000000 / C DATA LOG10(1),LOG10(2) / Z209A3F9A, ZCFF884FB /, SC/987/ C C MACHINE CONSTANTS FOR VAX/VMS VERSION 2.2 C C DATA SMALL(1),SMALL(2) / '80'X, '0'X / C DATA LARGE(1),LARGE(2) / 'FFFF7FFF'X, 'FFFFFFFF'X / C DATA RIGHT(1),RIGHT(2) / '2480'X, '0'X / C DATA DIVER(1),DIVER(2) / '2500'X, '0'X / C DATA LOG10(1),LOG10(2) / '209A3F9A'X, 'CFF884FB'X /, SC/987/ C C *** ISSUE STOP 779 IF ALL DATA STATEMENTS ARE COMMENTED... IF (SC .NE. 987) THEN DMACH(1) = 1.D13 IF ( SMALL(1) .EQ. 1117925532 * .AND. SMALL(2) .EQ. -448790528) THEN * *** IEEE BIG ENDIAN *** SMALL(1) = 1048576 SMALL(2) = 0 LARGE(1) = 2146435071 LARGE(2) = -1 RIGHT(1) = 1017118720 RIGHT(2) = 0 DIVER(1) = 1018167296 DIVER(2) = 0 LOG10(1) = 1070810131 LOG10(2) = 1352628735 ELSE IF ( SMALL(2) .EQ. 1117925532 * .AND. SMALL(1) .EQ. -448790528) THEN * *** IEEE LITTLE ENDIAN *** SMALL(2) = 1048576 SMALL(1) = 0 LARGE(2) = 2146435071 LARGE(1) = -1 RIGHT(2) = 1017118720 RIGHT(1) = 0 DIVER(2) = 1018167296 DIVER(1) = 0 LOG10(2) = 1070810131 LOG10(1) = 1352628735 ELSE IF ( SMALL(1) .EQ. -2065213935 * .AND. SMALL(2) .EQ. 10752) THEN * *** VAX WITH D_FLOATING *** SMALL(1) = 128 SMALL(2) = 0 LARGE(1) = -32769 LARGE(2) = -1 RIGHT(1) = 9344 RIGHT(2) = 0 DIVER(1) = 9472 DIVER(2) = 0 LOG10(1) = 546979738 LOG10(2) = -805796613 ELSE IF ( SMALL(1) .EQ. 1267827943 * .AND. SMALL(2) .EQ. 704643072) THEN * *** IBM MAINFRAME *** SMALL(1) = 1048576 SMALL(2) = 0 LARGE(1) = 2147483647 LARGE(2) = -1 RIGHT(1) = 856686592 RIGHT(2) = 0 DIVER(1) = 873463808 DIVER(2) = 0 LOG10(1) = 1091781651 LOG10(2) = 1352628735 ELSE IF ( SMALL(1) .EQ. 1120022684 * .AND. SMALL(2) .EQ. -448790528) THEN * *** CONVEX C-1 *** SMALL(1) = 1048576 SMALL(2) = 0 LARGE(1) = 2147483647 LARGE(2) = -1 RIGHT(1) = 1019215872 RIGHT(2) = 0 DIVER(1) = 1020264448 DIVER(2) = 0 LOG10(1) = 1072907283 LOG10(2) = 1352628735 ELSE IF ( SMALL(1) .EQ. 815547074 * .AND. SMALL(2) .EQ. 58688) THEN * *** VAX G-FLOATING *** SMALL(1) = 16 SMALL(2) = 0 LARGE(1) = -32769 LARGE(2) = -1 RIGHT(1) = 15552 RIGHT(2) = 0 DIVER(1) = 15568 DIVER(2) = 0 LOG10(1) = 1142112243 LOG10(2) = 2046775455 ELSE DMACH(2) = 1.D27 + 1 DMACH(3) = 1.D27 LARGE(2) = LARGE(2) - RIGHT(2) IF (LARGE(2) .EQ. 64 .AND. SMALL(2) .EQ. 0) THEN CRAY1(1) = 67291416 DO 10 J = 1, 20 10 CRAY1(J+1) = CRAY1(J) + CRAY1(J) CRAY1(22) = CRAY1(21) + 321322 DO 20 J = 22, 37 20 CRAY1(J+1) = CRAY1(J) + CRAY1(J) IF (CRAY1(38) .EQ. SMALL(1)) THEN * *** CRAY *** * SMALL(1) = 2332160919536140288 SMALL(1) = 2332160 SMALL(1) = 1000000*SMALL(1) + 919536 SMALL(1) = 1000000*SMALL(1) + 140288 SMALL(2) = 0 * LARGE(1) = 6917247552664371199 LARGE(1) = 6917247 LARGE(1) = 1000000*LARGE(1) + 552664 LARGE(1) = 1000000*LARGE(1) + 371199 * LARGE(2) = 281474976710654 LARGE(2) = 28147497 LARGE(2) = 10000000*LARGE(2) + 6710654 * RIGHT(1) = 4585649583081652224 RIGHT(1) = 4585649 RIGHT(1) = 1000000*RIGHT(1) + 583081 RIGHT(1) = 1000000*RIGHT(1) + 652224 RIGHT(2) = 0 * DIVER(1) = 4585931058058362880 DIVER(1) = 4585931 DIVER(1) = 1000000*DIVER(1) + 058058 DIVER(1) = 1000000*DIVER(1) + 362880 DIVER(2) = 0 * LOG10(1) = 4611574008272714703 LOG10(1) = 4611574 LOG10(1) = 1000000*LOG10(1) + 8272 LOG10(1) = 1000000*LOG10(1) + 714703 * LOG10(2) = 272234615232940 LOG10(2) = 27223461 LOG10(2) = 10000000*LOG10(2) + 5232940 ELSE WRITE(*,9000) STOP 779 END IF ELSE WRITE(*,9000) STOP 779 END IF END IF SC = 987 END IF C C *** ISSUE STOP 778 IF ALL DATA STATEMENTS ARE OBVIOUSLY WRONG... IF (DMACH(4) .GE. 1.0D0) STOP 778 *C/6S *C IF (I .LT. 1 .OR. I .GT. 5) *C 1 CALL SETERR(24HD1MACH - I OUT OF BOUNDS,24,1,2) *C/7S * IF (I .LT. 1 .OR. I .GT. 5) * 1 CALL SETERR('D1MACH - I OUT OF BOUNDS',24,1,2) *C/ IF (I .LT. 1 .OR. I .GT. 5) THEN WRITE(*,*) 'D1MACH(I): I =',I,' is out of bounds.' STOP END IF D1MACH = DMACH(I) RETURN C/6S C9000 FORMAT(/46H Adjust D1MACH by uncommenting data statements/ C *30H appropriate for your machine.) C/7S 9000 FORMAT(/' Adjust D1MACH by uncommenting data statements'/ *' appropriate for your machine.') C/ C * /* C source for D1MACH -- remove the * in column 1 */ *#include *#include *#include * *double d1mach_(long *i) *{ * switch(*i){ * case 1: return DBL_MIN; * case 2: return DBL_MAX; * case 3: return DBL_EPSILON/FLT_RADIX; * case 4: return DBL_EPSILON; * case 5: return log10(FLT_RADIX); * } * * fprintf(stderr, "invalid argument: d1mach(%ld)\n", *i); * exit(1); * return 0; /* for compilers that complain of missing return values */ * } END SHAR_EOF fi # end of overwriting check if test -f 'blas1.f' then echo shar: will not over-write existing file "'blas1.f'" else cat << \SHAR_EOF > 'blas1.f' double precision function ddot(n,sx,incx,sy,incy) c c forms the dot product of two vectors. c uses unrolled loop for increments equal to one. c jack dongarra, linpack, 3/11/78. c double precision sx(1),sy(1),stemp integer i,incx,incy,ix,iy,m,mp1,n c ddot = 0.0d0 stemp = 0.0d0 if(n.le.0)return if(incx.eq.1.and.incy.eq.1)go to 20 c c code for unequal increments or equal increments c not equal to 1 c ix = 1 iy = 1 if(incx.lt.0)ix = (-n+1)*incx + 1 if(incy.lt.0)iy = (-n+1)*incy + 1 do 10 i = 1,n stemp = stemp + sx(ix)*sy(iy) ix = ix + incx iy = iy + incy 10 continue ddot = stemp return c c code for both increments equal to 1 c c c clean-up loop c 20 m = mod(n,5) if( m .eq. 0 ) go to 40 do 30 i = 1,m stemp = stemp + sx(i)*sy(i) 30 continue if( n .lt. 5 ) go to 60 40 mp1 = m + 1 do 50 i = mp1,n,5 stemp = stemp + sx(i)*sy(i) + sx(i + 1)*sy(i + 1) + * sx(i + 2)*sy(i + 2) + sx(i + 3)*sy(i + 3) + sx(i + 4)*sy(i + 4) 50 continue 60 ddot = stemp return end subroutine daxpy(n,sa,sx,incx,sy,incy) c c constant times a vector plus a vector. c uses unrolled loop for increments equal to one. c jack dongarra, linpack, 3/11/78. c double precision sx(1),sy(1),sa integer i,incx,incy,ix,iy,m,mp1,n c if(n.le.0)return if (sa .eq. 0.0d0) return if(incx.eq.1.and.incy.eq.1)go to 20 c c code for unequal increments or equal increments c not equal to 1 c ix = 1 iy = 1 if(incx.lt.0)ix = (-n+1)*incx + 1 if(incy.lt.0)iy = (-n+1)*incy + 1 do 10 i = 1,n sy(iy) = sy(iy) + sa*sx(ix) ix = ix + incx iy = iy + incy 10 continue return c c code for both increments equal to 1 c c c clean-up loop c 20 m = mod(n,4) if( m .eq. 0 ) go to 40 do 30 i = 1,m sy(i) = sy(i) + sa*sx(i) 30 continue if( n .lt. 4 ) return 40 mp1 = m + 1 do 50 i = mp1,n,4 sy(i) = sy(i) + sa*sx(i) sy(i + 1) = sy(i + 1) + sa*sx(i + 1) sy(i + 2) = sy(i + 2) + sa*sx(i + 2) sy(i + 3) = sy(i + 3) + sa*sx(i + 3) 50 continue return end DOUBLE PRECISION FUNCTION DNRM2 ( N, SX, INCX) INTEGER NEXT DOUBLE PRECISION SX(1), CUTLO, CUTHI, HITEST, SUM, XMAX, ZERO, + ONE DATA ZERO, ONE /0.0D0, 1.0D0/ C C EUCLIDEAN NORM OF THE N-VECTOR STORED IN SX() WITH STORAGE C INCREMENT INCX . C IF N .LE. 0 RETURN WITH RESULT = 0. C IF N .GE. 1 THEN INCX MUST BE .GE. 1 C C C.L.LAWSON, 1978 JAN 08 C C FOUR PHASE METHOD USING TWO BUILT-IN CONSTANTS THAT ARE C HOPEFULLY APPLICABLE TO ALL MACHINES. C CUTLO = MAXIMUM OF SQRT(U/EPS) OVER ALL KNOWN MACHINES. C CUTHI = MINIMUM OF SQRT(V) OVER ALL KNOWN MACHINES. C WHERE C EPS = SMALLEST NO. SUCH THAT EPS + 1. .GT. 1. C U = SMALLEST POSITIVE NO. (UNDERFLOW LIMIT) C V = LARGEST NO. (OVERFLOW LIMIT) C C BRIEF OUTLINE OF ALGORITHM.. C C PHASE 1 SCANS ZERO COMPONENTS. C MOVE TO PHASE 2 WHEN A COMPONENT IS NONZERO AND .LE. CUTLO C MOVE TO PHASE 3 WHEN A COMPONENT IS .GT. CUTLO C MOVE TO PHASE 4 WHEN A COMPONENT IS .GE. CUTHI/M C WHERE M = N FOR X() REAL AND M = 2*N FOR COMPLEX. C C VALUES FOR CUTLO AND CUTHI.. C FROM THE ENVIRONMENTAL PARAMETERS LISTED IN THE IMSL CONVERTER C DOCUMENT THE LIMITING VALUES ARE AS FOLLOWS.. C CUTLO, S.P. U/EPS = 2**(-102) FOR HONEYWELL. CLOSE SECONDS ARE C UNIVAC AND DEC AT 2**(-103) C THUS CUTLO = 2**(-51) = 4.44089E-16 C CUTHI, S.P. V = 2**127 FOR UNIVAC, HONEYWELL, AND DEC. C THUS CUTHI = 2**(63.5) = 1.30438E19 C CUTLO, D.P. U/EPS = 2**(-67) FOR HONEYWELL AND DEC. C THUS CUTLO = 2**(-33.5) = 8.23181D-11 C CUTHI, D.P. SAME AS S.P. CUTHI = 1.30438D19 C DATA CUTLO, CUTHI / 8.232D-11, 1.304D19 / C DATA CUTLO, CUTHI / 4.441E-16, 1.304E19 / DATA CUTLO, CUTHI / 4.441D-16, 1.304D19 / C IF(N .GT. 0) GO TO 10 DNRM2 = ZERO GO TO 300 C 10 ASSIGN 30 TO NEXT SUM = ZERO NN = N * INCX C BEGIN MAIN LOOP I = 1 20 GO TO NEXT,(30, 50, 70, 110) 30 IF( ABS(SX(I)) .GT. CUTLO) GO TO 85 ASSIGN 50 TO NEXT XMAX = ZERO C C PHASE 1. SUM IS ZERO C 50 IF( SX(I) .EQ. ZERO) GO TO 200 IF( ABS(SX(I)) .GT. CUTLO) GO TO 85 C C PREPARE FOR PHASE 2. ASSIGN 70 TO NEXT GO TO 105 C C PREPARE FOR PHASE 4. C 100 I = J ASSIGN 110 TO NEXT SUM = (SUM / SX(I)) / SX(I) 105 XMAX = ABS(SX(I)) GO TO 115 C C PHASE 2. SUM IS SMALL. C SCALE TO AVOID DESTRUCTIVE UNDERFLOW. C 70 IF( ABS(SX(I)) .GT. CUTLO ) GO TO 75 C C COMMON CODE FOR PHASES 2 AND 4. C IN PHASE 4 SUM IS LARGE. SCALE TO AVOID OVERFLOW. C 110 IF( ABS(SX(I)) .LE. XMAX ) GO TO 115 SUM = ONE + SUM * (XMAX / SX(I))**2 XMAX = ABS(SX(I)) GO TO 200 C 115 SUM = SUM + (SX(I)/XMAX)**2 GO TO 200 C C C PREPARE FOR PHASE 3. C 75 SUM = (SUM * XMAX) * XMAX C C C FOR REAL OR D.P. SET HITEST = CUTHI/N C FOR COMPLEX SET HITEST = CUTHI/(2*N) C 85 HITEST = CUTHI/FLOAT( N ) C C PHASE 3. SUM IS MID-RANGE. NO SCALING. C DO 95 J =I,NN,INCX IF(ABS(SX(J)) .GE. HITEST) GO TO 100 95 SUM = SUM + SX(J)**2 DNRM2 = SQRT( SUM ) GO TO 300 C 200 CONTINUE I = I + INCX IF ( I .LE. NN ) GO TO 20 C C END OF MAIN LOOP. C C COMPUTE SQUARE ROOT AND ADJUST FOR SCALING. C DNRM2 = XMAX * SQRT(SUM) 300 CONTINUE RETURN END SHAR_EOF fi # end of overwriting check cd .. if test ! -d 'Sp' then mkdir 'Sp' fi cd 'Sp' if test -f 'ilubs1.f' then echo shar: will not over-write existing file "'ilubs1.f'" else cat << \SHAR_EOF > 'ilubs1.f' SUBROUTINE ILU (NPTS, NPD, A, LLDG, LSL, LLSL) INTEGER NPDE PARAMETER (NPDE = 1) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPD, LLDG(NPTS,-9:-2), LSL(*), LLSL(0:*) REAL A(NPTS,-9:9) C Ccc PURPOSE: C Incomplete LU decomposition of A C A stems from a 19-point stencil on a grid with irregular row and C plane sizes C A = ILU, vectorized by `hyperplane' ordening, where the `hyperplanes' C are sets of points that can be treated simultaneously. C A((i,j,k),1:NPDE,1:NPDE,.) contains a block of NPDE.NPDE elements C corresponding with node (i,j,k) C Ccc PARAMETER DESCRIPTION: C NPTS : IN. # gridpoints C NPDE : IN. # components of the PDE C A : INOUT. C IN: A(.,1:NPDE,1:NPDE,-9:-1) : lower block diagonals C A(.,1:NPDE,1:NPDE,0) : main block diagonal C A(.,1:NPDE,1:NPDE, 1: 9) : upper block diagonals C OUT: A(.,1:NPDE,1:NPDE,-9:-1) : lower block diagonals of L C A(.,ic,jc,0): jc < ic: main block diagonal of L C main diagonal L == I C jc >=ic: main block diagonal of U C main diagonal U inverted C A(.,1:NPDE,1:NPDE, 1: 9) : upper block diagonals of U C LLDG : IN. Block-column index of lower 8 block-diagonals C If block ld does not exist the LLDG(K,ld) = K C LSL : IN. (NPTS) C LSL(LLSL(m-1)+1:LLSL(m)): pointers to set of points S_m C in actual grid that can be treated at the m-th iteration C LLSL : IN. (0:LLSL(0)) C LLSL(0) = # iterations needed C LLSL(1:LLSL(0)): pointers to the start of a list in LSL C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER N, L, M C IF (NPDE .NE. NPD) STOP 'Wrong ILUBS loaded.' C C Loop over `hyperplanes' S_m, m = 1, LLSL(0) C Node # N = S_m(LLSL(l)) C C S_1 = {(i,j,k)| (i,j,k) not dependent on (i-ii,j-jj,k-kk), C ii,jj,kk >= 0, not ii=jj=kk=0; C i.e., Dirichlet points and left/down/front corners} M = 1 CDIR$ IVDEP DO 553 L = 1, LLSL(M) N = LSL(L) A(N,0) = 1.0 / A(N,0) 553 CONTINUE C C Loop over rest of `hyperplane' sets C NB. No exception handling is necessary for the first row and the first C point of the second row, since N > 1 in the loop and for those C points LLDG(N,.) = N, (=> no array index problems), C and the multiplicator of `non existing' array elements is zero. C DO 10 M = 2, LLSL(0) C C Compute lower diagonals CDIR$ IVDEP DO 20 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,-9) = (A(N,-9)) * A(LLDG(N,-9),0) A(N,-8) = (A(N,-8) - A(N,-9)*A(LLDG(N,-9),2)) + * A(LLDG(N,-8),0) A(N,-7) = (A(N,-7) - A(N,-9)*A(LLDG(N,-9),3) + - A(N,-8)*A(LLDG(N,-8),1)) + * A(LLDG(N,-7),0) A(N,-6) = (A(N,-6) - A(N,-9)*A(LLDG(N,-9),4) + - A(N,-7)*A(LLDG(N,-7),1)) + * A(LLDG(N,-6),0) A(N,-5) = (A(N,-5) - A(N,-8)*A(LLDG(N,-8),4) + - A(N,-7)*A(LLDG(N,-7),3) + - A(N,-6)*A(LLDG(N,-6),2)) + * A(LLDG(N,-5),0) A(N,-4) = (A(N,-4) - A(N,-9)*A(LLDG(N,-9),6) + - A(N,-8)*A(LLDG(N,-8),5)) + * A(LLDG(N,-4),0) A(N,-3) = (A(N,-3) - A(N,-9)*A(LLDG(N,-9),8) + - A(N,-7)*A(LLDG(N,-7),5) + - A(N,-4)*A(LLDG(N,-4),1)) + * A(LLDG(N,-3),0) A(N,-2) = (A(N,-2) - A(N,-9)*A(LLDG(N,-9),8) + - A(N,-6)*A(LLDG(N,-6),5) + - A(N,-3)*A(LLDG(N,-3),1)) + * A(LLDG(N,-2),0) A(N,-1) = (A(N,-1) - A(N,-8)*A(LLDG(N,-8),7) + - A(N,-7)*A(LLDG(N,-7),6) + - A(N,-4)*A(LLDG(N,-4),3) + - A(N,-3)*A(LLDG(N,-3),2)) + * A(N-1,0) C C Compute main diagonal A(N,0) = 1.0 / (A(N, 0) - A(N,-9)*A(LLDG(N,-9),9) + - A(N,-8)*A(LLDG(N,-8),8) + - A(N,-7)*A(LLDG(N,-7),7) + - A(N,-6)*A(LLDG(N,-6),6) + - A(N,-5)*A(LLDG(N,-5),5) + - A(N,-4)*A(LLDG(N,-4),4) + - A(N,-3)*A(LLDG(N,-3),3) + - A(N,-2)*A(LLDG(N,-2),2) + - A(N,-1)*A(N-1 ,1)) C C Compute upper diagonals A(N,1) = A(N, 1) - A(N,-7)*A(LLDG(N,-7),8) + - A(N,-6)*A(LLDG(N,-6),7) + - A(N,-3)*A(LLDG(N,-3),4) + - A(N,-2)*A(LLDG(N,-2),3) A(N,2) = A(N, 2) - A(N,-8)*A(LLDG(N,-8),9) + - A(N,-5)*A(LLDG(N,-5),6) + - A(N,-1)*A(N-1 ,3) A(N,3) = A(N, 3) - A(N,-7)*A(LLDG(N,-7),9) + - A(N,-5)*A(LLDG(N,-5),7) + - A(N,-1)*A(N-1 ,4) A(N,4) = A(N, 4) - A(N,-6)*A(LLDG(N,-6),9) + - A(N,-5)*A(LLDG(N,-5),8) A(N,5) = A(N, 5) - A(N,-9)*A(LLDG(N,-9),8) + - A(N,-3)*A(LLDG(N,-3),7) + - A(N,-2)*A(LLDG(N,-2),6) A(N,6) = A(N, 6) - A(N,-4)*A(LLDG(N,-4),9) + - A(N,-1)*A(N-1 ,7) A(N,7) = A(N, 7) - A(N,-3)*A(LLDG(N,-3),9) + - A(N,-1)*A(N-1 ,8) A(N,8) = A(N, 8) - A(N,-2)*A(LLDG(N,-2),9) 20 CONTINUE C 10 CONTINUE C RETURN END SUBROUTINE BCKSLV (NPTS, NPD, A, LLDG, LUDG, LSL, LLSL, LSU, LLSU, + B) INTEGER NPDE PARAMETER (NPDE = 1) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPD, LLDG(NPTS,-9:-2), LUDG(NPTS,2:9), + LSL(*), LLSL(0:*), LSU(*), LLSU(0:*) REAL A(NPTS,-9:9), B(NPTS) C Ccc PURPOSE: C Solve LUx = b C A stems from a 19-point stencil on a grid with irregular row and C plane sizes C A = ILU, vectorized by `hyperplane' ordening, where the `hyperplanes' C are sets of points that can be treated simultaneously. C A((i,j,k),1:NPDE,1:NPDE,.) contains a block of NPDE.NPDE elements C corresponding with node (i,j,k) C Ccc PARAMETER DESCRIPTION: C NPTS : IN. # gridpoints C NPDE : IN. # components of the PDE C A : IN. A(.,1:NPDE,1:NPDE,-9:-1) : lower block diagonals of L C A(.,ic,jc,0): jc < ic: main block diagonal of L C main diagonal L == I C jc >=ic: main block diagonal of U C main diagonal U inverted C A(.,1:NPDE,1:NPDE, 1: 9) : upper block diagonals of U C LLDG : IN. Block-column index of lower 8 block-diagonals C If block ld does not exist the LLDG(K,ld) = K C LUDG : IN. Block-column index of upper 8 block-diagonals C If block ud does not exist the LUDG(K,lu) = K C LSL : IN. (NPTS) C LSL(LLSL(m-1)+1:LLSL(m)): pointers to set of points S_m C in actual grid that can be treated at the m-th iteration C of Ly = b C LLSL : IN. (0:LLSL(0)) C LLSL(0) = # iterations needed C LLSL(1:LLSL(0)): pointers to the start of a list in LSL C LSU : IN. (NPTS) C LSU(LLSU(m-1)+1:LLSU(m)): pointers to set of points S_m C in actual grid that can be treated at the m-th iteration C of Ux = y C LLSU : IN. (0:LLSU(0)) C LLSU(0) = # iterations needed C LLSU(1:LLSU(0)): pointers to the start of a list in LSU C B : INOUT. C IN: right-hand side vector b C OUT: solution vector x C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER N, L, M C CCC Ly = b C C Loop over `hyperplanes' S_m, m = 1, LLSL(0) C Node # N = LSL_m(LLSL(l)) C C Loop over rest of `hyperplane' sets C NB. No exception handling is necessary for the first row and the first C point of the second row, since N > 1 in the loop and for those C points LLDG(N,.) = N, (=> no array index problems), C and the multiplicator of `non existing' array elements is zero. C DO 10 M = 2, LLSL(0) C C Compute y elements in this set CDIR$ IVDEP DO 20 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) B(N) = B(N) - A(N,-1)*B(N- 1) + - A(N,-2)*B(LLDG(N,-2)) + - A(N,-3)*B(LLDG(N,-3)) + - A(N,-4)*B(LLDG(N,-4)) + - A(N,-5)*B(LLDG(N,-5)) + - A(N,-6)*B(LLDG(N,-6)) + - A(N,-7)*B(LLDG(N,-7)) + - A(N,-8)*B(LLDG(N,-8)) + - A(N,-9)*B(LLDG(N,-9)) 20 CONTINUE C 10 CONTINUE C CCC Ux = y C C Loop over `hyperplanes' LSU_m, m = 1, LLSU(0) C Node # N = LSU_m(LLSU(l)) C C LSU_1 = {(i,j,k)| (i,j,k) not dependent on (i+ii,j+jj,k+kk), C ii,jj,kk >= 0, not ii=jj=kk=0; C e.g., Dirichlet points and right/up/back corners} C M = 1 CDIR$ IVDEP DO 133 L = 1, LLSU(M) N = LSU(L) B(N) = B(N) * A(N,0) 133 CONTINUE C C Loop over rest of `hyperplane' sets C NB. No exception handling is necessary for the last row and the first C point of the second last row, since N < NPTS in the loop and for C those points LUDG(N,.) = N (=> no array index problems), C and the multiplicator of `non existing' array elements is zero. C DO 30 M = 2, LLSU(0) C C Compute x elements in this set CDIR$ IVDEP DO 40 L = LLSU(M-1)+1, LLSU(M) N = LSU(L) B(N) = (B(N) - A(N,1)*B(N+1 ) + - A(N,2)*B(LUDG(N,2)) + - A(N,3)*B(LUDG(N,3)) + - A(N,4)*B(LUDG(N,4)) + - A(N,5)*B(LUDG(N,5)) + - A(N,6)*B(LUDG(N,6)) + - A(N,7)*B(LUDG(N,7)) + - A(N,8)*B(LUDG(N,8)) + - A(N,9)*B(LUDG(N,9))) * A(N,0) 40 CONTINUE C 30 CONTINUE C RETURN END SHAR_EOF fi # end of overwriting check if test -f 'ilubs2.f' then echo shar: will not over-write existing file "'ilubs2.f'" else cat << \SHAR_EOF > 'ilubs2.f' SUBROUTINE ILU (NPTS, NPD, A, LLDG, LSL, LLSL) INTEGER NPDE PARAMETER (NPDE = 2) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPD, LLDG(NPTS,-9:-2), LSL(*), LLSL(0:*) REAL A(NPTS,NPDE,NPDE,-9:9) C Ccc PURPOSE: C Incomplete LU decomposition of A C A stems from a 19-point stencil on a grid with irregular row and C plane sizes C A = ILU, vectorized by `hyperplane' ordening, where the `hyperplanes' C are sets of points that can be treated simultaneously. C A((i,j,k),1:NPDE,1:NPDE,.) contains a block of NPDE.NPDE elements C corresponding with node (i,j,k) C Ccc PARAMETER DESCRIPTION: C NPTS : IN. # gridpoints C NPDE : IN. # components of the PDE C A : INOUT. C IN: A(.,1:NPDE,1:NPDE,-9:-1) : lower block diagonals C A(.,1:NPDE,1:NPDE,0) : main block diagonal C A(.,1:NPDE,1:NPDE, 1: 9) : upper block diagonals C OUT: A(.,1:NPDE,1:NPDE,-9:-1) : lower block diagonals of L C A(.,ic,jc,0): jc < ic: main block diagonal of L C main diagonal L == I C jc >=ic: main block diagonal of U C main diagonal U inverted C A(.,1:NPDE,1:NPDE, 1: 9) : upper block diagonals of U C LLDG : IN. Block-column index of lower 8 block-diagonals C If block ld does not exist the LLDG(N,ld) = N C LSL : IN. (NPTS) C LSL(LLSL(m-1)+1:LLSL(m)): pointers to set of points S_m C in actual grid that can be treated at the m-th iteration C LLSL : IN. (0:LLSL(0)) C LLSL(0) = # iterations needed C LLSL(1:LLSL(0)): pointers to the start of a list in LSL C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER IC, JC, LC, N, L, M C IF (NPDE .NE. NPD) STOP 'Wrong ILUBS loaded.' C C Loop over `hyperplanes' S_m, m = 1, LLSL(0) C Node # N = S_m(LLSL(l)) C C S_1 = {(i,j,k)| (i,j,k) not dependent on (i-ii,j-jj,k-kk), C ii,jj,kk >= 0, not ii=jj=kk=0; C i.e., Dirichlet points and left/down/front corners} M = 1 C C Compute main block diagonal DO 550 IC = 1, NPDE DO 554 LC = 1, IC-1 DO 555 JC = IC, NPDE CDIR$ IVDEP DO 551 L = 1, LLSL(M) N = LSL(L) A(N,IC,JC,0) = A(N,IC,JC,0) + - A(N,IC,LC,0)*A(N,LC,JC,0) 551 CONTINUE 555 CONTINUE DO 556 JC = IC+1, NPDE CDIR$ IVDEP DO 552 L = 1, LLSL(M) N = LSL(L) A(N,JC,IC,0) = A(N,JC,IC,0) + - A(N,JC,LC,0)*A(N,LC,IC,0) 552 CONTINUE 556 CONTINUE 554 CONTINUE CDIR$ IVDEP DO 553 L = 1, LLSL(M) N = LSL(L) A(N,IC,IC,0) = 1.0 / A(N,IC,IC,0) 553 CONTINUE DO 557 JC = IC+1, NPDE CDIR$ IVDEP DO 559 L = 1, LLSL(M) N = LSL(L) A(N,JC,IC,0) = A(N,JC,IC,0) * A(N,IC,IC,0) 559 CONTINUE 557 CONTINUE 550 CONTINUE C C Compute upper block diagonals DO 560 IC = 1, NPDE DO 563 LC = 1, IC-1 DO 564 JC = 1, NPDE CDIR$ IVDEP DO 561 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,1) = A(N,IC,JC,1) + - A(N,IC,LC,0)*A(N,LC,JC,1) A(N,IC,JC,2) = A(N,IC,JC,2) + - A(N,IC,LC,0)*A(N,LC,JC,2) A(N,IC,JC,3) = A(N,IC,JC,3) + - A(N,IC,LC,0)*A(N,LC,JC,3) A(N,IC,JC,4) = A(N,IC,JC,4) + - A(N,IC,LC,0)*A(N,LC,JC,4) A(N,IC,JC,5) = A(N,IC,JC,5) + - A(N,IC,LC,0)*A(N,LC,JC,5) A(N,IC,JC,6) = A(N,IC,JC,6) + - A(N,IC,LC,0)*A(N,LC,JC,6) A(N,IC,JC,7) = A(N,IC,JC,7) + - A(N,IC,LC,0)*A(N,LC,JC,7) A(N,IC,JC,8) = A(N,IC,JC,8) + - A(N,IC,LC,0)*A(N,LC,JC,8) A(N,IC,JC,9) = A(N,IC,JC,9) + - A(N,IC,LC,0)*A(N,LC,JC,9) 561 CONTINUE 564 CONTINUE 563 CONTINUE 560 CONTINUE C C Loop over rest of `hyperplane' sets C NB. No exception handling is necessary for the first row and the first C point of the second row, since N > 1 in the loop and for those C points LLDG(N,.) = N, (=> no array index problems), C and the multiplicator of `non existing' array elements is zero. C DO 10 M = 2, LLSL(0) C C Compute lower diagonals DO 120 JC = 1, NPDE DO 121 LC = 1, JC-1 CDIR$ IVDEP DO 20 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 122 IC = 1, NPDE A(N,IC,JC,-9) = A(N,IC,JC,-9) + - A(N,IC,LC,-9) * A(LLDG(N,-9),LC,JC,0) 122 CONTINUE 20 CONTINUE 121 CONTINUE CDIR$ IVDEP DO 21 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 123 IC = 1, NPDE A(N,IC,JC,-9) = A(N,IC,JC,-9) * A(LLDG(N,-9),JC,JC,0) 123 CONTINUE 21 CONTINUE 120 CONTINUE DO 130 JC = 1, NPDE CDIR$ IVDEP DO 30 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 131 LC = 1, NPDE CFPP$ UNROLL DO 132 IC = 1, NPDE A(N,IC,JC,-8) = A(N,IC,JC,-8) + - A(N,IC,LC,-9)*A(LLDG(N,-9),LC,JC,2) 132 CONTINUE 131 CONTINUE 30 CONTINUE DO 133 LC = 1, JC-1 CDIR$ IVDEP DO 31 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 134 IC = 1, NPDE A(N,IC,JC,-8) = A(N,IC,JC,-8) + - A(N,IC,LC,-8)*A(LLDG(N,-8),LC,JC,0) 134 CONTINUE 31 CONTINUE 133 CONTINUE CDIR$ IVDEP DO 32 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 135 IC = 1, NPDE A(N,IC,JC,-8) = A(N,IC,JC,-8) * A(LLDG(N,-8),JC,JC,0) 135 CONTINUE 32 CONTINUE 130 CONTINUE DO 140 JC = 1, NPDE CDIR$ IVDEP DO 40 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 141 LC = 1, NPDE CFPP$ UNROLL DO 142 IC = 1, NPDE A(N,IC,JC,-7) = A(N,IC,JC,-7) + - A(N,IC,LC,-9)*A(LLDG(N,-9),LC,JC,3) + - A(N,IC,LC,-8)*A(LLDG(N,-8),LC,JC,1) 142 CONTINUE 141 CONTINUE 40 CONTINUE DO 143 LC = 1, JC-1 CDIR$ IVDEP DO 41 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 144 IC = 1, NPDE A(N,IC,JC,-7) = A(N,IC,JC,-7) + - A(N,IC,LC,-7)*A(LLDG(N,-7),LC,JC,0) 144 CONTINUE 41 CONTINUE 143 CONTINUE CDIR$ IVDEP DO 42 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 145 IC = 1, NPDE A(N,IC,JC,-7) = A(N,IC,JC,-7) * A(LLDG(N,-7),JC,JC,0) 145 CONTINUE 42 CONTINUE 140 CONTINUE DO 150 JC = 1, NPDE CDIR$ IVDEP DO 50 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 151 LC = 1, NPDE CFPP$ UNROLL DO 152 IC = 1, NPDE A(N,IC,JC,-6) = A(N,IC,JC,-6) + - A(N,IC,LC,-9)*A(LLDG(N,-9),LC,JC,4) + - A(N,IC,LC,-7)*A(LLDG(N,-7),LC,JC,1) 152 CONTINUE 151 CONTINUE 50 CONTINUE DO 153 LC = 1, JC-1 CDIR$ IVDEP DO 51 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 154 IC = 1, NPDE A(N,IC,JC,-6) = A(N,IC,JC,-6) + - A(N,IC,LC,-6)*A(LLDG(N,-6),LC,JC,0) 154 CONTINUE 51 CONTINUE 153 CONTINUE CDIR$ IVDEP DO 52 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 155 IC = 1, NPDE A(N,IC,JC,-6) = A(N,IC,JC,-6) * A(LLDG(N,-6),JC,JC,0) 155 CONTINUE 52 CONTINUE 150 CONTINUE DO 160 JC = 1, NPDE CDIR$ IVDEP DO 60 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 161 LC = 1, NPDE CFPP$ UNROLL DO 162 IC = 1, NPDE A(N,IC,JC,-5) = A(N,IC,JC,-5) + - A(N,IC,LC,-8)*A(LLDG(N,-8),LC,JC,4) + - A(N,IC,LC,-7)*A(LLDG(N,-7),LC,JC,3) + - A(N,IC,LC,-6)*A(LLDG(N,-6),LC,JC,2) A(N,IC,JC,-4) = A(N,IC,JC,-4) + - A(N,IC,LC,-9)*A(LLDG(N,-9),LC,JC,6) + - A(N,IC,LC,-8)*A(LLDG(N,-8),LC,JC,5) 162 CONTINUE 161 CONTINUE 60 CONTINUE DO 163 LC = 1, JC-1 CDIR$ IVDEP DO 61 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 164 IC = 1, NPDE A(N,IC,JC,-5) = A(N,IC,JC,-5) + - A(N,IC,LC,-5)*A(LLDG(N,-5),LC,JC,0) A(N,IC,JC,-4) = A(N,IC,JC,-4) + - A(N,IC,LC,-4)*A(LLDG(N,-4),LC,JC,0) 164 CONTINUE 61 CONTINUE 163 CONTINUE CDIR$ IVDEP DO 62 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 165 IC = 1, NPDE A(N,IC,JC,-5) = A(N,IC,JC,-5) * A(LLDG(N,-5),JC,JC,0) A(N,IC,JC,-4) = A(N,IC,JC,-4) * A(LLDG(N,-4),JC,JC,0) 165 CONTINUE 62 CONTINUE 160 CONTINUE DO 170 JC = 1, NPDE CDIR$ IVDEP DO 70 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 171 LC = 1, NPDE CFPP$ UNROLL DO 172 IC = 1, NPDE A(N,IC,JC,-3) = A(N,IC,JC,-3) + - A(N,IC,LC,-9)*A(LLDG(N,-9),LC,JC,8) + - A(N,IC,LC,-7)*A(LLDG(N,-7),LC,JC,5) + - A(N,IC,LC,-4)*A(LLDG(N,-4),LC,JC,1) 172 CONTINUE 171 CONTINUE 70 CONTINUE DO 173 LC = 1, JC-1 CDIR$ IVDEP DO 71 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 174 IC = 1, NPDE A(N,IC,JC,-3) = A(N,IC,JC,-3) + - A(N,IC,LC,-3)*A(LLDG(N,-3),LC,JC,0) 174 CONTINUE 71 CONTINUE 173 CONTINUE CDIR$ IVDEP DO 72 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 175 IC = 1, NPDE A(N,IC,JC,-3) = A(N,IC,JC,-3) * A(LLDG(N,-3),JC,JC,0) 175 CONTINUE 72 CONTINUE 170 CONTINUE DO 180 JC = 1, NPDE CDIR$ IVDEP DO 80 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 181 LC = 1, NPDE CFPP$ UNROLL DO 182 IC = 1, NPDE A(N,IC,JC,-2) = A(N,IC,JC,-2) + - A(N,IC,LC,-9)*A(LLDG(N,-9),LC,JC,8) + - A(N,IC,LC,-6)*A(LLDG(N,-6),LC,JC,5) + - A(N,IC,LC,-3)*A(LLDG(N,-3),LC,JC,1) A(N,IC,JC,-1) = A(N,IC,JC,-1) + - A(N,IC,LC,-8)*A(LLDG(N,-8),LC,JC,7) + - A(N,IC,LC,-7)*A(LLDG(N,-7),LC,JC,6) + - A(N,IC,LC,-4)*A(LLDG(N,-4),LC,JC,3) + - A(N,IC,LC,-3)*A(LLDG(N,-3),LC,JC,2) 182 CONTINUE 181 CONTINUE 80 CONTINUE DO 183 LC = 1, JC-1 CDIR$ IVDEP DO 81 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 184 IC = 1, NPDE A(N,IC,JC,-2) = A(N,IC,JC,-2) + - A(N,IC,LC,-2)*A(LLDG(N,-2),LC,JC,0) A(N,IC,JC,-1) = A(N,IC,JC,-1) + - A(N,IC,LC,-1)*A(N-1 ,LC,JC,0) 184 CONTINUE 81 CONTINUE 183 CONTINUE CDIR$ IVDEP DO 82 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 185 IC = 1, NPDE A(N,IC,JC,-2) = A(N,IC,JC,-2) * A(LLDG(N,-2),JC,JC,0) A(N,IC,JC,-1) = A(N,IC,JC,-1) * A(N-1 ,JC,JC,0) 185 CONTINUE 82 CONTINUE 180 CONTINUE C C Compute main diagonal DO 300 IC = 1, NPDE DO 302 JC = IC, NPDE CDIR$ IVDEP DO 200 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 301 LC = 1, NPDE A(N,IC,JC,0) = A(N,IC,JC, 0) + - A(N,IC,LC,-9)*A(LLDG(N,-9),LC,JC,9) + - A(N,IC,LC,-8)*A(LLDG(N,-8),LC,JC,8) + - A(N,IC,LC,-7)*A(LLDG(N,-7),LC,JC,7) + - A(N,IC,LC,-6)*A(LLDG(N,-6),LC,JC,6) + - A(N,IC,LC,-5)*A(LLDG(N,-5),LC,JC,5) + - A(N,IC,LC,-4)*A(LLDG(N,-4),LC,JC,4) + - A(N,IC,LC,-3)*A(LLDG(N,-3),LC,JC,3) + - A(N,IC,LC,-2)*A(LLDG(N,-2),LC,JC,2) + - A(N,IC,LC,-1)*A(N-1 ,LC,JC,1) 301 CONTINUE 200 CONTINUE 302 CONTINUE DO 303 JC = IC+1, NPDE CDIR$ IVDEP DO 201 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 1301 LC = 1, NPDE A(N,JC,IC,0) = A(N,JC,IC, 0) + - A(N,JC,LC,-9)*A(LLDG(N,-9),LC,IC,9) + - A(N,JC,LC,-8)*A(LLDG(N,-8),LC,IC,8) + - A(N,JC,LC,-7)*A(LLDG(N,-7),LC,IC,7) + - A(N,JC,LC,-6)*A(LLDG(N,-6),LC,IC,6) + - A(N,JC,LC,-5)*A(LLDG(N,-5),LC,IC,5) + - A(N,JC,LC,-4)*A(LLDG(N,-4),LC,IC,4) + - A(N,JC,LC,-3)*A(LLDG(N,-3),LC,IC,3) + - A(N,JC,LC,-2)*A(LLDG(N,-2),LC,IC,2) + - A(N,JC,LC,-1)*A(N-1 ,LC,IC,1) 1301 CONTINUE 201 CONTINUE 303 CONTINUE DO 304 LC = 1, IC-1 DO 305 JC = IC, NPDE CDIR$ IVDEP DO 202 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,0) = A(N,IC,JC,0) + - A(N,IC,LC,0)*A(N ,LC,JC,0) 202 CONTINUE 305 CONTINUE DO 306 JC = IC+1, NPDE CDIR$ IVDEP DO 203 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,JC,IC,0) = A(N,JC,IC,0) + - A(N,JC,LC,0)*A(N ,LC,IC,0) 203 CONTINUE 306 CONTINUE 304 CONTINUE CDIR$ IVDEP DO 204 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,IC,0) = 1.0 / A(N,IC,IC,0) 204 CONTINUE DO 307 JC = IC+1, NPDE CDIR$ IVDEP DO 205 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,JC,IC,0) = A(N,JC,IC,0) * A(N,IC,IC,0) 205 CONTINUE 307 CONTINUE 300 CONTINUE C C Compute upper diagonals DO 500 IC = 1, NPDE CDIR$ IVDEP DO 400 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 501 LC = 1, NPDE A(N,IC,1,1) = A(N,IC,1,1) - A(N,IC,LC,-7)*A(LLDG(N,-7),LC,1,8) - A 1 (N,IC,LC,-6)*A(LLDG(N,-6),LC,1,7) - A(N,IC,LC,-3)*A(LLDG(N,-3), 2 LC,1,4) - A(N,IC,LC,-2)*A(LLDG(N,-2),LC,1,3) A(N,IC,1,2) = A(N,IC,1,2) - A(N,IC,LC,-8)*A(LLDG(N,-8),LC,1,9) - A 1 (N,IC,LC,-5)*A(LLDG(N,-5),LC,1,6) - A(N,IC,LC,-1)*A(N-1,LC,1,3) A(N,IC,1,3) = A(N,IC,1,3) - A(N,IC,LC,-7)*A(LLDG(N,-7),LC,1,9) - A 1 (N,IC,LC,-5)*A(LLDG(N,-5),LC,1,7) - A(N,IC,LC,-1)*A(N-1,LC,1,4) A(N,IC,1,4) = A(N,IC,1,4) - A(N,IC,LC,-6)*A(LLDG(N,-6),LC,1,9) - A 1 (N,IC,LC,-5)*A(LLDG(N,-5),LC,1,8) A(N,IC,1,5) = A(N,IC,1,5) - A(N,IC,LC,-9)*A(LLDG(N,-9),LC,1,8) - A 1 (N,IC,LC,-3)*A(LLDG(N,-3),LC,1,7) - A(N,IC,LC,-2)*A(LLDG(N,-2), 2 LC,1,6) A(N,IC,1,6) = A(N,IC,1,6) - A(N,IC,LC,-4)*A(LLDG(N,-4),LC,1,9) - A 1 (N,IC,LC,-1)*A(N-1,LC,1,7) A(N,IC,1,7) = A(N,IC,1,7) - A(N,IC,LC,-3)*A(LLDG(N,-3),LC,1,9) - A 1 (N,IC,LC,-1)*A(N-1,LC,1,8) A(N,IC,1,8) = A(N,IC,1,8) - A(N,IC,LC,-2)*A(LLDG(N,-2),LC,1,9) A(N,IC,2,1) = A(N,IC,2,1) - A(N,IC,LC,-7)*A(LLDG(N,-7),LC,2,8) - A 1 (N,IC,LC,-6)*A(LLDG(N,-6),LC,2,7) - A(N,IC,LC,-3)*A(LLDG(N,-3), 2 LC,2,4) - A(N,IC,LC,-2)*A(LLDG(N,-2),LC,2,3) A(N,IC,2,2) = A(N,IC,2,2) - A(N,IC,LC,-8)*A(LLDG(N,-8),LC,2,9) - A 1 (N,IC,LC,-5)*A(LLDG(N,-5),LC,2,6) - A(N,IC,LC,-1)*A(N-1,LC,2,3) A(N,IC,2,3) = A(N,IC,2,3) - A(N,IC,LC,-7)*A(LLDG(N,-7),LC,2,9) - A 1 (N,IC,LC,-5)*A(LLDG(N,-5),LC,2,7) - A(N,IC,LC,-1)*A(N-1,LC,2,4) A(N,IC,2,4) = A(N,IC,2,4) - A(N,IC,LC,-6)*A(LLDG(N,-6),LC,2,9) - A 1 (N,IC,LC,-5)*A(LLDG(N,-5),LC,2,8) A(N,IC,2,5) = A(N,IC,2,5) - A(N,IC,LC,-9)*A(LLDG(N,-9),LC,2,8) - A 1 (N,IC,LC,-3)*A(LLDG(N,-3),LC,2,7) - A(N,IC,LC,-2)*A(LLDG(N,-2), 2 LC,2,6) A(N,IC,2,6) = A(N,IC,2,6) - A(N,IC,LC,-4)*A(LLDG(N,-4),LC,2,9) - A 1 (N,IC,LC,-1)*A(N-1,LC,2,7) A(N,IC,2,7) = A(N,IC,2,7) - A(N,IC,LC,-3)*A(LLDG(N,-3),LC,2,9) - A 1 (N,IC,LC,-1)*A(N-1,LC,2,8) A(N,IC,2,8) = A(N,IC,2,8) - A(N,IC,LC,-2)*A(LLDG(N,-2),LC,2,9) 501 CONTINUE 400 CONTINUE DO 503 LC = 1, IC-1 CDIR$ IVDEP DO 401 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 504 JC = 1, NPDE A(N,IC,JC,1) = A(N,IC,JC,1) + - A(N,IC,LC,0)*A(N,LC,JC,1) A(N,IC,JC,2) = A(N,IC,JC,2) + - A(N,IC,LC,0)*A(N,LC,JC,2) A(N,IC,JC,3) = A(N,IC,JC,3) + - A(N,IC,LC,0)*A(N,LC,JC,3) A(N,IC,JC,4) = A(N,IC,JC,4) + - A(N,IC,LC,0)*A(N,LC,JC,4) A(N,IC,JC,5) = A(N,IC,JC,5) + - A(N,IC,LC,0)*A(N,LC,JC,5) A(N,IC,JC,6) = A(N,IC,JC,6) + - A(N,IC,LC,0)*A(N,LC,JC,6) A(N,IC,JC,7) = A(N,IC,JC,7) + - A(N,IC,LC,0)*A(N,LC,JC,7) A(N,IC,JC,8) = A(N,IC,JC,8) + - A(N,IC,LC,0)*A(N,LC,JC,8) A(N,IC,JC,9) = A(N,IC,JC,9) + - A(N,IC,LC,0)*A(N,LC,JC,9) 504 CONTINUE 401 CONTINUE 503 CONTINUE 500 CONTINUE C 10 CONTINUE C RETURN END SUBROUTINE BCKSLV (NPTS, NPD, A, LLDG, LUDG, LSL, LLSL, LSU, LLSU, + B) INTEGER NPDE PARAMETER (NPDE = 2) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPD, LLDG(NPTS,-9:-2), LUDG(NPTS,2:9), + LSL(*), LLSL(0:*), LSU(*), LLSU(0:*) REAL A(NPTS,NPDE,NPDE,-9:9), B(NPTS,NPDE) C Ccc PURPOSE: C Solve LUx = b C A stems from a 19-point stencil on a grid with irregular row and C plane sizes C A = ILU, vectorized by `hyperplane' ordening, where the `hyperplanes' C are sets of points that can be treated simultaneously. C A((i,j,k),1:NPDE,1:NPDE,.) contains a block of NPDE.NPDE elements C corresponding with node (i,j,k) C Ccc PARAMETER DESCRIPTION: C NPTS : IN. # gridpoints C NPDE : IN. # components of the PDE C A : IN. A(.,1:NPDE,1:NPDE,-9:-1) : lower block diagonals of L C A(.,ic,jc,0): jc < ic: main block diagonal of L C main diagonal L == I C jc >=ic: main block diagonal of U C main diagonal U inverted C A(.,1:NPDE,1:NPDE, 1: 9) : upper block diagonals of U C LLDG : IN. Block-column index of lower 8 block-diagonals C If block ld does not exist the LLDG(N,ld) = N C LUDG : IN. Block-column index of upper 8 block-diagonals C If block ud does not exist the LUDG(N,lu) = N C LSL : IN. (NPTS) C LSL(LLSL(m-1)+1:LLSL(m)): pointers to set of points S_m C in actual grid that can be treated at the m-th iteration C of Ly = b C LLSL : IN. (0:LLSL(0)) C LLSL(0) = # iterations needed C LLSL(1:LLSL(0)): pointers to the start of a list in LSL C LSU : IN. (NPTS) C LSU(LLSU(m-1)+1:LLSU(m)): pointers to set of points S_m C in actual grid that can be treated at the m-th iteration C of Ux = y C LLSU : IN. (0:LLSU(0)) C LLSU(0) = # iterations needed C LLSU(1:LLSU(0)): pointers to the start of a list in LSU C B : INOUT. C IN: right-hand side vector b C OUT: solution vector x C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER IC, JC, N, L, M C CCC Ly = b C C Loop over `hyperplanes' S_m, m = 1, LLSL(0) C Node # N = LSL_m(LLSL(l)) C C LSL_1 = {(i,j,k)| (i,j,k) not dependent on (i-ii,j-jj,k-kk), C ii,jj,kk >= 0, not ii=jj=kk=0; C i.e., Dirichlet points and left/down/front corners} M = 1 DO 100 IC = 2, NPDE DO 101 JC = 1, IC-1 CDIR$ IVDEP DO 1 L = 1, LLSL(M) N = LSL(L) B(N,IC) = B(N,IC) - A(N,IC,JC,0)*B(N,JC) 1 CONTINUE 101 CONTINUE 100 CONTINUE C C Loop over rest of `hyperplane' sets C NB. No exception handling is necessary for the first row and the first C point of the second row, since N > 1 in the loop and for those C points LLDG(N,.) = N, (=> no array index problems), C and the multiplicator of `non existing' array elements is zero. C DO 10 M = 2, LLSL(0) C C Compute y elements in this set CDIR$ IVDEP DO 20 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 120 IC = 1, NPDE CFPP$ UNROLL DO 121 JC = 1, NPDE B(N,IC) = B(N,IC) - A(N,IC,JC,-1)*B(N- 1,JC) + - A(N,IC,JC,-2)*B(LLDG(N,-2),JC) + - A(N,IC,JC,-3)*B(LLDG(N,-3),JC) + - A(N,IC,JC,-4)*B(LLDG(N,-4),JC) + - A(N,IC,JC,-5)*B(LLDG(N,-5),JC) + - A(N,IC,JC,-6)*B(LLDG(N,-6),JC) + - A(N,IC,JC,-7)*B(LLDG(N,-7),JC) + - A(N,IC,JC,-8)*B(LLDG(N,-8),JC) + - A(N,IC,JC,-9)*B(LLDG(N,-9),JC) 121 CONTINUE 120 CONTINUE 20 CONTINUE DO 123 IC = 2, NPDE DO 122 JC = 1, IC-1 CDIR$ IVDEP DO 21 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) B(N,IC) = B(N,IC) - A(N,IC,JC,0)*B(N,JC) 21 CONTINUE 122 CONTINUE 123 CONTINUE C 10 CONTINUE C CCC Ux = y C C Loop over `hyperplanes' LSU_m, m = 1, LLSU(0) C Node # N = LSU_m(LLSU(l)) C C LSU_1 = {(i,j,k)| (i,j,k) not dependent on (i+ii,j+jj,k+kk), C ii,jj,kk >= 0, not ii=jj=kk=0; C e.g., Dirichlet points and right/up/back corners} C M = 1 DO 130 IC = NPDE, 1, -1 DO 131 JC = NPDE, IC+1, -1 CDIR$ IVDEP DO 132 L = 1, LLSU(M) N = LSU(L) B(N,IC) = B(N,IC) - A(N,IC,JC,0)*B(N,JC) 132 CONTINUE 131 CONTINUE CDIR$ IVDEP DO 133 L = 1, LLSU(M) N = LSU(L) B(N,IC) = B(N,IC) * A(N,IC,IC,0) 133 CONTINUE 130 CONTINUE C C Loop over rest of `hyperplane' sets C NB. No exception handling is necessary for the last row and the first C point of the second last row, since N < NPTS in the loop and for C those points LUDG(N,.) = N (=> no array index problems), C and the multiplicator of `non existing' array elements is zero. C DO 30 M = 2, LLSU(0) C C Compute x elements in this set CDIR$ IVDEP DO 40 L = LLSU(M-1)+1, LLSU(M) N = LSU(L) CFPP$ UNROLL DO 150 IC = NPDE, 1, -1 CFPP$ UNROLL DO 151 JC = NPDE, 1, -1 B(N,IC) = B(N,IC) - A(N,IC,JC,1)*B(N+1 ,JC) + - A(N,IC,JC,2)*B(LUDG(N,2),JC) + - A(N,IC,JC,3)*B(LUDG(N,3),JC) + - A(N,IC,JC,4)*B(LUDG(N,4),JC) + - A(N,IC,JC,5)*B(LUDG(N,5),JC) + - A(N,IC,JC,6)*B(LUDG(N,6),JC) + - A(N,IC,JC,7)*B(LUDG(N,7),JC) + - A(N,IC,JC,8)*B(LUDG(N,8),JC) + - A(N,IC,JC,9)*B(LUDG(N,9),JC) 151 CONTINUE 150 CONTINUE 40 CONTINUE DO 1150 IC = NPDE, 1, -1 DO 152 JC = NPDE, IC+1, -1 CDIR$ IVDEP DO 51 L = LLSU(M-1)+1, LLSU(M) N = LSU(L) B(N,IC) = B(N,IC) - A(N,IC,JC,0)*B(N,JC) 51 CONTINUE 152 CONTINUE CDIR$ IVDEP DO 52 L = LLSU(M-1)+1, LLSU(M) N = LSU(L) B(N,IC) = B(N,IC) * A(N,IC,IC,0) 52 CONTINUE 1150 CONTINUE C 30 CONTINUE C RETURN END SHAR_EOF fi # end of overwriting check if test -f 'ilubs3.f' then echo shar: will not over-write existing file "'ilubs3.f'" else cat << \SHAR_EOF > 'ilubs3.f' SUBROUTINE ILU (NPTS, NPD, A, LLDG, LSL, LLSL) INTEGER NPDE PARAMETER (NPDE = 3) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPD, LLDG(NPTS,-9:-2), LSL(*), LLSL(0:*) REAL A(NPTS,NPDE,NPDE,-9:9) C Ccc PURPOSE: C Incomplete LU decomposition of A C A stems from a 19-point stencil on a grid with irregular row and C plane sizes C A = ILU, vectorized by `hyperplane' ordening, where the `hyperplanes' C are sets of points that can be treated simultaneously. C A((i,j,k),1:NPDE,1:NPDE,.) contains a block of NPDE.NPDE elements C corresponding with node (i,j,k) C Ccc PARAMETER DESCRIPTION: C NPTS : IN. # gridpoints C NPDE : IN. # components of the PDE C A : INOUT. C IN: A(.,1:NPDE,1:NPDE,-9:-1) : lower block diagonals C A(.,1:NPDE,1:NPDE,0) : main block diagonal C A(.,1:NPDE,1:NPDE, 1: 9) : upper block diagonals C OUT: A(.,1:NPDE,1:NPDE,-9:-1) : lower block diagonals of L C A(.,ic,jc,0): jc < ic: main block diagonal of L C main diagonal L == I C jc >=ic: main block diagonal of U C main diagonal U inverted C A(.,1:NPDE,1:NPDE, 1: 9) : upper block diagonals of U C LLDG : IN. Block-column index of lower 8 block-diagonals C If block ld does not exist the LLDG(N,ld) = N C LSL : IN. (NPTS) C LSL(LLSL(m-1)+1:LLSL(m)): pointers to set of points S_m C in actual grid that can be treated at the m-th iteration C LLSL : IN. (0:LLSL(0)) C LLSL(0) = # iterations needed C LLSL(1:LLSL(0)): pointers to the start of a list in LSL C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER IC, JC, LC, N, L, M C IF (NPDE .NE. NPD) STOP 'Wrong ILUBS loaded.' C C Loop over `hyperplanes' S_m, m = 1, LLSL(0) C Node # N = S_m(LLSL(l)) C C S_1 = {(i,j,k)| (i,j,k) not dependent on (i-ii,j-jj,k-kk), C ii,jj,kk >= 0, not ii=jj=kk=0; C i.e., Dirichlet points and left/down/front corners} M = 1 C C Compute main block diagonal DO 550 IC = 1, NPDE DO 554 LC = 1, IC-1 DO 555 JC = IC, NPDE CDIR$ IVDEP DO 551 L = 1, LLSL(M) N = LSL(L) A(N,IC,JC,0) = A(N,IC,JC,0) + - A(N,IC,LC,0)*A(N,LC,JC,0) 551 CONTINUE 555 CONTINUE DO 556 JC = IC+1, NPDE CDIR$ IVDEP DO 552 L = 1, LLSL(M) N = LSL(L) A(N,JC,IC,0) = A(N,JC,IC,0) + - A(N,JC,LC,0)*A(N,LC,IC,0) 552 CONTINUE 556 CONTINUE 554 CONTINUE CDIR$ IVDEP DO 553 L = 1, LLSL(M) N = LSL(L) A(N,IC,IC,0) = 1.0 / A(N,IC,IC,0) 553 CONTINUE DO 557 JC = IC+1, NPDE CDIR$ IVDEP DO 559 L = 1, LLSL(M) N = LSL(L) A(N,JC,IC,0) = A(N,JC,IC,0) * A(N,IC,IC,0) 559 CONTINUE 557 CONTINUE 550 CONTINUE C C Compute upper block diagonals DO 560 IC = 1, NPDE DO 563 LC = 1, IC-1 DO 564 JC = 1, NPDE CDIR$ IVDEP DO 561 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,1) = A(N,IC,JC,1) + - A(N,IC,LC,0)*A(N,LC,JC,1) A(N,IC,JC,2) = A(N,IC,JC,2) + - A(N,IC,LC,0)*A(N,LC,JC,2) A(N,IC,JC,3) = A(N,IC,JC,3) + - A(N,IC,LC,0)*A(N,LC,JC,3) A(N,IC,JC,4) = A(N,IC,JC,4) + - A(N,IC,LC,0)*A(N,LC,JC,4) A(N,IC,JC,5) = A(N,IC,JC,5) + - A(N,IC,LC,0)*A(N,LC,JC,5) A(N,IC,JC,6) = A(N,IC,JC,6) + - A(N,IC,LC,0)*A(N,LC,JC,6) A(N,IC,JC,7) = A(N,IC,JC,7) + - A(N,IC,LC,0)*A(N,LC,JC,7) A(N,IC,JC,8) = A(N,IC,JC,8) + - A(N,IC,LC,0)*A(N,LC,JC,8) A(N,IC,JC,9) = A(N,IC,JC,9) + - A(N,IC,LC,0)*A(N,LC,JC,9) 561 CONTINUE 564 CONTINUE 563 CONTINUE 560 CONTINUE C C Loop over rest of `hyperplane' sets C NB. No exception handling is necessary for the first row and the first C point of the second row, since N > 1 in the loop and for those C points LLDG(N,.) = N, (=> no array index problems), C and the multiplicator of `non existing' array elements is zero. C DO 10 M = 2, LLSL(0) C C Compute lower diagonals DO 120 JC = 1, NPDE DO 121 LC = 1, JC-1 CDIR$ IVDEP DO 20 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 122 IC = 1, NPDE A(N,IC,JC,-9) = A(N,IC,JC,-9) + - A(N,IC,LC,-9) * A(LLDG(N,-9),LC,JC,0) 122 CONTINUE 20 CONTINUE 121 CONTINUE CDIR$ IVDEP DO 21 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 123 IC = 1, NPDE A(N,IC,JC,-9) = A(N,IC,JC,-9) * A(LLDG(N,-9),JC,JC,0) 123 CONTINUE 21 CONTINUE 120 CONTINUE DO 130 JC = 1, NPDE CDIR$ IVDEP DO 30 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 131 LC = 1, NPDE CFPP$ UNROLL DO 132 IC = 1, NPDE A(N,IC,JC,-8) = A(N,IC,JC,-8) + - A(N,IC,LC,-9)*A(LLDG(N,-9),LC,JC,2) 132 CONTINUE 131 CONTINUE 30 CONTINUE DO 133 LC = 1, JC-1 CDIR$ IVDEP DO 31 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 134 IC = 1, NPDE A(N,IC,JC,-8) = A(N,IC,JC,-8) + - A(N,IC,LC,-8)*A(LLDG(N,-8),LC,JC,0) 134 CONTINUE 31 CONTINUE 133 CONTINUE CDIR$ IVDEP DO 32 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 135 IC = 1, NPDE A(N,IC,JC,-8) = A(N,IC,JC,-8) * A(LLDG(N,-8),JC,JC,0) 135 CONTINUE 32 CONTINUE 130 CONTINUE DO 140 JC = 1, NPDE CDIR$ IVDEP DO 40 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 141 LC = 1, NPDE CFPP$ UNROLL DO 142 IC = 1, NPDE A(N,IC,JC,-7) = A(N,IC,JC,-7) + - A(N,IC,LC,-9)*A(LLDG(N,-9),LC,JC,3) + - A(N,IC,LC,-8)*A(LLDG(N,-8),LC,JC,1) 142 CONTINUE 141 CONTINUE 40 CONTINUE DO 143 LC = 1, JC-1 CDIR$ IVDEP DO 41 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 144 IC = 1, NPDE A(N,IC,JC,-7) = A(N,IC,JC,-7) + - A(N,IC,LC,-7)*A(LLDG(N,-7),LC,JC,0) 144 CONTINUE 41 CONTINUE 143 CONTINUE CDIR$ IVDEP DO 42 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 145 IC = 1, NPDE A(N,IC,JC,-7) = A(N,IC,JC,-7) * A(LLDG(N,-7),JC,JC,0) 145 CONTINUE 42 CONTINUE 140 CONTINUE DO 150 JC = 1, NPDE CDIR$ IVDEP DO 50 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 151 LC = 1, NPDE CFPP$ UNROLL DO 152 IC = 1, NPDE A(N,IC,JC,-6) = A(N,IC,JC,-6) + - A(N,IC,LC,-9)*A(LLDG(N,-9),LC,JC,4) + - A(N,IC,LC,-7)*A(LLDG(N,-7),LC,JC,1) 152 CONTINUE 151 CONTINUE 50 CONTINUE DO 153 LC = 1, JC-1 CDIR$ IVDEP DO 51 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 154 IC = 1, NPDE A(N,IC,JC,-6) = A(N,IC,JC,-6) + - A(N,IC,LC,-6)*A(LLDG(N,-6),LC,JC,0) 154 CONTINUE 51 CONTINUE 153 CONTINUE CDIR$ IVDEP DO 52 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 155 IC = 1, NPDE A(N,IC,JC,-6) = A(N,IC,JC,-6) * A(LLDG(N,-6),JC,JC,0) 155 CONTINUE 52 CONTINUE 150 CONTINUE DO 160 JC = 1, NPDE CDIR$ IVDEP DO 60 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 161 LC = 1, NPDE CFPP$ UNROLL DO 162 IC = 1, NPDE A(N,IC,JC,-5) = A(N,IC,JC,-5) + - A(N,IC,LC,-8)*A(LLDG(N,-8),LC,JC,4) + - A(N,IC,LC,-7)*A(LLDG(N,-7),LC,JC,3) + - A(N,IC,LC,-6)*A(LLDG(N,-6),LC,JC,2) A(N,IC,JC,-4) = A(N,IC,JC,-4) + - A(N,IC,LC,-9)*A(LLDG(N,-9),LC,JC,6) + - A(N,IC,LC,-8)*A(LLDG(N,-8),LC,JC,5) 162 CONTINUE 161 CONTINUE 60 CONTINUE DO 163 LC = 1, JC-1 CDIR$ IVDEP DO 61 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 164 IC = 1, NPDE A(N,IC,JC,-5) = A(N,IC,JC,-5) + - A(N,IC,LC,-5)*A(LLDG(N,-5),LC,JC,0) A(N,IC,JC,-4) = A(N,IC,JC,-4) + - A(N,IC,LC,-4)*A(LLDG(N,-4),LC,JC,0) 164 CONTINUE 61 CONTINUE 163 CONTINUE CDIR$ IVDEP DO 62 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 165 IC = 1, NPDE A(N,IC,JC,-5) = A(N,IC,JC,-5) * A(LLDG(N,-5),JC,JC,0) A(N,IC,JC,-4) = A(N,IC,JC,-4) * A(LLDG(N,-4),JC,JC,0) 165 CONTINUE 62 CONTINUE 160 CONTINUE DO 170 JC = 1, NPDE CDIR$ IVDEP DO 70 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 171 LC = 1, NPDE CFPP$ UNROLL DO 172 IC = 1, NPDE A(N,IC,JC,-3) = A(N,IC,JC,-3) + - A(N,IC,LC,-9)*A(LLDG(N,-9),LC,JC,8) + - A(N,IC,LC,-7)*A(LLDG(N,-7),LC,JC,5) + - A(N,IC,LC,-4)*A(LLDG(N,-4),LC,JC,1) 172 CONTINUE 171 CONTINUE 70 CONTINUE DO 173 LC = 1, JC-1 CDIR$ IVDEP DO 71 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 174 IC = 1, NPDE A(N,IC,JC,-3) = A(N,IC,JC,-3) + - A(N,IC,LC,-3)*A(LLDG(N,-3),LC,JC,0) 174 CONTINUE 71 CONTINUE 173 CONTINUE CDIR$ IVDEP DO 72 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 175 IC = 1, NPDE A(N,IC,JC,-3) = A(N,IC,JC,-3) * A(LLDG(N,-3),JC,JC,0) 175 CONTINUE 72 CONTINUE 170 CONTINUE DO 180 JC = 1, NPDE CDIR$ IVDEP DO 80 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 181 LC = 1, NPDE CFPP$ UNROLL DO 182 IC = 1, NPDE A(N,IC,JC,-2) = A(N,IC,JC,-2) + - A(N,IC,LC,-9)*A(LLDG(N,-9),LC,JC,8) + - A(N,IC,LC,-6)*A(LLDG(N,-6),LC,JC,5) + - A(N,IC,LC,-3)*A(LLDG(N,-3),LC,JC,1) A(N,IC,JC,-1) = A(N,IC,JC,-1) + - A(N,IC,LC,-8)*A(LLDG(N,-8),LC,JC,7) + - A(N,IC,LC,-7)*A(LLDG(N,-7),LC,JC,6) + - A(N,IC,LC,-4)*A(LLDG(N,-4),LC,JC,3) + - A(N,IC,LC,-3)*A(LLDG(N,-3),LC,JC,2) 182 CONTINUE 181 CONTINUE 80 CONTINUE DO 183 LC = 1, JC-1 CDIR$ IVDEP DO 81 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 184 IC = 1, NPDE A(N,IC,JC,-2) = A(N,IC,JC,-2) + - A(N,IC,LC,-2)*A(LLDG(N,-2),LC,JC,0) A(N,IC,JC,-1) = A(N,IC,JC,-1) + - A(N,IC,LC,-1)*A(N-1 ,LC,JC,0) 184 CONTINUE 81 CONTINUE 183 CONTINUE CDIR$ IVDEP DO 82 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 185 IC = 1, NPDE A(N,IC,JC,-2) = A(N,IC,JC,-2) * A(LLDG(N,-2),JC,JC,0) A(N,IC,JC,-1) = A(N,IC,JC,-1) * A(N-1 ,JC,JC,0) 185 CONTINUE 82 CONTINUE 180 CONTINUE C C Compute main diagonal DO 300 IC = 1, NPDE DO 302 JC = IC, NPDE CDIR$ IVDEP DO 200 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 301 LC = 1, NPDE A(N,IC,JC,0) = A(N,IC,JC, 0) + - A(N,IC,LC,-9)*A(LLDG(N,-9),LC,JC,9) + - A(N,IC,LC,-8)*A(LLDG(N,-8),LC,JC,8) + - A(N,IC,LC,-7)*A(LLDG(N,-7),LC,JC,7) + - A(N,IC,LC,-6)*A(LLDG(N,-6),LC,JC,6) + - A(N,IC,LC,-5)*A(LLDG(N,-5),LC,JC,5) + - A(N,IC,LC,-4)*A(LLDG(N,-4),LC,JC,4) + - A(N,IC,LC,-3)*A(LLDG(N,-3),LC,JC,3) + - A(N,IC,LC,-2)*A(LLDG(N,-2),LC,JC,2) + - A(N,IC,LC,-1)*A(N-1 ,LC,JC,1) 301 CONTINUE 200 CONTINUE 302 CONTINUE DO 303 JC = IC+1, NPDE CDIR$ IVDEP DO 201 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 1301 LC = 1, NPDE A(N,JC,IC,0) = A(N,JC,IC, 0) + - A(N,JC,LC,-9)*A(LLDG(N,-9),LC,IC,9) + - A(N,JC,LC,-8)*A(LLDG(N,-8),LC,IC,8) + - A(N,JC,LC,-7)*A(LLDG(N,-7),LC,IC,7) + - A(N,JC,LC,-6)*A(LLDG(N,-6),LC,IC,6) + - A(N,JC,LC,-5)*A(LLDG(N,-5),LC,IC,5) + - A(N,JC,LC,-4)*A(LLDG(N,-4),LC,IC,4) + - A(N,JC,LC,-3)*A(LLDG(N,-3),LC,IC,3) + - A(N,JC,LC,-2)*A(LLDG(N,-2),LC,IC,2) + - A(N,JC,LC,-1)*A(N-1 ,LC,IC,1) 1301 CONTINUE 201 CONTINUE 303 CONTINUE DO 304 LC = 1, IC-1 DO 305 JC = IC, NPDE CDIR$ IVDEP DO 202 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,0) = A(N,IC,JC,0) + - A(N,IC,LC,0)*A(N ,LC,JC,0) 202 CONTINUE 305 CONTINUE DO 306 JC = IC+1, NPDE CDIR$ IVDEP DO 203 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,JC,IC,0) = A(N,JC,IC,0) + - A(N,JC,LC,0)*A(N ,LC,IC,0) 203 CONTINUE 306 CONTINUE 304 CONTINUE CDIR$ IVDEP DO 204 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,IC,0) = 1.0 / A(N,IC,IC,0) 204 CONTINUE DO 307 JC = IC+1, NPDE CDIR$ IVDEP DO 205 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,JC,IC,0) = A(N,JC,IC,0) * A(N,IC,IC,0) 205 CONTINUE 307 CONTINUE 300 CONTINUE C C Compute upper diagonals DO 500 IC = 1, NPDE CDIR$ IVDEP DO 400 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL A(N,IC,1,1) = A(N,IC,1,1) - A(N,IC,1,-7)*A(LLDG(N,-7),1,1,8) - A 1 (N,IC,1,-6)*A(LLDG(N,-6),1,1,7) - A(N,IC,1,-3)*A(LLDG(N,-3), 2 1,1,4) - A(N,IC,1,-2)*A(LLDG(N,-2),1,1,3) A(N,IC,1,2) = A(N,IC,1,2) - A(N,IC,1,-8)*A(LLDG(N,-8),1,1,9) - A 1 (N,IC,1,-5)*A(LLDG(N,-5),1,1,6) - A(N,IC,1,-1)*A(N-1,1,1,3) A(N,IC,1,3) = A(N,IC,1,3) - A(N,IC,1,-7)*A(LLDG(N,-7),1,1,9) - A 1 (N,IC,1,-5)*A(LLDG(N,-5),1,1,7) - A(N,IC,1,-1)*A(N-1,1,1,4) A(N,IC,1,4) = A(N,IC,1,4) - A(N,IC,1,-6)*A(LLDG(N,-6),1,1,9) - A 1 (N,IC,1,-5)*A(LLDG(N,-5),1,1,8) A(N,IC,1,5) = A(N,IC,1,5) - A(N,IC,1,-9)*A(LLDG(N,-9),1,1,8) - A 1 (N,IC,1,-3)*A(LLDG(N,-3),1,1,7) - A(N,IC,1,-2)*A(LLDG(N,-2), 2 1,1,6) A(N,IC,1,6) = A(N,IC,1,6) - A(N,IC,1,-4)*A(LLDG(N,-4),1,1,9) - A 1 (N,IC,1,-1)*A(N-1,1,1,7) A(N,IC,1,7) = A(N,IC,1,7) - A(N,IC,1,-3)*A(LLDG(N,-3),1,1,9) - A 1 (N,IC,1,-1)*A(N-1,1,1,8) A(N,IC,1,8) = A(N,IC,1,8) - A(N,IC,1,-2)*A(LLDG(N,-2),1,1,9) A(N,IC,2,1) = A(N,IC,2,1) - A(N,IC,1,-7)*A(LLDG(N,-7),1,2,8) - A 1 (N,IC,1,-6)*A(LLDG(N,-6),1,2,7) - A(N,IC,1,-3)*A(LLDG(N,-3), 2 1,2,4) - A(N,IC,1,-2)*A(LLDG(N,-2),1,2,3) A(N,IC,2,2) = A(N,IC,2,2) - A(N,IC,1,-8)*A(LLDG(N,-8),1,2,9) - A 1 (N,IC,1,-5)*A(LLDG(N,-5),1,2,6) - A(N,IC,1,-1)*A(N-1,1,2,3) A(N,IC,2,3) = A(N,IC,2,3) - A(N,IC,1,-7)*A(LLDG(N,-7),1,2,9) - A 1 (N,IC,1,-5)*A(LLDG(N,-5),1,2,7) - A(N,IC,1,-1)*A(N-1,1,2,4) A(N,IC,2,4) = A(N,IC,2,4) - A(N,IC,1,-6)*A(LLDG(N,-6),1,2,9) - A 1 (N,IC,1,-5)*A(LLDG(N,-5),1,2,8) A(N,IC,2,5) = A(N,IC,2,5) - A(N,IC,1,-9)*A(LLDG(N,-9),1,2,8) - A 1 (N,IC,1,-3)*A(LLDG(N,-3),1,2,7) - A(N,IC,1,-2)*A(LLDG(N,-2), 2 1,2,6) A(N,IC,2,6) = A(N,IC,2,6) - A(N,IC,1,-4)*A(LLDG(N,-4),1,2,9) - A 1 (N,IC,1,-1)*A(N-1,1,2,7) A(N,IC,2,7) = A(N,IC,2,7) - A(N,IC,1,-3)*A(LLDG(N,-3),1,2,9) - A 1 (N,IC,1,-1)*A(N-1,1,2,8) A(N,IC,2,8) = A(N,IC,2,8) - A(N,IC,1,-2)*A(LLDG(N,-2),1,2,9) A(N,IC,3,1) = A(N,IC,3,1) - A(N,IC,1,-7)*A(LLDG(N,-7),1,3,8) - A 1 (N,IC,1,-6)*A(LLDG(N,-6),1,3,7) - A(N,IC,1,-3)*A(LLDG(N,-3), 2 1,3,4) - A(N,IC,1,-2)*A(LLDG(N,-2),1,3,3) A(N,IC,3,2) = A(N,IC,3,2) - A(N,IC,1,-8)*A(LLDG(N,-8),1,3,9) - A 1 (N,IC,1,-5)*A(LLDG(N,-5),1,3,6) - A(N,IC,1,-1)*A(N-1,1,3,3) A(N,IC,3,3) = A(N,IC,3,3) - A(N,IC,1,-7)*A(LLDG(N,-7),1,3,9) - A 1 (N,IC,1,-5)*A(LLDG(N,-5),1,3,7) - A(N,IC,1,-1)*A(N-1,1,3,4) A(N,IC,3,4) = A(N,IC,3,4) - A(N,IC,1,-6)*A(LLDG(N,-6),1,3,9) - A 1 (N,IC,1,-5)*A(LLDG(N,-5),1,3,8) A(N,IC,3,5) = A(N,IC,3,5) - A(N,IC,1,-9)*A(LLDG(N,-9),1,3,8) - A 1 (N,IC,1,-3)*A(LLDG(N,-3),1,3,7) - A(N,IC,1,-2)*A(LLDG(N,-2), 2 1,3,6) A(N,IC,3,6) = A(N,IC,3,6) - A(N,IC,1,-4)*A(LLDG(N,-4),1,3,9) - A 1 (N,IC,1,-1)*A(N-1,1,3,7) A(N,IC,3,7) = A(N,IC,3,7) - A(N,IC,1,-3)*A(LLDG(N,-3),1,3,9) - A 1 (N,IC,1,-1)*A(N-1,1,3,8) A(N,IC,3,8) = A(N,IC,3,8) - A(N,IC,1,-2)*A(LLDG(N,-2),1,3,9) A(N,IC,1,1) = A(N,IC,1,1) - A(N,IC,2,-7)*A(LLDG(N,-7),2,1,8) - A 1 (N,IC,2,-6)*A(LLDG(N,-6),2,1,7) - A(N,IC,2,-3)*A(LLDG(N,-3), 2 2,1,4) - A(N,IC,2,-2)*A(LLDG(N,-2),2,1,3) A(N,IC,1,2) = A(N,IC,1,2) - A(N,IC,2,-8)*A(LLDG(N,-8),2,1,9) - A 1 (N,IC,2,-5)*A(LLDG(N,-5),2,1,6) - A(N,IC,2,-1)*A(N-1,2,1,3) A(N,IC,1,3) = A(N,IC,1,3) - A(N,IC,2,-7)*A(LLDG(N,-7),2,1,9) - A 1 (N,IC,2,-5)*A(LLDG(N,-5),2,1,7) - A(N,IC,2,-1)*A(N-1,2,1,4) A(N,IC,1,4) = A(N,IC,1,4) - A(N,IC,2,-6)*A(LLDG(N,-6),2,1,9) - A 1 (N,IC,2,-5)*A(LLDG(N,-5),2,1,8) A(N,IC,1,5) = A(N,IC,1,5) - A(N,IC,2,-9)*A(LLDG(N,-9),2,1,8) - A 1 (N,IC,2,-3)*A(LLDG(N,-3),2,1,7) - A(N,IC,2,-2)*A(LLDG(N,-2), 2 2,1,6) A(N,IC,1,6) = A(N,IC,1,6) - A(N,IC,2,-4)*A(LLDG(N,-4),2,1,9) - A 1 (N,IC,2,-1)*A(N-1,2,1,7) A(N,IC,1,7) = A(N,IC,1,7) - A(N,IC,2,-3)*A(LLDG(N,-3),2,1,9) - A 1 (N,IC,2,-1)*A(N-1,2,1,8) A(N,IC,1,8) = A(N,IC,1,8) - A(N,IC,2,-2)*A(LLDG(N,-2),2,1,9) A(N,IC,2,1) = A(N,IC,2,1) - A(N,IC,2,-7)*A(LLDG(N,-7),2,2,8) - A 1 (N,IC,2,-6)*A(LLDG(N,-6),2,2,7) - A(N,IC,2,-3)*A(LLDG(N,-3), 2 2,2,4) - A(N,IC,2,-2)*A(LLDG(N,-2),2,2,3) A(N,IC,2,2) = A(N,IC,2,2) - A(N,IC,2,-8)*A(LLDG(N,-8),2,2,9) - A 1 (N,IC,2,-5)*A(LLDG(N,-5),2,2,6) - A(N,IC,2,-1)*A(N-1,2,2,3) A(N,IC,2,3) = A(N,IC,2,3) - A(N,IC,2,-7)*A(LLDG(N,-7),2,2,9) - A 1 (N,IC,2,-5)*A(LLDG(N,-5),2,2,7) - A(N,IC,2,-1)*A(N-1,2,2,4) A(N,IC,2,4) = A(N,IC,2,4) - A(N,IC,2,-6)*A(LLDG(N,-6),2,2,9) - A 1 (N,IC,2,-5)*A(LLDG(N,-5),2,2,8) A(N,IC,2,5) = A(N,IC,2,5) - A(N,IC,2,-9)*A(LLDG(N,-9),2,2,8) - A 1 (N,IC,2,-3)*A(LLDG(N,-3),2,2,7) - A(N,IC,2,-2)*A(LLDG(N,-2), 2 2,2,6) A(N,IC,2,6) = A(N,IC,2,6) - A(N,IC,2,-4)*A(LLDG(N,-4),2,2,9) - A 1 (N,IC,2,-1)*A(N-1,2,2,7) A(N,IC,2,7) = A(N,IC,2,7) - A(N,IC,2,-3)*A(LLDG(N,-3),2,2,9) - A 1 (N,IC,2,-1)*A(N-1,2,2,8) A(N,IC,2,8) = A(N,IC,2,8) - A(N,IC,2,-2)*A(LLDG(N,-2),2,2,9) A(N,IC,3,1) = A(N,IC,3,1) - A(N,IC,2,-7)*A(LLDG(N,-7),2,3,8) - A 1 (N,IC,2,-6)*A(LLDG(N,-6),2,3,7) - A(N,IC,2,-3)*A(LLDG(N,-3), 2 2,3,4) - A(N,IC,2,-2)*A(LLDG(N,-2),2,3,3) A(N,IC,3,2) = A(N,IC,3,2) - A(N,IC,2,-8)*A(LLDG(N,-8),2,3,9) - A 1 (N,IC,2,-5)*A(LLDG(N,-5),2,3,6) - A(N,IC,2,-1)*A(N-1,2,3,3) A(N,IC,3,3) = A(N,IC,3,3) - A(N,IC,2,-7)*A(LLDG(N,-7),2,3,9) - A 1 (N,IC,2,-5)*A(LLDG(N,-5),2,3,7) - A(N,IC,2,-1)*A(N-1,2,3,4) A(N,IC,3,4) = A(N,IC,3,4) - A(N,IC,2,-6)*A(LLDG(N,-6),2,3,9) - A 1 (N,IC,2,-5)*A(LLDG(N,-5),2,3,8) A(N,IC,3,5) = A(N,IC,3,5) - A(N,IC,2,-9)*A(LLDG(N,-9),2,3,8) - A 1 (N,IC,2,-3)*A(LLDG(N,-3),2,3,7) - A(N,IC,2,-2)*A(LLDG(N,-2), 2 2,3,6) A(N,IC,3,6) = A(N,IC,3,6) - A(N,IC,2,-4)*A(LLDG(N,-4),2,3,9) - A 1 (N,IC,2,-1)*A(N-1,2,3,7) A(N,IC,3,7) = A(N,IC,3,7) - A(N,IC,2,-3)*A(LLDG(N,-3),2,3,9) - A 1 (N,IC,2,-1)*A(N-1,2,3,8) A(N,IC,3,8) = A(N,IC,3,8) - A(N,IC,2,-2)*A(LLDG(N,-2),2,3,9) A(N,IC,1,1) = A(N,IC,1,1) - A(N,IC,3,-7)*A(LLDG(N,-7),3,1,8) - A 1 (N,IC,3,-6)*A(LLDG(N,-6),3,1,7) - A(N,IC,3,-3)*A(LLDG(N,-3), 2 3,1,4) - A(N,IC,3,-2)*A(LLDG(N,-2),3,1,3) A(N,IC,1,2) = A(N,IC,1,2) - A(N,IC,3,-8)*A(LLDG(N,-8),3,1,9) - A 1 (N,IC,3,-5)*A(LLDG(N,-5),3,1,6) - A(N,IC,3,-1)*A(N-1,3,1,3) A(N,IC,1,3) = A(N,IC,1,3) - A(N,IC,3,-7)*A(LLDG(N,-7),3,1,9) - A 1 (N,IC,3,-5)*A(LLDG(N,-5),3,1,7) - A(N,IC,3,-1)*A(N-1,3,1,4) A(N,IC,1,4) = A(N,IC,1,4) - A(N,IC,3,-6)*A(LLDG(N,-6),3,1,9) - A 1 (N,IC,3,-5)*A(LLDG(N,-5),3,1,8) A(N,IC,1,5) = A(N,IC,1,5) - A(N,IC,3,-9)*A(LLDG(N,-9),3,1,8) - A 1 (N,IC,3,-3)*A(LLDG(N,-3),3,1,7) - A(N,IC,3,-2)*A(LLDG(N,-2), 2 3,1,6) A(N,IC,1,6) = A(N,IC,1,6) - A(N,IC,3,-4)*A(LLDG(N,-4),3,1,9) - A 1 (N,IC,3,-1)*A(N-1,3,1,7) A(N,IC,1,7) = A(N,IC,1,7) - A(N,IC,3,-3)*A(LLDG(N,-3),3,1,9) - A 1 (N,IC,3,-1)*A(N-1,3,1,8) A(N,IC,1,8) = A(N,IC,1,8) - A(N,IC,3,-2)*A(LLDG(N,-2),3,1,9) A(N,IC,2,1) = A(N,IC,2,1) - A(N,IC,3,-7)*A(LLDG(N,-7),3,2,8) - A 1 (N,IC,3,-6)*A(LLDG(N,-6),3,2,7) - A(N,IC,3,-3)*A(LLDG(N,-3), 2 3,2,4) - A(N,IC,3,-2)*A(LLDG(N,-2),3,2,3) A(N,IC,2,2) = A(N,IC,2,2) - A(N,IC,3,-8)*A(LLDG(N,-8),3,2,9) - A 1 (N,IC,3,-5)*A(LLDG(N,-5),3,2,6) - A(N,IC,3,-1)*A(N-1,3,2,3) A(N,IC,2,3) = A(N,IC,2,3) - A(N,IC,3,-7)*A(LLDG(N,-7),3,2,9) - A 1 (N,IC,3,-5)*A(LLDG(N,-5),3,2,7) - A(N,IC,3,-1)*A(N-1,3,2,4) A(N,IC,2,4) = A(N,IC,2,4) - A(N,IC,3,-6)*A(LLDG(N,-6),3,2,9) - A 1 (N,IC,3,-5)*A(LLDG(N,-5),3,2,8) A(N,IC,2,5) = A(N,IC,2,5) - A(N,IC,3,-9)*A(LLDG(N,-9),3,2,8) - A 1 (N,IC,3,-3)*A(LLDG(N,-3),3,2,7) - A(N,IC,3,-2)*A(LLDG(N,-2), 2 3,2,6) A(N,IC,2,6) = A(N,IC,2,6) - A(N,IC,3,-4)*A(LLDG(N,-4),3,2,9) - A 1 (N,IC,3,-1)*A(N-1,3,2,7) A(N,IC,2,7) = A(N,IC,2,7) - A(N,IC,3,-3)*A(LLDG(N,-3),3,2,9) - A 1 (N,IC,3,-1)*A(N-1,3,2,8) A(N,IC,2,8) = A(N,IC,2,8) - A(N,IC,3,-2)*A(LLDG(N,-2),3,2,9) A(N,IC,3,1) = A(N,IC,3,1) - A(N,IC,3,-7)*A(LLDG(N,-7),3,3,8) - A 1 (N,IC,3,-6)*A(LLDG(N,-6),3,3,7) - A(N,IC,3,-3)*A(LLDG(N,-3), 2 3,3,4) - A(N,IC,3,-2)*A(LLDG(N,-2),3,3,3) A(N,IC,3,2) = A(N,IC,3,2) - A(N,IC,3,-8)*A(LLDG(N,-8),3,3,9) - A 1 (N,IC,3,-5)*A(LLDG(N,-5),3,3,6) - A(N,IC,3,-1)*A(N-1,3,3,3) A(N,IC,3,3) = A(N,IC,3,3) - A(N,IC,3,-7)*A(LLDG(N,-7),3,3,9) - A 1 (N,IC,3,-5)*A(LLDG(N,-5),3,3,7) - A(N,IC,3,-1)*A(N-1,3,3,4) A(N,IC,3,4) = A(N,IC,3,4) - A(N,IC,3,-6)*A(LLDG(N,-6),3,3,9) - A 1 (N,IC,3,-5)*A(LLDG(N,-5),3,3,8) A(N,IC,3,5) = A(N,IC,3,5) - A(N,IC,3,-9)*A(LLDG(N,-9),3,3,8) - A 1 (N,IC,3,-3)*A(LLDG(N,-3),3,3,7) - A(N,IC,3,-2)*A(LLDG(N,-2), 2 3,3,6) A(N,IC,3,6) = A(N,IC,3,6) - A(N,IC,3,-4)*A(LLDG(N,-4),3,3,9) - A 1 (N,IC,3,-1)*A(N-1,3,3,7) A(N,IC,3,7) = A(N,IC,3,7) - A(N,IC,3,-3)*A(LLDG(N,-3),3,3,9) - A 1 (N,IC,3,-1)*A(N-1,3,3,8) A(N,IC,3,8) = A(N,IC,3,8) - A(N,IC,3,-2)*A(LLDG(N,-2),3,3,9) 400 CONTINUE DO 503 LC = 1, IC-1 CDIR$ IVDEP DO 401 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 504 JC = 1, NPDE A(N,IC,JC,1) = A(N,IC,JC,1) + - A(N,IC,LC,0)*A(N,LC,JC,1) A(N,IC,JC,2) = A(N,IC,JC,2) + - A(N,IC,LC,0)*A(N,LC,JC,2) A(N,IC,JC,3) = A(N,IC,JC,3) + - A(N,IC,LC,0)*A(N,LC,JC,3) A(N,IC,JC,4) = A(N,IC,JC,4) + - A(N,IC,LC,0)*A(N,LC,JC,4) A(N,IC,JC,5) = A(N,IC,JC,5) + - A(N,IC,LC,0)*A(N,LC,JC,5) A(N,IC,JC,6) = A(N,IC,JC,6) + - A(N,IC,LC,0)*A(N,LC,JC,6) A(N,IC,JC,7) = A(N,IC,JC,7) + - A(N,IC,LC,0)*A(N,LC,JC,7) A(N,IC,JC,8) = A(N,IC,JC,8) + - A(N,IC,LC,0)*A(N,LC,JC,8) A(N,IC,JC,9) = A(N,IC,JC,9) + - A(N,IC,LC,0)*A(N,LC,JC,9) 504 CONTINUE 401 CONTINUE 503 CONTINUE 500 CONTINUE C 10 CONTINUE C RETURN END SUBROUTINE BCKSLV (NPTS, NPD, A, LLDG, LUDG, LSL, LLSL, LSU, LLSU, + B) INTEGER NPDE PARAMETER (NPDE = 3) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPD, LLDG(NPTS,-9:-2), LUDG(NPTS,2:9), + LSL(*), LLSL(0:*), LSU(*), LLSU(0:*) REAL A(NPTS,NPDE,NPDE,-9:9), B(NPTS,NPDE) C Ccc PURPOSE: C Solve LUx = b C A stems from a 19-point stencil on a grid with irregular row and C plane sizes C A = ILU, vectorized by `hyperplane' ordening, where the `hyperplanes' C are sets of points that can be treated simultaneously. C A((i,j,k),1:NPDE,1:NPDE,.) contains a block of NPDE.NPDE elements C corresponding with node (i,j,k) C Ccc PARAMETER DESCRIPTION: C NPTS : IN. # gridpoints C NPDE : IN. # components of the PDE C A : IN. A(.,1:NPDE,1:NPDE,-9:-1) : lower block diagonals of L C A(.,ic,jc,0): jc < ic: main block diagonal of L C main diagonal L == I C jc >=ic: main block diagonal of U C main diagonal U inverted C A(.,1:NPDE,1:NPDE, 1: 9) : upper block diagonals of U C LLDG : IN. Block-column index of lower 8 block-diagonals C If block ld does not exist the LLDG(N,ld) = N C LUDG : IN. Block-column index of upper 8 block-diagonals C If block ud does not exist the LUDG(N,lu) = N C LSL : IN. (NPTS) C LSL(LLSL(m-1)+1:LLSL(m)): pointers to set of points S_m C in actual grid that can be treated at the m-th iteration C of Ly = b C LLSL : IN. (0:LLSL(0)) C LLSL(0) = # iterations needed C LLSL(1:LLSL(0)): pointers to the start of a list in LSL C LSU : IN. (NPTS) C LSU(LLSU(m-1)+1:LLSU(m)): pointers to set of points S_m C in actual grid that can be treated at the m-th iteration C of Ux = y C LLSU : IN. (0:LLSU(0)) C LLSU(0) = # iterations needed C LLSU(1:LLSU(0)): pointers to the start of a list in LSU C B : INOUT. C IN: right-hand side vector b C OUT: solution vector x C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER IC, JC, N, L, M C CCC Ly = b C C Loop over `hyperplanes' S_m, m = 1, LLSL(0) C Node # N = LSL_m(LLSL(l)) C C LSL_1 = {(i,j,k)| (i,j,k) not dependent on (i-ii,j-jj,k-kk), C ii,jj,kk >= 0, not ii=jj=kk=0; C i.e., Dirichlet points and left/down/front corners} M = 1 DO 100 IC = 2, NPDE DO 101 JC = 1, IC-1 CDIR$ IVDEP DO 1 L = 1, LLSL(M) N = LSL(L) B(N,IC) = B(N,IC) - A(N,IC,JC,0)*B(N,JC) 1 CONTINUE 101 CONTINUE 100 CONTINUE C C Loop over rest of `hyperplane' sets C NB. No exception handling is necessary for the first row and the first C point of the second row, since N > 1 in the loop and for those C points LLDG(N,.) = N, (=> no array index problems), C and the multiplicator of `non existing' array elements is zero. C DO 10 M = 2, LLSL(0) C C Compute y elements in this set CDIR$ IVDEP DO 20 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) CFPP$ UNROLL DO 120 IC = 1, NPDE CFPP$ UNROLL DO 121 JC = 1, NPDE B(N,IC) = B(N,IC) - A(N,IC,JC,-1)*B(N- 1,JC) + - A(N,IC,JC,-2)*B(LLDG(N,-2),JC) + - A(N,IC,JC,-3)*B(LLDG(N,-3),JC) + - A(N,IC,JC,-4)*B(LLDG(N,-4),JC) + - A(N,IC,JC,-5)*B(LLDG(N,-5),JC) + - A(N,IC,JC,-6)*B(LLDG(N,-6),JC) + - A(N,IC,JC,-7)*B(LLDG(N,-7),JC) + - A(N,IC,JC,-8)*B(LLDG(N,-8),JC) + - A(N,IC,JC,-9)*B(LLDG(N,-9),JC) 121 CONTINUE 120 CONTINUE 20 CONTINUE DO 123 IC = 2, NPDE DO 122 JC = 1, IC-1 CDIR$ IVDEP DO 21 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) B(N,IC) = B(N,IC) - A(N,IC,JC,0)*B(N,JC) 21 CONTINUE 122 CONTINUE 123 CONTINUE C 10 CONTINUE C CCC Ux = y C C Loop over `hyperplanes' LSU_m, m = 1, LLSU(0) C Node # N = LSU_m(LLSU(l)) C C LSU_1 = {(i,j,k)| (i,j,k) not dependent on (i+ii,j+jj,k+kk), C ii,jj,kk >= 0, not ii=jj=kk=0; C e.g., Dirichlet points and right/up/back corners} C M = 1 DO 130 IC = NPDE, 1, -1 DO 131 JC = NPDE, IC+1, -1 CDIR$ IVDEP DO 132 L = 1, LLSU(M) N = LSU(L) B(N,IC) = B(N,IC) - A(N,IC,JC,0)*B(N,JC) 132 CONTINUE 131 CONTINUE CDIR$ IVDEP DO 133 L = 1, LLSU(M) N = LSU(L) B(N,IC) = B(N,IC) * A(N,IC,IC,0) 133 CONTINUE 130 CONTINUE C C Loop over rest of `hyperplane' sets C NB. No exception handling is necessary for the last row and the first C point of the second last row, since N < NPTS in the loop and for C those points LUDG(N,.) = N (=> no array index problems), C and the multiplicator of `non existing' array elements is zero. C DO 30 M = 2, LLSU(0) C C Compute x elements in this set CDIR$ IVDEP DO 40 L = LLSU(M-1)+1, LLSU(M) N = LSU(L) CFPP$ UNROLL DO 150 IC = NPDE, 1, -1 CFPP$ UNROLL DO 151 JC = NPDE, 1, -1 B(N,IC) = B(N,IC) - A(N,IC,JC,1)*B(N+1 ,JC) + - A(N,IC,JC,2)*B(LUDG(N,2),JC) + - A(N,IC,JC,3)*B(LUDG(N,3),JC) + - A(N,IC,JC,4)*B(LUDG(N,4),JC) + - A(N,IC,JC,5)*B(LUDG(N,5),JC) + - A(N,IC,JC,6)*B(LUDG(N,6),JC) + - A(N,IC,JC,7)*B(LUDG(N,7),JC) + - A(N,IC,JC,8)*B(LUDG(N,8),JC) + - A(N,IC,JC,9)*B(LUDG(N,9),JC) 151 CONTINUE 150 CONTINUE 40 CONTINUE DO 1150 IC = NPDE, 1, -1 DO 152 JC = NPDE, IC+1, -1 CDIR$ IVDEP DO 51 L = LLSU(M-1)+1, LLSU(M) N = LSU(L) B(N,IC) = B(N,IC) - A(N,IC,JC,0)*B(N,JC) 51 CONTINUE 152 CONTINUE CDIR$ IVDEP DO 52 L = LLSU(M-1)+1, LLSU(M) N = LSU(L) B(N,IC) = B(N,IC) * A(N,IC,IC,0) 52 CONTINUE 1150 CONTINUE C 30 CONTINUE C RETURN END SHAR_EOF fi # end of overwriting check if test -f 'ilubsn.f' then echo shar: will not over-write existing file "'ilubsn.f'" else cat << \SHAR_EOF > 'ilubsn.f' SUBROUTINE ILU (NPTS, NPDE, A, LLDG, LSL, LLSL) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE, LLDG(NPTS,-9:-2), LSL(*), LLSL(0:*) REAL A(NPTS,NPDE,NPDE,-9:9) C Ccc PURPOSE: C Incomplete LU decomposition of A C A stems from a 19-point stencil on a grid with irregular row and C plane sizes C A = ILU, vectorized by `hyperplane' ordening, where the `hyperplanes' C are sets of points that can be treated simultaneously. C A((i,j,k),1:NPDE,1:NPDE,.) contains a block of NPDE.NPDE elements C corresponding with node (i,j,k) C Ccc PARAMETER DESCRIPTION: C NPTS : IN. # gridpoints C NPDE : IN. # components of the PDE C A : INOUT. C IN: A(.,1:NPDE,1:NPDE,-9:-1) : lower block diagonals C A(.,1:NPDE,1:NPDE,0) : main block diagonal C A(.,1:NPDE,1:NPDE, 1: 9) : upper block diagonals C OUT: A(.,1:NPDE,1:NPDE,-9:-1) : lower block diagonals of L C A(.,ic,jc,0): jc < ic: main block diagonal of L C main diagonal L == I C jc >=ic: main block diagonal of U C main diagonal U inverted C A(.,1:NPDE,1:NPDE, 1: 9) : upper block diagonals of U C LLDG : IN. Block-column index of lower 8 block-diagonals C If block ld does not exist the LLDG(N,ld) = N C LSL : IN. (NPTS) C LSL(LLSL(m-1)+1:LLSL(m)): pointers to set of points S_m C in actual grid that can be treated at the m-th iteration C LLSL : IN. (0:LLSL(0)) C LLSL(0) = # iterations needed C LLSL(1:LLSL(0)): pointers to the start of a list in LSL C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER IC, JC, LC, N, L, M C C Loop over `hyperplanes' S_m, m = 1, LLSL(0) C Node # N = S_m(LLSL(l)) C C S_1 = {(i,j,k)| (i,j,k) not dependent on (i-ii,j-jj,k-kk), C ii,jj,kk >= 0, not ii=jj=kk=0; C i.e., Dirichlet points and left/down/front corners} M = 1 C C Compute main block diagonal DO 550 IC = 1, NPDE DO 554 LC = 1, IC-1 DO 555 JC = IC, NPDE CDIR$ IVDEP DO 551 L = 1, LLSL(M) N = LSL(L) A(N,IC,JC,0) = A(N,IC,JC,0) + - A(N,IC,LC,0)*A(N,LC,JC,0) 551 CONTINUE 555 CONTINUE DO 556 JC = IC+1, NPDE CDIR$ IVDEP DO 552 L = 1, LLSL(M) N = LSL(L) A(N,JC,IC,0) = A(N,JC,IC,0) + - A(N,JC,LC,0)*A(N,LC,IC,0) 552 CONTINUE 556 CONTINUE 554 CONTINUE CDIR$ IVDEP DO 553 L = 1, LLSL(M) N = LSL(L) A(N,IC,IC,0) = 1.0 / A(N,IC,IC,0) 553 CONTINUE DO 557 JC = IC+1, NPDE CDIR$ IVDEP DO 559 L = 1, LLSL(M) N = LSL(L) A(N,JC,IC,0) = A(N,JC,IC,0) * A(N,IC,IC,0) 559 CONTINUE 557 CONTINUE 550 CONTINUE C C Compute upper block diagonals DO 560 IC = 1, NPDE DO 563 LC = 1, IC-1 DO 564 JC = 1, NPDE CDIR$ IVDEP DO 561 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,1) = A(N,IC,JC,1) + - A(N,IC,LC,0)*A(N,LC,JC,1) A(N,IC,JC,2) = A(N,IC,JC,2) + - A(N,IC,LC,0)*A(N,LC,JC,2) A(N,IC,JC,3) = A(N,IC,JC,3) + - A(N,IC,LC,0)*A(N,LC,JC,3) A(N,IC,JC,4) = A(N,IC,JC,4) + - A(N,IC,LC,0)*A(N,LC,JC,4) A(N,IC,JC,5) = A(N,IC,JC,5) + - A(N,IC,LC,0)*A(N,LC,JC,5) A(N,IC,JC,6) = A(N,IC,JC,6) + - A(N,IC,LC,0)*A(N,LC,JC,6) A(N,IC,JC,7) = A(N,IC,JC,7) + - A(N,IC,LC,0)*A(N,LC,JC,7) A(N,IC,JC,8) = A(N,IC,JC,8) + - A(N,IC,LC,0)*A(N,LC,JC,8) A(N,IC,JC,9) = A(N,IC,JC,9) + - A(N,IC,LC,0)*A(N,LC,JC,9) 561 CONTINUE 564 CONTINUE 563 CONTINUE 560 CONTINUE C C Loop over rest of `hyperplane' sets C NB. No exception handling is necessary for the first row and the first C point of the second row, since N > 1 in the loop and for those C points LLDG(N,.) = N, (=> no array index problems), C and the multiplicator of `non existing' array elements is zero. C DO 10 M = 2, LLSL(0) C C Compute lower diagonals DO 120 JC = 1, NPDE DO 121 LC = 1, JC-1 DO 122 IC = 1, NPDE CDIR$ IVDEP DO 20 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,-9) = A(N,IC,JC,-9) + - A(N,IC,LC,-9) * A(LLDG(N,-9),LC,JC,0) 20 CONTINUE 122 CONTINUE 121 CONTINUE DO 123 IC = 1, NPDE CDIR$ IVDEP DO 21 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,-9) = A(N,IC,JC,-9) * A(LLDG(N,-9),JC,JC,0) 21 CONTINUE 123 CONTINUE 120 CONTINUE DO 130 JC = 1, NPDE DO 131 LC = 1, NPDE DO 132 IC = 1, NPDE CDIR$ IVDEP DO 30 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,-8) = A(N,IC,JC,-8) + - A(N,IC,LC,-9)*A(LLDG(N,-9),LC,JC,2) 30 CONTINUE 132 CONTINUE 131 CONTINUE DO 133 LC = 1, JC-1 DO 134 IC = 1, NPDE CDIR$ IVDEP DO 31 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,-8) = A(N,IC,JC,-8) + - A(N,IC,LC,-8)*A(LLDG(N,-8),LC,JC,0) 31 CONTINUE 134 CONTINUE 133 CONTINUE DO 135 IC = 1, NPDE CDIR$ IVDEP DO 32 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,-8) = A(N,IC,JC,-8) * A(LLDG(N,-8),JC,JC,0) 32 CONTINUE 135 CONTINUE 130 CONTINUE DO 140 JC = 1, NPDE DO 141 LC = 1, NPDE DO 142 IC = 1, NPDE CDIR$ IVDEP DO 40 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,-7) = A(N,IC,JC,-7) + - A(N,IC,LC,-9)*A(LLDG(N,-9),LC,JC,3) + - A(N,IC,LC,-8)*A(LLDG(N,-8),LC,JC,1) 40 CONTINUE 142 CONTINUE 141 CONTINUE DO 143 LC = 1, JC-1 DO 144 IC = 1, NPDE CDIR$ IVDEP DO 41 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,-7) = A(N,IC,JC,-7) + - A(N,IC,LC,-7)*A(LLDG(N,-7),LC,JC,0) 41 CONTINUE 144 CONTINUE 143 CONTINUE DO 145 IC = 1, NPDE CDIR$ IVDEP DO 42 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,-7) = A(N,IC,JC,-7) * A(LLDG(N,-7),JC,JC,0) 42 CONTINUE 145 CONTINUE 140 CONTINUE DO 150 JC = 1, NPDE DO 151 LC = 1, NPDE DO 152 IC = 1, NPDE CDIR$ IVDEP DO 50 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,-6) = A(N,IC,JC,-6) + - A(N,IC,LC,-9)*A(LLDG(N,-9),LC,JC,4) + - A(N,IC,LC,-7)*A(LLDG(N,-7),LC,JC,1) 50 CONTINUE 152 CONTINUE 151 CONTINUE DO 153 LC = 1, JC-1 DO 154 IC = 1, NPDE CDIR$ IVDEP DO 51 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,-6) = A(N,IC,JC,-6) + - A(N,IC,LC,-6)*A(LLDG(N,-6),LC,JC,0) 51 CONTINUE 154 CONTINUE 153 CONTINUE DO 155 IC = 1, NPDE CDIR$ IVDEP DO 52 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,-6) = A(N,IC,JC,-6) * A(LLDG(N,-6),JC,JC,0) 52 CONTINUE 155 CONTINUE 150 CONTINUE DO 160 JC = 1, NPDE DO 161 LC = 1, NPDE DO 162 IC = 1, NPDE CDIR$ IVDEP DO 60 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,-5) = A(N,IC,JC,-5) + - A(N,IC,LC,-8)*A(LLDG(N,-8),LC,JC,4) + - A(N,IC,LC,-7)*A(LLDG(N,-7),LC,JC,3) + - A(N,IC,LC,-6)*A(LLDG(N,-6),LC,JC,2) A(N,IC,JC,-4) = A(N,IC,JC,-4) + - A(N,IC,LC,-9)*A(LLDG(N,-9),LC,JC,6) + - A(N,IC,LC,-8)*A(LLDG(N,-8),LC,JC,5) 60 CONTINUE 162 CONTINUE 161 CONTINUE DO 163 LC = 1, JC-1 DO 164 IC = 1, NPDE CDIR$ IVDEP DO 61 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,-5) = A(N,IC,JC,-5) + - A(N,IC,LC,-5)*A(LLDG(N,-5),LC,JC,0) A(N,IC,JC,-4) = A(N,IC,JC,-4) + - A(N,IC,LC,-4)*A(LLDG(N,-4),LC,JC,0) 61 CONTINUE 164 CONTINUE 163 CONTINUE DO 165 IC = 1, NPDE CDIR$ IVDEP DO 62 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,-5) = A(N,IC,JC,-5) * A(LLDG(N,-5),JC,JC,0) A(N,IC,JC,-4) = A(N,IC,JC,-4) * A(LLDG(N,-4),JC,JC,0) 62 CONTINUE 165 CONTINUE 160 CONTINUE DO 170 JC = 1, NPDE DO 171 LC = 1, NPDE DO 172 IC = 1, NPDE CDIR$ IVDEP DO 70 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,-3) = A(N,IC,JC,-3) + - A(N,IC,LC,-9)*A(LLDG(N,-9),LC,JC,8) + - A(N,IC,LC,-7)*A(LLDG(N,-7),LC,JC,5) + - A(N,IC,LC,-4)*A(LLDG(N,-4),LC,JC,1) 70 CONTINUE 172 CONTINUE 171 CONTINUE DO 173 LC = 1, JC-1 DO 174 IC = 1, NPDE CDIR$ IVDEP DO 71 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,-3) = A(N,IC,JC,-3) + - A(N,IC,LC,-3)*A(LLDG(N,-3),LC,JC,0) 71 CONTINUE 174 CONTINUE 173 CONTINUE DO 175 IC = 1, NPDE CDIR$ IVDEP DO 72 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,-3) = A(N,IC,JC,-3) * A(LLDG(N,-3),JC,JC,0) 72 CONTINUE 175 CONTINUE 170 CONTINUE DO 180 JC = 1, NPDE DO 181 LC = 1, NPDE DO 182 IC = 1, NPDE CDIR$ IVDEP DO 80 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,-2) = A(N,IC,JC,-2) + - A(N,IC,LC,-9)*A(LLDG(N,-9),LC,JC,8) + - A(N,IC,LC,-6)*A(LLDG(N,-6),LC,JC,5) + - A(N,IC,LC,-3)*A(LLDG(N,-3),LC,JC,1) A(N,IC,JC,-1) = A(N,IC,JC,-1) + - A(N,IC,LC,-8)*A(LLDG(N,-8),LC,JC,7) + - A(N,IC,LC,-7)*A(LLDG(N,-7),LC,JC,6) + - A(N,IC,LC,-4)*A(LLDG(N,-4),LC,JC,3) + - A(N,IC,LC,-3)*A(LLDG(N,-3),LC,JC,2) 80 CONTINUE 182 CONTINUE 181 CONTINUE DO 183 LC = 1, JC-1 DO 184 IC = 1, NPDE CDIR$ IVDEP DO 81 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,-2) = A(N,IC,JC,-2) + - A(N,IC,LC,-2)*A(LLDG(N,-2),LC,JC,0) A(N,IC,JC,-1) = A(N,IC,JC,-1) + - A(N,IC,LC,-1)*A(N-1 ,LC,JC,0) 81 CONTINUE 184 CONTINUE 183 CONTINUE DO 185 IC = 1, NPDE CDIR$ IVDEP DO 82 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,-2) = A(N,IC,JC,-2) * A(LLDG(N,-2),JC,JC,0) A(N,IC,JC,-1) = A(N,IC,JC,-1) * A(N-1 ,JC,JC,0) 82 CONTINUE 185 CONTINUE 180 CONTINUE C C Compute main diagonal DO 300 IC = 1, NPDE DO 301 LC = 1, NPDE DO 302 JC = IC, NPDE CDIR$ IVDEP DO 200 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,0) = A(N,IC,JC, 0) + - A(N,IC,LC,-9)*A(LLDG(N,-9),LC,JC,9) + - A(N,IC,LC,-8)*A(LLDG(N,-8),LC,JC,8) + - A(N,IC,LC,-7)*A(LLDG(N,-7),LC,JC,7) + - A(N,IC,LC,-6)*A(LLDG(N,-6),LC,JC,6) + - A(N,IC,LC,-5)*A(LLDG(N,-5),LC,JC,5) + - A(N,IC,LC,-4)*A(LLDG(N,-4),LC,JC,4) + - A(N,IC,LC,-3)*A(LLDG(N,-3),LC,JC,3) + - A(N,IC,LC,-2)*A(LLDG(N,-2),LC,JC,2) + - A(N,IC,LC,-1)*A(N-1 ,LC,JC,1) 200 CONTINUE 302 CONTINUE DO 303 JC = IC+1, NPDE CDIR$ IVDEP DO 201 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,JC,IC,0) = A(N,JC,IC, 0) + - A(N,JC,LC,-9)*A(LLDG(N,-9),LC,IC,9) + - A(N,JC,LC,-8)*A(LLDG(N,-8),LC,IC,8) + - A(N,JC,LC,-7)*A(LLDG(N,-7),LC,IC,7) + - A(N,JC,LC,-6)*A(LLDG(N,-6),LC,IC,6) + - A(N,JC,LC,-5)*A(LLDG(N,-5),LC,IC,5) + - A(N,JC,LC,-4)*A(LLDG(N,-4),LC,IC,4) + - A(N,JC,LC,-3)*A(LLDG(N,-3),LC,IC,3) + - A(N,JC,LC,-2)*A(LLDG(N,-2),LC,IC,2) + - A(N,JC,LC,-1)*A(N-1 ,LC,IC,1) 201 CONTINUE 303 CONTINUE 301 CONTINUE DO 304 LC = 1, IC-1 DO 305 JC = IC, NPDE CDIR$ IVDEP DO 202 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,0) = A(N,IC,JC,0) + - A(N,IC,LC,0)*A(N ,LC,JC,0) 202 CONTINUE 305 CONTINUE DO 306 JC = IC+1, NPDE CDIR$ IVDEP DO 203 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,JC,IC,0) = A(N,JC,IC,0) + - A(N,JC,LC,0)*A(N ,LC,IC,0) 203 CONTINUE 306 CONTINUE 304 CONTINUE CDIR$ IVDEP DO 204 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,IC,0) = 1.0 / A(N,IC,IC,0) 204 CONTINUE DO 307 JC = IC+1, NPDE CDIR$ IVDEP DO 205 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,JC,IC,0) = A(N,JC,IC,0) * A(N,IC,IC,0) 205 CONTINUE 307 CONTINUE 300 CONTINUE C C Compute upper diagonals DO 500 IC = 1, NPDE DO 501 LC = 1, NPDE DO 502 JC = 1, NPDE CDIR$ IVDEP DO 400 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,1) = A(N,IC,JC, 1) + - A(N,IC,LC,-7)*A(LLDG(N,-7),LC,JC,8) + - A(N,IC,LC,-6)*A(LLDG(N,-6),LC,JC,7) + - A(N,IC,LC,-3)*A(LLDG(N,-3),LC,JC,4) + - A(N,IC,LC,-2)*A(LLDG(N,-2),LC,JC,3) A(N,IC,JC,2) = A(N,IC,JC, 2) + - A(N,IC,LC,-8)*A(LLDG(N,-8),LC,JC,9) + - A(N,IC,LC,-5)*A(LLDG(N,-5),LC,JC,6) + - A(N,IC,LC,-1)*A(N-1 ,LC,JC,3) A(N,IC,JC,3) = A(N,IC,JC, 3) + - A(N,IC,LC,-7)*A(LLDG(N,-7),LC,JC,9) + - A(N,IC,LC,-5)*A(LLDG(N,-5),LC,JC,7) + - A(N,IC,LC,-1)*A(N-1 ,LC,JC,4) A(N,IC,JC,4) = A(N,IC,JC, 4) + - A(N,IC,LC,-6)*A(LLDG(N,-6),LC,JC,9) + - A(N,IC,LC,-5)*A(LLDG(N,-5),LC,JC,8) A(N,IC,JC,5) = A(N,IC,JC, 5) + - A(N,IC,LC,-9)*A(LLDG(N,-9),LC,JC,8) + - A(N,IC,LC,-3)*A(LLDG(N,-3),LC,JC,7) + - A(N,IC,LC,-2)*A(LLDG(N,-2),LC,JC,6) A(N,IC,JC,6) = A(N,IC,JC, 6) + - A(N,IC,LC,-4)*A(LLDG(N,-4),LC,JC,9) + - A(N,IC,LC,-1)*A(N-1 ,LC,JC,7) A(N,IC,JC,7) = A(N,IC,JC, 7) + - A(N,IC,LC,-3)*A(LLDG(N,-3),LC,JC,9) + - A(N,IC,LC,-1)*A(N-1 ,LC,JC,8) A(N,IC,JC,8) = A(N,IC,JC, 8) + - A(N,IC,LC,-2)*A(LLDG(N,-2),LC,JC,9) 400 CONTINUE 502 CONTINUE 501 CONTINUE DO 503 LC = 1, IC-1 DO 504 JC = 1, NPDE CDIR$ IVDEP DO 401 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) A(N,IC,JC,1) = A(N,IC,JC,1) + - A(N,IC,LC,0)*A(N,LC,JC,1) A(N,IC,JC,2) = A(N,IC,JC,2) + - A(N,IC,LC,0)*A(N,LC,JC,2) A(N,IC,JC,3) = A(N,IC,JC,3) + - A(N,IC,LC,0)*A(N,LC,JC,3) A(N,IC,JC,4) = A(N,IC,JC,4) + - A(N,IC,LC,0)*A(N,LC,JC,4) A(N,IC,JC,5) = A(N,IC,JC,5) + - A(N,IC,LC,0)*A(N,LC,JC,5) A(N,IC,JC,6) = A(N,IC,JC,6) + - A(N,IC,LC,0)*A(N,LC,JC,6) A(N,IC,JC,7) = A(N,IC,JC,7) + - A(N,IC,LC,0)*A(N,LC,JC,7) A(N,IC,JC,8) = A(N,IC,JC,8) + - A(N,IC,LC,0)*A(N,LC,JC,8) A(N,IC,JC,9) = A(N,IC,JC,9) + - A(N,IC,LC,0)*A(N,LC,JC,9) 401 CONTINUE 504 CONTINUE 503 CONTINUE 500 CONTINUE C 10 CONTINUE C RETURN END SUBROUTINE BCKSLV (NPTS,NPDE, A, LLDG, LUDG, LSL, LLSL, LSU, LLSU, + B) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE, LLDG(NPTS,-9:-2), LUDG(NPTS,2:9), + LSL(*), LLSL(0:*), LSU(*), LLSU(0:*) REAL A(NPTS,NPDE,NPDE,-9:9), B(NPTS,NPDE) C Ccc PURPOSE: C Solve LUx = b C A stems from a 19-point stencil on a grid with irregular row and C plane sizes C A = ILU, vectorized by `hyperplane' ordening, where the `hyperplanes' C are sets of points that can be treated simultaneously. C A((i,j,k),1:NPDE,1:NPDE,.) contains a block of NPDE.NPDE elements C corresponding with node (i,j,k) C Ccc PARAMETER DESCRIPTION: C NPTS : IN. # gridpoints C NPDE : IN. # components of the PDE C A : IN. A(.,1:NPDE,1:NPDE,-9:-1) : lower block diagonals of L C A(.,ic,jc,0): jc < ic: main block diagonal of L C main diagonal L == I C jc >=ic: main block diagonal of U C main diagonal U inverted C A(.,1:NPDE,1:NPDE, 1: 9) : upper block diagonals of U C LLDG : IN. Block-column index of lower 8 block-diagonals C If block ld does not exist the LLDG(N,ld) = N C LUDG : IN. Block-column index of upper 8 block-diagonals C If block ud does not exist the LUDG(N,lu) = N C LSL : IN. (NPTS) C LSL(LLSL(m-1)+1:LLSL(m)): pointers to set of points S_m C in actual grid that can be treated at the m-th iteration C of Ly = b C LLSL : IN. (0:LLSL(0)) C LLSL(0) = # iterations needed C LLSL(1:LLSL(0)): pointers to the start of a list in LSL C LSU : IN. (NPTS) C LSU(LLSU(m-1)+1:LLSU(m)): pointers to set of points S_m C in actual grid that can be treated at the m-th iteration C of Ux = y C LLSU : IN. (0:LLSU(0)) C LLSU(0) = # iterations needed C LLSU(1:LLSU(0)): pointers to the start of a list in LSU C B : INOUT. C IN: right-hand side vector b C OUT: solution vector x C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER IC, JC, N, L, M C CCC Ly = b C C Loop over `hyperplanes' S_m, m = 1, LLSL(0) C Node # N = LSL_m(LLSL(l)) C C LSL_1 = {(i,j,k)| (i,j,k) not dependent on (i-ii,j-jj,k-kk), C ii,jj,kk >= 0, not ii=jj=kk=0; C i.e., Dirichlet points and left/down/front corners} M = 1 DO 100 IC = 2, NPDE DO 101 JC = 1, IC-1 CDIR$ IVDEP DO 1 L = 1, LLSL(M) N = LSL(L) B(N,IC) = B(N,IC) - A(N,IC,JC,0)*B(N,JC) 1 CONTINUE 101 CONTINUE 100 CONTINUE C C Loop over rest of `hyperplane' sets C NB. No exception handling is necessary for the first row and the first C point of the second row, since N > 1 in the loop and for those C points LLDG(N,.) = N, (=> no array index problems), C and the multiplicator of `non existing' array elements is zero. C DO 10 M = 2, LLSL(0) C C Compute y elements in this set DO 120 IC = 1, NPDE DO 121 JC = 1, NPDE CDIR$ IVDEP DO 20 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) B(N,IC) = B(N,IC) - A(N,IC,JC,-1)*B(N- 1,JC) + - A(N,IC,JC,-2)*B(LLDG(N,-2),JC) + - A(N,IC,JC,-3)*B(LLDG(N,-3),JC) + - A(N,IC,JC,-4)*B(LLDG(N,-4),JC) + - A(N,IC,JC,-5)*B(LLDG(N,-5),JC) + - A(N,IC,JC,-6)*B(LLDG(N,-6),JC) + - A(N,IC,JC,-7)*B(LLDG(N,-7),JC) + - A(N,IC,JC,-8)*B(LLDG(N,-8),JC) + - A(N,IC,JC,-9)*B(LLDG(N,-9),JC) 20 CONTINUE 121 CONTINUE 120 CONTINUE DO 123 IC = 2, NPDE DO 122 JC = 1, IC-1 CDIR$ IVDEP DO 21 L = LLSL(M-1)+1, LLSL(M) N = LSL(L) B(N,IC) = B(N,IC) - A(N,IC,JC,0)*B(N,JC) 21 CONTINUE 122 CONTINUE 123 CONTINUE C 10 CONTINUE C CCC Ux = y C C Loop over `hyperplanes' LSU_m, m = 1, LLSU(0) C Node # N = LSU_m(LLSU(l)) C C LSU_1 = {(i,j,k)| (i,j,k) not dependent on (i+ii,j+jj,k+kk), C ii,jj,kk >= 0, not ii=jj=kk=0; C e.g., Dirichlet points and right/up/back corners} C M = 1 DO 130 IC = NPDE, 1, -1 DO 131 JC = NPDE, IC+1, -1 CDIR$ IVDEP DO 132 L = 1, LLSU(M) N = LSU(L) B(N,IC) = B(N,IC) - A(N,IC,JC,0)*B(N,JC) 132 CONTINUE 131 CONTINUE CDIR$ IVDEP DO 133 L = 1, LLSU(M) N = LSU(L) B(N,IC) = B(N,IC) * A(N,IC,IC,0) 133 CONTINUE 130 CONTINUE C C Loop over rest of `hyperplane' sets C NB. No exception handling is necessary for the last row and the first C point of the second last row, since N < NPTS in the loop and for C those points LUDG(N,.) = N (=> no array index problems), C and the multiplicator of `non existing' array elements is zero. C DO 30 M = 2, LLSU(0) C C Compute x elements in this set CDIR$ IVDEP DO 150 IC = NPDE, 1, -1 DO 151 JC = NPDE, 1, -1 DO 40 L = LLSU(M-1)+1, LLSU(M) N = LSU(L) B(N,IC) = B(N,IC) - A(N,IC,JC,1)*B(N+1 ,JC) + - A(N,IC,JC,2)*B(LUDG(N,2),JC) + - A(N,IC,JC,3)*B(LUDG(N,3),JC) + - A(N,IC,JC,4)*B(LUDG(N,4),JC) + - A(N,IC,JC,5)*B(LUDG(N,5),JC) + - A(N,IC,JC,6)*B(LUDG(N,6),JC) + - A(N,IC,JC,7)*B(LUDG(N,7),JC) + - A(N,IC,JC,8)*B(LUDG(N,8),JC) + - A(N,IC,JC,9)*B(LUDG(N,9),JC) 40 CONTINUE 151 CONTINUE DO 152 JC = NPDE, IC+1, -1 CDIR$ IVDEP DO 51 L = LLSU(M-1)+1, LLSU(M) N = LSU(L) B(N,IC) = B(N,IC) - A(N,IC,JC,0)*B(N,JC) 51 CONTINUE 152 CONTINUE CDIR$ IVDEP DO 52 L = LLSU(M-1)+1, LLSU(M) N = LSU(L) B(N,IC) = B(N,IC) * A(N,IC,IC,0) 52 CONTINUE 150 CONTINUE C 30 CONTINUE C RETURN END SHAR_EOF fi # end of overwriting check if test -f 'user.f' then echo shar: will not over-write existing file "'user.f'" else cat << \SHAR_EOF > 'user.f' LOGICAL FUNCTION INIDOM (MAXPTS, + XL, YF, ZD, XR, YB, ZU, DX, DY, DZ, + LPLN, IPLN, LROW, IROW, ICOL, LLBND, ILBND, LBND) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER MAXPTS, LPLN(0:*), IPLN(*), LROW(*), IROW(*), ICOL(*), + LLBND(0:*), ILBND(*), LBND(*) REAL XL, YF, ZD, XR, YB, ZU, DX, DY, DZ C Ccc PURPOSE: C Define grid for initial rectangular-prism domain C ((XL,YF,ZD),(XR,YB,ZU)) in physical coordinates and C (( 0, 0, 0),(Nx,Ny,Nz)) in computational grid coordinates, C where Nx = (XR-XL)/DX, Ny = (YB-YF)/DY, and Nz = (ZU-ZD)/DZ. C Only real grid points are stored. C The coordinate values of the initial grid should be stored rowwise, C in LPLN, IPLN, LROW, IROW, ICOL. C Pointers to the boundary points should be stored in a list together C with the type of the boundary. (LLBND, ILBND, LBND) C C On exit INIDOM = .FALSE. if the # grid points required is larger C than MAXPTS and MAXPTS is set to the required # points. C Ccc PARAMETER DESCRIPTION: C MAXPTS : INOUT. C IN: Max. # grid points allowed by the available workspace C OUT: # grid points required, if larger than # points allowed C XL : IN. X-coordinate of left/front/down point of rectangular C prism C YF : IN. Y-coordinate of left/front/down point of rectangular C prism C ZD : IN. Z-coordinate of left/front/down point of rectangular C prism C XR : IN. X-coordinate of right/back/upper point of rectangular C prism C YB : IN. Y-coordinate of right/back/upper point of rectangular C prism C ZU : IN. Z-coordinate of right/back/upper point of rectangular C prism C DX : IN. Grid width in X-direction C DY : IN. Grid width in Y-direction C DZ : IN. Grid width in Z-direction C LPLN : OUT. (0:LPLN(0)+1) C LPLN(0) = NPLNS: Actual # planes in LROW C LPLN(1:NPLNS): pointers to the start of a plane in LROW C LPLN(NPLNS+1) = NROWS+1: Total # rows in grid + 1 C IPLN : OUT. (NPLNS) C IPLN(IP): plane number of plane IP in virtual box C LROW : OUT. (NROWS+1) C LROW(1:NROWS): pointers to the start of a row in the grid C LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 C IROW : OUT. (NROWS) C IROW(IR): row number of row IR in virtual box C ICOL : OUT. (NPTS) C ICOL(IPT): column number of grid point IPT in virtual box C LLBND : OUT. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : OUT. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : OUT. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C structure C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER NX, NY, NZ, I, IPT, IR, J, K, NPLNS, NROWS, NPTS, NBNDS, + NPTSPL NX = NINT((XR-XL)/DX) NY = NINT((YB-YF)/DY) NZ = NINT((ZU-ZD)/DZ) C Ccc Make initial grid NPLNS = NZ+1 NROWS = (NY+1)*NPLNS NPTS = (NX+1)*NROWS IF (MAXPTS .LT. NPTS) THEN INIDOM = .FALSE. MAXPTS = NPTS RETURN ELSE INIDOM = .TRUE. ENDIF C C Make grid structure LPLN(0) = NPLNS IPT = 1 IR = 1 DO 10 K = 0, NZ LPLN(K+1) = IR IPLN(K+1) = K DO 20 I = 0, NY LROW(IR) = IPT IROW(IR) = I IR = IR + 1 DO 30 J = 0, NX ICOL(IPT) = J IPT = IPT + 1 30 CONTINUE 20 CONTINUE 10 CONTINUE LROW(NROWS+1) = NPTS+1 LPLN(NPLNS+1) = NROWS+1 C C Boundaries NPTSPL = (NX+1)*(NY+1) NBNDS = 6 ILBND(1) = 1 ILBND(2) = 2 ILBND(3) = 3 ILBND(4) = 4 ILBND(5) = 5 ILBND(6) = 6 LLBND(0) = NBNDS LLBND(1) = 1 LLBND(2) = LLBND(1) + (NY+1)*(NZ+1) LLBND(3) = LLBND(2) + (NX+1)*(NY+1) LLBND(4) = LLBND(3) + (NY+1)*(NZ+1) LLBND(5) = LLBND(4) + (NX+1)*(NY+1) LLBND(6) = LLBND(5) + (NX+1)*(NZ+1) LLBND(7) = LLBND(6) + (NX+1)*(NZ+1) C Left and right boundary plane pointers DO 100 K = 0, NZ DO 110 I = 0, NY LBND(LLBND(1)+K*(NY+1)+I) = K*NPTSPL + I*(NX+1) + 1 LBND(LLBND(3)+K*(NY+1)+I) = (K+1)*NPTSPL - I*(NX+1) 110 CONTINUE 100 CONTINUE C Down and up boundary plane pointers DO 120 I = 0, NY DO 130 J = 0, NX LBND(LLBND(2)+I*(NX+1)+J) = I*(NX+1) + J + 1 LBND(LLBND(4)+I*(NX+1)+J) = NPTS - (I*(NX+1)+J) 130 CONTINUE 120 CONTINUE C Front and back boundary plane pointers DO 140 K = 0, NZ DO 150 J = 0, NX LBND(LLBND(5)+K*(NX+1)+J) = K*NPTSPL + J + 1 LBND(LLBND(6)+K*(NX+1)+J) = NPTS - (K*NPTSPL+J) 150 CONTINUE 140 CONTINUE C RETURN END SUBROUTINE DERIVF (F, T, X, Y, Z, NPTS, NPDE, U, + A0, DT, DX, DY, DZ, + LLBND, ILBND, LBND, UIB, UT, UX, UY, UZ, UXX, UYY, UZZ, + UXY, UXZ, UYZ, ABSTOL, DEL, WORK, + FU, FUX, FUY, FUZ, FUXX, FUYY, FUZZ, FUXY, FUXZ, FUYZ) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE, LLBND(0:*), ILBND(*), LBND(*) REAL F(NPTS*NPDE), T, X(*), Y(*), Z(*), U(*), A0, DT, DX, DY, DZ, + UIB(*), UT(*), UX(*), UY(*), UZ(*), UXX(*), UYY(*), UZZ(*), + UXY(*), UXZ(*), UYZ(*), + ABSTOL(*), DEL(NPTS), WORK(2*NPTS*NPDE), + FU(NPTS*NPDE,NPDE), + FUX(NPTS*NPDE,NPDE), FUY(NPTS*NPDE,NPDE), FUZ(NPTS*NPDE,NPDE), + FUXX(NPTS*NPDE,NPDE),FUYY(NPTS*NPDE,NPDE),FUZZ(NPTS*NPDE,NPDE), + FUXY(NPTS*NPDE,NPDE),FUXZ(NPTS*NPDE,NPDE),FUYZ(NPTS*NPDE,NPDE) C Ccc PURPOSE: C Compute derivatives of residual wrt (derivatives of) U by numerical C differencing C C PARAMETER DESCRIPTION: C F : IN. Residual F(t,U,Ut) C T : IN. Current time C X,Y,Z : IN. Physical coordinates of gridpoints C NPTS : IN. # grid points C NPDE : IN. # PDE components C U : IN. Solution at T on current grid C A0 : IN. Coefficient of U_n+1 in time derivative C DT : IN. Current time step size C DX : IN. Cell width in X-direction for current grid C DY : IN. Cell width in Y-direction for current grid C DZ : IN. Cell width in Z-direction for current grid C LLBND : IN. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C UIB : IN. Solution at T on internal boundaries C UT : IN. Time derivative of U on current grid C UX : IN. -I C UY : IN. I C UZ : IN. I C UXX : IN. I C UYY : IN. I Space derivatives of U on current grid C UZZ : IN. I C UXY : IN. I C UXZ : IN. I C UYZ : IN. -I C ABSTOL : IN. Absolute tolerance for Newton process C DEL : WORK. (NPTS) C WORK : WORK. (2.LENU) C FU : OUT. dF(U,Ut)dU C FUX : OUT. dF(Ux)dUx C FUY : OUT. dF(Uy)dUy C FUZ : OUT. dF(Uz)dUz C FUXX : OUT. dF(Uxx)dUxx C FUYY : OUT. dF(Uyy)dUyy C FUZZ : OUT. dF(Uzz)dUzz C FUXY : OUT. dF(Uxy)dUxy C FUXZ : OUT. dF(Uxz)dUxz C FUYZ : OUT. dF(Uyz)dUyz C Ccc EXTERNALS USED: EXTERNAL PERTRB, PRTRBU, RES C C----------------------------------------------------------------------- C INTEGER I, IC, ICPTB, IPT, LUTBAR REAL FACX, FACY, FACZ, FACXX, FACYY, FACZZ, FACXY, FACXZ, FACYZ, + TOL LUTBAR = 1 + NPTS*NPDE C Ccc How to decide if derivatives are `zero'? C Take `zero'-value of U divided by the grid width FACX = 1/(2*DX) FACY = 1/(2*DY) FACZ = 1/(2*DZ) FACXX = 1/DX**2 FACYY = 1/DY**2 FACZZ = 1/DZ**2 FACXY = 1/(2*DX*2*DY) FACXZ = 1/(2*DX*2*DZ) FACYZ = 1/(2*DY*2*DZ) C Ccc Loop over the components of the (derivatives of) U DO 10 ICPTB = 1, NPDE C C dF(U,Ut)/dU TOL = ABSTOL(ICPTB) CALL PRTRBU (ICPTB, NPTS, NPDE, U, A0, DT, UT, TOL, DEL, + WORK, WORK(LUTBAR)) CALL RES (T, X, Y, Z, NPTS, NPDE, WORK, + LLBND, ILBND, LBND, UIB, + WORK(LUTBAR), UX, UY, UZ, + UXX, UYY, UZZ, UXY, UXZ, UYZ, FU(1,ICPTB)) DO 20 IC = 1, NPDE DO 20 IPT = 1, NPTS I = IPT + (IC-1)*NPTS FU(I,ICPTB) = (FU(I,ICPTB) - F(I)) / DEL(IPT) 20 CONTINUE C C dF(Ux)/dUx TOL = ABSTOL(ICPTB)*FACX CALL PERTRB (ICPTB, NPTS, NPDE, UX, TOL, DEL, WORK) CALL RES (T, X, Y, Z, NPTS, NPDE, U, + LLBND, ILBND, LBND, UIB, + UT, WORK, UY, UZ, + UXX, UYY, UZZ, UXY, UXZ, UYZ, FUX(1,ICPTB)) DO 40 IC = 1, NPDE DO 40 IPT = 1, NPTS I = IPT + (IC-1)*NPTS FUX(I,ICPTB) = (FUX(I,ICPTB) - F(I)) / DEL(IPT) 40 CONTINUE C C dF(Uy)/dUy TOL = ABSTOL(ICPTB)*FACY CALL PERTRB (ICPTB, NPTS, NPDE, UY, TOL, DEL, WORK) CALL RES (T, X, Y, Z, NPTS, NPDE, U, + LLBND, ILBND, LBND, UIB, + UT, UX, WORK, UZ, + UXX, UYY, UZZ, UXY, UXZ, UYZ, FUY(1,ICPTB)) DO 50 IC = 1, NPDE DO 50 IPT = 1, NPTS I = IPT + (IC-1)*NPTS FUY(I,ICPTB) = (FUY(I,ICPTB) - F(I)) / DEL(IPT) 50 CONTINUE C C dF(Uz)/dUz TOL = ABSTOL(ICPTB)*FACZ CALL PERTRB (ICPTB, NPTS, NPDE, UZ, TOL, DEL, WORK) CALL RES (T, X, Y, Z, NPTS, NPDE, U, + LLBND, ILBND, LBND, UIB, + UT, UX, UY, WORK, + UXX, UYY, UZZ, UXY, UXZ, UYZ, FUZ(1,ICPTB)) DO 60 IC = 1, NPDE DO 60 IPT = 1, NPTS I = IPT + (IC-1)*NPTS FUZ(I,ICPTB) = (FUZ(I,ICPTB) - F(I)) / DEL(IPT) 60 CONTINUE C C dF(Uxx)/dUxx TOL = ABSTOL(ICPTB)*FACXX CALL PERTRB (ICPTB, NPTS, NPDE, UXX, TOL, DEL, WORK) CALL RES (T, X, Y, Z, NPTS, NPDE, U, + LLBND, ILBND, LBND, UIB, + UT, UX, UY, UZ, + WORK, UYY, UZZ, UXY, UXZ, UYZ, FUXX(1,ICPTB)) DO 70 IC = 1, NPDE DO 70 IPT = 1, NPTS I = IPT + (IC-1)*NPTS FUXX(I,ICPTB) = (FUXX(I,ICPTB) - F(I)) / DEL(IPT) 70 CONTINUE C C dF(Uyy)/dUyy TOL = ABSTOL(ICPTB)*FACYY CALL PERTRB (ICPTB, NPTS, NPDE, UYY, TOL, DEL, WORK) CALL RES (T, X, Y, Z, NPTS, NPDE, U, + LLBND, ILBND, LBND, UIB, + UT, UX, UY, UZ, + UXX, WORK, UZZ, UXY, UXZ, UYZ, FUYY(1,ICPTB)) DO 80 IC = 1, NPDE DO 80 IPT = 1, NPTS I = IPT + (IC-1)*NPTS FUYY(I,ICPTB) = (FUYY(I,ICPTB) - F(I)) / DEL(IPT) 80 CONTINUE C C dF(Uzz)/dUzz TOL = ABSTOL(ICPTB)*FACZZ CALL PERTRB (ICPTB, NPTS, NPDE, UZZ, TOL, DEL, WORK) CALL RES (T, X, Y, Z, NPTS, NPDE, U, + LLBND, ILBND, LBND, UIB, + UT, UX, UY, UZ, + UXX, UYY, WORK, UXY, UXZ, UYZ, FUZZ(1,ICPTB)) DO 90 IC = 1, NPDE DO 90 IPT = 1, NPTS I = IPT + (IC-1)*NPTS FUZZ(I,ICPTB) = (FUZZ(I,ICPTB) - F(I)) / DEL(IPT) 90 CONTINUE C C dF(Uxy)/dUxy TOL = ABSTOL(ICPTB)*FACXY CALL PERTRB (ICPTB, NPTS, NPDE, UXY, TOL, DEL, WORK) CALL RES (T, X, Y, Z, NPTS, NPDE, U, + LLBND, ILBND, LBND, UIB, + UT, UX, UY, UZ, + UXX, UYY, UZZ, WORK, UXZ, UYZ, FUXY(1,ICPTB)) DO 100 IC = 1, NPDE DO 100 IPT = 1, NPTS I = IPT + (IC-1)*NPTS FUXY(I,ICPTB) = (FUXY(I,ICPTB) - F(I)) / DEL(IPT) 100 CONTINUE C C dF(Uxz)/dUxz TOL = ABSTOL(ICPTB)*FACXZ CALL PERTRB (ICPTB, NPTS, NPDE, UXZ, TOL, DEL, WORK) CALL RES (T, X, Y, Z, NPTS, NPDE, U, + LLBND, ILBND, LBND, UIB, + UT, UX, UY, UZ, + UXX, UYY, UZZ, UXY, WORK, UYZ, FUXZ(1,ICPTB)) DO 110 IC = 1, NPDE DO 110 IPT = 1, NPTS I = IPT + (IC-1)*NPTS FUXZ(I,ICPTB) = (FUXZ(I,ICPTB) - F(I)) / DEL(IPT) 110 CONTINUE C C dF(Uyz)/dUyz TOL = ABSTOL(ICPTB)*FACYZ CALL PERTRB (ICPTB, NPTS, NPDE, UYZ, TOL, DEL, WORK) CALL RES (T, X, Y, Z, NPTS, NPDE, U, + LLBND, ILBND, LBND, UIB, + UT, UX, UY, UZ, + UXX, UYY, UZZ, UXY, UXZ, WORK, FUYZ(1,ICPTB)) DO 120 IC = 1, NPDE DO 120 IPT = 1, NPTS I = IPT + (IC-1)*NPTS FUYZ(I,ICPTB) = (FUYZ(I,ICPTB) - F(I)) / DEL(IPT) 120 CONTINUE 10 CONTINUE RETURN END SUBROUTINE MONITR (T, DT, DTNEW, XL, YF, ZD, DXB, DYB, DZB, + LGRID, ISTRUC, LSOL, SOL) INTEGER LGRID(0:*), ISTRUC(*), LSOL(*) REAL T, DT, DTNEW, XL, YF, ZD, DXB, DYB, DZB, SOL(*) RETURN END SUBROUTINE CHSPCM (T, LEVEL, NPTS, X, Y, Z, NPDE, U, SPCMON, TOL) INTEGER LEVEL, NPTS, NPDE REAL T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE), SPCMON(NPTS), TOL RETURN END SHAR_EOF fi # end of overwriting check if test -f 'src.f' then echo shar: will not over-write existing file "'src.f'" else cat << \SHAR_EOF > 'src.f' SUBROUTINE VLUGR3 (NPDE, T, TOUT, DT, + XL,YF,ZD, XR,YB,ZU, DX, DY, DZ, + TOLS, TOLT, INFO, RINFO, RWK, LENRWK, IWK, LENIWK, LWK, LENLWK, + MNTR) C C======================================================================= C Ccc PURPOSE: C========== C This code solves systems of PDEs of the type C F(t,x,y,z,U,Ut,Ux,Uy,Uz,Uxx,Uyy,Uzz,Uxy,Uxz,Uyz)=0 C with boundary conditions C B(t,x,y,z,U,Ut,Ux,Uy,Uz)=0 C and initial values C U(t0,x,y,z)=U0 C on a 3D domain bounded by right-angled polyhedrons. C C In space Local Uniform Grid Refinement is applied to resolve local C sharp gradients in the solution. For the time integration the C implicit BDF2 method is used with variable stepsizes. C Although time-independent and hyperbolic PDEs fit into the problem C class, it should be observed that VLUGR3 is tuned for time-dependent C parabolic PDEs (see below `HOW TO REPLACE MODULES' and the part on C INCLUDEd files for the (non)linear solvers). C C C Ccc PARAMETER SPECIFICATION: C========================== INTEGER LENIWK INTEGER NPDE, INFO(*), LENRWK, IWK(LENIWK), LENLWK, MNTR LOGICAL LWK(LENLWK) REAL T, TOUT, DT, + XL,YF,ZD, XR,YB,ZU, DX, DY, DZ, + TOLS, TOLT, RINFO(*), RWK(LENRWK) C Ccc LANGUAGE: FORTRAN 77 C=========== C Ccc TYPE: Single precision C======= C Ccc REFERENCE: C============ C VLUGR3: A Vectorizable Adaptive Grid Solver for PDEs in 3D C Part I. Algorithmic Aspects and Applications C J.G. Blom and J.G. Verwer, Applied Numerical Mathematics, Vol.16 C pp.129-156 (1994). C C VLUGR3: A Vectorizable Adaptive Grid Solver for PDEs in 3D C Part II. Code Description C J.G. Blom and J.G. Verwer, Report NM-R9405, CWI, Amsterdam. C (to appear in ACM TOMS) C C C Ccc PARAMETER DESCRIPTION: C======================== C NPDE : IN. # PDE components. C T : INOUT. Current value of time variable C IN: If this is the first call the initial time C OUT: Time to which PDE has been integrated C TOUT : IN. Time point at which solution is desired C DT : INOUT. C IN: If this is the first call the initial time stepsize C OUT: Stepsize for next time step C XL : IN. If this is the first call and INFO(3) = 0 C X-coordinate of left/front/down point of rectangular C prism C YF : IN. If this is the first call and INFO(3) = 0 C Y-coordinate of left/front/down point of rectangular C prism C ZD : IN. If this is the first call and INFO(3) = 0 C Z-coordinate of left/front/down point of rectangular C prism C XR : IN. If this is the first call and INFO(3) = 0 C X-coordinate of right/back/upper point of rectangular C prism C YB : IN. If this is the first call and INFO(3) = 0 C Y-coordinate of right/back/upper point of rectangular C prism C ZU : IN. If this is the first call and INFO(3) = 0 C Z-coordinate of right/back/upper point of rectangular C prism C DX : IN. If this is the first call and INFO(3) = 0 C Cell width in X-direction of base grid C DY : IN. If this is the first call and INFO(3) = 0 C Cell width in Y-direction of base grid C DZ : IN. If this is the first call and INFO(3) = 0 C Cell width in Z-direction of base grid C TOLS : IN. Space tolerance C TOLT : IN. Time tolerance C INFO : IN. If INFO(1)=0, default parameters are used, otherwise C RINFO : IN. they should be specified in INFO and RINFO array C (for description see below) C RWK : WORK. (LENRWK) C LENRWK : IN. Dimension of RWK. (6.NPDE for VLUGR3)+: C Let NPTS be the max. # points on a grid level and C NPTSA the average # points over all grid levels. C Then LENRWK should be: C MAXLEV=1: 3.NPTS.NPDE+3.NPTS+13.NPTS.NPDE + LSSWRK C LSSWRK: C ( INFO(4)=0 C | 38.NPDE.NPTS.NPDE C !:INFO(4)=10 C | (MAX(NPDE.7+3,2.MAXLR+MAXL+6)+NPDE).NPTS.NPDE+ C MAXLR*MAXLR+(MAXL+3).MAXL+1 C !:INFO(4)=11 C | (MAX(NPDE.4+3,2.MAXLR+MAXL+6)+NPDE).NPTS.NPDE+ C MAXLR*MAXLR+(MAXL+3).MAXL+1 C !:INFO(4)=12 C | (2.MAXLR+MAXL+7).NPTS.NPDE+ C MAXLR*MAXLR+(MAXL+3).MAXL+1 C !:INFO(4)=13 C | (2.MAXLR+MAXL+7).NPTS.NPDE+ C MAXLR*MAXLR+(MAXL+3).MAXL+1 C ) C (default: MAXLR = 5, MAXL = 20) C Indication of the length for a maximum grid level C MAXLEV (default value MAXLEV=3): C 5.NPTSA.NPDE.MAXLEV+(3+13.NPDE).NPTS + LSSWRK C IWK : WORK. (LENIWK) C LENIWK : IN. Dimension of IWK. (8.MAXLEV+3 for VLUGR3)+: C MAXLEV=1: 28.NPTS C Indication of the length for a maximum grid level MAXLEV, C 7.NPTSA.MAXLEV+7.NPTS + ( INFO(4)=0| 19.NPTS ) C LWK : WORK. (LENLWK) C LENLWK : IN. Dimension of LWK. Indication of the length C 2.NPTS C MNTR : INOUT. Monitor of VLUGR3 C IN: State of integration C 0. First call C 1. Continuation call C OUT: Error return flag C 1. OK C -1. Workspace too small C -2. Time step size too small C -10. COMMON to keep the statistics is too small C C C Ccc HOW TO USE: Default case C=========================== C C 3 problem defining routines should be specified C C----------------------------------------------------------------------- C C SUBROUTINE PDEIV (T, X, Y, Z, U, NPTS, NPDE) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: C INTEGER NPTS, NPDE C REAL T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE) C Ccc PURPOSE: C Define (initial) solution of PDE. C Ccc PARAMETER DESCRIPTION: C T : IN. Time at which (initial) solution should be given C X,Y,Z : IN. Arrays of physical coordinates for the gridpoints C U : OUT. Array of PDE component values for the gridpoints. C NPTS : IN. Number of gridpoints C NPDE : IN. # PDE components C C----------------------------------------------------------------------- C C SUBROUTINE PDEF (T, X, Y, Z, U, C + UT, UX, UY, UZ, UXX, UYY, UZZ, UXY, UXZ, UYZ, RES, NPTS, NPDE) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: C INTEGER NPTS, NPDE C REAL T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE), C + UT(NPTS,NPDE), UX(NPTS,NPDE), UY(NPTS,NPDE), UZ(NPTS,NPDE), C + UXX(NPTS,NPDE), UYY(NPTS,NPDE), UZZ(NPTS,NPDE), C + UXY(NPTS,NPDE), UXZ(NPTS,NPDE), UYZ(NPTS,NPDE), C + RES(NPTS,NPDE) C Ccc PURPOSE: C Define residual of PDE on interior of domain. Boundary values will be C overwritten later on. C Ccc PARAMETER DESCRIPTION: C T : IN. Time at which residual should be evaluated C X,Y,Z : IN. Physical coordinates of gridpoints C U : IN. Array of PDE components for the gridpoints. C UT : IN. Array of time derivative of PDE components C UX : IN. -I C UY : IN. I C UZ : IN. I C UXX : IN. I C UYY : IN. I Space derivatives of U on current grid C UZZ : IN. I C UXY : IN. I C UXZ : IN. I C UYZ : IN. -I C RES : OUT. Array containg PDE residual at gridpoints in interior of C domain. The residual values at boundary points will be C overwritten by a call to PDEBC. C NPTS : IN. Number of gridpoints C NPDE : IN. Number of PDE components C C----------------------------------------------------------------------- C C SUBROUTINE PDEBC (T, X, Y, Z, U, UT, UX, UY, UZ, RES, NPTS, NPDE, C + LLBND, ILBND, LBND) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: C INTEGER NPTS, NPDE, LLBND(0:*), ILBND(*), LBND(*) C REAL T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE), C + UT(NPTS,NPDE), UX(NPTS,NPDE), UY(NPTS,NPDE), UZ(NPTS,NPDE), C + RES(NPTS,NPDE) C Ccc PURPOSE: C Define residual of boundary equations of PDE. The residual on interior C points has already been stored in RES. C Ccc PARAMETER DESCRIPTION: C T : IN. Time at which BC's should be evaluated C X,Y,Z : IN. Physical coordinates of gridpoints C U : IN. Array of PDE components for the gridpoints. C UT : IN. Array of time derivative of PDE components C UX : IN. -I C UY : IN. I Arrays containing space derivatives of PDE components C UZ : IN. -I C RES : INOUT. C IN: PDE residual for interior points (set by PDEF) C OUT: Array with PDE residual at physical boundary points C inserted C NPTS : IN. Number of grid components C NPDE : IN. Number of PDE components C LLBND : (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical horizontal planes in C actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBDPTS) C LBND(LB): pointer to boundary point in actual grid C structure (as in X, Y, Z, and U) C C----------------------------------------------------------------------- C C C Ccc HOW TO USE: Extra's C====================== C C If INFO(1) <> 0 a number of parameters can be specified in INFO and C RINFO that are described below. The parenthesized value is the C default value. C C INFO(2) : MAXLEV (3) C maximum # grid levels allowed C INFO(3) : RCTDOM (0) C If RCTDOM=0 the initial domain is a rectangular C prism otherwise the user should specify a subroutine C INIDOM to define the initial grid (see below) C INFO(4) : LINSYS (0) C Linear system solver in use C 0: BiCGStab + ILU C 10: GCRO + Block-diagonal preconditioning C 11: GCRO + Block-diagonal preconditioning C (neglecting first-order derivatives C at the boundaries) C 12: GCRO + Diagonal preconditioning C 13: GCRO + Diagonal preconditioning C (neglecting first-order derivatives C at the boundaries) C NB. 10-13 are matrix-free solvers C INFO(5) : LUNPDS (0) C Logical Unit # of file for information on the C integration history. If 0, only global information C will be written on standard output. C INFO(6) : LUNNLS (0) C Logical Unit # of file for information on the C Newton process. If 0, no information will be C written. C INFO(7) : LUNLSS (0) C Logical Unit # of file for information on the C linear system solver. If 0, no information will be C written. C C RINFO(1) : DTMIN (0.0) C minimum time stepsize allowed C RINFO(2) : DTMAX (TOUT-T) C maximum time stepsize allowed C RINFO(3) : UMAX ((1.0)) C approx. max. value of the PDE solution components. C Used for scaling purposes C RINFO(3+NPDE) : SPCWGT ((1.0)) C weighting factor used in the space monitor to C indicate the relative importance of a PDE C component on the space monitor C RINFO(3+2.NPDE) : TIMWGT ((1.0)) C weighting factor used in the time monitor to C indicate the relative importance of a PDE C component on the time monitor C C C C After each successful time step a subroutine MONITR is called. C Default is an empty body, but it can be overloaded with C----------------------------------------------------------------------- C C SUBROUTINE MONITR (T, DT, DTNEW, XL, YL, ZD, DXB, DYB, DZB, C + LGRID, ISTRUC, LSOL, SOL) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: C INTEGER LGRID(0:*), ISTRUC(*), LSOL(*) C REAL T, DT, DTNEW, XL, YL, ZD, DXB, DYB, DZB, SOL(*) C Ccc PURPOSE: C Control after a successful time step. The solution can be printed, C plotted or compared with the exact solution. C Ccc PARAMETER DESCRIPTION: C T : IN. Current value of time variable C DT : IN. Current time step size C DTNEW : IN. Time step size for next time step C XL : IN. X-coordinate of left/front/down point of (virtual) box C YF : IN. Y-coordinate of left/front/down point of (virtual) box C ZD : IN. Z-coordinate of left/front/down point of (virtual) box C DXB : IN. Cell width in X-direction of base grid C DYB : IN. Cell width in Y-direction of base grid C DZB : IN. Cell width in Z-direction of base grid C LGRID : IN. (0:*) C LGRID(0) = max. grid level used at T C LGRID(1): pointer to base grid structure ISTRUC C LGRID(LEVEL): pointer to grid structure C (LPLN,IPLN,LROW,IROW,ICOL) of refinement C level LEVEL for time T C ISTRUC : IN. (*) C ISTRUC(LGRID(LEVEL):.) contains (LPLN,IPLN,LROW,IROW,ICOL) C of grid level LEVEL, C LPLN : (0:LPLN(0)+1) C LPLN(0) = NPLNS: Actual # horizontal planes in LROW C LPLN(1:NPLNS): pointers to the start of a plane in LROW C LPLN(NPLNS+1) = NROWS+1: Total # rows in grid + 1 C IPLN : (NPLNS) C IPLN(IP): plane number of plane IP in virtual box C LROW : (NROWS+1) C LROW(1:NROWS): pointers to the start of a row in the grid C LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 C IROW : (NROWS) C IROW(IR): row number of row IR in virtual box C ICOL : (NPTS) C ICOL(IPT): column number of grid point IPT in virtual box C LSOL : IN. (*) C LSOL(LEVEL): pointer to (injected) solution at grid C of refinement level LEVEL for time T C SOL : IN. (*) C SOL(LSOL(LEVEL)+1:LSOL(LEVEL)+NPTS(LEVEL)*NPDE) contains C U_LEVEL(NPTS,NPDE) C C----------------------------------------------------------------------- C C C C To force grid refinement at a specific point in space and time and C on a specific level, one can overload the routine CHSPCM with C C----------------------------------------------------------------------- C C SUBROUTINE CHSPCM (T, LEVEL, NPTS, X, Y, Z, NPDE, U, SPCMON, TOL) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: C INTEGER LEVEL, NPTS, NPDE C REAL T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE), SPCMON(NPTS), TOL C Ccc PURPOSE: C Force grid refinement. C If for a node IPT SPCMON(IPT) > TOL the 64 surrounding cells will be C refined. C Ccc PARAMETER DESCRIPTION: C T : IN. Current value of time variable C LEVEL : IN. Current grid level C NPTS : IN. Number of grid points at this level C X,Y,Z : IN. Arrays of physical coordinates for the gridpoints C NPDE : IN. Number of PDE components C U : IN. Array of PDE components for the gridpoints C SPCMON : INOUT. C IN: Space monitor values as determined by VLUGR3 C OUT: Changed to a value > TOL where refinement is required C TOL : IN. Tolerance with which SPCMON will be compared C C----------------------------------------------------------------------- C C C C If the initial domain is not a rectangular prism one should specify C the initial grid via the function INIDOM C C----------------------------------------------------------------------- C C LOGICAL FUNCTION INIDOM (MAXPTS, C + XL, YF, ZD, XR, YB, ZU, DX, DY, DZ, C + LPLN, IPLN, LROW, IROW, ICOL, LLBND, ILBND, LBND) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: C INTEGER MAXPTS, LPLN(0:*), IPLN(*), LROW(*), IROW(*), ICOL(*), C + LLBND(0:*), ILBND(*), LBND(*) C REAL XL, YF, ZD, XR, YB, ZU, DX, DY, DZ C Ccc PURPOSE: C Define initial domain. NB. Boundaries should consist of as many points C as are necessary to employ second-order space discretization, i.e., C a boundary enclosing the internal part of the domain should not C include less than 3 grid points in any coordinate direction including C the corners. If Neumann boundaries are used the minimum is 4 since C otherwise the Jacobian matrix will be singular. C C A (virtual) box is placed around the (irregular) domain. C The left/front/down point of this box is (XL,YF,ZD) in physical C coordinates and (0,0,0) in column, row, plane coordinates, resp.. C The right/back/upper point is (XR,YB,ZU) resp. (Nx,Ny,Nz), where C Nx = (XR-XL)/DX, Ny = (YB-YF)/DY, and Nz = (ZU-ZD)/DZ. C Only real grid points are stored. C The coordinate values of the initial grid should be stored plane C after plane and rowwise in LPLN, IPLN, LROW, IROW, ICOL. C Pointers to the boundary points should be stored in a list together C with the type of the boundary. (LLBND, ILBND, LBND) C C On exit INIDOM = .FALSE. if the # grid points required is larger C than MAXPTS and MAXPTS is set to the required # points. C Ccc PARAMETER DESCRIPTION: C MAXPTS : INOUT. C IN: Max. # grid points allowed by the available workspace C OUT: # grid points required, if larger than # points allowed C XL : OUT. X-coordinate of left/front/down point of virtual box C YF : OUT. Y-coordinate of left/front/down point of virtual box C ZD : OUT. Z-coordinate of left/front/down point of virtual box C XR : OUT. X-coordinate of right/back/upper point of virtual box C YB : OUT. Y-coordinate of right/back/upper point of virtual box C ZU : OUT. Z-coordinate of right/back/upper point of virtual box C DX : OUT. Grid width in X-direction C DY : OUT. Grid width in Y-direction C DZ : OUT. Grid width in Z-direction C LPLN : OUT. (0:LPLN(0)+1) C LPLN(0) = NPLNS: Actual # horizontal planes in LROW C LPLN(1:NPLNS): pointers to the start of a plane in LROW C LPLN(NPLNS+1) = NROWS+1: Total # rows in grid + 1 C IPLN : OUT. (NPLNS) C IPLN(IP): plane number of plane IP in virtual box C LROW : OUT. (NROWS+1) C LROW(1:NROWS): pointers to the start of a row in the grid C LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 C IROW : OUT. (NROWS) C IROW(IR): row number of row IR in virtual box C ICOL : OUT. (NPTS) C ICOL(IPT): column number of grid point IPT in virtual box C LLBND : OUT. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : OUT. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C structure C C----------------------------------------------------------------------- C C C C To store the exact partial derivatives of the residual F with respect C to (the derivatives of) U. C C----------------------------------------------------------------------- C C SUBROUTINE DERIVF (F, T, X, Y, Z, NPTS, NPDE, U, C + A0, DT, DX, DY, DZ, C + LLBND, ILBND, LBND, UIB, UT, UX, UY, UZ, UXX, UYY, UZZ, C + UXY, UXZ, UYZ, ATOL, DEL, WORK, C + FU, FUX, FUY, FUZ, FUXX, FUYY, FUZZ, FUXY, FUXZ, FUYZ) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: C INTEGER NPTS, NPDE, LLBND(0:*), ILBND(*), LBND(*) C REAL F(NPTS,NPDE), T, X(NPTS), Y(NPTS), Z(NPTS), U(NPTS,NPDE), C + A0, DT, DX, DY, DZ, UIB(*), C + UT(NPTS,NPDE), UX(NPTS,NPDE), UY(NPTS,NPDE), UZ(NPTS,NPDE), C + UXX(NPTS,NPDE), UYY(NPTS,NPDE), UZZ(NPTS,NPDE), C + UXY(NPTS,NPDE), UXZ(NPTS,NPDE), UYZ(NPTS,NPDE), C + ATOL(NPDE), DEL(NPTS), WORK(2*NPTS*NPDE), C + FUX(NPTS,NPDE,NPDE), FUY(NPTS,NPDE,NPDE), FUZ(NPTS,NPDE,NPDE), C + FUXX(NPTS,NPDE,NPDE),FUYY(NPTS,NPDE,NPDE),FUZZ(NPTS,NPDE,NPDE), C + FUXY(NPTS,NPDE,NPDE),FUXZ(NPTS,NPDE,NPDE),FUYZ(NPTS,NPDE,NPDE) C Ccc PURPOSE: C Compute derivatives of residual wrt (derivatives of) U C C PARAMETER DESCRIPTION: C F : IN. Residual F(t,U,Ut) C T : IN. Current time C X,Y,Z : IN. Physical coordinates of gridpoints C NPTS : IN. # grid points C NPDE : IN. # PDE components C U : IN. Solution at T on current grid C A0 : IN. Coefficient of U_n+1 in time derivative C DT : IN. Current time step size C DX : IN. Cell width in X-direction for current grid C DY : IN. Cell width in Y-direction for current grid C DZ : IN. Cell width in Z-direction for current grid C LLBND : IN. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C UIB : IN. Solution at T on internal boundaries C UT : IN. Time derivative of U on current grid C UX : IN. -I C UY : IN. I C UZ : IN. I C UXX : IN. I C UYY : IN. I Space derivatives of U on current grid C UZZ : IN. I C UXY : IN. I C UXZ : IN. I C UYZ : IN. -I C ATOL : IN. Absolute tolerance for Newton process C DEL : WORK. (NPTS) C WORK : WORK. (2.NPTS.NPDE) C FU : OUT. dF(U,Ut)dU C FUX : OUT. dF(Ux)dUx C FUY : OUT. dF(Uy)dUy C FUZ : OUT. dF(Uz)dUz C FUXX : OUT. dF(Uxx)dUxx C FUYY : OUT. dF(Uyy)dUyy C FUZZ : OUT. dF(Uzz)dUzz C FUXY : OUT. dF(Uxy)dUxy C FUXZ : OUT. dF(Uxz)dUxz C FUYZ : OUT. dF(Uyz)dUyz C C----------------------------------------------------------------------- C C C Ccc `HANDY' ROUTINES: C=================== C C VLUGR3 contains some routines that facilitate the use of the C data structure. C C C C To make a printout of the domain one has defined with INIDOM one C can call PRDOM C C----------------------------------------------------------------------- C C SUBROUTINE PRDOM (LPLN, IPLN, LROW, IROW, ICOL, C + LLBND, ILBND, LBND, IDOM, NX, NY, NZ) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: C INTEGER LPLN(0:*), IPLN(*), LROW(*), IROW(*), ICOL(*), C + LLBND(0:*), ILBND(*), LBND(*), IDOM(0:*), NX, NY, NZ C Ccc PURPOSE: C Print domain plane-wise. Internal points are .., external points XX, C physical plane-boundary points their ILBND value. Edges are given C both ILBND values, corners an explicated 2-character value, and C internal boundary values II. C Ccc PARAMETER DESCRIPTION: C See INIDOM C C----------------------------------------------------------------------- C C C C To get the X-,Y- and Z-coordinates corresponding with the grid points C C----------------------------------------------------------------------- C C SUBROUTINE SETXYZ (XL, YF, ZD, DX, DY, DZ, C + LPLN, IPLN, LROW, IROW, ICOL, X, Y, Z) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: C INTEGER LPLN(0:*), IPLN(*), LROW(*), IROW(*), ICOL(*) C REAL XL, YF, ZD, DX, DY, DZ, X(*), Y(*), Z(*) C Ccc PURPOSE: C Store X-, Y- and Z-coordinates of the grid points. C Ccc PARAMETER DESCRIPTION: C See MONITR. C NB. DX = DXB.2^(1-LEVEL); the same for DY and DZ. C C----------------------------------------------------------------------- C C C C To print the solution and the corresponding coordinate values at all C grid levels C C----------------------------------------------------------------------- C C SUBROUTINE PRSOL (LUN, T, NPDE, XL, YF, ZD, DXB, DYB, DZB, C + LGRID, ISTRUC, LSOL, SOL) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: C INTEGER LUN, NPDE, LGRID(0:*), ISTRUC(*), LSOL(*) C REAL T, XL, YF, ZD, DXB, DYB, DZB, SOL(*) C Ccc PURPOSE: C Print solution and coordinate values at all grid levels. C Ccc PARAMETER DESCRIPTION: C LUN : IN. Logical unit number of print file C NPDE : IN. # PDE components C Others see MONITR. C C----------------------------------------------------------------------- C C C C To write to file the (interpolated) solution values on a uniform grid C of a specified grid level and the maximum grid level used in each C point C C----------------------------------------------------------------------- C C SUBROUTINE WRUNI (LUNS, LUNG, UNILEV, C + T, NPDE, XL, YF, ZD, DXB, DYB, DZB, NXB, NYB, NZB, C + LGRID, ISTRUC, LSOL, SOL, UNIFRM, NX, NY, NZ) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: C INTEGER LUNS, LUNG, UNILEV, C + NPDE, NXB, NYB, NZB, LGRID(0:*), ISTRUC(*), LSOL(*), NX, NY, NZ C REAL T, XL, YF, ZD, DXB, DYB, DZB, SOL(*), C + UNIFRM(0:NX,0:NY,0:NZ,NPDE) C Ccc PURPOSE: C Write (interpolated) solution values at grid level UNILEV to file C LUNS. C Write maximum gridlevel used in each point to file LUNG. C NB. The data will not be correct for a domain with holes in it with C a size of the width of the base grid. C Ccc PARAMETER DESCRIPTION: C LUNS : IN. Logical unit number of solution file C LUNG : IN. Logical unit number of grid level file C UNILEV : IN. Maximum grid level to be used to generate the data C NPDE : IN. # PDE components C NXB,NYB,NZB: IN. # gridcells in X-, Y- and Z-direction, resp., on grid C of base level C UNIFRM : WORK. (Interpolated) solution on level UNILEV / max. grid C level used. C NX,NY,NZ: IN. # gridcells in X-, Y- and Z-direction, resp., on grid C of level UNILEV C Others see MONITR. C C----------------------------------------------------------------------- C C C C To dump all necessary information for a restart on file. C C----------------------------------------------------------------------- C C SUBROUTINE DUMP (LUNDMP, RWK, IWK) C C----------------------------------------------------------------------- C C C C C To read all necessary information for a restart from the dump file. C C----------------------------------------------------------------------- C C SUBROUTINE RDDUMP (LUNDMP, RWK, LENRWK, IWK, LENIWK) C C----------------------------------------------------------------------- C C C Ccc HOW TO REPLACE MODULES: C========================= C Ccc Space discretization. C Replace the computation of the derivatives in subroutine DERIVS by the C desired discretization. C If the new space discretization uses a larger stencil than the C implemented one (internally a central 19-point stencil and at the C boundary a 3-point one sided), one should use as linear system C solver the matrix-free GCRO variant (INFO(4)=10,11,12 or 13). C Moreover, one should check whether the required grid points are C available on the current grid level, e.g. using the x-, y- C and z-coordinates of the grid points (see SETXYZ above). C Note that the refinement strategy results in subgrids of at least C 5 points in every coordinate direction. C Ccc Linear system solver. C If the new solver is matrix-free: C rewrite the body of subroutine GCRO using the routines C MVDIFF to compute y=Ax C If the (block-)diagonal preconditioner is wanted, use the routine C BCKBDI to compute w=P^(-1).v C (copy the call used in GCRO and replace the vector arguments for C x, y, v, w, and, optionally for the workspace needed) C otherwise, if the ILU preconditioner is to be used: C rewrite the body of subroutine BICGST using the routines C BCKSLV to compute v=P^(-1).v and C MVDIAG to compute y=Ax C (copy the call used in BICGST and replace the vector argument(s)). C C If a user-made preconditioner is wanted, one should adapt INTGRB C (when the Jacobian is used) or INTGRC (for a matrix-free solver). C The calls to JACPB and PINIT, resp. should be replaced by calls to C the routine that computes the preconditioner. In BICGST and GCRO, C resp., one should call one's own routine to compute w=P^(-1).v C instead of BCKSLV and BCKBDI, resp.. C C If extra workspace is needed, the easiest way is to declare it in C the subroutine. C C C Ccc DESCRIPTION OF THE SETUP IN THE WORKARRAYS: C============================================= C Ccc Datastructure for the solution at a grid level C The solution is stored plane after plane, rowwise, one component C vector after the other in C REAL U(0:NPTS*NPDE) C The element U(0) is added because pointers to non-existing nodes point C to 0. C Ccc Solutions from 3 different time levels have to be saved. For Tn-1 C only the injected one (U); for Tn the original solution (S) belonging C to a specific grid, the injected solution (U), and the injected C solution at the Tn+1 grid; and for Tn+1 the solution (S) and when C finished the injected solution (U). C C The real work storage is set up as follows: C First some method related arrays of length NPDE each: SPCTOL, TIMWGT, C RELTOL, ABSTOL, RTOL, ATOL. C From 6*NPDE+1 work storage for PDESOL where the array RWK starts with C index 1. From there it will contain the following items: C First the X-, Y- and Z- coordinates for the base grid: X(NPTSB), C Y(NPTSB), and Z(NPTSB). C From 3*NPTSB+1 the solutions are stored: C First for Tn-1: U_i for i=LSGNM1(0),(-1),1 C Next for Tn: S_i for i=1,...,LSGN(0) C U_i for i=LSGN(0)-1,(-1),1 C Next for Tn+1: S_1 C U_i(Tn) at grid LSGNP1(i) I C S_i(Tn+1) I for i=2,...,LEVEL C when refinement is finished: C U_i(Tn+1) for i=LSGNP1(0)-1,(-1),1 C After the solutions work storage is available for the (interpolated) C solutions from Tn-1 at the current grid, the current X- and C Y-coordinates, if necessary the (interpolated) solution values at the C internal boundary, the initial solution at Tn+1 at the current grid C (since the not updated solution of the old time level has to be used), C and for the derivatives and the linear solver. C Ccc If the linear solver uses a Jacobian and an ILU preconditioner C (INFO(4)=0) the Jacobian is stored as a block 19-diagonal matrix. C If a second-order discretization is used at the boundary the extra C information will be stored in one of the `mixed-derivative blocks'. C Addressing is done with the use of pointers to off 3-diagonal blocks C (cf. LLDG and LUDG below). C For the incomplete LU the second-order discretization at the C boundaries is replaced by a first order discretization, since a true C block 19-diagonal matrix is required to apply the hyperplane method. C The same block structure will be used as for the Jacobian itself. C C C Ccc Datastructure for the grid at the current grid level C A (virtual) box is placed around the irregular domain. C The left/front/down point of this box is (XL,YF,ZD) in physical C coordinates and (0,0,0) in column, row, plane coordinates, resp.. C The right/back/upper point is (XR,YB,ZU) resp. (Nx,Ny,Nz), where C Nx = (XR-XL)/DX, Ny = (YB-YF)/DY, and Nz = (ZU-ZD)/DZ. C Only real grid points are stored, plane after plane, rowwise. C C INTEGER ISTRUC(0:*) C Ccc ISTRUC contains the following arrays: C LPLN : (0:LPLN(0)+1) C LPLN(0) = NPLNS: Actual # horizontal planes in LROW C LPLN(1:NPLNS): pointers to the start of a plane in LROW C LPLN(NPLNS+1) = NROWS+1: Total # rows in grid + 1 C IPLN : (NPLNS) C IPLN(IP): plane number of plane IP in virtual box C LROW : (NROWS+1) C LROW(1:NROWS): pointers to the start of a row in the grid C LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 C IROW : (NROWS) C IROW(IR): row number of row IR in virtual box C ICOL : (NPTS) C ICOL(IPT): column number of grid point IPT in virtual box C LLBND : (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C structure C LBLWY : (0:NPTS) C LBLWY(IPT): pointer to node below in Y-direction in C actual grid C 0, if index node is front-plane boundary point C LABVY : (0:NPTS) C LABVY(IPT): pointer to node above in Y-direction in C actual grid C 0, if index node is back-plane boundary point C LBLWZ : (0:NPTS) C LBLWZ(IPT): pointer to node below in Z-direction in C actual grid C 0, if index node is down-plane boundary point C LABVZ : (0:NPTS) C LABVZ(IPT): pointer to node above in Z-direction in C actual grid C 0, if index node is up-plane boundary point C C The next 6 arrays are only stored if INFO(4) = 0 C The next 2 arrays are used for the Jacobian structure and its ILU C LLDG : (NPTS,-9:-2) C LLDG(IPT,-9): pointer to node Y-below Z-below C or to node Z-below Z-below C LLDG(IPT,-8): pointer to node left of Z-below C LLDG(IPT,-7): pointer to node Z-below C LLDG(IPT,-6): pointer to node right of Z-below C LLDG(IPT,-5): pointer to node Y-above Z-below C LLDG(IPT,-4): pointer to node left of Y-below C or to node Y-below Y-below C LLDG(IPT,-3): pointer to node Y-below C LLDG(IPT,-2): pointer to node right of Y-below C or to node left of the node left C LUDG : (NPTS,2:9) C LUDG(IPT,2): pointer to node left of Y-above C or to node right of the node right C LUDG(IPT,3): pointer to node Y-above C LUDG(IPT,4): pointer to node right of node Y-above C or to node Y-above Y-above C LUDG(IPT,5): pointer to node Y-below Z-above C LUDG(IPT,6): pointer to node left of Z-above C LUDG(IPT,7): pointer to node Z-above C LUDG(IPT,8): pointer to node right of Z-above C LUDG(IPT,9): pointer to node Y-above Z-above C or to node Z-above Z-above C C The next 4 arrays are used to hold the data dependency lists C for the ILU factorization and the forward, resp. backward C sweep of the backsolve C LSL : (NPTS) C LSL(ISLPT): pointer to node in actual grid C LLSL : (0:LLSL(0)) C LLSL(0) = # independent data dependency lists in ILU C factorization and forward sweep C LLSL(1:LLSL(0)): pointers to the start of a list in LSL C LSU : (NPTS) C LSU(ISLPT): pointer to node in actual grid C LLSU : (0:LLSU(0)) C LLSU(0) = # independent data dependency lists in backward C sweep C LLSU(1:LLSU(0)): pointers to the start of a list in LSU C C For the base grid the complete datastructure is saved (including C the last 6 arrays because of restart), for higher level grids C only the first 5 arrays LPLN, IPLN, LROW, IROW and ICOL. C C Pointers to the specific arrays in ISTRUC are obtained by C LLPLN = 0 C NPLNS = ISTRUC(LLPLN) C LIPLN = LLPLN+NPLNS+2 C LLROW = LIPLN+NPLNS C NROWS = ISTRUC(LLPLN+NPLNS+1)-1 C NPTS = ISTRUC(LLROW+NROWS)-1 C LIROW = LLROW+NROWS+1 C LICOL = LIROW+NROWS C LLLBND = LICOL+NPTS C NBNDS = ISTRUC(LLLBND) C NBIPTS = ISTRUC(LLLBND+NBNDS+2)-1 C LILBND = LLLBND+NBNDS+3 C LLBNDP = LILBND+NBNDS C LLBLWY = LLBNDP+NBIPTS C LLABVY = LLBLWY+NPTS+1 C LLBLWZ = LLABVY+NPTS+1 C LLABVZ = LLBLWZ+NPTS+1 C LIWK = LLABVZ+NPTS C C LLLDG = LIWK C LLUDG = LLLDG+NPTS*8 C LLSLP = LLUDG+NPTS*8 C LLLSL = LLSLP+NPTS C LLSUP = LLLSL+ISTRUC(LLLSL)+1 C LLLSU = LLSUP+NPTS C LIWK = LLLSU+ISTRUC(LLLSU)+1 C C Ccc All grids from 3 different time levels have to be saved C The integer work storage is set up as follows: C LSGNM1 : (0:MAXLEV) C LSGNM1(0) = max. grid level used at Tn-1 C LSGNM1(1): pointer to base grid structure ISTRUC C LSGNM1(LEVEL): pointer to grid structure C (LPLN, IPLN, LROW, IROW, ICOL) C of refinement level LEVEL for time Tn-1 C LSGN : (0:MAXLEV) C LSGN(0) = max. grid level used at Tn C LSGN(1): pointer to base grid structure ISTRUC C LSGN(LEVEL): pointer to grid structure C (LPLN, IPLN, LROW, IROW, ICOL) C of refinement level LEVEL for time Tn C LSGNP1 : (0:MAXLEV) C LSGNP1(0) = max. grid level used at Tn+1 C LSGNP1(1): pointer to base grid structure ISTRUC C LSGNP1(2): pointer after grid structure of max. refinement C level for time Tn C LSGNP1(LEVEL): pointer to augmented grid structure C (LPLN, IPLN, LROW, IROW, ICOL, LLBND, ILBND, LBND) C of refinement level LEVEL for time Tn+1 C LSGNP1(LEVEL+1): pointer to grid structure ISTRUC of C refinement level LEVEL+1 for time Tn+1 C LSUNM1 : (MAXLEV) C LSUNM1(LEVEL): pointer to (injected) solution at grid C of refinement level LEVEL for time Tn-1 C LSSN : (MAXLEV) C LSSN(LEVEL): pointer to original solution belonging C to refinement level LEVEL for time Tn C LSUN : (MAXLEV) C LSUN(LEVEL): pointer to (injected) solution at grid C of refinement level LEVEL for time Tn C LSSNP1 : (MAXLEV) C LSSNP1(LEVEL): pointer to original solution belonging C to refinement level LEVEL for time Tn+1 C LSUNP1 : (MAXLEV) C LSUNP1(LEVEL): pointer to (injected) solution at grid C of refinement level LEVEL for time Tn+1 C From 8*MAXLEV+4 the grids are stored, in PDESOL the array IWK starts C with the grids at index 1. C Storage order: C First ISTRUC for the base grid C Next for Tn-1: (LPLN, IPLN, LROW, IROW, ICOL)_i for i=2,...,LSGNM1(0) C Next for Tn: (LPLN, IPLN, LROW, IROW, ICOL)_i for i=2,...,LSGN(0) C Next for Tn+1: (LPLN, IPLN, LROW, IROW, ICOL, LLBND, ILBND, LBND)_i C for i=2,...,LEVEL C ISTRUC_i for i=LEVEL+1 C After the grids work storage is available for domain flags and C the linear solver C C======================================================================= C C IMPORTANT: C ========= C C The INCLUDEd file CMNCMMACH contains machine numbers that C are set in the routine MACNUM by calling the appropriate functions C of the BLAS library. If I1MACH and R1MACH of the file blas.f are used, C the functions should be altered for the particular machine used (cf. C comment in I1MACH and R1MACH). C Ccc CMNCMMACH C C COMMON with `machine numbers' C LUNOUT : Logical unit # standard output -I C LUNERR : Logical unit # standard error I Set in the routine C UROUND : Smallest machine number such that I MACNUM C 1.0+UROUND > 1.0 and 1.0-UROUND < 1.0 I C XMIN : Smallest floating-point number > 0.0 -I C INTEGER LUNOUT, LUNERR C REAL UROUND, XMIN C COMMON /IMACH/ LUNOUT, LUNERR C COMMON /RMACH/ UROUND, XMIN C SAVE /IMACH/, /RMACH/ C C C C The INCLUDE files PARNEWTON, PARBICGSTAB, and PARGCRO contain the C method parameters for the corresponding (non)linear solvers. These C parameters may be changed by the user. C Ccc PARNEWTON C C Parameters for Newton process C MAXNIT : Max. number of Newton iterations C NB. If MAXNIT > 20 the include file CMNSTATS C == should also be changed. C MAXJAC : Max. number of Jacobian / preconditioner evaluations during C a Newton process C TOLNEW : Tolerance for Newton process: C rho/(1-rho)*|| corr.||_w < TOLNEW C INTEGER MAXNIT, MAXJAC C REAL TOLNEW C PARAMETER (MAXNIT = 10, MAXJAC = 2, TOLNEW = 1.0) C Ccc PARBICGSTAB C C Parameters for linear system solver BiCGStab C MAXLIT : Max. number of BiCGStab iterations C TOLLSB : Tolerance for linear system solver: C || P^(-1).residual ||_w < TOLLSB/2^NIT C INTEGER MAXLIT C REAL TOLLSB C PARAMETER (MAXLIT = 100, TOLLSB = TOLNEW/10) C Ccc PARGCRO C C Parameters for linear system solver GCRO + (block-)diagonal C preconditioner C IDIAGP : 0: block-diagonal + first order derivatives C 1: block-diagonal neglecting first order derivatives C 2: diagonal + first order derivatives C 3: diagonal neglecting first order derivatives C NRRMAX : Max. number of restarts of outer loop C MAXLR : Max. number of iterations in outer loop C MAXL : Max. number of iterations in GMRES inner loop C TOLLSC : Tolerance for linear system solver C || P^(-1).residual ||_w < TOLLSC/2^NIT C INTEGER IDIAGP, NRRMAX, MAXLR, MAXL C REAL TOLLSC C PARAMETER (NRRMAX = 1, MAXLR = 5, MAXL = 20) C PARAMETER (TOLLSC = TOLNEW/10) C COMMON /IGCRO/ IDIAGP C SAVE /IGCRO/ C C Note, that in the actual code the INCLUDE statements have been C replaced by C CCcc INCLUDE 'file' C ... code in file CC end INCLUDE 'file' C C So if one wishes to change the method parameters care should be taken C that it is done for all occurrences. C C======================================================================= C Ccc EXTERNALS USED: EXTERNAL ICOPY, INTGRB, INTGRC, IYPOC, PDESOL, RCOPY C C Ccc INCLUDE 'CMNSTATS' C C CMNSTATS C C COMMON with integration statistics INTEGER MXCLEV, MXCNIT PARAMETER (MXCLEV = 10, MXCNIT = 20) INTEGER LUNPDS, LUNNLS, LUNLSS, LEVEL, NSTEPS, NREJS, + NJACS(MXCLEV), NRESID(MXCLEV), NNIT(MXCLEV), + NLSIT(MXCLEV,MXCNIT) COMMON /STATS/ LUNPDS, LUNNLS, LUNLSS, LEVEL, NSTEPS, NREJS, + NJACS, NRESID, NNIT, NLSIT SAVE /STATS/ C C end INCLUDE 'CMNSTATS' C C Ccc INCLUDE 'CMNCMMACH' C C CMNCMMACH C C COMMON with `machine numbers' C LUNOUT : Logical unit # standard output -I C LUNERR : Logical unit # standard error I Set in the routine C UROUND : Smallest machine number such that I MACNUM C 1.0+UROUND > 1.0 and 1.0-UROUND < 1.0 I C XMIN : Smallest floating-point number -I INTEGER LUNOUT, LUNERR REAL UROUND, XMIN COMMON /IMACH/ LUNOUT, LUNERR COMMON /RMACH/ UROUND, XMIN SAVE /IMACH/, /RMACH/ C C end INCLUDE 'CMNCMMACH' C C Ccc INCLUDE 'CMNWRITEF' C C CMNWRITEF C C COMMON needed for continuation calls INTEGER MAXLVW, NPDEW, LRWKPS, LIWKPS, LRWKB, LIWKB LOGICAL FIRST, SECOND REAL T0,TW,TEW,DTW, XLW,YFW,ZDW, XRW,YBW,ZUW, DXB,DYB,DZB, DTO COMMON /WRITIF/ MAXLVW, NPDEW, LRWKPS, LIWKPS, LRWKB, LIWKB COMMON /WRITLF/ FIRST, SECOND COMMON /WRITRF/ T0,TW,TEW,DTW, XLW,YFW,ZDW, XRW,YBW,ZUW, + DXB,DYB,DZB, DTO SAVE /WRITIF/, /WRITLF/, /WRITRF/ C C end INCLUDE 'CMNWRITEF' C C Ccc INCLUDE 'PARNEWTON' C C PARNEWTON C C Parameters for Newton process C MAXNIT : Max. number of Newton iterations C MAXJAC : Max. number of Jacobian / preconditioner evaluations during C a Newton process C TOLNEW : Tolerance for Newton process: C rho/(1-rho)*|| corr.||_w < TOLNEW INTEGER MAXNIT, MAXJAC REAL TOLNEW PARAMETER (MAXNIT = 10, MAXJAC = 2, TOLNEW = 1.0) C C end INCLUDE 'PARNEWTON' C C Ccc INCLUDE 'PARBICGSTAB' C C PARBICGSTAB C C Parameters for linear system solver BiCGStab C MAXLIT : Max. number of BiCGStab iterations C TOLLSB : Tolerance for linear system solver INTEGER MAXLIT REAL TOLLSB PARAMETER (MAXLIT = 100, TOLLSB = TOLNEW/10) C C end INCLUDE 'PARBICGSTAB' C C Ccc INCLUDE 'PARGCRO' C C PARGCRO C C Parameters for linear system solver GCRO + (block-)diagonal C preconditioner C IDIAGP : 0: block-diagonal + first order derivatives C 1: block-diagonal neglecting first order derivatives C 2: diagonal + first order derivatives C 3: diagonal neglecting first order derivatives C NRRMAX : Max. number of restarts of outer loop C MAXLR : Max. number of iterations in outer loop C MAXL : Max. number of iterations in GMRES inner loop C TOLLSC : Tolerance for linear system solver INTEGER IDIAGP, NRRMAX, MAXLR, MAXL REAL TOLLSC PARAMETER (NRRMAX = 1, MAXLR = 5, MAXL = 20) C PARAMETER (NRRMAX = 1, MAXLR = 3, MAXL = 15) PARAMETER (TOLLSC = TOLNEW/10) COMMON /IGCRO/ IDIAGP SAVE /IGCRO/ C C end INCLUDE 'PARGCRO' C C C----------------------------------------------------------------------- C INTEGER LSGNM1, LSGN, LSGNP1, LSUNM1, LSUN, LSUNP1, LSSN, LSSNP1, + LGNM1, LGN, LGNP1, LUNM1, LUN, LSN, LSNP1, + MAXLEV, LSPCTL, LTIMWT, LRELTL, LABSTL, LRTOL, LATOL, LSPCWT, + LUMAX, RCTDOM, LINSYS, I, I1, I2, IC, J, LRWK, LIWK, LIWKPN REAL DTMIN, DTMAX, TOL C CDIR$ NOVECTOR IF (MNTR .EQ. 1) THEN NPDE = NPDEW T = TW DT = DTW XL = XLW YF = YFW ZD = ZDW XR = XRW YB = YBW ZU = ZUW ENDIF C C Set machine numbers in /CMMACH/ CALL MACNUM C C Setup real work storage LSPCTL = 1 LTIMWT = LSPCTL+NPDE LRELTL = LTIMWT+NPDE LABSTL = LRELTL+NPDE LRTOL = LABSTL+NPDE LATOL = LRTOL +NPDE LRWKPS = LATOL +NPDE LSPCWT = LSPCTL LUMAX = LATOL C C Get User info IF (INFO(1) .EQ. 0) THEN MAXLEV = 3 RCTDOM = 0 LINSYS = 0 LUNPDS = 0 LUNNLS = 0 LUNLSS = 0 DTMIN = 0.0 DTMAX = TOUT - T DO 10 IC = 1, NPDE RWK(LUMAX-1 +IC) = 1.0 RWK(LSPCWT-1+IC) = 1.0 RWK(LTIMWT-1+IC) = 1.0 10 CONTINUE ELSE MAXLEV = INFO(2) IF (MAXLEV .EQ. 0) MAXLEV = 3 RCTDOM = INFO(3) IDIAGP = MOD(INFO(4),10) LINSYS = INFO(4)/10 LUNPDS = INFO(5) LUNNLS = INFO(6) LUNLSS = INFO(7) DTMIN = RINFO(1) DTMAX = RINFO(2) IF (DTMAX .EQ. 0.0) DTMAX = TOUT - T DO 20 IC = 1, NPDE RWK(LUMAX-1 +IC) = RINFO(2+IC) RWK(LSPCWT-1+IC) = RINFO(2+NPDE+IC) RWK(LTIMWT-1+IC) = RINFO(2+2*NPDE+IC) 20 CONTINUE ENDIF C C Store method arrays TOL = 1E-1*MIN(TOLT*TOLT,TOLS) DO 30 IC = 1, NPDE RWK(LSPCTL-1+IC) = RWK(LSPCWT-1+IC)/(RWK(LUMAX-1+IC)*TOLS) RWK(LRELTL-1+IC) = TOLT RWK(LABSTL-1+IC) = 0.01*RWK(LUMAX-1+IC)*TOLT RWK(LRTOL-1+IC) = TOL RWK(LATOL-1+IC) = 0.01*RWK(LUMAX-1+IC)*TOL 30 CONTINUE C C Setup integer work storage IF (MXCLEV .LT. MAXLEV) THEN WRITE(LUNERR,*) 'Arrays for the statistic are too small' WRITE(LUNERR,*) 'Either MAXLEV > 10 or MAXNIT > 20' WRITE(LUNERR,*) 'Adapt the parameter statements for /STATS/' MNTR = -10 RETURN ENDIF LSGNM1 = 1 LSGN = LSGNM1 + MAXLEV+1 LSGNP1 = LSGN + MAXLEV+1 LSUNM1 = LSGNP1 + MAXLEV+1 LSSN = LSUNM1 + MAXLEV LSUN = LSSN + MAXLEV LSSNP1 = LSUN + MAXLEV LSUNP1 = LSSNP1 + MAXLEV LIWKPN = LSUNP1 + MAXLEV IF (MNTR .EQ. 0) THEN C This is the first call, initialize pointer arrays and STATS common DO 50 I = 1, LIWKPN-1 IWK(I) = 1 50 CONTINUE NSTEPS = 0 NREJS = 0 DO 60 I = 1, MXCLEV NJACS(I) = 0 NRESID(I) = 0 NNIT(I) = 0 DO 70 J = 1, MXCNIT NLSIT(I,J) = 0 70 CONTINUE 60 CONTINUE ELSE IF (MAXLEV .GT. MAXLVW) THEN C MAXLEV larger than previous call; shift info in IWK array backwards IF (LENIWK .LT. LIWKPN+LIWKB) THEN WRITE(LUNERR,*) 'Integer work space too small, required:', + LIWKPN+LIWKB MNTR = -1 RETURN ENDIF CALL IYPOC (LIWKB, IWK(LIWKPS), IWK(LIWKPN)) LIWK = LIWKPS - MAXLVW CALL IYPOC (MAXLVW, IWK(LIWK), IWK(LSUNP1)) LIWK = LIWK - MAXLVW CALL IYPOC (MAXLVW, IWK(LIWK), IWK(LSSNP1)) LIWK = LIWK - MAXLVW CALL IYPOC (MAXLVW, IWK(LIWK), IWK(LSUN)) LIWK = LIWK - MAXLVW CALL IYPOC (MAXLVW, IWK(LIWK), IWK(LSSN)) LIWK = LIWK - MAXLVW CALL IYPOC (MAXLVW, IWK(LIWK), IWK(LSUNM1)) LIWK = LIWK - MAXLVW-1 CALL IYPOC (MAXLVW+1, IWK(LIWK), IWK(LSGNP1)) LIWK = LIWK - MAXLVW-1 CALL IYPOC (MAXLVW+1, IWK(LIWK), IWK(LSGN)) ELSE IF (MAXLEV .LT. MAXLVW) THEN C MAXLEV smaller than previous call; shift info in IWK array forwards LGNM1 = 1 LGN = LGNM1 + MAXLVW+1 LGNP1 = LGN + MAXLVW+1 LUNM1 = LGNP1 + MAXLVW+1 LSN = LUNM1 + MAXLVW LUN = LSN + MAXLVW LSNP1 = LUN + MAXLVW IF (IWK(LGNM1) .GT. MAXLEV) THEN C Shift grid_n forwards to LGNM1(MAXLEV+1) I1 = IWK(LGN+2) I2 = IWK(LGNM1+MAXLEV+1) CALL ICOPY (LIWKB-I1, IWK(I1), IWK(I2)) DO 110 I = 2, IWK(LGN) IWK(LGN+I) = IWK(LGN+I) - (I1-I2) 110 CONTINUE LIWKB = LIWKB - (I1-I2) C Shift info from U_n-1(MAXLEV) forwards to LUNM1(LGNM1(0)) I1 = IWK(LUNM1-1+MAXLEV) I2 = IWK(LUNM1-1+IWK(LGNM1)) CALL RCOPY (LRWKB-I1, RWK(I1), RWK(I2)) DO 120 I = 1, MAXLEV IWK(LUNM1-1+I) = IWK(LUNM1-1+I) - (I1-I2) 120 CONTINUE DO 130 I = 1, IWK(LGN) IWK(LSN-1+I) = IWK(LSN-1+I) - (I1-I2) IWK(LUN-1+I) = IWK(LUN-1+I) - (I1-I2) 130 CONTINUE IWK(LSNP1) = IWK(LSNP1) - (I1-I2) LRWKB = LRWKB - (I1-I2) IWK(LGNM1) = MAXLEV ENDIF IF (IWK(LGN) .GT. MAXLEV) THEN LIWKB = IWK(LGN+MAXLEV+1) C Shift info from U_n(MAXLEV) forwards to LUN(LGN(0)) I1 = IWK(LUN-1+MAXLEV) I2 = IWK(LUN-1+IWK(LGN)) CALL RCOPY (LRWKB-I1, RWK(I1), RWK(I2)) DO 140 I = 1, MAXLEV IWK(LUN-1+I) = IWK(LUN-1+I) - (I1-I2) 140 CONTINUE IWK(LSNP1) = IWK(LSNP1) - (I1-I2) LRWKB = LRWKB - (I1-I2) IWK(LGN) = MAXLEV ENDIF C Shift pointer arrays and grids forwards CALL ICOPY (MAXLEV+1, IWK(LGN), IWK(LSGN)) CALL ICOPY (MAXLEV+1, IWK(LGNP1), IWK(LSGNP1)) CALL ICOPY (MAXLEV, IWK(LUNM1), IWK(LSUNM1)) CALL ICOPY (MAXLEV, IWK(LSN), IWK(LSSN)) CALL ICOPY (MAXLEV, IWK(LUN), IWK(LSUN)) IWK(LSSNP1) = IWK(LSNP1) CALL ICOPY (LIWKB, IWK(LIWKPS), IWK(LIWKPN)) ENDIF LIWKPS = LIWKPN IF (LUNPDS .NE. 0) THEN LUN = LUNPDS ELSE LUN = LUNOUT ENDIF C C Call main routine LRWK = LENRWK - LRWKPS+1 LIWK = LENIWK - LIWKPS+1 WRITE(LUN,*) 'Newton: MAXNIT, MAXJAC, TOLNEW:', + MAXNIT, MAXJAC, TOLNEW IF (LINSYS .EQ. 0) THEN C Lin. sys. solver = BiCGStab WRITE(LUN,*) 'Lin. solver BiCGStab + ILU: MAXLIT, TOLLSB:', + MAXLIT, TOLLSB CALL PDESOL (MAXLEV, NPDE, IWK(LSGNM1), IWK(LSGN), IWK(LSGNP1), + IWK(LSUNM1), IWK(LSSN), IWK(LSUN), IWK(LSSNP1), IWK(LSUNP1), + T, TOUT, DT, DTMIN, DTMAX, XL, YF, ZD, XR, YB, ZU, DX, DY, DZ, + RWK(LRTOL), RWK(LATOL), RWK(LSPCTL), RWK(LTIMWT), + RWK(LRELTL), RWK(LABSTL), + LINSYS, INTGRB, + RWK(LRWKPS), LRWK, IWK(LIWKPS), LIWK, LWK, LENLWK, MNTR) ELSE IF (LINSYS .EQ. 1) THEN C Lin. sys. solver = matrix-free GCRO IF (IDIAGP .LE. 1) THEN WRITE(LUN,*) 'Lin. solver matrix-free GCRO + Block-diag:', + 'NRRMAX, MAXLR, MAXL, TOLLSC:', NRRMAX, MAXLR, MAXL, TOLLSC ELSE WRITE(LUN,*) 'Lin. solver matrix-free GCRO + Diag:', + 'NRRMAX, MAXLR, MAXL, TOLLSC:', NRRMAX, MAXLR, MAXL, TOLLSC ENDIF CALL PDESOL (MAXLEV, NPDE, IWK(LSGNM1), IWK(LSGN), IWK(LSGNP1), + IWK(LSUNM1), IWK(LSSN), IWK(LSUN), IWK(LSSNP1), IWK(LSUNP1), + T, TOUT, DT, DTMIN, DTMAX, XL, YF, ZD, XR, YB, ZU, DX, DY, DZ, + RWK(LRTOL), RWK(LATOL), RWK(LSPCTL), RWK(LTIMWT), + RWK(LRELTL), RWK(LABSTL), + LINSYS, INTGRC, + RWK(LRWKPS), LRWK, IWK(LIWKPS), LIWK, LWK, LENLWK, MNTR) ENDIF C C Give final statistics IF (MNTR .NE. 0) THEN WRITE(LUN,'(''Error exit PDESOL, MNTR='',I4)') MNTR ELSE MNTR = 1 ENDIF WRITE(LUN,*) WRITE(LUN,'(''Statistics:'')') WRITE(LUN,'('' # accepted timesteps ='', I5, + '', # rejected timesteps ='', I5)') NSTEPS, NREJS WRITE(LUN,'('' Level # Nit # Jacs # Res'')') DO 200 I = 1, MXCLEV IF (NNIT(I) .NE. 0) + WRITE(LUN,'(2I6,2I8)') I, NNIT(I), NJACS(I), NRESID(I) 200 CONTINUE WRITE(LUN,'('' Nit Level # Lin. sys. it'')') DO 210 J = 1, MXCNIT DO 210 I = 1, MXCLEV IF (NLSIT(I,J) .NE. 0) + WRITE(LUN,'(2I6,I12)') J, I, NLSIT(I,J) 210 CONTINUE C C Take care of all information needed to dump info to file MAXLVW = MAXLEV NPDEW = NPDE LRWKB = IWK(LSSNP1) TW = T TEW = TOUT DTW = DT XLW = XL YFW = YF ZDW = ZD XRW = XR YBW = YB ZUW = ZU RETURN END SUBROUTINE PDESOL (MAXLEV, NPDE, LSGNM1, LSGN, LSGNP1, + LSUNM1, LSSN, LSUN, LSSNP1, LSUNP1, + TN, TE, DT, DTMIN, DTMAX, XL, YF, ZD, XR, YB, ZU, DX, DY, DZ, + RTOL, ATOL, SPCTOL, TIMWGT, RELTOL, ABSTOL, + LINSYS, INTGRT, + RWK, LENRWK, IWK, LENIWK, LWK, LENLWK, IERR) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER LENIWK INTEGER MAXLEV, NPDE, + LSGNM1(0:MAXLEV), LSGN(0:MAXLEV), LSGNP1(0:MAXLEV), + LSUNM1(MAXLEV), LSSN(MAXLEV), LSUN(MAXLEV), + LSSNP1(MAXLEV), LSUNP1(MAXLEV), LINSYS, + LENRWK, IWK(LENIWK), LENLWK, IERR LOGICAL LWK(LENLWK) REAL TN, TE, DT, DTMIN, DTMAX, XL, YF, ZD, XR, YB, ZU, DX, DY, DZ, + RTOL(NPDE), ATOL(NPDE), SPCTOL(NPDE), TIMWGT(NPDE), + RELTOL(NPDE), ABSTOL(NPDE), RWK(LENRWK) EXTERNAL INTGRT C Ccc PARAMETER DESCRIPTION: C MAXLEV : IN. Max. # grid levels allowed C NPDE : IN. # PDE components. C LSGNM1 : IN. (0:MAXLEV) C LSGNM1(0) = max. grid level used at Tn-1 C LSGNM1(1): pointer to base grid structure ISTRUC C LSGNM1(LEVEL): pointer to grid structure C (LPLN,IPLN,LROW,IROW,ICOL) C of refinement level LEVEL for time Tn-1 C LSGN : IN. (0:MAXLEV) C LSGN(0) = max. grid level used at Tn C LSGN(1): pointer to base grid structure ISTRUC C LSGN(LEVEL): pointer to grid structure C (LPLN,IPLN,LROW,IROW,ICOL) C of refinement level LEVEL for time Tn C LSGNP1 : IN. (0:MAXLEV) C LSGNP1(0) = max. grid level used at Tn+1 C LSGNP1(1): pointer to base grid structure ISTRUC C LSGNP1(2): pointer after grid structure of max. refinement C level for time Tn C LSGNP1(LEVEL): pointer to augmented grid structure C (LPLN,IPLN,LROW,IROW,ICOL,LLBND,ILBND,LBND) C of refinement level LEVEL for time Tn+1 C LSGNP1(LEVEL+1): pointer to grid structure ISTRUC of C refinement level LEVEL+1 for time Tn+1 C LSUNM1 : IN. (MAXLEV) C LSUNM1(LEVEL): pointer to (injected) solution at grid C of refinement level LEVEL for time Tn-1 C LSSN : IN. (MAXLEV) C LSSN(LEVEL): pointer to original solution belonging C to refinement level LEVEL for time Tn C LSUN : IN. (MAXLEV) C LSUN(LEVEL): pointer to (injected) solution at grid C of refinement level LEVEL for time Tn C LSSNP1 : IN. (MAXLEV) C LSSNP1(LEVEL): pointer to original solution belonging C to refinement level LEVEL for time Tn+1 C LSUNP1 : IN. (MAXLEV) C LSUNP1(LEVEL): pointer to (injected) solution at grid C of refinement level LEVEL for time Tn+1 C NB. All the above pointers should be initialized on 1 C TN : INOUT. Current value of time variable C IN: Initial time C OUT: Time to which PDE has been integrated C TE : IN. Time point at which solution is desired C DT : INOUT. C IN: The initial time stepsize C OUT: Stepsize for next time step C DTMIN : IN. Minimum time stepsize allowed C If IERR=0 and domain a rectangular prism: C DTMAX : IN. Maximum time stepsize allowed C XL : IN. X-coordinate of left/front/down point of rectangular C prism C YF : IN. Y-coordinate of left/front/down point of rectangular C prism C ZD : IN. Z-coordinate of left/front/down point of rectangular C prism C XR : IN. X-coordinate of right/back/upper point of rectangular C prism C YB : IN. Y-coordinate of right/back/upper point of rectangular C prism C ZU : IN. Z-coordinate of right/back/upper point of rectangular C prism C DX : IN. Cell width in X-direction of base grid C DY : IN. Cell width in Y-direction of base grid C DZ : IN. Cell width in Z-direction of base grid C C RTOL : IN. (NPDE) C Relative tolerance for the Newton iteration process C ATOL : IN. (NPDE) C Absolute tolerance for the Newton iteration process C SPCTOL : IN. (NPDE) C Space tolerance used to determine if resolution of grid C is large enough C TIMWGT : IN. (NPDE) C Time weights used in check if time stepsize can be accepted C RELTOL : IN. (NPDE) C Relative time tolerance used to determine if time stepsize C can be accepted and to determine the new step size C ABSTOL : IN. (NPDE) C Absolute time tolerance used to determine if time stepsize C can be accepted and to determine the new step size C LINSYS : IN. Linear system solver in use C 0: BiCGStab + ILU C 1: GCRO + (Block-)diagonally preconditioning C INTGRT : IN. Name of external routine that performs the integration C If LINSYS=0: INTGRB, otherwise INTGRC C RWK : WORK. (LENRWK) C LENRWK : IN. Dimension of RWK. C Let NPTS be the max. # points on a grid level and C NPTSA the average # points over all grid levels. C Then LENRWK should be: C MAXLEV=1: 3.NPTS.NPDE+3.NPTS+13.NPTS.NPDE + LSSWRK C LSSWRK: C ( INFO(4)=0 C | 38.NPDE.NPTS.NPDE C !:INFO(4)=10 C | (MAX(NPDE.7+3,2.MAXLR+MAXL+6)+NPDE).NPTS.NPDE+ C MAXLR*MAXLR+(MAXL+3).MAXL+1 C !:INFO(4)=11 C | (MAX(NPDE.4+3,2.MAXLR+MAXL+6)+NPDE).NPTS.NPDE+ C MAXLR*MAXLR+(MAXL+3).MAXL+1 C !:INFO(4)=12 C | (MAX(10, 2.MAXLR+MAXL+6) +1).NPTS.NPDE+ C MAXLR*MAXLR+(MAXL+3).MAXL+1 C !:INFO(4)=13 C | (MAX( 7, 2.MAXLR+MAXL+6) +1).NPTS.NPDE+ C MAXLR*MAXLR+(MAXL+3).MAXL+1 C ) C (default: MAXLR = 5, MAXL = 20) C Indication of the length for a maximum grid level C MAXLEV (default value MAXLEV=3): C 5.NPTSA.NPDE.MAXLEV+(3+13.NPDE).NPTS + LSSWRK C IWK : WORK. (LENIWK) C LENIWK : IN. Dimension of IWK. C MAXLEV=1: 28.NPTS C Indication of the length for a maximum grid level MAXLEV, C 7.NPTSA.MAXLEV+7.NPTS + ( INFO(4)=0| 19.NPTS ) C LWK : WORK. (LENLWK) C LENLWK : IN. Dimension of LWK >= NPTS+1 C IERR : INOUT. C IN: 0: First call of PDESOL C 1: Continuation call C OUT: 0: OK C -1: Workspace too small for required # gridpoints in C base grid. No continuation possible C -2: Stepsize too small C Ccc EXTERNALS USED: LOGICAL CHKWRK, CHKGRD, CHKTIM EXTERNAL CHKWRK, CHKGRD, CHKTIM, GETSOL, GETINI, ICOPY, INIGRD, + MKFGRD, MONITR, PDEIV, PUTSOL, RCOPY, SETXYZ C C Ccc INCLUDE 'PARNEWTON' C C PARNEWTON C C Parameters for Newton process C MAXNIT : Max. number of Newton iterations C MAXJAC : Max. number of Jacobian / preconditioner evaluations during C a Newton process C TOLNEW : Tolerance for Newton process: C rho/(1-rho)*|| corr.||_w < TOLNEW INTEGER MAXNIT, MAXJAC REAL TOLNEW PARAMETER (MAXNIT = 10, MAXJAC = 2, TOLNEW = 1.0) C C end INCLUDE 'PARNEWTON' C C Ccc INCLUDE 'PARGCRO' C C PARGCRO C C Parameters for linear system solver GCRO + (block-)diagonal C preconditioner C IDIAGP : 0: block-diagonal + first order derivatives C 1: block-diagonal neglecting first order derivatives C 2: diagonal + first order derivatives C 3: diagonal neglecting first order derivatives C NRRMAX : Max. number of restarts of outer loop C MAXLR : Max. number of iterations in outer loop C MAXL : Max. number of iterations in GMRES inner loop C TOLLSC : Tolerance for linear system solver INTEGER IDIAGP, NRRMAX, MAXLR, MAXL REAL TOLLSC PARAMETER (NRRMAX = 1, MAXLR = 5, MAXL = 20) C PARAMETER (NRRMAX = 1, MAXLR = 3, MAXL = 15) PARAMETER (TOLLSC = TOLNEW/10) COMMON /IGCRO/ IDIAGP SAVE /IGCRO/ C C end INCLUDE 'PARGCRO' C C Ccc INCLUDE 'CMNCMMACH' C C CMNCMMACH C C COMMON with `machine numbers' C LUNOUT : Logical unit # standard output -I C LUNERR : Logical unit # standard error I Set in the routine C UROUND : Smallest machine number such that I MACNUM C 1.0+UROUND > 1.0 and 1.0-UROUND < 1.0 I C XMIN : Smallest floating-point number -I INTEGER LUNOUT, LUNERR REAL UROUND, XMIN COMMON /IMACH/ LUNOUT, LUNERR COMMON /RMACH/ UROUND, XMIN SAVE /IMACH/, /RMACH/ C C end INCLUDE 'CMNCMMACH' C C Ccc INCLUDE 'CMNSTATS' C C CMNSTATS C C COMMON with integration statistics INTEGER MXCLEV, MXCNIT PARAMETER (MXCLEV = 10, MXCNIT = 20) INTEGER LUNPDS, LUNNLS, LUNLSS, LEVEL, NSTEPS, NREJS, + NJACS(MXCLEV), NRESID(MXCLEV), NNIT(MXCLEV), + NLSIT(MXCLEV,MXCNIT) COMMON /STATS/ LUNPDS, LUNNLS, LUNLSS, LEVEL, NSTEPS, NREJS, + NJACS, NRESID, NNIT, NLSIT SAVE /STATS/ C C end INCLUDE 'CMNSTATS' C C Ccc INCLUDE 'CMNWRITEF' C C CMNWRITEF C C COMMON needed for continuation calls INTEGER MAXLVW, NPDEW, LRWKPS, LIWKPS, LRWKB, LIWKB LOGICAL FIRST, SECOND REAL T0,TW,TEW,DTW, XLW,YFW,ZDW, XRW,YBW,ZUW, DXB,DYB,DZB, DTO COMMON /WRITIF/ MAXLVW, NPDEW, LRWKPS, LIWKPS, LRWKB, LIWKB COMMON /WRITLF/ FIRST, SECOND COMMON /WRITRF/ T0,TW,TEW,DTW, XLW,YFW,ZDW, XRW,YBW,ZUW, + DXB,DYB,DZB, DTO SAVE /WRITIF/, /WRITLF/, /WRITRF/ C C end INCLUDE 'CMNWRITEF' C C C----------------------------------------------------------------------- C CDIR$ NOVECTOR C INTEGER NPTSB, LENUB, LXB, LYB, LZB, + LLPLN, NPLNS, LIPLN, LLROW, NROWS, NPTS, LIROW, LICOL, + LLLBND, NBNDS, NBDPTS, NBIPTS, LILBND, LLBNDP, NIBPTS, + LGNP1, LX, LY, LZ, LUNM1, LUN, LUNP1, LUNP1I, LENU, LUIB, + LGNP1C, LXC, LUNM1C, LUNC, LUNP1C, LENUC, + LGNM1, LGN, LSN, LUNM1T, LENS, LENG, LENGN, LENUN, LEUNP1, + LWT, LF, LCORR, LEV, MLVNM1, MLVN, MLVNP1, + LISTRF, LIWK, LRWK, LLWKN, LIWKN, LRWKN, MAXPTS, + LENPRE, LENLSW, LU, LUO LOGICAL LEVN, LEVNM1, OK REAL DTNEW, DTRAT, TOLWGT, SPCMON, TIMMON C IF (IERR .EQ. 0) THEN C Ccc This is the first call of PDESOL. T0 = TN C C Initialize datastructure, X- and Y-coordinates for base grid IF (LINSYS .EQ. 0) THEN LRWKN = (3 +16*NPDE + 38*NPDE*NPDE) ELSE IF (IDIAGP .EQ. 0) THEN LENPRE = NPDE LENLSW = NPDE*7+3 ELSE IF (IDIAGP .EQ. 1) THEN LENPRE = NPDE LENLSW = NPDE*4+3 ELSE IF (IDIAGP .EQ. 2) THEN LENPRE = 1 LENLSW = 10 ELSE LENPRE = 1 LENLSW = 7 ENDIF LENLSW = MAX(LENLSW,2*MAXLR+MAXL+6) LRWKN = (3 + 16*NPDE + (LENLSW + LENPRE)*NPDE) ENDIF LIWKN = 28 MAXPTS = MIN((LENRWK-3)/LRWKN, LENIWK/LIWKN, LENLWK-1) CALL INIGRD (MAXPTS, XL, YF, ZD, XR, YB, ZU, DX, DY, DZ, + RWK, IWK, NPTSB, LIWKB, IERR) DXB = DX DYB = DY DZB = DZ IF (IERR .EQ. 1) THEN LRWKN = LRWKN*NPTSB+3 LIWKN = LIWKN*NPTSB LLWKN = NPTSB+1 OK = CHKWRK (LRWKN+6*NPDE, LENRWK+6*NPDE, + LIWKN+8*MAXLEV+3, LENIWK+8*MAXLEV+3, LLWKN, LENLWK) IERR = -1 RETURN ELSE IF (IERR .NE. 0) THEN STOP 'Return from INIGRD with unknown IERR' ENDIF LXB = 1 LYB = LXB + NPTSB LZB = LYB + NPTSB C C Set max. grid levels for Tn and Tn-1 at 1 LSGNM1(0) = 1 LSGN (0) = 1 C C Set pointers to base grid data structures for Tn-1, Tn and Tn+1 C and to solution for Tn-1 and Tn LSGNM1(1) = 1 LSGN (1) = 1 LSGNP1(1) = 1 LSUNM1(1) = LZB + NPTSB LSSN (1) = LSUNM1(1) LSUN (1) = LSUNM1(1) C C Initialize solution values at base grid at Tn = T0 RWK(LSUN(1)) = 0.0 CALL PDEIV (T0, RWK(LXB), RWK(LYB), RWK(LZB), RWK(LSUN(1)+1), + NPTSB, NPDE) LENUB = NPTSB*NPDE+1 C C Set pointer to not updated base grid solution at Tn+1 LSSNP1(1) = LSUN(1) + LENUB C C Initialize time integration variables FIRST = .TRUE. SECOND = .FALSE. C ELSE IF (IERR .EQ. 1) THEN C Ccc This is a continuation call of PDESOL. C Set all required variables that were not saved in COMMON IF (LINSYS .EQ. 1) THEN IF (IDIAGP .EQ. 0) THEN LENPRE = NPDE LENLSW = NPDE*7+3 ELSE IF (IDIAGP .EQ. 1) THEN LENPRE = NPDE LENLSW = NPDE*4+3 ELSE IF (IDIAGP .EQ. 2) THEN LENPRE = 1 LENLSW = 10 ELSE LENPRE = 1 LENLSW = 7 ENDIF LENLSW = MAX(LENLSW,2*MAXLR+MAXL+6) ENDIF NPTSB = IWK(IWK(IWK(1)+2)+2*IWK(1)+2)-1 LENUB = NPTSB*NPDE+1 LXB = 1 LYB = LXB + NPTSB LZB = LYB + NPTSB C ELSE C This shouldn't happen STOP 'PDESOL called with unknown IERR' ENDIF C Ccccc Time integration loop 10 CONTINUE C Adjust time stepsize such that interval TE-TN takes an integer # of C time steps of this size DT = (TE-TN)/INT((TE-TN)/DT+0.95) DT = (TN+DT)-TN C Check if time stepsize is acceptable IF (DT .LT. DTMIN) THEN WRITE(LUNERR,'(''Time step size too small, DT ='',E16.7)') DT IERR = -2 RETURN ENDIF C C Time integration method: BE in first time step, BDF2 in following. C DTRAT = DT / DT_old; 0 => BE IF (FIRST) THEN DTRAT = 0 ELSE DTRAT = DT / DTO ENDIF C LEVEL = 1 C Ccc Set pointer to first free element after grid structure of max. C refinement level for Tn IF (MAXLEV .GT. 1) LSGNP1(2) = LIWKB C LGNP1 = LSGNP1(1) LX = LXB LY = LYB LZ = LZB DX = DXB DY = DYB DZ = DZB LUNM1 = LSUNM1(1) LUN = LSUN (1) LUNP1 = LSSNP1(1) LENU = LENUB LUIB = LUNP1+LENU C Pointer to space for eventual refined grid structure LISTRF = LIWKB LIWK = LIWKB LRWK = LUNP1 + LENU C Ccc Initial solution at coarse grid is coarse grid solution of previous C time level LUNP1I = LSSN(1) CALL RCOPY (LENU, RWK(LUNP1I), RWK(LUNP1)) C Ccccc Grid refinement Loop C 100 CONTINUE IF (LUNPDS .NE. 0) THEN NPLNS = IWK(LGNP1) NROWS = IWK(LGNP1+NPLNS+1)-1 NPTS = IWK(LGNP1+2*NPLNS+1+NROWS+1)-1 WRITE(LUNPDS, + '(''Time integration at T='',E10.2,'', Grid level='',I3, + '', NPTS='',I6)') TN+DT, LEVEL, NPTS ENDIF C Ccc Timestep on current level LWT = LRWK LF = LWT + LENU-1 LCORR = LF + LENU-1 LRWK = LCORR + LENU-1 CALL INTGRT (IWK(LGNP1), RWK(LX), RWK(LY), RWK(LZ), NPDE, + RWK(LUIB), RWK(LUNP1), RWK(LUN), RWK(LUNM1), RTOL, ATOL, + TN, DT, DTRAT, DX, DY, DZ, RWK(LWT), RWK(LF), RWK(LCORR), + RWK(LRWK), IERR) LRWK = LWT IF (IERR .EQ. 10) THEN C If Newton failure redo time step with stepsize quartered NREJS = NREJS+1 IF (LUNPDS .NE. 0) THEN WRITE(LUNPDS, + '(''Newton failure at T='',E10.2,'', Grid level'',I3)') + TN+DT, LEVEL ENDIF IERR = 0 DT = DT/4 GOTO 10 ELSE IF (IERR .NE. 0) THEN C This shouldn't happen STOP 'Return from INTGRT with unknown IERR' ENDIF C Ccc Compute space monitor and if necessary determine new grid IF (LSGN(0) .GT. LEVEL) THEN C More severe tolerance on grid monitor if max.grid level at Tn C exceeded current level TOLWGT = 0.9 ELSE TOLWGT = 1.0 ENDIF OK = CHKGRD (TN+DT, LEVEL, RWK(LUNP1), NPDE, + RWK(LX), RWK(LY), RWK(LZ), + SPCTOL, TOLWGT, IWK(LGNP1), RWK(LRWK), LWK, SPCMON) C If no grid refinement needed, check time error IF (LUNPDS .NE. 0) THEN WRITE(LUNPDS,'(''T='',E10.2,'', LEVEL='',I3, + '' ,TOLWGT='',F3.1,'', SPCMON='',E10.2)') + TN+DT, LEVEL, TOLWGT, SPCMON ENDIF IF (OK) GOTO 200 IF (LEVEL .EQ. MAXLEV) THEN WRITE(LUNERR,'(''Max. grid level exceeded at T='',E16.7)') + TN+DT GOTO 200 ENDIF C Ccc Create refined grid C Save coarse grid pointers LGNP1C = LGNP1 LUNP1C = LUNP1 LUNC = LUN LUNM1C = LUNM1 LXC = LX LENUC = LENU C C Make fine grid structure LGNP1 = LISTRF CALL MKFGRD (LWK, IWK, LENIWK, LGNP1C, LGNP1, LINSYS, + NPTS, LIWK, IERR) LENU = NPTS*NPDE+1 C C Check on workspace needed IF (LINSYS .EQ. 0) THEN LRWKN = LUNP1C+LENUC+8*LENU+3*NPTS+10*LENU+38*NPDE*LENU ELSE LRWKN = LUNP1C+LENUC+8*LENU+3*NPTS+10*LENU+ + (LENLSW+LENPRE)*LENU+MAXLR*MAXLR+(MAXL+3)*MAXL ENDIF LIWKN = LIWK+NPTS+1 LLWKN = NPTS+1 OK = CHKWRK (LRWKN+6*NPDE, LENRWK+6*NPDE, + LIWKN+8*MAXLEV+3, LENIWK+8*MAXLEV+3, LLWKN, LENLWK) IF (.NOT. OK) THEN IERR = -1 RETURN ENDIF C C Set fine grid pointers and values LLPLN = LGNP1 NPLNS = IWK(LLPLN) LIPLN = LLPLN+NPLNS+2 NROWS = IWK(LLPLN+NPLNS+1)-1 LLROW = LIPLN+NPLNS LIROW = LLROW+NROWS+1 LICOL = LIROW+NROWS LLLBND = LICOL+NPTS NBNDS = IWK(LLLBND) NBDPTS = IWK(LLLBND+NBNDS+1)-1 NBIPTS = IWK(LLLBND+NBNDS+2)-1 LILBND = LLLBND+NBNDS+3 LLBNDP = LILBND+NBNDS LISTRF = LLBNDP+NBIPTS LUN = LUNP1C+LENUC LUNP1 = LUN+LENU LUNM1 = LUNP1+LENU LX = LUNM1+LENU LY = LX+NPTS LZ = LY+NPTS LUIB = LZ+NPTS NIBPTS = NBIPTS-NBDPTS LRWK = LUIB+NIBPTS*NPDE LSGNP1(LEVEL+1) = LGNP1 LSSNP1(LEVEL+1) = LUNP1 DX = DX/2 DY = DY/2 DZ = DZ/2 C C Save initial solution at current grid level at end of workspace to C prevent overwriting CALL RCOPY (LENUC, RWK(LUNP1I), RWK(LENRWK-LENUC)) LUNP1I = LENRWK-LENUC C C Store grid values at Tn and Tn-1 in temporary storage LEVN = LSGN(0) .GE. LEVEL+1 LEVNM1 = LSGNM1(0) .GE. LEVEL+1 IF (FIRST) THEN C Store X- and Y- coordinates, and initial solution in Un = Un-1 LUNM1 = LUN LX = LUNP1+LENU LY = LX+NPTS LZ = LY+NPTS LUIB = LZ+NPTS LRWK = LUIB+NIBPTS*NPDE CALL SETXYZ (XL,YF,ZD, DX, DY, DZ, + IWK(LLPLN), IWK(LIPLN), IWK(LLROW), IWK(LIROW), IWK(LICOL), + RWK(LX), RWK(LY), RWK(LZ)) RWK(LUN) = 0.0 CALL PDEIV (T0, RWK(LX), RWK(LY), RWK(LZ), RWK(LUN+1), + NPTS, NPDE) C ELSE IF (SECOND) THEN C Get Un on refined grid CALL GETSOL (NPDE, RWK(LUNC), IWK(LGNP1C), + LEVN, RWK(LSUN(LEVEL+1)), IWK(LSGN(LEVEL+1)), + RWK(LUN), IWK(LGNP1), IWK(LIWK), RWK(LRWK)) C Store X- and Y- coordinates and initial solution in Un-1 CALL SETXYZ (XL,YF,ZD, DX, DY, DZ, + IWK(LLPLN), IWK(LIPLN), IWK(LLROW), IWK(LIROW), IWK(LICOL), + RWK(LX), RWK(LY), RWK(LZ)) RWK(LUNM1) = 0.0 CALL PDEIV (T0, RWK(LX), RWK(LY), RWK(LZ), RWK(LUNM1+1), + NPTS, NPDE) C ELSE C Get Un-1 and Un on refined grid LUNM1T = MAX(LUNM1,LXC) CALL GETSOL (NPDE, RWK(LUNM1C), IWK(LGNP1C), + LEVNM1, RWK(LSUNM1(LEVEL+1)), IWK(LSGNM1(LEVEL+1)), + RWK(LUNM1T), IWK(LGNP1), IWK(LIWK), RWK(LRWK)) IF (LUNM1T .GT. LUNM1) + CALL RCOPY (LENU, RWK(LUNM1T), RWK(LUNM1)) CALL GETSOL (NPDE, RWK(LUNC), IWK(LGNP1C), + LEVN, RWK(LSUN(LEVEL+1)), IWK(LSGN(LEVEL+1)), + RWK(LUN), IWK(LGNP1), IWK(LIWK), RWK(LRWK)) C Store X- and Y- coordinates CALL SETXYZ (XL,YF,ZD, DX, DY, DZ, + IWK(LLPLN), IWK(LIPLN), IWK(LLROW), IWK(LIROW), IWK(LICOL), + RWK(LX), RWK(LY), RWK(LZ)) C ENDIF C Get initial solution Un+1, store internal boundary values also in UIB C list CALL GETINI (NPDE, RWK(LUNP1I), RWK(LUNP1C), IWK(LGNP1C), + LEVN, RWK(LSSN(LEVEL+1)), IWK(LSGN(LEVEL+1)), + RWK(LUNP1), IWK(LGNP1), RWK(LUIB), IWK(LIWK), RWK(LRWK)) LUNP1I = LRWK LRWK = LUNP1I + LENU CALL RCOPY (LENU, RWK(LUNP1), RWK(LUNP1I)) LEVEL = LEVEL+1 GOTO 100 Ccc End Refinement Loop C 200 CONTINUE C Ccc Time step finished C Inject values from finest level LSGNP1(0) = LEVEL LSUNP1(LEVEL) = LSSNP1(LEVEL) DO 210 LEV = LEVEL, 2, -1 LSUNP1(LEV-1) = LSUNP1(LEV) + LENU CALL PUTSOL (NPDE, RWK(LSUNP1(LEV)), IWK(LSGNP1(LEV)), + RWK(LSSNP1(LEV-1)), IWK(LSGNP1(LEV-1)), + RWK(LSUNP1(LEV-1)), LENU) 210 CONTINUE LRWK = LSUNP1(1) + LENU C Ccc Check time-error LU = LSUNP1(1)+LENUB LUO = LSSNP1(1)-LENUB OK = CHKTIM (RWK, LU, LUO, NPDE, IWK, + LSGNP1, TIMWGT, RELTOL, ABSTOL, RWK(LRWK), DT, DTNEW, TIMMON) IF (LUNPDS .NE. 0) THEN WRITE(LUNPDS,'(''TN='',E10.2,'', DT='',E10.2, + '', DTNEW='',E10.2, '', TIMMON='',E10.2)') + TN, DT, DTNEW, TIMMON ENDIF C Restrict stepsize DTNEW = MIN(DTNEW, DTMAX) IF (.NOT. OK) THEN C Ccc Time step rejected NREJS = NREJS+1 IF (LUNPDS .NE. 0) THEN WRITE(LUNPDS,'(''Time step rejected'')') ENDIF DT = DTNEW GOTO 10 ELSE C Ccc Time step accepted NSTEPS = NSTEPS+1 C Ccc Time step accepted; move data saved for Tn to nm1-save and C data at Tn+1 to n-save. C C Move updated solution at Tn (Un) to Unm1 save, and gridstructure at Tn C to Gnm1 save C NB. For first step this is not necessary, but harmless MLVNM1 = LSGNM1(0) MLVN = LSGN(0) C Start of Unm1 data (= 2*NPTSB+1) LUNM1 = LSUNM1(MLVNM1) C Start of updated Un data LUN = LSUN(MLVN) C LSSNP1(1)-1: end of updated Un data LENUN = LSSNP1(1) - LUN CALL RCOPY (LENUN, RWK(LUN), RWK(LUNM1)) C Adjust pointers to Unm1 data DO 220 LEV = MLVN, 1, -1 LSUNM1(LEV) = LSUN(LEV) - (LUN-LUNM1) 220 CONTINUE C New start of not-updated Un data LSN = LUNM1 + LENUN C C New max. Gnm1-level LSGNM1(0) = MLVN IF (MLVNM1 .EQ. 1) THEN C Grids already in place, adjust pointers DO 230 LEV = 2, MLVN LSGNM1(LEV) = LSGN(LEV) 230 CONTINUE C New start of Gn data is old one LGN = LIWKB ELSE IF (MLVN .GT. 1) THEN C Both Gnm1 and Gn have more than 1 level, move Gn C Start of Gnm1 data (after base grid) LGNM1 = LSGNM1(2) C Start of Gn data LGN = LSGN(2) C LSGNP1(2)-1: end of Gn data LENGN = LSGNP1(2) - LGN CALL ICOPY (LENGN, IWK(LGN), IWK(LGNM1)) C Adjust pointers to Gnm1 data DO 240 LEV = 2, MLVN LSGNM1(LEV) = LSGN(LEV) - (LGN-LGNM1) 240 CONTINUE C New start of Gn data LGN = LSGNM1(2) + LENGN ELSE C At Tn only base grid, new start of Gn data is after base grid LGN = LSGNM1(2) ENDIF C C Move Tn+1 data, not_updated solution (Snp1) to Sn save, gridstructure C to Gn save, and injected solution to Un save MLVNP1 = LSGNP1(0) LSGN(0) = MLVNP1 C Move not-updated solution Snp1 on base grid CALL RCOPY (LENUB, RWK(LSSNP1(1)), RWK(LSN)) LSSN(1) = LSN LSN = LSN + LENUB C Move Snp1 and (LROW,IROW,ICOL) of higher levels, adjust pointers to C Sn and Gn data DO 250 LEV = 2, MLVNP1 LLPLN = LSGNP1(LEV) NPLNS = IWK(LLPLN) LIPLN = LLPLN+NPLNS+2 NROWS = IWK(LLPLN+NPLNS+1)-1 LLROW = LIPLN+NPLNS NPTS = IWK(LLROW+NROWS)-1 LENS = NPTS*NPDE+1 LENG = NPLNS+2 + NPLNS + NROWS+1 + NROWS + NPTS CALL RCOPY (LENS, RWK(LSSNP1(LEV)), RWK(LSN)) LSSN(LEV) = LSN LSN = LSN + LENS CALL ICOPY (LENG, IWK(LSGNP1(LEV)), IWK(LGN)) LSGN(LEV) = LGN LGN = LGN + LENG 250 CONTINUE C C Adjust pointer to solution on highest grid level LSUN(MLVNP1) = LSSN(MLVNP1) IF (MLVNP1 .GT. 1) THEN C Move updated solutions on grids (max.lev-1),...,2 and adjust C pointers to Un data LUNP1 = LSUNP1(MLVNP1-1) LEUNP1 = LSUNP1(1)+LENUB - LUNP1 CALL RCOPY (LEUNP1, RWK(LUNP1), RWK(LSN)) DO 260 LEV = 1, MLVNP1-1 LSUN(LEV) = LSUNP1(LEV) - (LUNP1-LSN) 260 CONTINUE ENDIF C Ccc Set pointer to not updated base grid solution at Tn+1 LSSNP1(1) = LSUN(1) + LENUB Ccc Set pointer to first free element after grid structure of max. C refinement level for Tn LIWKB = LGN C Ccc Adapt time variables CALL MONITR (TN+DT, DT, DTNEW, XL, YF, ZD, DXB, DYB, DZB, + LSGN, IWK, LSUN, RWK) TN = TN + DT DTO = DT DT = DTNEW IF (FIRST) THEN FIRST = .FALSE. SECOND = .TRUE. ELSE IF (SECOND) THEN SECOND = .FALSE. ENDIF IF (TN .GE. TE) THEN IF (LUNPDS .NE. 0) THEN WRITE(LUNPDS,'(''# steps accepted:'',I5, + '', # steps rejected:'',I5)') NSTEPS, NREJS ENDIF RETURN ELSE GOTO 10 ENDIF ENDIF RETURN END SUBROUTINE INIGRD (MAXPTS, XL, YF, ZD, XR, YB, ZU, DX, DY, DZ, + XYZ, IWK, NPTS, LIWK, IERR) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER MAXPTS, IWK(*), NPTS, LIWK, IERR REAL XL, YF, ZD, XR, YB, ZU, DX, DY, DZ, XYZ(*) C Ccc PURPOSE: C Stores datastructure and coordinate values of initial grid (rowwise). C A (virtual) rectangular box is placed around the irregular domain. The C intersection point of the left, front, and down plane of this box is C (XL,YF,ZD) in physical coordinates and (0,0,0) in column, row, resp. C plane coordinates. The intersection point of the right, back, and C upper plane is (XR,YB,ZU) resp. (Nx,Ny,Nz), where Nx = (XR-XL)/DX, C Ny = (YB-YF)/DY, and Nz = (ZU-ZD)/DZ. Only real grid points are stored C in the order: plane, row, column. C In the default case the domain is a rectangular prism and the user C has to specify only the (XL,YF,ZD)- and the (XR,YB,ZU)-point, and C the gridwidth in each direction. Otherwise the user has to write C the domain specifying routine INIDOM in which also the coordinate C values and the cellwidths can be specified. C Ccc PARAMETER DESCRIPTION: C MAXPTS : IN. Max. # grid points allowed by the available workspace C XL : INOUT. X-coordinate of left/front/down point of virtual box C YF : INOUT. Y-coordinate of left/front/down point of virtual box C ZD : INOUT. Z-coordinate of left/front/down point of virtual box C XR : INOUT. X-coordinate of right/back/upper point of virtual box C YB : INOUT. Y-coordinate of right/back/upper point of virtual box C ZU : INOUT. Z-coordinate of right/back/upper point of virtual box C DX : INOUT. Grid width in X-direction C DY : INOUT. Grid width in Y-direction C DZ : INOUT. Grid width in Z-direction C XYZ : OUT. Contains the X-, Y- and Z-coordinates for the base grid C IWK : OUT. Contains the following arrays: CcLPLN : (0:LPLN(0)+1) Cc LPLN(0) = NPLNS: Actual # planes in LROW Cc LPLN(1:NPLNS): pointers to the start of a plane in LROW Cc LPLN(NPLNS+1) = NROWS+1: Total # rows in grid + 1 CcIPLN : (NPLNS) Cc IPLN(IP): plane number of plane IP in virtual box CcLROW : (NROWS+1) Cc LROW(1:NROWS): pointers to the start of a row in the grid Cc LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 CcIROW : (NROWS) Cc IROW(IR): row number of row IR in virtual box CcICOL : (NPTS) Cc ICOL(IPT): column number of grid point IPT in virtual box CcLLBND : (0:LLBND(0)+2) Cc LLBND(0) = NBNDS: total # physical planes in actual domain. Cc NB. edges and corners are stored for each plane they Cc belong to. Cc LLBND(1:NBNDS): pointers to a specific boundary in LBND Cc LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points Cc in LBND + 1 Cc LLBND(NBNDS+1): pointer to internal boundary in LBND Cc LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 CcILBND : (NBNDS) Cc ILBND(IB): type of boundary: Cc 1: Left plane -I Cc 2: Down plane I Cc 3: Right plane I max. first order derivative Cc 4: Up plane I Cc 5: Front plane I Cc 6: Back plane -I CcLBND : (NBIPTS) Cc LBND(IBPT): pointer to boundary point in actual grid CcLBLWY : IN. (0:NPTS) Cc LBLWY(IPT): pointer to node below in Y-direction in Cc actual grid Cc 0, if index node is front-plane boundary point CcLABVY : IN. (0:NPTS) Cc LABVY(IPT): pointer to node above in Y-direction in Cc actual grid Cc 0, if index node is back-plane boundary point CcLBLWZ : IN. (0:NPTS) Cc LBLWZ(IPT): pointer to node below in Z-direction in Cc actual grid Cc 0, if index node is down-plane boundary point CcLABVZ : IN. (0:NPTS) Cc LABVZ(IPT): pointer to node above in Z-direction in Cc actual grid Cc 0, if index node is up-plane boundary point Cc (Even if LINSYS/=0, because of restart:) Cc The next 2 arrays are used for the Jacobian structure and its Cc ILU CcLLDG : (NPTS,-9:-2) Cc LLDG(IPT,-9): pointer to node Y-below Z-below Cc or to node Z-below Z-below Cc LLDG(IPT,-8): pointer to node left of Z-below Cc LLDG(IPT,-7): pointer to node Z-below Cc LLDG(IPT,-6): pointer to node right of Z-below Cc LLDG(IPT,-5): pointer to node Y-above Z-below Cc LLDG(IPT,-4): pointer to node left of Y-below Cc or to node Y-below Y-below Cc LLDG(IPT,-3): pointer to node Y-below Cc LLDG(IPT,-2): pointer to node right of Y-below Cc or to node left of the node left CcLUDG : (NPTS,2:9) Cc LUDG(IPT,2): pointer to node left of Y-above Cc or to node right of the node right Cc LUDG(IPT,3): pointer to node Y-above Cc LUDG(IPT,4): pointer to node right of node Y-above Cc or to node Y-above Y-above Cc LUDG(IPT,5): pointer to node Y-below Z-above Cc LUDG(IPT,6): pointer to node left of Z-above Cc LUDG(IPT,7): pointer to node Z-above Cc LUDG(IPT,8): pointer to node right of Z-above Cc LUDG(IPT,9): pointer to node Y-above Z-above Cc or to node Z-above Z-above Cc the next 4 arrays are used to hold the data dependency lists Cc for the ILU factorization and the forward, resp. backward Cc sweep of the backsolve CcLSL : LSL(NPTS) Cc LSL(ISLPT): pointer to node in actual grid CcLLSL : LLSL(0:LLSL(0)) Cc LLSL(0) = # independent data dependency lists in ILU Cc factorization and forward sweep Cc LLSL(1:LLSL(0)): pointers to the start of a list in LSL CcLSU : LSU(NPTS) Cc LSU(ISLPT): pointer to node in actual grid CcLLSU : LLSU(0:LLSU(0)) Cc LLSU(0) = # independent data dependency lists in backward C sweep Cc LLSU(1:LLSU(0)): pointers to the start of a list in LSU C NPTS : OUT. # grid points in base grid C LIWK : OUT. Pointer to first free element in IWK C IERR : OUT. Error return flag C 0: OK. C 1: workspace too small for required # gridpoints C Ccc EXTERNALS USED: LOGICAL INIDOM EXTERNAL ICOPY, INIDOM, JACSDP, JACSLP, JACSUP, SETBA, SETXYZ C C----------------------------------------------------------------------- C INTEGER I1, I2, I3, I4, I5, I6, I7, I8, + LLPLN, LIPLN, LLROW, LIROW, LICOL, + LLLBND, LILBND, LLBNDP, LLBLWY, LLABVY, LLBLWZ, LLABVZ, + NPLNS, NROWS, NBNDS, NBDPTS, + LLLDG, LLUDG, LLSLP, LLLSL, LLSUP, LLLSU LOGICAL OK C IERR = 0 C Ccc Get (user defined) initial domain I1 = 1 I2 = I1 + MAXPTS I3 = I2 + MAXPTS I4 = I3 + MAXPTS I5 = I4 + MAXPTS I6 = I5 + MAXPTS I7 = I6 + MAXPTS I8 = I7 + MAXPTS OK = INIDOM (MAXPTS, XL, YF, ZD, XR, YB, ZU, DX, DY, DZ, + IWK(I1), IWK(I2), IWK(I3), IWK(I4), IWK(I5), IWK(I6), IWK(I7), + IWK(I8)) IF (.NOT. OK) THEN IERR = 1 NPTS = MAXPTS RETURN ENDIF C Ccc Copy integer arrays to their correct position in the IWK array NPLNS = IWK(I1) NROWS = IWK(I1+NPLNS+1)-1 NPTS = IWK(I3+NROWS)-1 NBNDS = IWK(I6) NBDPTS = IWK(I6+NBNDS+1)-1 C LPLN at correct position LLPLN = 1 C Copy IPLN LIPLN = LLPLN+NPLNS+2 CALL ICOPY (NPLNS, IWK(I2), IWK(LIPLN)) C Copy LROW LLROW = LIPLN+NPLNS CALL ICOPY (NROWS+1, IWK(I3), IWK(LLROW)) C Copy IROW LIROW = LLROW+NROWS+1 CALL ICOPY (NROWS, IWK(I4), IWK(LIROW)) C Copy ICOL LICOL = LIROW+NROWS CALL ICOPY (NPTS, IWK(I5), IWK(LICOL)) C Copy LLBND LLLBND = LICOL+NPTS CALL ICOPY (NBNDS+2, IWK(I6), IWK(LLLBND)) C No internal boundaries IWK(LLLBND+NBNDS+2) = NBDPTS+1 C Copy ILBND LILBND = LLLBND+NBNDS+3 CALL ICOPY (NBNDS, IWK(I7), IWK(LILBND)) C Copy LBND LLBNDP = LILBND+NBNDS CALL ICOPY (NBDPTS, IWK(I8), IWK(LLBNDP)) C Ccc Store X-, Y-, and Z-coordinates CALL SETXYZ (XL, YF, ZD, DX, DY, DZ, + IWK(LLPLN), IWK(LIPLN), IWK(LLROW), IWK(LIROW), IWK(LICOL), + XYZ(1), XYZ(1+NPTS), XYZ(1+2*NPTS)) C Ccc Set pointers to nodes below and above a grid point LLBLWY = LLBNDP+NBDPTS LLABVY = LLBLWY+NPTS+1 LLBLWZ = LLABVY+NPTS+1 LLABVZ = LLBLWZ+NPTS+1 CALL SETBA (IWK(LLPLN), IWK(LIPLN), IWK(LLROW), IWK(LIROW), + IWK(LICOL), IWK(LLBLWY), IWK(LLABVY), IWK(LLBLWZ), IWK(LLABVZ)) LIWK = LLABVZ+NPTS+1 C Ccc Set pointers to lower and upper diagonals in Jacobian for base grid LLLDG = LIWK LLUDG = LLLDG + NPTS*8 CALL JACSDP (NPTS, IWK(LLLBND), IWK(LILBND), IWK(LLBNDP), + IWK(LLBLWY), IWK(LLABVY), IWK(LLBLWZ), IWK(LLABVZ), + IWK(LLLDG), IWK(LLUDG)) LIWK = LLUDG + NPTS*8 C Ccc Make data-dependency lists for ILU on base-grid Jacobian LLSLP = LIWK LLLSL = LLSLP + NPTS LIWK = LLLSL + NPTS CALL JACSLP (NPTS, IWK(LLLBND), IWK(LILBND), IWK(LLBNDP), + IWK(LLLDG), IWK(LIWK), IWK(LLLSL), IWK(LLSLP)) LLSUP = LLLSL + IWK(LLLSL)+1 LLLSU = LLSUP + NPTS LIWK = LLLSU + NPTS CALL JACSUP (NPTS, IWK(LLLBND), IWK(LILBND), IWK(LLBNDP), + IWK(LLUDG), IWK(LIWK), IWK(LLLSU), IWK(LLSUP)) LIWK = LLLSU + IWK(LLLSU)+1 RETURN END SUBROUTINE SETBA (LPLN, IPLN, LROW, IROW, ICOL, + LBLWY, LABVY, LBLWZ, LABVZ) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER LPLN(0:*), IPLN(*), LROW(*), IROW(*), ICOL(*), + LBLWY(0:*), LABVY(0:*), LBLWZ(0:*), LABVZ(0:*) C Ccc PURPOSE: C Set pointers to nodes below and above a grid point, if such a node C exists, otherwise the pointer is set to zero. C Ccc PARAMETER DESCRIPTION: C LPLN : IN. (0:LPLN(0)+1) C LPLN(0) = NPLNS: Actual # planes in LROW C LPLN(1:NPLNS): pointers to the start of a plane in LROW C LPLN(NPLNS+1) = NROWS+1: Total # rows in grid + 1 C IPLN : IN. (NPLNS) C IPLN(IP): plane number of plane IP in virtual box C LROW : IN. (NROWS+1) C LROW(1:NROWS): pointers to the start of a row in the grid C LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 C IROW : IN. (NROWS) C IROW(IR): row number of row IR in virtual box C ICOL : IN. (NPTS) C ICOL(IPT): column number of grid point IPT in virtual box C LBLWY : OUT. (0:NPTS) C LBLWY(IPT): pointer to node below in Y-direction in C actual grid C 0, if index node is front-plane boundary point C LABVY : OUT. (0:NPTS) C LABVY(IPT): pointer to node above in Y-direction in C actual grid C 0, if index node is back-plane boundary point C LBLWZ : OUT. (0:NPTS) C LBLWZ(IPT): pointer to node below in Z-direction in C actual grid C 0, if index node is down-plane boundary point C LABVZ : OUT. (0:NPTS) C LABVZ(IPT): pointer to node above in Z-direction in C actual grid C 0, if index node is up-plane boundary point C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER IP, IPT, IPTA, IR, IRA, NPLNS, NROWS, NPTS C NPLNS = LPLN(0) NROWS = LPLN(NPLNS+1)-1 NPTS = LROW(NROWS+1)-1 DO 10 IPT = 0, NPTS LBLWY(IPT) = 0 LABVY(IPT) = 0 LBLWZ(IPT) = 0 LABVZ(IPT) = 0 10 CONTINUE DO 20 IP = 1, NPLNS DO 30 IR = LPLN(IP), LPLN(IP+1)-2 C Check if next row in datastructure is next row in virtual plane IF (IROW(IR) .EQ. IROW(IR+1)-1) THEN C Compare column indices in row with those in row above, C until the two match or one of both rows is finished IPTA = LROW(IR+1) DO 40 IPT = LROW(IR), LROW(IR+1)-1 50 IF (ICOL(IPT) .LT. ICOL(IPTA)) THEN GOTO 40 ELSE IF (ICOL(IPT) .EQ. ICOL(IPTA)) THEN C Set above pointer in current row and below pointer in C next row LBLWY(IPTA) = IPT LABVY(IPT) = IPTA ELSE IPTA = IPTA + 1 IF (IPTA .GT. LROW(IR+2)-1) GOTO 30 GOTO 50 ENDIF 40 CONTINUE ENDIF 30 CONTINUE 20 CONTINUE DO 100 IP = 1, NPLNS-1 C Check if next plane in datastructure is next plane in virtual box IF (IPLN(IP) .EQ. IPLN(IP+1)-1) THEN C Compare row indices in plane with those in plane above, until C the two match or one of both planes is finished IRA = LPLN(IP+1) DO 110 IR = LPLN(IP), LPLN(IP+1)-1 120 IF (IROW(IR) .LT. IROW(IRA)) THEN GOTO 110 ELSE IF (IROW(IR) .EQ. IROW(IRA)) THEN C Compare column indices in row with those in row above, C until the two match or one of both rows is finished IPTA = LROW(IRA) DO 130 IPT = LROW(IR), LROW(IR+1)-1 140 IF (ICOL(IPT) .LT. ICOL(IPTA)) THEN GOTO 130 ELSE IF (ICOL(IPT) .EQ. ICOL(IPTA)) THEN C Set above pointer in current row and below pointer C in next row LBLWZ(IPTA) = IPT LABVZ(IPT) = IPTA ELSE IPTA = IPTA + 1 IF (IPTA .GT. LROW(IRA+1)-1) GOTO 110 GOTO 140 ENDIF 130 CONTINUE ELSE IRA = IRA + 1 IF (IRA .GT. LPLN(IP+2)-1) GOTO 100 GOTO 120 ENDIF 110 CONTINUE ENDIF 100 CONTINUE RETURN END LOGICAL FUNCTION CHKGRD (T, LEVEL, U, NPDE, X, Y, Z, SPCTOL, + TOLWGT, ISTRUC, WORK, REFFLG, SPCMON) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER LEVEL, NPDE, ISTRUC(0:*) LOGICAL REFFLG(0:*) REAL T, U(0:*), X(*), Y(*), Z(*), + SPCTOL(NPDE), TOLWGT, WORK(*), SPCMON C Ccc PURPOSE: C Check if grid needs to be refined. If so, CHKGRD = .FALSE. and C flags are set where the refinement is needed. C Ccc PARAMETER DESCRIPTION: C T : IN. Current time level C LEVEL : IN. Current grid level C U : IN. Solution on current grid C NPDE : IN. # PDE components C X,Y,Z : IN. Physical coordinates of grid points C SPCTOL : IN. User defined space tolerance for each PDE component C TOLWGT : IN. Weight factor for tolerance. If new level at previous C time existed TOLWGT < 1, else 1 C ISTRUC : IN. Datastructure for current grid C WORK : WORK. (3*NPTS*NPDE) C REFFLG : OUT. If one of the corners of a cell is flagged the cell C needs to be refined C SPCMON : OUT. Value of space monitor C Ccc EXTERNALS USED: LOGICAL CHKREF EXTERNAL CHKREF C C----------------------------------------------------------------------- C INTEGER LLPLN, NPLNS, LIPLN, LLROW, NROWS, NPTS, LIROW, LICOL, + LLLBND, NBNDS, NBIPTS, LILBND, LLBNDP, + LLBLWY, LLABVY, LLBLWZ, LLABVZ C LLPLN = 0 NPLNS = ISTRUC(LLPLN) LIPLN = LLPLN+NPLNS+2 LLROW = LIPLN+NPLNS NROWS = ISTRUC(LLPLN+NPLNS+1)-1 NPTS = ISTRUC(LLROW+NROWS)-1 LIROW = LLROW+NROWS+1 LICOL = LIROW+NROWS LLLBND = LICOL+NPTS NBNDS = ISTRUC(LLLBND) NBIPTS = ISTRUC(LLLBND+NBNDS+2)-1 LILBND = LLLBND+NBNDS+3 LLBNDP = LILBND+NBNDS LLBLWY = LLBNDP+NBIPTS LLABVY = LLBLWY+NPTS+1 LLBLWZ = LLABVY+NPTS+1 LLABVZ = LLBLWZ+NPTS+1 C Ccc Compute space monitor and check if grid needs to be refined CHKGRD = CHKREF (T, LEVEL, U, NPTS, NPDE, X, Y, Z, + ISTRUC(LLLBND), ISTRUC(LILBND), ISTRUC(LLBNDP), + ISTRUC(LLBLWY), ISTRUC(LLABVY), ISTRUC(LLBLWZ), ISTRUC(LLABVZ), + SPCTOL, TOLWGT, WORK(1),WORK(1+NPTS*NPDE),WORK(1+2*NPTS*NPDE), + REFFLG, SPCMON) RETURN END SUBROUTINE MKFGRD (REFFLG, IWK, LENIWK, LISTRC, LISTRF, LINSYS, + NPTSF, LIWK, IERR) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER LENIWK INTEGER IWK(LENIWK), LISTRC, LISTRF, LINSYS, NPTSF, LIWK, IERR LOGICAL REFFLG(0:*) C Ccc PURPOSE: C Make fine grid structure and store in IWK(LISTRF+...) C Ccc PARAMETER DESCRIPTION: C REFFLG : IN. If one of the corners of a cell is flagged the cell C needs to be refined C IWK : INOUTWORK. Integer workspace. C IN: Coarse grid structure C OUT: If coarse grid is base grid: coarse grid structure, C otherwise (LPLN,...,LBND) of coarse grid structure, and C fine grid structure (LPLN,...,LLLSU) C WORK: (NPTS+1+NPTSF+1) at end of IWK for domain flags C LENIWK : IN. Length of IWK C LISTRC : IN. Pointer to coarse grid structure in IWK C LISTRF : IN. Pointer to place where fine grid structure should be C stored in IWK C LINSYS : IN. Linear system solver in use C 0: BiCGStab + ILU C 1: Diagonally scaled GCRO C NPTSF : OUT. # grid points in fine grid C LIWK : OUT. Pointer to first free element in IWK after fine grid C structure C IERR : OUT. Error return flag C 0: OK C 1: workspace too small for required # fine gridpoints C Ccc EXTERNALS USED: EXTERNAL DOMFLG, ICOPY, JACSDP, JACSLP, JACSUP, MKBND, REFDOM, + SETBA C C----------------------------------------------------------------------- C INTEGER LLPLN, NPLNS, LIPLN, LLROW, NROWS, NPTS, LIROW, LICOL, + LLLBND, NBNDS, NBIPTS, LILBND, LLBNDP, + LLBLWY, LLABVY, LLBLWZ, LLABVZ, LLLDG, + LLPLNF, NPLNSF, LIPLNF, LLROWF, NROWSF, LIROWF, LICOLF, + LLLBDF, NBIPTF, LILBDF, LLBNDF, + LLBLYF, LLABYF, LLBLZF, LLABZF, + LLLDGF, LLUDGF, LLSLF, LLLSLF, LLSUF, LLLSUF, + LIDOM, LIDOMF, MAXPTS C IERR = 0 C LLPLN = LISTRC NPLNS = IWK(LLPLN) LIPLN = LLPLN+NPLNS+2 LLROW = LIPLN+NPLNS NROWS = IWK(LLPLN+NPLNS+1)-1 NPTS = IWK(LLROW+NROWS)-1 LIROW = LLROW+NROWS+1 LICOL = LIROW+NROWS LLLBND = LICOL+NPTS NBNDS = IWK(LLLBND) NBIPTS = IWK(LLLBND+NBNDS+2)-1 LILBND = LLLBND+NBNDS+3 LLBNDP = LILBND+NBNDS LLBLWY = LLBNDP+NBIPTS LLABVY = LLBLWY+NPTS+1 LLBLWZ = LLABVY+NPTS+1 LLABVZ = LLBLWZ+NPTS+1 LLLDG = LLABVZ+NPTS+1 LIDOM = LENIWK-NPTS C Ccc Make data structure fine grid MAXPTS = (LIDOM-MAX(LISTRF,LLLDG))/6 LIDOMF = LIDOM -MAXPTS-1 LICOLF = LIDOMF-MAXPTS LIROWF = LICOLF-MAXPTS+1 LLROWF = LIROWF-MAXPTS LIPLNF = LLROWF-MAXPTS LLPLNF = LIPLNF-MAXPTS C Set domain flags for coarse grid CALL DOMFLG (NPTS, IWK(LLLBND), IWK(LLBNDP), IWK(LIDOM)) CALL REFDOM (MAXPTS, REFFLG, NBNDS, + IWK(LLPLN), IWK(LIPLN), IWK(LLROW), IWK(LIROW), IWK(LICOL), + IWK(LLBLWY), IWK(LLABVY), IWK(LLBLWZ), IWK(LLABVZ), IWK(LIDOM), + IWK(LLPLNF), IWK(LIPLNF), IWK(LLROWF), IWK(LIROWF), + IWK(LICOLF), IWK(LIDOMF), NPTSF, IERR) IF (IERR .EQ. 1) THEN LIWK = LENIWK+1 RETURN ENDIF C Ccc Move fine grid structure to their correct position NPLNSF = IWK(LLPLNF) CALL ICOPY (NPLNSF+2, IWK(LLPLNF), IWK(LISTRF)) LLPLNF = LISTRF CALL ICOPY (NPLNSF, IWK(LIPLNF), IWK(LLPLNF+NPLNSF+2)) LIPLNF = LLPLNF+NPLNSF+2 NROWSF = IWK(LLPLNF+NPLNSF+1)-1 CALL ICOPY (NROWSF+1, IWK(LLROWF), IWK(LIPLNF+NPLNSF)) LLROWF = LIPLNF+NPLNSF CALL ICOPY (NROWSF, IWK(LIROWF), IWK(LLROWF+NROWSF+1)) LIROWF = LLROWF+NROWSF+1 CALL ICOPY (NPTSF, IWK(LICOLF), IWK(LIROWF+NROWSF)) LICOLF = LIROWF+NROWSF C Ccc Copy # physical boundaries and boundary types from coarse grid LLLBDF = LICOLF+NPTSF LILBDF = LLLBDF+NBNDS+3 LLBNDF = LILBDF+NBNDS IWK(LLLBDF) = NBNDS CALL ICOPY (NBNDS, IWK(LILBND), IWK(LILBDF)) C Ccc Set pointers below and above and new boundary lists LLBLYF = LLBNDF+NPTSF LLABYF = LLBLYF+NPTSF+1 LLBLZF = LLABYF+NPTSF+1 LLABZF = LLBLZF+NPTSF+1 LIWK = LLABZF+NPTSF+1 IF (LIWK .GT. LENIWK) THEN IERR = 1 RETURN ENDIF CALL SETBA (IWK(LLPLNF), IWK(LIPLNF), IWK(LLROWF), IWK(LIROWF), + IWK(LICOLF), IWK(LLBLYF),IWK(LLABYF), IWK(LLBLZF),IWK(LLABZF)) CALL MKBND (NPTSF, + IWK(LLPLNF),IWK(LIPLNF), IWK(LLROWF),IWK(LIROWF), IWK(LICOLF), + IWK(LLBLYF), IWK(LLABYF), IWK(LLBLZF),IWK(LLABZF), + IWK(LIDOMF), IWK(LLLBDF), IWK(LILBDF), IWK(LLBNDF)) C Ccc Move below/above pointers to their correct position NBIPTF = IWK(LLLBDF+NBNDS+2)-1 CALL ICOPY (NPTSF+1, IWK(LLBLYF), IWK(LLBNDF+NBIPTF)) LLBLYF = LLBNDF+NBIPTF CALL ICOPY (NPTSF+1, IWK(LLABYF), IWK(LLBLYF+NPTSF+1)) LLABYF = LLBLYF+NPTSF+1 CALL ICOPY (NPTSF+1, IWK(LLBLZF), IWK(LLABYF+NPTSF+1)) LLBLZF = LLABYF+NPTSF+1 CALL ICOPY (NPTSF+1, IWK(LLABZF), IWK(LLBLZF+NPTSF+1)) LLABZF = LLBLZF+NPTSF+1 LIWK = LLABZF+NPTSF+1 IF (LINSYS .NE. 0) RETURN C Ccc Set pointers to lower and upper diagonals in Jacobian for fine grid LLLDGF = LIWK LLUDGF = LLLDGF+NPTSF*8 LIWK = LLUDGF+NPTSF*8 IF (LIWK .GT. LENIWK) THEN IERR = 1 RETURN ENDIF CALL JACSDP (NPTSF, IWK(LLLBDF), IWK(LILBDF), IWK(LLBNDF), + IWK(LLBLYF), IWK(LLABYF), IWK(LLBLZF), IWK(LLABZF), + IWK(LLLDGF), IWK(LLUDGF)) C Ccc Make data-dependency lists for ILU on fine-grid Jacobian LLSLF = LIWK LLLSLF = LLSLF +NPTSF LIWK = LLLSLF+NPTSF IF (LIWK+NPTSF .GT. LENIWK) THEN IERR = 1 RETURN ENDIF CALL JACSLP (NPTSF, IWK(LLLBDF), IWK(LILBDF), IWK(LLBNDF), + IWK(LLLDGF), IWK(LIWK), IWK(LLLSLF), IWK(LLSLF)) LLSUF = LLLSLF+IWK(LLLSLF)+1 LLLSUF = LLSUF +NPTSF LIWK = LLLSUF+NPTSF IF (LIWK+NPTSF .GT. LENIWK) THEN LIWK = LIWK+NPTSF IERR = 1 RETURN ENDIF CALL JACSUP (NPTSF, IWK(LLLBDF), IWK(LILBDF), IWK(LLBNDF), + IWK(LLUDGF), IWK(LIWK), IWK(LLLSUF), IWK(LLSUF)) LIWK = LLLSUF+ IWK(LLLSUF)+1 RETURN END LOGICAL FUNCTION CHKREF (T, LEVEL, U, NPTS, NPDE, X, Y, Z, + LLBND, ILBND, LBND, LBLWY, LABVY, LBLWZ, LABVZ, + SPCTOL, TOLWGT, W1, W2, W3, REFFLG, SPCMON) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER LEVEL, NPTS, NPDE, LLBND(0:*), ILBND(*), LBND(*), + LBLWY(0:NPTS), LABVY(0:NPTS), LBLWZ(0:NPTS), LABVZ(0:NPTS) LOGICAL REFFLG(0:NPTS) REAL T, U(0:NPTS*NPDE), X(NPTS), Y(NPTS), Z(NPTS), + SPCTOL(NPDE), TOLWGT, + W1(NPTS*NPDE), W2(NPTS*NPDE), W3(NPTS*NPDE), SPCMON C Ccc PURPOSE: C Check if grid needs to be refined. If so, CHKREF = .FALSE. and C flags are set where the refinement is needed. C C Space monitor: C SPCMON(ipt) = max SPCTOL(ic).(|(dx)^2.Uxx(ipt)| + |(dy)^2.Uyy(ipt)| C (ic = 1, NPDE) + |(dz)^2.Uzz(ipt)|) C A user routine is called to eventually enforce refinement by setting C SPCMON. C If max SPCMON(ipt) < TOLWGT then no refinement is needed, C (ipt = 1, NPTS) C otherwise all gridpoints for which SPCMON(ipt) > 1/4 are flagged C plus their 26 neighbours. C On exit CHKREF = .TRUE. if no refinement is required C Ccc PARAMETER DESCRIPTION: C T : IN. Current time level C LEVEL : IN. Current grid level C U : IN. Array of solution values. C NPTS : IN. # grid points C NPDE : IN. # PDE components C X,Y,Z : IN. Physical coordinates of grid points C LLBND : (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C LBLWY : OUT. (0:NPTS) C LBLWY(IPT): pointer to node below in Y-direction in C actual grid C 0, if index node is back-plane boundary point C LABVY : OUT. (0:NPTS) C LABVY(IPT): pointer to node above in Y-direction in C actual grid C 0, if index node is down-plane boundary point C LBLWZ : OUT. (0:NPTS) C LBLWZ(IPT): pointer to node below in Z-direction in C actual grid C 0, if index node is down-plane boundary point C LABVZ : OUT. (0:NPTS) C LABVZ(IPT): pointer to node above in Z-direction in C actual grid C 0, if index node is up-plane boundary point C SPCTOL : IN. User defined space tolerance for the monitor values of C different components C TOLWGT : IN. Weight factor for tolerance. If new level at previous C time existed TOLWGT < 1, else 1 C W1,W2,W3 : WORK. C REFFLG : OUT. If the solution in a grid point violates the space C monitor condition, the gridpoint and its 26 neighbours are C flagged C SPCMON : OUT. Max SPCMON(ipt) C Ccc EXTERNALS USED: EXTERNAL CHSPCM C C----------------------------------------------------------------------- C INTEGER I, IB, IC, IPT, IM1, IM2, IP1, IP2, LB, NBNDS, NBIPTS C NBNDS = LLBND(0) NBIPTS = LLBND(NBNDS+2)-1 C Ccc Store (dx)^2.Uxx in W1, (dy)^2.Uyy in W2, and (dz)^2.Uzz in W3 C First interior points, boundary values will be rubbish DO 10 I = 2, NPTS*NPDE-1 W1(I) = U(I-1) - 2*U(I) + U(I+1) 10 CONTINUE DO 20 IC = 1, NPDE DO 20 IPT = 1, NPTS I = IPT + (IC-1)*NPTS IM1 = LBLWY(IPT) + (IC-1)*NPTS IP1 = LABVY(IPT) + (IC-1)*NPTS W2(I) = U(IM1) - 2*U(I) + U(IP1) IM1 = LBLWZ(IPT) + (IC-1)*NPTS IP1 = LABVZ(IPT) + (IC-1)*NPTS W3(I) = U(IM1) - 2*U(I) + U(IP1) 20 CONTINUE C C Correct boundaries, first the physical boundaries then the internal C ones DO 30 IB = 1, NBNDS IF (ILBND(IB) .EQ. 1) THEN C Left boundary plane, correct (dx)^2.Uxx in W1 DO 40 IC = 1, NPDE DO 40 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) I = IPT + (IC-1)*NPTS W1(I) = U(I) - 2*U(I+1) + U(I+2) 40 CONTINUE ELSE IF (ILBND(IB) .EQ. 2) THEN C Down boundary plane, correct (dz)^2.Uzz in W3 DO 50 IC = 1, NPDE DO 50 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) I = IPT + (IC-1)*NPTS IP1 = LABVZ(IPT) IP2 = LABVZ(IP1) + (IC-1)*NPTS IP1 = IP1 + (IC-1)*NPTS W3(I) = U(I) - 2*U(IP1) + U(IP2) 50 CONTINUE ELSE IF (ILBND(IB) .EQ. 3) THEN C Right boundary plane, correct (dx)^2.Uxx in W1 DO 60 IC = 1, NPDE DO 60 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) I = IPT + (IC-1)*NPTS W1(I) = U(I) - 2*U(I-1) + U(I-2) 60 CONTINUE ELSE IF (ILBND(IB) .EQ. 4) THEN C Up boundary plane, correct (dz)^2.Uzz in W3 DO 70 IC = 1, NPDE DO 70 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) I = IPT + (IC-1)*NPTS IM1 = LBLWZ(IPT) IM2 = LBLWZ(IM1) + (IC-1)*NPTS IM1 = IM1 + (IC-1)*NPTS W3(I) = U(I) - 2*U(IM1) + U(IM2) 70 CONTINUE ELSE IF (ILBND(IB) .EQ. 5) THEN C Front boundary plane, correct (dy)^2.Uyy in W2 DO 80 IC = 1, NPDE DO 80 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) I = IPT + (IC-1)*NPTS IP1 = LABVY(IPT) IP2 = LABVY(IP1) + (IC-1)*NPTS IP1 = IP1 + (IC-1)*NPTS W2(I) = U(I) - 2*U(IP1) + U(IP2) 80 CONTINUE ELSE IF (ILBND(IB) .EQ. 6) THEN C Back boundary plane, correct (dy)^2.Uyy in W2 DO 90 IC = 1, NPDE DO 90 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) I = IPT + (IC-1)*NPTS IM1 = LBLWY(IPT) IM2 = LBLWY(IM1) + (IC-1)*NPTS IM1 = IM1 + (IC-1)*NPTS W2(I) = U(I) - 2*U(IM1) + U(IM2) 90 CONTINUE ENDIF 30 CONTINUE IB = NBNDS + 1 C Internal boundary, Dirichlet condition, space error = 0 DO 210 IC = 1, NPDE DO 210 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) I = IPT + (IC-1)*NPTS W1(I) = 0.0 W2(I) = 0.0 W3(I) = 0.0 210 CONTINUE C Ccc Compute space monitor SPCMON, and its maximum IC = 1 DO 300 IPT = 1, NPTS W1(IPT) = SPCTOL(IC)*(ABS(W1(IPT)) + ABS(W2(IPT)) + + ABS(W3(IPT))) 300 CONTINUE DO 310 IC = 2, NPDE DO 310 IPT = 1, NPTS I = IPT + (IC-1)*NPTS W1(IPT) = MAX(W1(IPT),SPCTOL(IC)*(ABS(W1(I)) + ABS(W2(I)) + + ABS(W3(I)))) 310 CONTINUE C C Call user routine to possibly force refinement CALL CHSPCM (T, LEVEL, NPTS, X, Y, Z, NPDE, U(1), W1, TOLWGT) C C Compute maximum SPCMON = W1(1) DO 320 IPT = 2, NPTS SPCMON = MAX(SPCMON,W1(IPT)) 320 CONTINUE C Ccc Check if grid refinement is needed IF (SPCMON .LT. TOLWGT) THEN C No refinement needed CHKREF = .TRUE. RETURN ENDIF C Ccc Flag each node where space monitor is too large + its 26 neighbors. C Cells will be refined if a flag is set on 1 corner CHKREF = .FALSE. DO 400 IPT = 0, NPTS REFFLG(IPT) = .FALSE. 400 CONTINUE C C If neighbors in the grid datastructure are not physical neighbors in C the grid the former are wrongly flagged but since those points C are boundary points the flags will be unset later on DO 410 IPT = 1, NPTS IF (W1(IPT) .GE. 0.25) THEN IM1 = LBLWZ(IPT) IF (IM1 .GT. 0) THEN REFFLG(LABVY(IM1-1)) = .TRUE. REFFLG( IM1-1) = .TRUE. REFFLG(LBLWY(IM1-1)) = .TRUE. ENDIF REFFLG(LABVY(IM1)) = .TRUE. REFFLG( IM1) = .TRUE. REFFLG(LBLWY(IM1)) = .TRUE. REFFLG(LABVY(IM1+1)) = .TRUE. REFFLG( IM1+1) = .TRUE. REFFLG(LBLWY(IM1+1)) = .TRUE. C REFFLG(LABVY(IPT-1)) = .TRUE. REFFLG( IPT-1) = .TRUE. REFFLG(LBLWY(IPT-1)) = .TRUE. REFFLG(LABVY(IPT)) = .TRUE. REFFLG( IPT) = .TRUE. REFFLG(LBLWY(IPT)) = .TRUE. IF (IPT .LT. NPTS) THEN REFFLG(LABVY(IPT+1)) = .TRUE. REFFLG( IPT+1) = .TRUE. REFFLG(LBLWY(IPT+1)) = .TRUE. ENDIF C IP1 = LABVZ(IPT) IF (IP1 .GT. 0) THEN REFFLG(LABVY(IP1-1)) = .TRUE. REFFLG( IP1-1) = .TRUE. REFFLG(LBLWY(IP1-1)) = .TRUE. ENDIF REFFLG(LABVY(IP1)) = .TRUE. REFFLG( IP1) = .TRUE. REFFLG(LBLWY(IP1)) = .TRUE. IF (IP1 .LT. NPTS) THEN REFFLG(LABVY(IP1+1)) = .TRUE. REFFLG( IP1+1) = .TRUE. REFFLG(LBLWY(IP1+1)) = .TRUE. ENDIF ENDIF 410 CONTINUE REFFLG(0) = .FALSE. C Unset errorflags at (physical and internal) boundary DO 430 LB = 1, NBIPTS IPT = LBND(LB) REFFLG(IPT) = .FALSE. 430 CONTINUE RETURN END SUBROUTINE DOMFLG (NPTS, LLBND, LBND, IDOM) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, LLBND(0:*), LBND(*), IDOM(0:NPTS) C Ccc PURPOSE: C Set domain flags for determination of location of grid point in grid C Ccc PARAMETER DESCRIPTION: C NPTS : IN. # grid points C LLBND : (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary or corner in C LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C IDOM : OUT. IDOM(IPT): location in domain of node IPT C 0: interior point C IB: on boundary C if not on edge or corner, or if internal boundary C then IB, IB = 1, NBNDS+1 C else | IB4 | IB3 | IB2 | IBYTE | if point is part of C the boundary planes IBYTE, IB2, IB3, and IB4 C Ccc EXTERNALS USED: NONE C INTEGER BYTE PARAMETER (BYTE = 2**8) C C----------------------------------------------------------------------- C INTEGER IPT, IB, LB, NBNDS C NBNDS = LLBND(0) C C Set domain flags DO 10 IPT = 0, NPTS IDOM(IPT) = 0 10 CONTINUE DO 20 IB = 1, NBNDS DO 30 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) IF (IDOM(IPT) .EQ. 0) THEN IDOM(IPT) = IB ELSE IDOM(IPT) = IB+BYTE*IDOM(IPT) ENDIF 30 CONTINUE 20 CONTINUE IB = NBNDS+1 DO 40 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) IDOM(IPT) = IB 40 CONTINUE RETURN END SUBROUTINE REFDOM (MAXPTS, REFFLG, NBNDS, + LPLNC, IPLNC, LROWC, IROWC, ICOLC, + LBLWYC, LABVYC, LBLWZC, LABVZC, IDOMC, + LPLN, IPLN, LROW, IROW, ICOL, IDOM, NPTS, IERR) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER MAXPTS, NBNDS, + LPLNC(0:*), IPLNC(*), LROWC(*), IROWC(*), ICOLC(*), + LABVYC(0:*), LBLWYC(0:*), LABVZC(0:*), LBLWZC(0:*), IDOMC(0:*), + LPLN(0:*), IPLN(*), LROW(*), IROW(*), ICOL(*), IDOM(0:*), + NPTS, IERR LOGICAL REFFLG(0:*) C Ccc PURPOSE: C Create refined grid. If one of the corners of a cell is flagged, the C cell is divided in 8. The (LPLN,IPLN,LROW,IROW,ICOL) structure of the C fine grid will be stored and IDOM will contain domainflags (only for C rows corresponding with the coarse grid) to indicate the location of a C node in the fine grid. C Ccc PARAMETER DESCRIPTION: C MAXPTS : IN. Max. # grid points allowed on fine grid C REFFLG : IN. (0:NPTSC) C If the solution in a grid point violates the space monitor C condition, the gridpoint and its 26 neighbors are flagged. C Gridpoints at the boundaries are not flagged C LPLNC : IN. (0:LPLNC(0)+1) C LPLNC(0) = NPLNSC: Actual # planes in LROWC C LPLNC(1:NPLNSC): pointers to the start of a plane in LROWC C LPLNC(NPLNSC+1) = NROWSC+1: Total # rows in coarse grid + 1 C IPLNC : IN. (NPLNSC) C IPLNC(IP): plane number of plane IP in virtual box C LROWC : IN. (NROWSC+1) C LROWC(1:NROWSC): pointers to the start of a row in the grid C LROWC(NROWSC+1) = NPTSC+1: Actual # nodes in grid + 1 C IROWC : IN. (NROWSC) C IROWC(IR): row number of row IR in virtual box C ICOLC : IN. (NPTSC) C ICOLC(IPT): column number of grid point IPT in virtual box C LBLWYC : IN. (0:NPTSC) C LBLWYC(IPT): pointer to node below in Y-direction in C actual grid C 0, if index node is front-plane boundary point C LABVYC : IN. (0:NPTSC) C LABVYC(IPT): pointer to node above in Y-direction in C actual grid C 0, if index node is back-plane boundary point C LBLWZC : IN. (0:NPTSC) C LBLWZC(IPT): pointer to node below in Z-direction in C actual grid C 0, if index node is down-plane boundary point C LABVZC : IN. (0:NPTSC) C LABVZC(IPT): pointer to node above in Z-direction in C actual grid C 0, if index node is up-plane boundary point C IDOMC : IN. (0:NPTSC) C IDOMC(IPT): location in coarse grid of node IPT C 0: interior point C IB: on boundary C if not on edge or corner, or if internal boundary C then IB, IB = 1, NBNDS+1 C else | IB4 | IB3 | IB2 | IBYTE | if point is part of C the boundary planes IBYTE, IB2, IB3, and IB4 C LPLN : OUT. (0:LPLN(0)+1) C LPLN(0) = NPLNS: Actual # planes in LROW C LPLN(1:NPLNS): pointers to the start of a plane in LROW C LPLN(NPLNS+1) = NROWS+1: Total # rows in grid + 1 C IPLN : OUT. (NPLNS) C IPLN(IP): plane number of plane IP in virtual box C LROW : OUT. (NROWS+1) C LROW(1:NROWS): pointers to the start of a row in the grid C LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 C IROW : OUT. (NROWS) C IROW(IR): row number of row IR in virtual box C ICOL : OUT. (NPTS) C ICOL(IPT): column number of grid point IPT in virtual box C IDOM : OUT. (0:NPTS) C IDOM(IPT): location in coarse grid of node IPT (only set for C rows corresponding with coarse grid rows) C 0: interior point or new horizontal internal boundary C IB: on boundary C if not on edge or corner, or if internal boundary C then IB, IB = 1, NBNDS+1 C else | IB4 | IB3 | IB2 | IBYTE | if point is part of C the boundary planes IBYTE, IB2, IB3, and IB4 C NPTS : OUT. # grid points on fine grid or MAXPTS if IERR=1 C IERR : OUT. Error return flag C 0: OK. C 1: workspace too small for required # fine gridpoints C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER IPC, IP, IPTC, IPT, IPTO, IPTOLD, IRC, IR, IROLD, + NPLNSC, NPLNS, NROWS LOGICAL LEFT, MIDDLE, RIGHT C IERR = 0 IDOM(0) = 0 DO 1 IPT = 1, MAXPTS IDOM(IPT) = -1 1 CONTINUE C NPLNSC = LPLNC(0) C Ccc Create new grid level, all cells with at least one flagged corner C will be refined IP = 0 IR = 0 IPT = 0 DO 10 IPC = 1, NPLNSC C Ccc Make coarse grid plane of fine grid IROLD = IR DO 100 IRC = LPLNC(IPC), LPLNC(IPC+1)-1 C Ccc Make coarse grid row of fine grid IPTOLD = IPT IPTO = IPT LEFT = .FALSE. IPTC = LROWC(IRC) MIDDLE = REFFLG(LBLWYC(LBLWZC(IPTC))) .OR. + REFFLG(LBLWZC(IPTC)) .OR. REFFLG(LABVYC(LBLWZC(IPTC))) + .OR. REFFLG(LBLWYC(IPTC)) .OR. + REFFLG(IPTC) .OR. REFFLG(LABVYC(IPTC)) .OR. + REFFLG(LBLWYC(LABVZC(IPTC))) .OR. + REFFLG(LABVZC(IPTC)) .OR. REFFLG(LABVYC(LABVZC(IPTC))) DO 110 IPTC = LROWC(IRC)+1, LROWC(IRC+1)-1 RIGHT = REFFLG(LBLWYC(LBLWZC(IPTC))) .OR. + REFFLG(LBLWZC(IPTC)) .OR. REFFLG(LABVYC(LBLWZC(IPTC))) + .OR. REFFLG(LBLWYC(IPTC)) .OR. + REFFLG(IPTC) .OR. REFFLG(LABVYC(IPTC)) .OR. + REFFLG(LBLWYC(LABVZC(IPTC))) .OR. + REFFLG(LABVZC(IPTC)) .OR. REFFLG(LABVYC(LABVZC(IPTC))) IF (MIDDLE .OR. RIGHT) THEN C Refine cell IF (IPT+2 .GT. MAXPTS) GOTO 900 C Add node (ICOLC(IPTC-1),IROWC(IRC),IPLNC(IPC)) + C its right neighbor IPT = IPT + 1 ICOL(IPT) = 2*ICOLC(IPTC-1) IF (IDOMC(IPTC-1) .NE. 0) THEN C Coarse grid point is at (physical) boundary, so is new IDOM(IPT) = IDOMC(IPTC-1) ELSE IF (IPT .EQ. IPTO+1) THEN C First new point in this (sub)row: internal boundary IDOM(IPT) = NBNDS+1 ELSE C Internal point, or internal X-, or Z- boundary IDOM(IPT) = 0 ENDIF IPT = IPT + 1 ICOL(IPT) = ICOL(IPT-1)+1 C If one of both (coarse) neighbors is an internal point, so C is IPT; otherwise it lies on a X-, or Z- boundary and C only one of the neighbors can be a physical corner IF (IDOMC(IPTC-1) .EQ. 0 .OR. + IDOMC(IPTC) .EQ. 0) THEN IDOM(IPT) = 0 ELSE IF (IDOMC(IPTC-1) .EQ. NBNDS+1 .OR. + IDOMC(IPTC) .EQ. NBNDS+1) THEN IDOM(IPT) = NBNDS+1 ELSE IDOM(IPT) = MIN(IDOMC(IPTC-1),IDOMC(IPTC)) ENDIF ELSE IF (LEFT) THEN C Previous cell is refined, current not IF (IPT+1 .GT. MAXPTS) GOTO 900 C Add node (ICOLC(IPTC-1),IROWC(IRC),IPLNC(IPC)) IPT = IPT + 1 ICOL(IPT) = 2*ICOLC(IPTC-1) IF (IDOMC(IPTC-1) .NE. 0) THEN C Coarse grid point is at (physical) boundary, so is new IDOM(IPT) = IDOMC(IPTC-1) ELSE C Internal boundary IDOM(IPT) = NBNDS+1 ENDIF IPTO = IPT ENDIF LEFT = MIDDLE MIDDLE = RIGHT 110 CONTINUE IF (LEFT) THEN C Last cell in row has been refined IF (IPT+1 .GT. MAXPTS) GOTO 900 C Add last coarse node IPTC = LROWC(IRC+1)-1 IPT = IPT + 1 ICOL(IPT) = 2*ICOLC(IPTC) C Coarse grid point is at physical or internal boundary, so is new IDOM(IPT) = IDOMC(IPTC) ENDIF C IF (IPT .GT. IPTOLD) THEN C Current coarse grid row has been refined IR = IR + 1 LROW(IR) = IPTOLD + 1 IROW(IR) = 2*IROWC(IRC) ENDIF C IF (IRC .EQ. LPLNC(IPC+1)-1) GOTO 100 C Ccc Make intermediate row of fine grid IPTOLD = IPT LEFT = .FALSE. IPTC = LROWC(IRC) MIDDLE = + REFFLG(LBLWZC(IPTC)) .OR. REFFLG(LABVYC(LBLWZC(IPTC))) + .OR. REFFLG(IPTC) .OR. REFFLG(LABVYC(IPTC)) .OR. + REFFLG(LABVZC(IPTC)) .OR. REFFLG(LABVYC(LABVZC(IPTC))) DO 120 IPTC = LROWC(IRC)+1, LROWC(IRC+1)-1 RIGHT = + REFFLG(LBLWZC(IPTC)) .OR. REFFLG(LABVYC(LBLWZC(IPTC))) + .OR. REFFLG(IPTC) .OR. REFFLG(LABVYC(IPTC)) .OR. + REFFLG(LABVZC(IPTC)) .OR. REFFLG(LABVYC(LABVZC(IPTC))) IF (MIDDLE .OR. RIGHT) THEN C Refine cell IF (IPT+2 .GT. MAXPTS) GOTO 900 C Add node (ICOLC(IPTC-1),IROWC(IRC)+1/2,IPLNC(IPC)) + C its right neighbor IPT = IPT + 1 ICOL(IPT) = 2*ICOLC(IPTC-1) IPT = IPT + 1 ICOL(IPT) = ICOL(IPT-1)+1 ELSE IF (LEFT) THEN C Previous cell is refined, current not IF (IPT+1 .GT. MAXPTS) GOTO 900 C Add node (ICOLC(IPTC-1),IROWC(IRC)+1/2,IPLNC(IPC)) IPT = IPT + 1 ICOL(IPT) = 2*ICOLC(IPTC-1) ENDIF LEFT = MIDDLE MIDDLE = RIGHT 120 CONTINUE IF (LEFT) THEN C Last cell in row has been refined IF (IPT+1 .GT. MAXPTS) GOTO 900 C Add last coarse node IPTC = LROWC(IRC+1)-1 IPT = IPT + 1 ICOL(IPT) = 2*ICOLC(IPTC) ENDIF C IF (IPT .GT. IPTOLD) THEN C Current intermediate row has been refined IR = IR + 1 LROW(IR) = IPTOLD + 1 IROW(IR) = 2*IROWC(IRC)+1 ENDIF 100 CONTINUE C IF (IR .GT. IROLD) THEN C Current coarse grid plane has been refined IP = IP + 1 LPLN(IP) = IROLD + 1 IPLN(IP) = 2*IPLNC(IPC) ENDIF IF (IPC .EQ. NPLNSC) GOTO 10 C Ccc Make intermediate grid plane of fine grid IROLD = IR DO 200 IRC = LPLNC(IPC), LPLNC(IPC+1)-1 C Ccc Make coarse grid row of fine grid IPTOLD = IPT LEFT = .FALSE. IPTC = LROWC(IRC) MIDDLE = REFFLG(LBLWYC(IPTC)) .OR. + REFFLG(IPTC) .OR. REFFLG(LABVYC(IPTC)) .OR. + REFFLG(LBLWYC(LABVZC(IPTC))) .OR. + REFFLG(LABVZC(IPTC)) .OR. REFFLG(LABVYC(LABVZC(IPTC))) DO 210 IPTC = LROWC(IRC)+1, LROWC(IRC+1)-1 RIGHT = REFFLG(LBLWYC(IPTC)) .OR. + REFFLG(IPTC) .OR. REFFLG(LABVYC(IPTC)) .OR. + REFFLG(LBLWYC(LABVZC(IPTC))) .OR. + REFFLG(LABVZC(IPTC)) .OR. REFFLG(LABVYC(LABVZC(IPTC))) IF (MIDDLE .OR. RIGHT) THEN C Refine cell IF (IPT+2 .GT. MAXPTS) GOTO 900 C Add node (ICOLC(IPTC-1),IROWC(IRC),IPNC(IPC)+1/2) + C its right neighbor IPT = IPT + 1 ICOL(IPT) = 2*ICOLC(IPTC-1) IPT = IPT + 1 ICOL(IPT) = ICOL(IPT-1)+1 ELSE IF (LEFT) THEN C Previous cell is refined, current not IF (IPT+1 .GT. MAXPTS) GOTO 900 C Add node (ICOLC(IPTC-1),IROWC(IRC),IPNC(IPC)+1/2) IPT = IPT + 1 ICOL(IPT) = 2*ICOLC(IPTC-1) ENDIF LEFT = MIDDLE MIDDLE = RIGHT 210 CONTINUE IF (LEFT) THEN C Last cell in row has been refined IF (IPT+1 .GT. MAXPTS) GOTO 900 C Add last coarse node IPTC = LROWC(IRC+1)-1 IPT = IPT + 1 ICOL(IPT) = 2*ICOLC(IPTC) ENDIF C IF (IPT .GT. IPTOLD) THEN C Current coarse grid row has been refined IR = IR + 1 LROW(IR) = IPTOLD + 1 IROW(IR) = 2*IROWC(IRC) ENDIF C IF (IRC .EQ. LPLNC(IPC+1)-1) GOTO 200 C Ccc Make intermediate row of fine grid IPTOLD = IPT LEFT = .FALSE. IPTC = LROWC(IRC) MIDDLE = + REFFLG(IPTC) .OR. REFFLG(LABVYC(IPTC)) .OR. + REFFLG(LABVZC(IPTC)) .OR. REFFLG(LABVYC(LABVZC(IPTC))) DO 220 IPTC = LROWC(IRC)+1, LROWC(IRC+1)-1 RIGHT = + REFFLG(IPTC) .OR. REFFLG(LABVYC(IPTC)) .OR. + REFFLG(LABVZC(IPTC)) .OR. REFFLG(LABVYC(LABVZC(IPTC))) IF (MIDDLE .OR. RIGHT) THEN C Refine cell IF (IPT+2 .GT. MAXPTS) GOTO 900 C Add node (ICOLC(IPTC-1),IROWC(IRC)+1/2,IPNC(IPC)+1/2) + C its right neighbor IPT = IPT + 1 ICOL(IPT) = 2*ICOLC(IPTC-1) IPT = IPT + 1 ICOL(IPT) = ICOL(IPT-1)+1 ELSE IF (LEFT) THEN C Previous cell is refined, current not IF (IPT+1 .GT. MAXPTS) GOTO 900 C Add node (ICOLC(IPTC-1),IROWC(IRC)+1/2,IPNC(IPC)+1/2) IPT = IPT + 1 ICOL(IPT) = 2*ICOLC(IPTC-1) ENDIF LEFT = MIDDLE MIDDLE = RIGHT 220 CONTINUE IF (LEFT) THEN C Last cell in row has been refined IF (IPT+1 .GT. MAXPTS) GOTO 900 C Add last coarse node IPTC = LROWC(IRC+1)-1 IPT = IPT + 1 ICOL(IPT) = 2*ICOLC(IPTC) ENDIF C IF (IPT .GT. IPTOLD) THEN C Current intermediate row has been refined IR = IR + 1 LROW(IR) = IPTOLD + 1 IROW(IR) = 2*IROWC(IRC)+1 ENDIF 200 CONTINUE IF (IR .GT. IROLD) THEN C Current intermediate grid plane has been refined IP = IP + 1 LPLN(IP) = IROLD + 1 IPLN(IP) = 2*IPLNC(IPC)+1 ENDIF 10 CONTINUE C Ccc Store # find grid planes in LPLN(0) and # fine grid points in NPTS C and LROW(NROWS+1) NPLNS = IP NROWS = IR NPTS = IPT LPLN(0) = NPLNS LPLN(NPLNS+1) = NROWS + 1 LROW(NROWS+1) = NPTS + 1 C RETURN C Ccc Error return 900 CONTINUE NPTS = MAXPTS IERR = 1 C RETURN END SUBROUTINE MKBND (NPTSF, LPLN, IPLN, LROW, IROW, ICOL, + LBLWY, LABVY, LBLWZ, LABVZ, + IDOM, LLBND, ILBND, LBND) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTSF INTEGER LPLN(0:*), IPLN(*), LROW(*), IROW(*), ICOL(NPTSF), + LBLWY(0:NPTSF), LABVY(0:NPTSF), LBLWZ(0:NPTSF), LABVZ(0:NPTSF), + IDOM(0:NPTSF), LLBND(0:*), ILBND(*), LBND(*) C Ccc PURPOSE: C Make boundary list for refined grid using domain flags set on grid C points corresponding to coarse grid points C Ccc PARAMETER DESCRIPTION: C LPLN : IN. (0:LPLN(0)+1) C LPLN(0) = NPLNS: Actual # planes in LROW C LPLN(1:NPLNS): pointers to the start of a plane in LROW C LPLN(NPLNS+1) = NROWS+1: Total # rows in grid + 1 C IPLN : IN. (NPLNS) C IPLN(IP): plane number of plane IP in virtual box C LROW : IN. (NROWS+1) C LROW(1:NROWS): pointers to the start of a row in the grid C LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 C IROW : IN. (NROWS) C IROW(IR): row number of row IR in virtual box C ICOL : IN. (NPTS) C ICOL(IPT): column number of grid point IPT in virtual box C LBLWY : IN. (0:NPTS) C LBLWY(IPT): pointer to node below in Y-direction in C actual grid C 0, if index node is front-plane boundary point C LABVY : IN. (0:NPTS) C LABVY(IPT): pointer to node above in Y-direction in C actual grid C 0, if index node is back-plane boundary point C LBLWZ : IN. (0:NPTS) C LBLWZ(IPT): pointer to node below in Z-direction in C actual grid C 0, if index node is down-plane boundary point C LABVZ : IN. (0:NPTS) C LABVZ(IPT): pointer to node above in Z-direction in C actual grid C 0, if index node is up-plane boundary point C IDOM : INWORK. (0:NPTS) C IDOM(IPT): location in coarse grid of node IPT (only set for C rows corresponding with coarse grid rows) C 0: interior point or new horizontal internal boundary C IB: on boundary C if not on edge or corner, or if internal boundary C then IB, IB = 1, NBNDS+1 C else | IB4 | IB3 | IB2 | IBYTE | if point is part of C the boundary planes IBYTE, IB2, IB3, and IB4 C LLBND : OUT. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : OUT. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : OUT. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C Ccc EXTERNALS USED: NONE C INTEGER BYTE PARAMETER (BYTE = 2**8) C C----------------------------------------------------------------------- C INTEGER IB, ID, ID1, IDA, IDB, IP, IPT, IR, NPLNS, NROWS, + NPTS, NBNDS C NPLNS = LPLN(0) NROWS = LPLN(NPLNS+1)-1 NPTS = LROW(NROWS+1)-1 NBNDS = LLBND(0) C Ccc Domain flags have been set at nodes corresponding with coarse grid C nodes and their X-neighbors, but some internal boundaries parallel to C the X- or Z-axis can still be marked as internal points. Correct these C by checking if any neighbor is missing. These points have X-neighbors. C Correct the IDOM value for planes that do not longer exist in the C refinement DO 10 IP = 1, NPLNS IF (IPLN(IP)/2*2 .NE. IPLN(IP)) GOTO 10 DO 20 IR = LPLN(IP), LPLN(IP+1)-1 IF (IROW(IR)/2*2 .NE. IROW(IR)) GOTO 20 DO 30 IPT = LROW(IR), LROW(IR+1)-1 IF (IDOM(IPT) .EQ. 0) THEN IF (LBLWY(IPT-1)*LBLWY(IPT)*LBLWY(IPT+1) .EQ. 0 .OR. + LABVY(IPT-1)*LABVY(IPT)*LABVY(IPT+1) .EQ. 0 .OR. + LBLWZ(IPT-1)*LBLWZ(IPT)*LBLWZ(IPT+1) .EQ. 0 .OR. + LABVZ(IPT-1)*LABVZ(IPT)*LABVZ(IPT+1) .EQ. 0 .OR. + LBLWZ(LBLWY(IPT-1))*LBLWZ(LBLWY(IPT))* + LBLWZ(LBLWY(IPT+1)) .EQ. 0 .OR. + LABVZ(LBLWY(IPT-1))*LABVZ(LBLWY(IPT))* + LABVZ(LBLWY(IPT+1)) .EQ. 0 .OR. + LBLWZ(LABVY(IPT-1))*LBLWZ(LABVY(IPT))* + LBLWZ(LABVY(IPT+1)) .EQ. 0 .OR. + LABVZ(LABVY(IPT-1))*LABVZ(LABVY(IPT))* + LABVZ(LABVY(IPT+1)) .EQ. 0) + IDOM(IPT) = NBNDS+1 ELSE IF (IDOM(IPT) .GT. BYTE) THEN ID = 0 ID1 = MOD(IDOM(IPT),BYTE) IB = ILBND(ID1) IF (IB .EQ. 1 .AND. ICOL(IPT)+1 .EQ. ICOL(IPT+1)) THEN ID = ID1 ELSE IF (IB .EQ. 2 .AND. LABVZ(IPT) .NE. 0) THEN ID = ID1 ELSE IF (IB .EQ. 3 .AND. ICOL(IPT)-1 .EQ. ICOL(IPT-1)) + THEN ID = ID1 ELSE IF (IB .EQ. 4 .AND. LBLWZ(IPT) .NE. 0) THEN ID = ID1 ELSE IF (IB .EQ. 5 .AND. LABVY(IPT) .NE. 0) THEN ID = ID1 ELSE IF (IB .EQ. 6 .AND. LBLWY(IPT) .NE. 0) THEN ID = ID1 ENDIF IDOM(IPT) = IDOM(IPT)/BYTE ID1 = MOD(IDOM(IPT),BYTE) IB = ILBND(ID1) IF (IB .EQ. 1 .AND. ICOL(IPT)+1 .EQ. ICOL(IPT+1)) THEN ID = ID*BYTE+ID1 ELSE IF (IB .EQ. 2 .AND. LABVZ(IPT) .NE. 0) THEN ID = ID*BYTE+ID1 ELSE IF (IB .EQ. 3 .AND. ICOL(IPT)-1 .EQ. ICOL(IPT-1)) + THEN ID = ID*BYTE+ID1 ELSE IF (IB .EQ. 4 .AND. LBLWZ(IPT) .NE. 0) THEN ID = ID*BYTE+ID1 ELSE IF (IB .EQ. 5 .AND. LABVY(IPT) .NE. 0) THEN ID = ID*BYTE+ID1 ELSE IF (IB .EQ. 6 .AND. LBLWY(IPT) .NE. 0) THEN ID = ID*BYTE+ID1 ENDIF IDOM(IPT) = IDOM(IPT)/BYTE IF (IDOM(IPT) .EQ. 0) GOTO 40 ID1 = MOD(IDOM(IPT),BYTE) IB = ILBND(ID1) IF (IB .EQ. 1 .AND. ICOL(IPT)+1 .EQ. ICOL(IPT+1)) THEN ID = ID*BYTE+ID1 ELSE IF (IB .EQ. 2 .AND. LABVZ(IPT) .NE. 0) THEN ID = ID*BYTE+ID1 ELSE IF (IB .EQ. 3 .AND. ICOL(IPT)-1 .EQ. ICOL(IPT-1)) + THEN ID = ID*BYTE+ID1 ELSE IF (IB .EQ. 4 .AND. LBLWZ(IPT) .NE. 0) THEN ID = ID*BYTE+ID1 ELSE IF (IB .EQ. 5 .AND. LABVY(IPT) .NE. 0) THEN ID = ID*BYTE+ID1 ELSE IF (IB .EQ. 6 .AND. LBLWY(IPT) .NE. 0) THEN ID = ID*BYTE+ID1 ENDIF IDOM(IPT) = IDOM(IPT)/BYTE IF (IDOM(IPT) .EQ. 0) GOTO 40 ID1 = MOD(IDOM(IPT),BYTE) IB = ILBND(ID1) IF (IB .EQ. 1 .AND. ICOL(IPT)+1 .EQ. ICOL(IPT+1)) THEN ID = ID*BYTE+ID1 ELSE IF (IB .EQ. 2 .AND. LABVZ(IPT) .NE. 0) THEN ID = ID*BYTE+ID1 ELSE IF (IB .EQ. 3 .AND. ICOL(IPT)-1 .EQ. ICOL(IPT-1)) + THEN ID = ID*BYTE+ID1 ELSE IF (IB .EQ. 4 .AND. LBLWZ(IPT) .NE. 0) THEN ID = ID*BYTE+ID1 ELSE IF (IB .EQ. 5 .AND. LABVY(IPT) .NE. 0) THEN ID = ID*BYTE+ID1 ELSE IF (IB .EQ. 6 .AND. LBLWY(IPT) .NE. 0) THEN ID = ID*BYTE+ID1 ENDIF 40 IDOM(IPT) = ID ENDIF 30 CONTINUE 20 CONTINUE 10 CONTINUE C Ccc Set domain flags in intermediate rows of coarse grid planes DO 100 IP = 1, NPLNS IF (IPLN(IP)/2*2 .NE. IPLN(IP)) GOTO 100 DO 110 IR = LPLN(IP), LPLN(IP+1)-1 IF (IROW(IR)/2*2 .EQ. IROW(IR)) GOTO 110 DO 120 IPT = LROW(IR), LROW(IR+1)-1 IDA = IDOM(LABVY(IPT)) IDB = IDOM(LBLWY(IPT)) C If one of both neighbors is an internal point, so C is IPT; otherwise it lies on a Y- or Z-boundary, C if both Y-neighbors are lying on a plane only one can be a C physical edge, if both are lying on an edge only one can be a C physical corner IF (IDA .EQ. 0 .OR. IDB .EQ. 0) THEN IDOM(IPT) = 0 ELSE IF (IDA .EQ. NBNDS+1 .OR. IDB .EQ. NBNDS+1) THEN IDOM(IPT) = NBNDS+1 ELSE IDOM(IPT) = MIN(IDA,IDB) ENDIF 120 CONTINUE 110 CONTINUE 100 CONTINUE C Ccc Set domain flags in intermediate planes DO 150 IP = 1, NPLNS IF (IPLN(IP)/2*2 .EQ. IPLN(IP)) GOTO 150 DO 160 IR = LPLN(IP), LPLN(IP+1)-1 DO 170 IPT = LROW(IR), LROW(IR+1)-1 IDA = IDOM(LABVZ(IPT)) IDB = IDOM(LBLWZ(IPT)) C If one of both neighbors is an internal point, so C is IPT; otherwise it lies on a X- or Y-boundary, C if both Z-neighbors are lying on a plane only one can be a C physical edge, if both are lying on an edge only one can be a C physical corner IF (IDA .EQ. 0 .OR. IDB .EQ. 0) THEN IDOM(IPT) = 0 ELSE IF (IDA .EQ. NBNDS+1 .OR. IDB .EQ. NBNDS+1) THEN IDOM(IPT) = NBNDS+1 ELSE IDOM(IPT) = MIN(IDA,IDB) ENDIF 170 CONTINUE 160 CONTINUE 150 CONTINUE C Ccc Edges between physical and internal boundaries can still wrongly be C marked physical DO 200 IP = 1, NPLNS DO 210 IR = LPLN(IP), LPLN(IP+1)-1 DO 220 IPT = LROW(IR), LROW(IR+1)-1 ID = IDOM(IPT) IF (ID .EQ. 0 .OR. ID .EQ. NBNDS+1 .OR. + ID .GT. BYTE) GOTO 220 IB = ILBND(ID) IF (IB .EQ. 1) THEN ID1 = IDOM(IPT+1) IF (ID1 .EQ. NBNDS+1) IDOM(IPT) = NBNDS+1 ELSE IF (IB .EQ. 2) THEN ID1 = IDOM(LABVZ(IPT)) IF (ID1 .EQ. NBNDS+1) IDOM(IPT) = NBNDS+1 ELSE IF (IB .EQ. 3) THEN ID1 = IDOM(IPT-1) IF (ID1 .EQ. NBNDS+1) IDOM(IPT) = NBNDS+1 ELSE IF (IB .EQ. 4) THEN ID1 = IDOM(LBLWZ(IPT)) IF (ID1 .EQ. NBNDS+1) IDOM(IPT) = NBNDS+1 ELSE IF (IB .EQ. 5) THEN ID1 = IDOM(LABVY(IPT)) IF (ID1 .EQ. NBNDS+1) IDOM(IPT) = NBNDS+1 ELSE IF (IB .EQ. 6) THEN ID1 = IDOM(LBLWY(IPT)) IF (ID1 .EQ. NBNDS+1) IDOM(IPT) = NBNDS+1 ENDIF 220 CONTINUE 210 CONTINUE 200 CONTINUE C Ccc Corners can still wrongly be marked physical. If a point has at C least 2 neighbors that are internal boundary points, so is the C point itself DO 230 IP = 1, NPLNS DO 240 IR = LPLN(IP), LPLN(IP+1)-1 IPT = LROW(IR) IF (IDOM(IPT) .LT. BYTE) GOTO 249 IB = 0 IF (IDOM(IPT+1) .EQ. NBNDS+1) IB = IB+1 IF (IDOM(LBLWY(IPT)) .EQ. NBNDS+1) IB = IB+1 IF (IDOM(LABVY(IPT)) .EQ. NBNDS+1) IB = IB+1 IF (IDOM(LBLWZ(IPT)) .EQ. NBNDS+1) IB = IB+1 IF (IDOM(LABVZ(IPT)) .EQ. NBNDS+1) IB = IB+1 IF (IB .GE. 2) IDOM(IPT) = NBNDS+1 249 DO 250 IPT = LROW(IR)+1, LROW(IR+1)-2 IF (IDOM(IPT) .LT. BYTE) GOTO 250 IB = 0 IF (ICOL(IPT-1) .EQ. ICOL(IPT)-1 .AND. + IDOM(IPT-1) .EQ. NBNDS+1) IB = IB+1 IF (ICOL(IPT+1) .EQ. ICOL(IPT)+1 .AND. + IDOM(IPT+1) .EQ. NBNDS+1) IB = IB+1 IF (IDOM(LBLWY(IPT)) .EQ. NBNDS+1) IB = IB+1 IF (IDOM(LABVY(IPT)) .EQ. NBNDS+1) IB = IB+1 IF (IDOM(LBLWZ(IPT)) .EQ. NBNDS+1) IB = IB+1 IF (IDOM(LABVZ(IPT)) .EQ. NBNDS+1) IB = IB+1 IF (IB .GE. 2) IDOM(IPT) = NBNDS+1 250 CONTINUE IPT = LROW(IR+1)-1 IF (IDOM(IPT) .LT. BYTE) GOTO 240 IB = 0 IF (IDOM(IPT-1) .EQ. NBNDS+1) IB = IB+1 IF (IDOM(LBLWY(IPT)) .EQ. NBNDS+1) IB = IB+1 IF (IDOM(LABVY(IPT)) .EQ. NBNDS+1) IB = IB+1 IF (IDOM(LBLWZ(IPT)) .EQ. NBNDS+1) IB = IB+1 IF (IDOM(LABVZ(IPT)) .EQ. NBNDS+1) IB = IB+1 IF (IB .GE. 2) IDOM(IPT) = NBNDS+1 240 CONTINUE 230 CONTINUE Ccc Make boundary lists DO 300 IB = 0, NBNDS+1 LLBND(IB) = 0 300 CONTINUE DO 310 IPT = 1, NPTS ID = IDOM(IPT) ID1 = MOD(ID,BYTE) LLBND(ID1) = LLBND(ID1) + 1 IF (ID .EQ. ID1) GOTO 310 ID = ID/BYTE ID1 = MOD(ID,BYTE) LLBND(ID1) = LLBND(ID1) + 1 IF (ID .EQ. ID1) GOTO 310 ID = ID/BYTE ID1 = MOD(ID,BYTE) LLBND(ID1) = LLBND(ID1) + 1 IF (ID .EQ. ID1) GOTO 310 ID = ID/BYTE LLBND(ID) = LLBND(ID) + 1 310 CONTINUE LLBND(0) = 1 DO 320 IB = 1, NBNDS LLBND(IB) = LLBND(IB-1) + LLBND(IB) 320 CONTINUE DO 330 IB = NBNDS, 0, -1 LLBND(IB+2) = LLBND(IB) 330 CONTINUE DO 340 IPT = 1, NPTS IF (IDOM(IPT) .EQ. 0) GOTO 340 ID = IDOM(IPT) ID1 = MOD(ID,BYTE) LBND(LLBND(ID1+1)) = IPT LLBND(ID1+1) = LLBND(ID1+1) + 1 IF (ID .EQ. ID1) GOTO 340 ID = ID/BYTE ID1 = MOD(ID,BYTE) LBND(LLBND(ID1+1)) = IPT LLBND(ID1+1) = LLBND(ID1+1) + 1 IF (ID .EQ. ID1) GOTO 340 ID = ID/BYTE ID1 = MOD(ID,BYTE) LBND(LLBND(ID1+1)) = IPT LLBND(ID1+1) = LLBND(ID1+1) + 1 IF (ID .EQ. ID1) GOTO 340 ID = ID/BYTE LBND(LLBND(ID+1)) = IPT LLBND(ID+1) = LLBND(ID+1) + 1 340 CONTINUE LLBND(0) = NBNDS LLBND(1) = 1 RETURN END SUBROUTINE GETSOL (NPDE, UC, ISTRCN, LEVO, UO, ISTRFO, U, ISTRUC, + IWORK, RWORK) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPDE, ISTRCN(0:*), ISTRFO(0:*), ISTRUC(0:*), IWORK(*) LOGICAL LEVO REAL UC(0:*), UO(0:*), U(0:*), RWORK(*) C Ccc PURPOSE: C Store solution at a previous time level on a grid of the current time C level. C First copy the (embedded) coarser grid solution, then copy all C available values from the old time grid of the same grid level, and C finally calculate all non-initialized values by interpolation. C Ccc PARAMETER DESCRIPTION: C NPDE : IN. # PDE components C UC : IN. Solution at embedded coarse grid C ISTRCN : IN. Datastructure of the embedded coarse grid C LEVO : IN. .TRUE. if new grid level existed at previous time level C UO : IN. If LEVO the solution at grid ISTRFO C ISTRFO : IN. If LEVO the datastructure of the grid with the same level C as the new grid level but on a previous time level C U : OUT. Solution of previous time level on new grid level C ISTRUC : IN. Data structure of new grid level at current time level C IWORK : WORK. (NPTS) C RWORK : WORK. (0) C Ccc EXTERNALS USED: EXTERNAL INJCF, INJON, INTPOL C C----------------------------------------------------------------------- C INTEGER LLPLNC,NPLNSC,LIPLNC, LLROWC,NROWSC,NPTSC,LIROWC, LICOLC, + LLPLNO,NPLNSO,LIPLNO, LLROWO, NROWSO, NPTSO, LIROWO, LICOLO, + LLPLN,NPLNS,LIPLN, LLROW, NROWS, NPTS, LIROW, LICOL, + LLLBND, NBNDS, NBIPTS, LILBND, LLBNDP, + LLBLWY, LLABVY, LLBLWZ, LLABVZ C LLPLNC = 0 NPLNSC = ISTRCN(LLPLNC) NROWSC = ISTRCN(LLPLNC+NPLNSC+1)-1 LIPLNC = LLPLNC+NPLNSC+2 LLROWC = LIPLNC+NPLNSC NPTSC = ISTRCN(LLROWC+NROWSC)-1 LIROWC = LLROWC+NROWSC+1 LICOLC = LIROWC+NROWSC LLPLN = 0 NPLNS = ISTRUC(LLPLN) NROWS = ISTRUC(LLPLN+NPLNS+1)-1 LIPLN = LLPLN+NPLNS+2 LLROW = LIPLN+NPLNS NPTS = ISTRUC(LLROW+NROWS)-1 LIROW = LLROW+NROWS+1 LICOL = LIROW+NROWS LLLBND = LICOL+NPTS NBNDS = ISTRUC(LLLBND) NBIPTS = ISTRUC(LLLBND+NBNDS+2)-1 LILBND = LLLBND+NBNDS+3 LLBNDP = LILBND+NBNDS LLBLWY = LLBNDP+NBIPTS LLABVY = LLBLWY+NPTS+1 LLBLWZ = LLABVY+NPTS+1 LLABVZ = LLBLWZ+NPTS+1 C U(0) = 0.0 C C Copy embedded coarse grid solution CALL INJCF (NPDE, UC, U, IWORK, + ISTRCN(LLPLNC), ISTRCN(LIPLNC), + ISTRCN(LLROWC), ISTRCN(LIROWC), ISTRCN(LICOLC), + ISTRUC(LLPLN), ISTRUC(LIPLN), + ISTRUC(LLROW), ISTRUC(LIROW), ISTRUC(LICOL)) C IF (LEVO) THEN C Copy solution of grid with same level but on previous time level LLPLNO = 0 NPLNSO = ISTRFO(LLPLNO) NROWSO = ISTRFO(LLPLNO+NPLNSO+1)-1 LIPLNO = LLPLNO+NPLNSO+2 LLROWO = LIPLNO+NPLNSO NPTSO = ISTRFO(LLROWO+NROWSO)-1 LIROWO = LLROWO+NROWSO+1 LICOLO = LIROWO+NROWSO CALL INJON (NPDE, UO, U, IWORK, + ISTRFO(LLPLNO), ISTRFO(LIPLNO), + ISTRFO(LLROWO), ISTRFO(LIROWO), ISTRFO(LICOLO), + ISTRUC(LLPLN), ISTRUC(LIPLN), + ISTRUC(LLROW), ISTRUC(LIROW), ISTRUC(LICOL)) ENDIF C C Calculate all uninitialized values by interpolation CALL INTPOL (NPDE, U, IWORK, + ISTRUC(LLPLN), ISTRUC(LIPLN), + ISTRUC(LLROW), ISTRUC(LIROW), ISTRUC(LICOL), + ISTRUC(LLBLWY), ISTRUC(LLABVY), + ISTRUC(LLBLWZ), ISTRUC(LLABVZ), RWORK) C RETURN END SUBROUTINE GETINI (NPDE, UIC, UC, ISTRCC, LEVO, UO, ISTRFO, + U, ISTRUC, UIB, IWORK, RWORK) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPDE, ISTRCC(0:*), ISTRFO(0:*), ISTRUC(0:*), IWORK(*) LOGICAL LEVO REAL UIC(0:*), UC(0:*), UO(0:*), U(0:*), UIB(*), RWORK(*) C Ccc PURPOSE: C Initialize solution at current time level on the next finer grid C level. Store (Dirichlet) internal boundary values in UIB. C First get the internal bounday values from interpolation of the C solution at the (embedded) coarser grid. C The initial solution is obtained by first copying the (embedded) C coarser grid initial solution, and then all available values from the C solution at the previous time level on the grid of the required grid C level. Finally all as yet non-initialized values are calculated by C interpolation. C Ccc PARAMETER DESCRIPTION: C NPDE : IN. # PDE components C UIC : IN. Initial solution at embedded coarse grid C UC : IN. Solution at embedded coarse grid C ISTRCC : IN. Datastructure of the embedded coarse grid C LEVO : IN. .TRUE. if new grid level existed at previous time level C UO : IN. If LEVO the solution at grid ISTRFO C ISTRFO : IN. If LEVO the datastructure of the grid with the same level C as the new grid level but on a previous time level C U : OUT. Solution of current time level on new grid level C ISTRUC : IN. Data structure of new grid level at current time level C UIB : OUT. List of internal boundary values C IWORK : WORK. (NPTS) C RWORK : WORK. (0) C Ccc EXTERNALS USED: EXTERNAL INJCF, INJCFB, INJON, INTPOL C C----------------------------------------------------------------------- C INTEGER LLPLNC,NPLNSC,LIPLNC, LLROWC,NROWSC,NPTSC,LIROWC, LICOLC, + LLPLNO, NPLNSO, LIPLNO, LLROWO, NROWSO, NPTSO, LIROWO, LICOLO, + LLPLN, NPLNS, LIPLN, LLROW, NROWS, NPTS, LIROW, LICOL, + LLLBND, NBNDS, NBDPTS, NBIPTS, LILBND, LLBNDP, + LLBLWY, LLABVY, LLBLWZ, LLABVZ, + NIBPTS, I, IB, IC, LB C LLPLNC = 0 NPLNSC = ISTRCC(LLPLNC) NROWSC = ISTRCC(LLPLNC+NPLNSC+1)-1 LIPLNC = LLPLNC+NPLNSC+2 LLROWC = LIPLNC+NPLNSC NPTSC = ISTRCC(LLROWC+NROWSC)-1 LIROWC = LLROWC+NROWSC+1 LICOLC = LIROWC+NROWSC LLPLN = 0 NPLNS = ISTRUC(LLPLN) NROWS = ISTRUC(LLPLN+NPLNS+1)-1 LIPLN = LLPLN+NPLNS+2 LLROW = LIPLN+NPLNS NPTS = ISTRUC(LLROW+NROWS)-1 LIROW = LLROW+NROWS+1 LICOL = LIROW+NROWS LLLBND = LICOL+NPTS NBNDS = ISTRUC(LLLBND) NBDPTS = ISTRUC(LLLBND+NBNDS+1)-1 NBIPTS = ISTRUC(LLLBND+NBNDS+2)-1 LILBND = LLLBND+NBNDS+3 LLBNDP = LILBND+NBNDS LLBLWY = LLBNDP+NBIPTS LLABVY = LLBLWY+NPTS+1 LLBLWZ = LLABVY+NPTS+1 LLABVZ = LLBLWZ+NPTS+1 NIBPTS = NBIPTS - NBDPTS C U(0) = 0.0 C Ccc Get internal boundary values C Copy embedded coarse grid solution CALL INJCFB (NPDE, UC, U, IWORK, + ISTRCC(LLPLNC), ISTRCC(LIPLNC), + ISTRCC(LLROWC), ISTRCC(LIROWC), ISTRCC(LICOLC), + ISTRUC(LLPLN), ISTRUC(LIPLN), + ISTRUC(LLROW), ISTRUC(LIROW), ISTRUC(LICOL), + ISTRUC(LLLBND), ISTRUC(LLBNDP)) C C Calculate all uninitialized values at the internal boundary by C interpolation CALL INTPOL (NPDE, U, IWORK, + ISTRUC(LLPLN), ISTRUC(LIPLN), + ISTRUC(LLROW), ISTRUC(LIROW), ISTRUC(LICOL), + ISTRUC(LLBLWY), ISTRUC(LLABVY), + ISTRUC(LLBLWZ), ISTRUC(LLABVZ), RWORK) C C Store internal boundary values in list DO 10 IC = 1, NPDE DO 10 LB = 1, NIBPTS I = ISTRUC(LLBNDP+NBDPTS-1+LB) + (IC-1)*NPTS IB = LB + (IC-1)*NIBPTS UIB(IB) = U(I) 10 CONTINUE C Ccc Get initial solution C Copy embedded coarse grid initial solution CALL INJCF (NPDE, UIC, U, IWORK, + ISTRCC(LLPLNC), ISTRCC(LIPLNC), + ISTRCC(LLROWC), ISTRCC(LIROWC), ISTRCC(LICOLC), + ISTRUC(LLPLN), ISTRUC(LIPLN), + ISTRUC(LLROW), ISTRUC(LIROW), ISTRUC(LICOL)) C IF (LEVO) THEN C C Copy solution of grid with same level but on previous time level LLPLNO = 0 NPLNSO = ISTRFO(LLPLNO) NROWSO = ISTRFO(LLPLNO+NPLNSO+1)-1 LIPLNO = LLPLNO+NPLNSO+2 LLROWO = LIPLNO+NPLNSO NPTSO = ISTRFO(LLROWO+NROWSO)-1 LIROWO = LLROWO+NROWSO+1 LICOLO = LIROWO+NROWSO CALL INJON (NPDE, UO, U, IWORK, + ISTRFO(LLPLNO), ISTRFO(LIPLNO), + ISTRFO(LLROWO), ISTRFO(LIROWO), ISTRFO(LICOLO), + ISTRUC(LLPLN), ISTRUC(LIPLN), + ISTRUC(LLROW), ISTRUC(LIROW), ISTRUC(LICOL)) C ENDIF C C Calculate all uninitialized values by interpolation CALL INTPOL (NPDE, U, IWORK, + ISTRUC(LLPLN), ISTRUC(LIPLN), + ISTRUC(LLROW), ISTRUC(LIROW), ISTRUC(LICOL), + ISTRUC(LLBLWY), ISTRUC(LLABVY), + ISTRUC(LLBLWZ), ISTRUC(LLABVZ), RWORK) C RETURN END SUBROUTINE INJCFB (NPDE, UC, U, IPDOM, + LPLNC, IPLNC, LROWC, IROWC, ICOLC, + LPLN, IPLN, LROW, IROW, ICOL, LLBND, LBND) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPDE, IPDOM(*), + LPLNC(0:*), IPLNC(*), LROWC(*), IROWC(*), ICOLC(*), + LPLN(0:*), IPLN(*), LROW(*), IROW(*), ICOL(*), + LLBND(0:*), LBND(*) REAL UC(0:*), U(0:*) C Ccc PURPOSE: C Inject solution from coarse grid into (embedded) fine grid C Ccc PARAMETER DESCRIPTION: C NPDE : IN. # PDE components C UC : IN. Solution at coarse grid C U : OUT. Solution at coarse gridpoints at internal boundary of C refined grid C IPDOM : OUT. Domain flags wrt to interpolation C 0: Injected point C -1: Otherwise C LPLNC : IN. -I C IPLNC : IN. I C LROWC : IN. I Data structure of the coarse grid C IROWC : IN. I see description for fine grid below C ICOLC : IN. -I C LPLN : IN. (0:LPLN(0)+1) C LPLN(0) = NPLNS: Actual # planes in LROW C LPLN(1:NPLNS): pointers to the start of a plane in LROW C LPLN(NPLNS+1) = NROWS+1: Total # rows in grid + 1 C IPLN : IN. (NPLNS) C IPLN(IP): plane number of plane IP in virtual box C LROW : IN. (NROWS+1) C LROW(1:NROWS): pointers to the start of a row in the grid C LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 C IROW : IN. (NROWS) C IROW(IR): row number of row IR in virtual box C ICOL : IN. (NPTS) C ICOL(IPT): column number of grid point IPT in virtual box C LLBND : (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary or corner in C LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C LBND : OUT. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER IB, IC, IPC, IP, IPTC, IPT, IRC, IR, + NBNDS, NPLNSC, NPLNS, NPTSC, NPTS, NROWSC, NROWS C NPLNS = LPLN(0) NROWS = LPLN(NPLNS+1)-1 NPTS = LROW(NROWS+1)-1 NBNDS = LLBND(0) NPLNSC = LPLNC(0) NROWSC = LPLNC(NPLNSC+1)-1 NPTSC = LROWC(NROWSC+1)-1 C Ccc Initialize interpolation flags DO 10 IPT = 1, NPTS IPDOM(IPT) = 0 10 CONTINUE DO 20 IB = LLBND(1), LLBND(NBNDS+2)-1 IPT = LBND(IB) IPDOM(IPT) = -1 20 CONTINUE C Ccc Inject values from coarse level into fine grid solution CDIR$ NOVECTOR IPC = 0 DO 30 IP = 1, NPLNS IF (IPLN(IP)/2*2 .NE. IPLN(IP)) GOTO 30 IPC = IPC + 1 40 IF (2*IPLNC(IPC) .NE. IPLN(IP)) THEN IPC = IPC + 1 GOTO 40 ENDIF IRC = LPLNC(IPC)-1 DO 50 IR = LPLN(IP), LPLN(IP+1)-1 IF (IROW(IR)/2*2 .NE. IROW(IR)) GOTO 50 IRC = IRC + 1 60 IF (2*IROWC(IRC) .NE. IROW(IR)) THEN IRC = IRC + 1 GOTO 60 ENDIF IPTC = LROWC(IRC)-1 DO 70 IPT = LROW(IR), LROW(IR+1)-1 IF (ICOL(IPT)/2*2 .NE. ICOL(IPT)) GOTO 70 IPTC = IPTC + 1 80 IF (2*ICOLC(IPTC) .NE. ICOL(IPT)) THEN IPTC = IPTC + 1 GOTO 80 ENDIF DO 90 IC = 1, NPDE U(IPT+(IC-1)*NPTS) = UC(IPTC+(IC-1)*NPTSC) 90 CONTINUE IPDOM(IPT) = 0 70 CONTINUE 50 CONTINUE 30 CONTINUE RETURN END SUBROUTINE INJCF (NPDE, UC, U, IPDOM, + LPLNC, IPLNC, LROWC, IROWC, ICOLC, + LPLN, IPLN, LROW, IROW, ICOL) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPDE, IPDOM(*), + LPLNC(0:*), IPLNC(*), LROWC(*), IROWC(*), ICOLC(*), + LPLN(0:*), IPLN(*), LROW(*), IROW(*), ICOL(*) REAL UC(0:*), U(0:*) C Ccc PURPOSE: C Inject solution from coarse grid into (embedded) fine grid C Ccc PARAMETER DESCRIPTION: C NPDE : IN. # PDE components C UC : IN. Solution at coarse grid C U : OUT. Solution at coarse gridpoints in refined grid C IPDOM : OUT. Domain flags wrt to interpolation C 0: Injected point C -1: Otherwise C LPLNC : IN. -I C IPLNC : IN. I C LROWC : IN. I Data structure of the coarse grid C IROWC : IN. I see description for fine grid below C ICOLC : IN. -I C LPLN : IN. (0:LPLN(0)+1) C LPLN(0) = NPLNS: Actual # planes in LROW C LPLN(1:NPLNS): pointers to the start of a plane in LROW C LPLN(NPLNS+1) = NROWS+1: Total # rows in grid + 1 C IPLN : IN. (NPLNS) C IPLN(IP): plane number of plane IP in virtual box C LROW : IN. (NROWS+1) C LROW(1:NROWS): pointers to the start of a row in the grid C LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 C IROW : IN. (NROWS) C IROW(IR): row number of row IR in virtual box C ICOL : IN. (NPTS) C ICOL(IPT): column number of grid point IPT in virtual box C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER IC, IPC, IP, IPTC, IPT, IRC, IR, + NPLNSC, NPLNS, NPTSC, NPTS, NROWSC, NROWS C NPLNS = LPLN(0) NROWS = LPLN(NPLNS+1)-1 NPTS = LROW(NROWS+1)-1 NPLNSC = LPLNC(0) NROWSC = LPLNC(NPLNSC+1)-1 NPTSC = LROWC(NROWSC+1)-1 C Ccc Initialize interpolation flags DO 10 IPT = 1, NPTS IPDOM(IPT) = -1 10 CONTINUE C Ccc Inject values from coarse level into fine grid solution CDIR$ NOVECTOR IPC = 0 DO 30 IP = 1, NPLNS IF (IPLN(IP)/2*2 .NE. IPLN(IP)) GOTO 30 IPC = IPC + 1 40 IF (2*IPLNC(IPC) .NE. IPLN(IP)) THEN IPC = IPC + 1 GOTO 40 ENDIF IRC = LPLNC(IPC)-1 DO 50 IR = LPLN(IP), LPLN(IP+1)-1 IF (IROW(IR)/2*2 .NE. IROW(IR)) GOTO 50 IRC = IRC + 1 60 IF (2*IROWC(IRC) .NE. IROW(IR)) THEN IRC = IRC + 1 GOTO 60 ENDIF IPTC = LROWC(IRC)-1 DO 70 IPT = LROW(IR), LROW(IR+1)-1 IF (ICOL(IPT)/2*2 .NE. ICOL(IPT)) GOTO 70 IPTC = IPTC + 1 80 IF (2*ICOLC(IPTC) .NE. ICOL(IPT)) THEN IPTC = IPTC + 1 GOTO 80 ENDIF DO 90 IC = 1, NPDE U(IPT+(IC-1)*NPTS) = UC(IPTC+(IC-1)*NPTSC) 90 CONTINUE IPDOM(IPT) = 0 70 CONTINUE 50 CONTINUE 30 CONTINUE RETURN END SUBROUTINE INJON (NPDE, UO, U, IPDOM, + LPLNO, IPLNO, LROWO, IROWO, ICOLO, + LPLN, IPLN, LROW, IROW, ICOL) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPDE, IPDOM(*), + LPLNO(0:*), IPLNO(*), LROWO(*), IROWO(*), ICOLO(*), + LPLN(0:*), IPLN(*), LROW(*), IROW(*), ICOL(*) REAL UO(0:*), U(0:*) C Ccc PURPOSE: C Inject solution from previous time at grid from same level into C solution at current time grid C Ccc PARAMETER DESCRIPTION: C NPDE : IN. # PDE components C UO : IN. Solution at previous time C U : INOUT. Solution at corresponding gridpoints injected from UO C IPDOM : INOUT. Domain flags wrt to interpolation C 0: Injected point C -1: Otherwise C LPLNO : IN. -I C IPLNO : IN. I C LROWO : IN. I Data structure of the old-time grid C IROWO : IN. I see description for current time grid below C ICOLO : IN. -I C LPLN : IN. (0:LPLN(0)+1) C LPLN(0) = NPLNS: Actual # planes in LROW C LPLN(1:NPLNS): pointers to the start of a plane in LROW C LPLN(NPLNS+1) = NROWS+1: Total # rows in grid + 1 C IPLN : IN. (NPLNS) C IPLN(IP): plane number of plane IP in virtual box C LROW : IN. (NROWS+1) C LROW(1:NROWS): pointers to the start of a row in the grid C LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 C IROW : IN. (NROWS) C IROW(IR): row number of row IR in virtual box C ICOL : IN. (NPTS) C ICOL(IPT): column number of grid point IPT in virtual box C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C CDIR$ NOVECTOR C INTEGER IC, IPO, IP, IPTO, IPT, IRO, IR, + NPLNSO, NPLNS, NPTSO, NPTS, NROWSO, NROWS C NPLNS = LPLN(0) NROWS = LPLN(NPLNS+1)-1 NPTS = LROW(NROWS+1)-1 NPLNSO = LPLNO(0) NROWSO = LPLNO(NPLNSO+1)-1 NPTSO = LROWO(NROWSO+1)-1 C Ccc Inject values from old time level into current-time solution IPO = 1 DO 10 IP = 1, NPLNS 20 IF (IPLNO(IPO) .LT. IPLN(IP)) THEN IPO = IPO + 1 IF (IPO .LE. NPLNSO) GOTO 20 RETURN ELSE IF (IPLNO(IPO) .GT. IPLN(IP)) THEN GOTO 10 ENDIF IRO = LPLNO(IPO) DO 30 IR = LPLN(IP), LPLN(IP+1)-1 40 IF (IROWO(IRO) .LT. IROW(IR)) THEN IRO = IRO + 1 IF (IRO .LE. NROWSO) GOTO 40 GOTO 10 ELSE IF (IROWO(IRO) .GT. IROW(IR)) THEN GOTO 30 ENDIF IPTO = LROWO(IRO) DO 50 IPT = LROW(IR), LROW(IR+1)-1 60 IF (ICOLO(IPTO) .LT. ICOL(IPT)) THEN IPTO = IPTO + 1 IF (IPTO .LE. LROWO(IRO+1)-1) GOTO 60 GOTO 30 ELSE IF (ICOLO(IPTO) .GT. ICOL(IPT)) THEN GOTO 50 ENDIF DO 70 IC = 1, NPDE U(IPT+(IC-1)*NPTS) = UO(IPTO+(IC-1)*NPTSO) 70 CONTINUE IPDOM(IPT) = 0 50 CONTINUE 30 CONTINUE 10 CONTINUE RETURN END SUBROUTINE PUTSOL (NPDE, U, ISTRUC, UC, ISTRCC, UI, LENUC) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPDE, ISTRUC(0:*), ISTRCC(0:*), LENUC REAL U(0:*), UC(0:*), UI(0:*) C Ccc PURPOSE: C Copy coarse grid solution UC to UI and inject fine grid solution U C Ccc PARAMETER DESCRIPTION: C NPDE : IN. # PDE components C U : IN. Solution at fine grid C ISTRUC : IN. Datastructure of the fine grid C UC : IN. Solution at coarse grid C ISTRCC : IN. Datastructure of the coarse grid C UI : OUT.Injected solution at coarse grid C LENUC : OUT.Dimension of coarse grid solution array C Ccc EXTERNALS USED: EXTERNAL INJFC, RCOPY C C----------------------------------------------------------------------- C INTEGER LLPLN, NPLNS, LIPLN, NROWS, LLROW, NPTS, LIROW, LICOL, + LLPLNC, NPLNSC, LIPLNC, NROWSC, LLROWC, NPTSC, LIROWC, LICOLC C LLPLN = 0 NPLNS = ISTRUC(LLPLN) LIPLN = LLPLN+NPLNS+2 NROWS = ISTRUC(LLPLN+NPLNS+1)-1 LLROW = LIPLN+NPLNS NPTS = ISTRUC(LLROW+NROWS)-1 LIROW = LLROW+NROWS+1 LICOL = LIROW+NROWS LLPLNC = 0 NPLNSC = ISTRCC(LLPLNC) LIPLNC = LLPLNC+NPLNSC+2 NROWSC = ISTRCC(LLPLNC+NPLNSC+1)-1 LLROWC = LIPLNC+NPLNSC NPTSC = ISTRCC(LLROWC+NROWSC)-1 LIROWC = LLROWC+NROWSC+1 LICOLC = LIROWC+NROWSC LENUC = NPTSC*NPDE + 1 C C Copy coarse grid solution to UI CALL RCOPY (LENUC, UC, UI) C C Inject fine grid solution into UI CALL INJFC (NPDE, U, UI, + ISTRUC(LLPLN), ISTRUC(LIPLN), + ISTRUC(LLROW), ISTRUC(LIROW), ISTRUC(LICOL), + ISTRCC(LLPLNC), ISTRCC(LIPLNC), + ISTRCC(LLROWC), ISTRCC(LIROWC), ISTRCC(LICOLC)) RETURN END SUBROUTINE INJFC (NPDE, U, UC, + LPLN, IPLN, LROW, IROW, ICOL, + LPLNC, IPLNC, LROWC, IROWC, ICOLC) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPDE, LPLN(0:*), IPLN(*), LROW(*), IROW(*), ICOL(*), + LPLNC(0:*), IPLNC(*), LROWC(*), IROWC(*), ICOLC(*) REAL U(0:*), UC(0:*) C Ccc PURPOSE: C Inject solution from (embedded) fine grid into coarser grid C Ccc PARAMETER DESCRIPTION: C NPDE : IN. # PDE components C U : IN. Fine grid solution C UC : INOUT. C IN: Coarse grid solution C OUT: Injected solution at coarse grid C LPLN : IN. (0:LPLN(0)+1) C LPLN(0) = NPLNS: Actual # planes in LROW C LPLN(1:NPLNS): pointers to the start of a plane in LROW C LPLN(NPLNS+1) = NROWS+1: Total # rows in grid + 1 C IPLN : IN. (NPLNS) C IPLN(IP): plane number of plane IP in virtual box C LROW : IN. (NROWS+1) C LROW(1:NROWS): pointers to the start of a row in the grid C LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 C IROW : IN. (NROWS) C IROW(IR): row number of row IR in virtual box C ICOL : IN. (NPTS) C ICOL(IPT): column number of grid point IPT in virtual box C LPLNC : IN. -I C IPLNC : IN. I C LROWC : IN. I Data structure of the coarse grid C IROWC : IN. I see description for fine grid above C ICOLC : IN. -I C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C CDIR$ NOVECTOR C INTEGER IC, IPC, IP, IPTC, IPT, IRC, IR, + NPLNSC, NPLNS, NPTSC, NPTS, NROWSC, NROWS C NPLNS = LPLN(0) NROWS = LPLN(NPLNS+1)-1 NPTS = LROW(NROWS+1)-1 NPLNSC = LPLNC(0) NROWSC = LPLNC(NPLNSC+1)-1 NPTSC = LROWC(NROWSC+1)-1 C Ccc Inject values from fine level into coarse grid solution IPC = 0 DO 10 IP = 1, NPLNS IF (IPLN(IP)/2*2 .NE. IPLN(IP)) GOTO 10 IPC = IPC + 1 20 IF (2*IPLNC(IPC) .NE. IPLN(IP)) THEN IPC = IPC + 1 GOTO 20 ENDIF IRC = LPLNC(IPC)-1 DO 30 IR = LPLN(IP), LPLN(IP+1)-1 IF (IROW(IR)/2*2 .NE. IROW(IR)) GOTO 30 IRC = IRC + 1 40 IF (2*IROWC(IRC) .NE. IROW(IR)) THEN IRC = IRC + 1 GOTO 40 ENDIF IPTC = LROWC(IRC)-1 DO 50 IPT = LROW(IR), LROW(IR+1)-1 IF (ICOL(IPT)/2*2 .NE. ICOL(IPT)) GOTO 50 IPTC = IPTC + 1 60 IF (2*ICOLC(IPTC) .NE. ICOL(IPT)) THEN IPTC = IPTC + 1 GOTO 60 ENDIF DO 70 IC = 1, NPDE UC(IPTC+(IC-1)*NPTSC) = U(IPT+(IC-1)*NPTS) 70 CONTINUE 50 CONTINUE 30 CONTINUE 10 CONTINUE C RETURN END SUBROUTINE INTPOL (NPDE, U, IPDOM, + LPLN, IPLN, LROW, IROW, ICOL, LBLWY, LABVY, LBLWZ, LABVZ, WORK) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPDE, IPDOM(*), + LPLN(0:*), IPLN(*), LROW(*), IROW(*), ICOL(*), + LBLWY(0:*), LABVY(0:*), LBLWZ(0:*), LABVZ(0:*) REAL U(0:*), WORK(*) C Ccc PURPOSE: C Interpolate where necessary solution C Ccc PARAMETER DESCRIPTION: C NPDE : IN. # PDE components C U : INOUT. C IN: Solution values at injected points C OUT: Interpolated solution values at other points C IPDOM : IN. Domain flags wrt to interpolation C 0: Injected point C -1: Otherwise C LPLN : IN. (0:LPLN(0)+1) C LPLN(0) = NPLNS: Actual # planes in LROW C LPLN(1:NPLNS): pointers to the start of a plane in LROW C LPLN(NPLNS+1) = NROWS+1: Total # rows in grid + 1 C IPLN : IN. (NPLNS) C IPLN(IP): plane number of plane IP in virtual box C LROW : IN. (NROWS+1) C LROW(1:NROWS): pointers to the start of a row in the grid C LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 C IROW : IN. (NROWS) C IROW(IR): row number of row IR in virtual box C ICOL : IN. (NPTS) C ICOL(IPT): column number of grid point IPT in virtual box C LBLWY : IN. (0:NPTS) C LBLWY(IPT): pointer to node below in Y-direction in C actual grid C 0, if index node is front-plane boundary point C LABVY : IN. (0:NPTS) C LABVY(IPT): pointer to node above in Y-direction in C actual grid C 0, if index node is back-plane boundary point C LBLWZ : IN. (0:NPTS) C LBLWZ(IPT): pointer to node below in Z-direction in C actual grid C 0, if index node is down-plane boundary point C LABVZ : IN. (0:NPTS) C LABVZ(IPT): pointer to node above in Z-direction in C actual grid C 0, if index node is up-plane boundary point C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C CDIR$ NOVECTOR C INTEGER IC, IP, IPT, IR, NPLNS, NPTS, NROWS C NPLNS = LPLN(0) NROWS = LPLN(NPLNS+1)-1 NPTS = LROW(NROWS+1)-1 C DO 10 IP = 1, NPLNS IF (IPLN(IP)/2*2 .NE. IPLN(IP)) GOTO 10 C Ccc Interpolation in coarse grid planes C C Interpolation in X-direction DO 20 IR = LPLN(IP), LPLN(IP+1)-1 IF (IROW(IR)/2*2 .NE. IROW(IR)) GOTO 20 DO 30 IPT = LROW(IR)+1, LROW(IR+1)-2 IF (IPDOM(IPT) .NE. 0) THEN DO 40 IC = 1, NPDE U(IPT+(IC-1)*NPTS) = + (U(IPT-1+(IC-1)*NPTS) + U(IPT+1+(IC-1)*NPTS))/2 40 CONTINUE ENDIF 30 CONTINUE 20 CONTINUE C C Interpolation in Y-direction DO 50 IR = LPLN(IP)+1, LPLN(IP+1)-2 IF (IROW(IR)/2*2 .EQ. IROW(IR)) GOTO 50 DO 60 IPT = LROW(IR), LROW(IR+1)-1 IF (IPDOM(IPT) .NE. 0) THEN DO 70 IC = 1, NPDE U(IPT+(IC-1)*NPTS) = + (U(LBLWY(IPT)+(IC-1)*NPTS) + + U(LABVY(IPT)+(IC-1)*NPTS))/2 70 CONTINUE ENDIF 60 CONTINUE 50 CONTINUE 10 CONTINUE DO 100 IP = 2, NPLNS-1 IF (IPLN(IP)/2*2 .EQ. IPLN(IP)) GOTO 100 C Ccc Interpolation in other then coarse grid planes C C Interpolation in Z-direction DO 110 IR = LPLN(IP), LPLN(IP+1)-1 DO 120 IPT = LROW(IR), LROW(IR+1)-1 IF (IPDOM(IPT) .NE. 0) THEN DO 130 IC = 1, NPDE U(IPT+(IC-1)*NPTS) = + (U(LBLWZ(IPT)+(IC-1)*NPTS) + + U(LABVZ(IPT)+(IC-1)*NPTS))/2 130 CONTINUE ENDIF 120 CONTINUE 110 CONTINUE 100 CONTINUE RETURN END SUBROUTINE RESID (T, X, Y, Z, NPTS, NPDE, UNP1, UN, UNM1, + DT, DTRAT, UIB, LLBND, ILBND, LBND, LBLWY, LABVY, LBLWZ, LABVZ, + DX, DY, DZ, UT, UX, UY, UZ, UXX, UYY, UZZ, UXY, UXZ, UYZ, F) C C----------------------------------------------------------------------- C C PARAMETER SPECIFICATION: INTEGER NPTS, NPDE, LLBND(0:*), ILBND(*), LBND(*), + LBLWY(0:*), LABVY(0:*), LBLWZ(0:*), LABVZ(0:*) REAL T, X(*), Y(*), Z(*), UNP1(0:*), UN(0:*), UNM1(0:*), + DT, DTRAT, UIB(*), DX, DY, DZ, UT(*), UX(*), UY(*), UZ(*), + UXX(*), UYY(*), UZZ(*), UXY(*), UXZ(*), UYZ(*), F(*) C C PURPOSE: C Compute time and space derivatives of U and residual F(t,Un+1,Udot) C C PARAMETER DESCRIPTION: C T : IN. Current time C X,Y,Z : IN. Physical coordinates of gridpoints C NPTS : IN. # grid points C NPDE : IN. # PDE components C UNP1 : IN. Solution at Tn+1 on current grid C UN : IN. Solution at Tn on current grid C UNM1 : IN. Solution at Tn-1 on current grid C DT : IN. Current time stepsize C DTRAT : IN. 0 or DT/DT_old C UIB : IN. Solution at T on internal boundaries C LLBND : IN. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C LBLWY : IN. (0:NPTS) C LBLWY(IPT): pointer to node below in Y-direction in C actual grid C 0, if index node is front-plane boundary point C LABVY : IN. (0:NPTS) C LABVY(IPT): pointer to node above in Y-direction in C actual grid C 0, if index node is back-plane boundary point C LBLWZ : IN. (0:NPTS) C LBLWZ(IPT): pointer to node below in Z-direction in C actual grid C 0, if index node is down-plane boundary point C LABVZ : IN. (0:NPTS) C LABVZ(IPT): pointer to node above in Z-direction in C actual grid C 0, if index node is up-plane boundary point C DX : IN. Current grid width in X-direction C DY : IN. Current grid width in Y-direction C DZ : IN. Current grid width in Z-direction C UT : OUT. Time derivative of U on current grid C UX : OUT. -I C UY : OUT. I C UZ : OUT. I C UXX : OUT. I Space derivatives of U on current grid C UYY : OUT. I C UZZ : OUT. I C UXY : OUT. I C UXZ : OUT. I C UYZ : OUT. -I C F : OUT. Residual C Ccc EXTERNALS USED: EXTERNAL DERIVS, DERIVT, RES C C----------------------------------------------------------------------- C Ccc Compute derivatives CALL DERIVT (NPTS, NPDE, UNP1(1), UN(1), UNM1(1), DT, DTRAT, UT) CALL DERIVS (NPTS, NPDE, UNP1, LLBND, ILBND, LBND, + LBLWY, LABVY, LBLWZ, LABVZ, DX, DY, DZ, + UX, UY, UZ, UXX, UYY, UZZ, UXY, UXZ, UYZ) C Ccc Compute residual CALL RES (T, X, Y, Z, NPTS, NPDE, UNP1(1), LLBND, ILBND, LBND, + UIB, UT, UX, UY, UZ, UXX, UYY, UZZ, UXY, UXZ, UYZ, F) C RETURN END SUBROUTINE DERIVT (NPTS, NPDE, UNP1, UN, UNM1, DT, DTRAT, UT) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE REAL UNP1(NPTS,NPDE), UN(NPTS,NPDE), UNM1(NPTS,NPDE), DT, DTRAT, + UT(NPTS,NPDE) C Ccc PURPOSE: C Compute time derivative. If DTRAT = 0 first order results, C if DTRAT = DT/DT_old second order. C Ccc PARAMETER DESCRIPTION: C NPTS : IN. # grid points of current grid C NPDE : IN. # PDE components C UNP1 : IN. Solution at Tn+1 on current grid C UN : IN. Solution at Tn on current grid C UNM1 : IN. Solution at Tn-1 on current grid C DT : IN. Current time stepsize C DTRAT : IN. 0 or DT/DT_old C UT : OUT. Time derivative of U on current grid C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER I, IC REAL A0, A1, A2 A0 = (1+2*DTRAT) / ((1+DTRAT)*DT) A1 = -(1+DTRAT)**2 / ((1+DTRAT)*DT) A2 = DTRAT**2 / ((1+DTRAT)*DT) DO 10 IC = 1, NPDE DO 10 I = 1, NPTS UT(I,IC) = A0*UNP1(I,IC) + A1*UN(I,IC) + A2*UNM1(I,IC) 10 CONTINUE RETURN END SUBROUTINE DERIVS (NPTS, NPDE, U, + LLBND, ILBND, LBND, LBLWY, LABVY, LBLWZ, LABVZ, + DX, DY, DZ, UX, UY, UZ, UXX, UYY, UZZ, UXY, UXZ, UYZ) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE, LLBND(0:*), ILBND(*), LBND(*), + LBLWY(0:NPTS), LABVY(0:NPTS), LBLWZ(0:NPTS), LABVZ(0:NPTS) REAL U(0:NPTS*NPDE), DX, DY, DZ, + UX(NPTS*NPDE), UY(NPTS*NPDE), UZ(NPTS*NPDE), + UXX(NPTS*NPDE), UYY(NPTS*NPDE), UZZ(NPTS*NPDE), + UXY(NPTS*NPDE), UXZ(NPTS*NPDE), UYZ(NPTS*NPDE) C Ccc PURPOSE: C Compute space derivatives with second order approximation. Second C order derivatives are required only in the interior of the domain. C Ccc PARAMETER DESCRIPTION: C NPTS : IN. # grid points of current grid C NPDE : IN. # PDE components C U : IN. Solution on current grid C LLBND : IN. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C LBLWY : IN. (0:NPTS) C LBLWY(IPT): pointer to node below in Y-direction in C actual grid C 0, if index node is front-plane boundary point C LABVY : IN. (0:NPTS) C LABVY(IPT): pointer to node above in Y-direction in C actual grid C 0, if index node is back-plane boundary point C LBLWZ : IN. (0:NPTS) C LBLWZ(IPT): pointer to node below in Z-direction in C actual grid C 0, if index node is down-plane boundary point C LABVZ : IN. (0:NPTS) C LABVZ(IPT): pointer to node above in Z-direction in C actual grid C 0, if index node is up-plane boundary point C DX : IN. Current grid width in X-direction C DY : IN. Current grid width in Y-direction C DZ : IN. Current grid width in Z-direction C UX : OUT. -I C UY : OUT. I C UZ : OUT. I C UXX : OUT. I Space derivatives of U on current grid C UYY : OUT. I C UZZ : OUT. I C UXY : OUT. I C UXZ : OUT. I C UYZ : OUT. -I C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER I, IB, IC, IPT, LB, IM1, IM2, IP1, IP2, I1, I2, I3, I4 REAL FACX, FACY, FACZ, FACXX, FACYY, FACZZ, FACXY, FACXZ, FACYZ C Ccc Zero derivative arrays in first and last point C (will possibly not be initialized) CDIR$ NEXTSCALAR DO 10 IC = 1, NPDE IPT = 1 I = IPT + (IC-1)*NPTS UX (I) = 0.0 UY (I) = 0.0 UZ (I) = 0.0 UXX(I) = 0.0 UYY(I) = 0.0 UZZ(I) = 0.0 UXY(I) = 0.0 UXZ(I) = 0.0 UYZ(I) = 0.0 IPT = NPTS I = IPT + (IC-1)*NPTS UX (I) = 0.0 UY (I) = 0.0 UZ (I) = 0.0 UXX(I) = 0.0 UYY(I) = 0.0 UZZ(I) = 0.0 UXY(I) = 0.0 UXZ(I) = 0.0 UYZ(I) = 0.0 10 CONTINUE C Ccc Compute derivatives in interior points, boundary values will be C rubbish FACX = 1/(2*DX) FACY = 1/(2*DY) FACZ = 1/(2*DZ) FACXX = 1/DX**2 FACYY = 1/DY**2 FACZZ = 1/DZ**2 FACXY = 1/(2*DX*2*DY) FACXZ = 1/(2*DX*2*DZ) FACYZ = 1/(2*DY*2*DZ) C DO 20 I = 2, NPTS*NPDE-1 UX (I) = (U(I+1)-U(I-1))*FACX UXX(I) = (U(I+1)-2*U(I)+U(I-1))*FACXX 20 CONTINUE C DO 30 IC = 1, NPDE DO 30 IPT = 2, NPTS-1 IM1 = LBLWY(IPT) + (IC-1)*NPTS I = IPT + (IC-1)*NPTS IP1 = LABVY(IPT) + (IC-1)*NPTS UY (I) = (U(IP1)-U(IM1))*FACY UYY(I) = (U(IP1)-2*U(I)+U(IM1))*FACYY IM1 = LBLWZ(IPT) + (IC-1)*NPTS I = IPT + (IC-1)*NPTS IP1 = LABVZ(IPT) + (IC-1)*NPTS UZ (I) = (U(IP1)-U(IM1))*FACZ UZZ(I) = (U(IP1)-2*U(I)+U(IM1))*FACZZ C I1 = LABVY(IPT-1) + (IC-1)*NPTS I2 = LABVY(IPT+1) + (IC-1)*NPTS I3 = LBLWY(IPT-1) + (IC-1)*NPTS I4 = LBLWY(IPT+1) + (IC-1)*NPTS UXY(I) = (U(I2)-U(I1)-U(I4)+U(I3))*FACXY I1 = LABVZ(IPT-1) + (IC-1)*NPTS I2 = LABVZ(IPT+1) + (IC-1)*NPTS I3 = LBLWZ(IPT-1) + (IC-1)*NPTS I4 = LBLWZ(IPT+1) + (IC-1)*NPTS UXZ(I) = (U(I2)-U(I1)-U(I4)+U(I3))*FACXZ I1 = LABVZ(LBLWY(IPT)) + (IC-1)*NPTS I2 = LABVZ(LABVY(IPT)) + (IC-1)*NPTS I3 = LBLWZ(LBLWY(IPT)) + (IC-1)*NPTS I4 = LBLWZ(LABVY(IPT)) + (IC-1)*NPTS UYZ(I) = (U(I2)-U(I1)-U(I4)+U(I3))*FACYZ 30 CONTINUE C Ccc Correct physical boundaries DO 40 IB = 1, LLBND(0) IF (ILBND(IB) .EQ. 1) THEN C Left plane, correct Ux DO 50 IC = 1, NPDE DO 50 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) I = IPT + (IC-1)*NPTS UX(I) = (-3*U(I)+4*U(I+1)-U(I+2))*FACX 50 CONTINUE ELSE IF (ILBND(IB) .EQ. 2) THEN C Down plane, correct Uz DO 60 IC = 1, NPDE DO 60 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) I = IPT + (IC-1)*NPTS IP1 = LABVZ(IPT) IP2 = LABVZ(IP1) + (IC-1)*NPTS IP1 = IP1 + (IC-1)*NPTS UZ(I) = (-3*U(I)+4*U(IP1)-U(IP2))*FACZ 60 CONTINUE ELSE IF (ILBND(IB) .EQ. 3) THEN C Right plane, correct Ux DO 70 IC = 1, NPDE DO 70 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) I = IPT + (IC-1)*NPTS UX(I) = (+3*U(I)-4*U(I-1)+U(I-2))*FACX 70 CONTINUE ELSE IF (ILBND(IB) .EQ. 4) THEN C Up plane, correct Uz DO 80 IC = 1, NPDE DO 80 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) I = IPT + (IC-1)*NPTS IM1 = LBLWZ(IPT) IM2 = LBLWZ(IM1) + (IC-1)*NPTS IM1 = IM1 + (IC-1)*NPTS UZ(I) = (+3*U(I)-4*U(IM1)+U(IM2))*FACZ 80 CONTINUE ELSE IF (ILBND(IB) .EQ. 5) THEN C Front plane, correct Uy DO 90 IC = 1, NPDE DO 90 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) I = IPT + (IC-1)*NPTS IP1 = LABVY(IPT) IP2 = LABVY(IP1) + (IC-1)*NPTS IP1 = IP1 + (IC-1)*NPTS UY(I) = (-3*U(I)+4*U(IP1)-U(IP2))*FACY 90 CONTINUE ELSE IF (ILBND(IB) .EQ. 6) THEN C Back boundary, correct Uy DO 100 IC = 1, NPDE DO 100 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) I = IPT + (IC-1)*NPTS IM1 = LBLWY(IPT) IM2 = LBLWY(IM1) + (IC-1)*NPTS IM1 = IM1 + (IC-1)*NPTS UY(I) = (+3*U(I)-4*U(IM1)+U(IM2))*FACY 100 CONTINUE ENDIF 40 CONTINUE C RETURN END SUBROUTINE RES (T, X, Y, Z, NPTS, NPDE, U, + LLBND, ILBND, LBND, UIB, + UT, UX, UY, UZ, UXX, UYY, UZZ, UXY, UXZ, UYZ, F) C C----------------------------------------------------------------------- C C PARAMETER SPECIFICATION: INTEGER NPTS, NPDE, LLBND(0:*), ILBND(*), LBND(*) REAL T, X(*), Y(*), Z(*), U(NPTS*NPDE), UIB(*), + UT(*), UX(*), UY(*), UZ(*), + UXX(*), UYY(*), UZZ(*), UXY(*), UXZ(*), UYZ(*), F(NPTS*NPDE) C Ccc PURPOSE: C Compute residual F(t,U,Ut) C C PARAMETER DESCRIPTION: C T : IN. Current time C X,Y,Z : IN. Physical coordinates of gridpoints C NPTS : IN. # grid points C NPDE : IN. # PDE components C U : IN. Solution at T on current grid C LLBND : IN. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C UIB : IN. Solution at T on internal boundaries C UT : IN. Time derivative of U on current grid C UX : IN. -I C UY : IN. I C UZ : IN. I C UXX : IN. I C UYY : IN. I Space derivatives of U on current grid C UZZ : IN. I C UXY : IN. I C UXZ : IN. I C UYZ : IN. -I C F : OUT. Residual C Ccc EXTERNALS USED: EXTERNAL PDEBC, PDEF C C----------------------------------------------------------------------- C INTEGER I, IB, IC, LB, NBNDS, NIBPTS, IBS, IBE C Ccc Get residual on internal domain CALL PDEF (T, X, Y, Z, U, + UT, UX, UY, UZ, UXX, UYY, UZZ, UXY, UXZ, UYZ, F, NPTS, NPDE) C Ccc Correct residual on physical boundaries CALL PDEBC (T, X, Y, Z, U, UT, UX, UY, UZ, F, NPTS, NPDE, + LLBND, ILBND, LBND) C Ccc Correct residual on internal boundaries NBNDS = LLBND(0) IBS = LLBND(NBNDS+1) IBE = LLBND(NBNDS+2)-1 NIBPTS = IBE-IBS+1 DO 10 IC = 1, NPDE DO 10 LB = IBS, IBE I = LBND(LB) + (IC-1)*NPTS IB = LB-IBS+1 + (IC-1)*NIBPTS F(I) = U(I) - UIB(IB) 10 CONTINUE RETURN END LOGICAL FUNCTION CHKTIM (RWK, LU, LUO, NPDE, IWK, LSG, + TIMWGT, RELTOL, ABSTOL, WORK, DT, DTNEW, TIMON) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER LU, LUO, NPDE, IWK(*), LSG(0:*) REAL RWK(*), TIMWGT(NPDE), RELTOL(NPDE), ABSTOL(NPDE), + WORK(*), DT, DTNEW, TIMON C Ccc PURPOSE: C Check if time step was OK. If so, CHKTIM = .TRUE. and DTNEW is set C to the stepsize for the next time step. If not CHKTIM = .FALSE. and C DTNEW is the stepsize for the next try. C Ccc PARAMETER DESCRIPTION: C RWK : IN. Work array containing both U and U_old on all grids of C this time level C LU : IN. Pointer after last element of U on base grid C LUO : IN. Pointer to first element of U_old on base grid C NPDE : IN. Number of PDE components C IWK : IN. Work array containing the datastructures for the C different grids on this level C LSG : IN. (0:LSG(0)) C LSG(0): # grid levels for this time step C LSG(I): pointer in IWK to datastructure for grid of level I C TIMWGT : IN. User defined time weight for each PDE component C used in check if time stepsize can be accepted C RELTOL : IN. (NPDE) C Relative time tolerance used to determine if time stepsize C can be accepted and to determine the new step size C ABSTOL : IN. (NPDE) C Absolute time tolerance used to determine if time stepsize C can be accepted and to determine the new step size C WORK : WORK. (max. # grid points on a level) C DT : IN. Current time stepsize C DTNEW : OUT. Stepsize for, new or retry of, timestep C Ccc EXTERNALS USED: REAL TIMMON EXTERNAL TIMMON C C----------------------------------------------------------------------- C INTEGER LEVEL, LLPLN, NPLNS, LIPLN, LLROW, NROWS, NPTS, LIROW, + LICOL, LLLBND, NBNDS, NBDPTS, NBIPTS, LILBND, LLBNDP, LENU REAL TIMONL C TIMON = 0.0 DO 10 LEVEL = 1, LSG(0) LLPLN = LSG(LEVEL) NPLNS = IWK(LLPLN) LIPLN = LLPLN+NPLNS+2 LLROW = LIPLN+NPLNS NROWS = IWK(LLPLN+NPLNS+1)-1 NPTS = IWK(LLROW+NROWS)-1 LIROW = LLROW+NROWS+1 LICOL = LIROW+NROWS LLLBND = LICOL+NPTS NBNDS = IWK(LLLBND) NBDPTS = IWK(LLLBND+NBNDS+1)-1 NBIPTS = IWK(LLLBND+NBNDS+2)-1 LILBND = LLLBND+NBNDS+3 LLBNDP = LILBND+NBNDS LENU = NPTS*NPDE+1 LU = LU - LENU C Compute time monitor for this grid level TIMONL = TIMMON (RWK(LU+1), RWK(LUO+1), NPTS, NPDE, + IWK(LLBNDP), NBIPTS, TIMWGT, RELTOL, ABSTOL, WORK) LUO = LUO + LENU*2 C Compute maximum of monitor values for all levels TIMON = MAX(TIMON,TIMONL) 10 CONTINUE C Ccc Compute new stepsize and check if current step can be accepted C Compute new stepsize such that prediction of next time monitor is 0.5 IF (TIMON .GT. 1.0) THEN C Reject step CHKTIM = .FALSE. DTNEW = 0.5 / TIMON * DT C restrict time step variance DTNEW = MAX(DTNEW, DT/4) ELSE C Accept step CHKTIM = .TRUE. C restrict time step variance DTNEW = 2*DT IF (TIMON .GT. 0.25) DTNEW = 0.5 / TIMON * DT ENDIF RETURN END REAL FUNCTION TIMMON (U, UO, NPTS, NPDE, LBND, NBIPTS, TIMWGT, + RELTOL, ABSTOL, DTUT) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NBIPTS INTEGER NPTS, NPDE, LBND(NBIPTS) REAL U(NPTS,NPDE), UO(NPTS,NPDE), TIMWGT(NPDE), + RELTOL(NPDE), ABSTOL(NPDE), DTUT(NPTS) C Ccc PURPOSE: C Compute time monitor for a specific grid level. C C Time monitor: C TIMMON = C sqrt{ sum TIMWGT(ic)/N sum [dt.Ut(ipt,ic) / w(ipt,ic)] ** 2 } C (ic=1,NPDE) (ipt=1,NPTS) C with N = NPTS*NPDE and w(ipt,ic) = ABSTOL(ic) + RELTOL(ic).|U(ipt,ic)| C On the boundaries Ut is set to zero. C Ccc PARAMETER DESCRIPTION: C U : IN. Array of solution values at Tn+1 on current grid C UO : IN. Array of solution values at Tn on current grid C NPTS : IN. # grid points C NPDE : IN. # PDE components C LBND : IN. Array containing pointers to boundary points in the grid C NBIPTS : IN. Total # boundary points C TIMWGT : IN. User defined time weight for each PDE component C used in check if time stepsize can be accepted C RELTOL : IN. (NPDE) C Relative time tolerance used to determine if time stepsize C can be accepted and to determine the new step size C ABSTOL : IN. (NPDE) C Absolute time tolerance used to determine if time stepsize C can be accepted and to determine the new step size C DTUT : WORK. (NPTS) C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER IC, IPT, LB, N REAL TMIC, W2 C N = NPTS*NPDE C TIMMON = 0.0 DO 10 IC = 1, NPDE IF (TIMWGT(IC) .EQ. 0.0) GOTO 10 DO 20 IPT = 1, NPTS DTUT(IPT) = U(IPT,IC)-UO(IPT,IC) 20 CONTINUE DO 30 LB = 1, NBIPTS IPT = LBND(LB) DTUT(IPT) = 0.0 30 CONTINUE TMIC = 0.0 DO 40 IPT = 1, NPTS W2 = ABSTOL(IC) + RELTOL(IC)*ABS(U(IPT,IC)) TMIC = TMIC + (DTUT(IPT) / W2) ** 2 40 CONTINUE TIMMON = TIMMON + TIMWGT(IC)*TMIC/N 10 CONTINUE TIMMON = SQRT(TIMMON) RETURN END SUBROUTINE INTGRB (ISTRUC, X, Y, Z, NPDE, UIB, UNP1, UN, UNM1, + RELTOL, ABSTOL, TN, DT, DTRAT, DX, DY, DZ, WT, F, CORR, RWORK, + IERR) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER ISTRUC(0:*), NPDE, IERR REAL X(*), Y(*), Z(*), UIB(*), UNP1(0:*), UN(0:*), UNM1(0:*), + RELTOL(NPDE), ABSTOL(NPDE), + TN, DT, DTRAT, DX, DY, DZ, + WT(*), F(*), CORR(*), RWORK(*) C Ccc PURPOSE: C Integration in time with BDF2 (first timestep BE). C Solve nonlinear system F(Tn+1, Un+1, Udot) = 0 with modified Newton. C Solve linear systems with ILU-preconditioned BiCGStab. C Ccc PARAMETER DESCRIPTION: C ISTRUC : IN. Data structure Un+1 grid. C X,Y,Z : IN. Physical coordinates grid. C NPDE : IN. # PDE components C UIB : IN. Dirichlet boundary values on internal boundary. C UNP1 : INOUT. On entry: Initial solution, on exit final solution C Newton converged C UN : IN. Solution at Tn on Un+1 grid C UNM1 : IN. Solution at Tn-1 on Un+1 grid C RELTOL : IN. Relative tolerance for Newton process C ABSTOL : IN. Absolute tolerance for Newton process C TN : IN. Previous time C DT : IN. Current time step C DX : IN. Current grid spacing in X-direction C DY : IN. Current grid spacing in Y-direction C DZ : IN. Current grid spacing in Z-direction C DTRAT : IN. If BE: 0, if BDF2: DT/DT_old C WT : WORK. (NPTS*NPDE) C Weight function for norm computation C F : WORK. (NPTS*NPDE) C Residual C CORR : WORK. (NPTS*NPDE) C Correction in Newton iteration C RWORK : WORK. (JACILU+max(RESWRK,LSSWRK)) C JACILU: 2.19.NPDE.LENU C RESWRK: LENU.10 C LSSWRK: LENU.5 C LENU : NPTS*NPDE C IERR : OUT. C 0: OK. C 10: Newton process did not converge C C Ccc EXTERNALS USED: REAL MAXNRM, WSNRM2 EXTERNAL ERRWGT, BICGST, JAC, JACPB, MAXNRM, RESID, WSNRM2 C C Ccc INCLUDE 'PARNEWTON' C C PARNEWTON C C Parameters for Newton process C MAXNIT : Max. number of Newton iterations C MAXJAC : Max. number of Jacobian / preconditioner evaluations during C a Newton process C TOLNEW : Tolerance for Newton process: C rho/(1-rho)*|| corr.||_w < TOLNEW INTEGER MAXNIT, MAXJAC REAL TOLNEW PARAMETER (MAXNIT = 10, MAXJAC = 2, TOLNEW = 1.0) C C end INCLUDE 'PARNEWTON' C C Ccc INCLUDE 'PARBICGSTAB' C C PARBICGSTAB C C Parameters for linear system solver BiCGStab C MAXLIT : Max. number of BiCGStab iterations C TOLLSB : Tolerance for linear system solver INTEGER MAXLIT REAL TOLLSB PARAMETER (MAXLIT = 100, TOLLSB = TOLNEW/10) C C end INCLUDE 'PARBICGSTAB' C C Ccc INCLUDE 'CMNCMMACH' C C CMNCMMACH C C COMMON with `machine numbers' C LUNOUT : Logical unit # standard output -I C LUNERR : Logical unit # standard error I Set in the routine C UROUND : Smallest machine number such that I MACNUM C 1.0+UROUND > 1.0 and 1.0-UROUND < 1.0 I C XMIN : Smallest floating-point number -I INTEGER LUNOUT, LUNERR REAL UROUND, XMIN COMMON /IMACH/ LUNOUT, LUNERR COMMON /RMACH/ UROUND, XMIN SAVE /IMACH/, /RMACH/ C C end INCLUDE 'CMNCMMACH' C C Ccc INCLUDE 'CMNSTATS' C C CMNSTATS C C COMMON with integration statistics INTEGER MXCLEV, MXCNIT PARAMETER (MXCLEV = 10, MXCNIT = 20) INTEGER LUNPDS, LUNNLS, LUNLSS, LEVEL, NSTEPS, NREJS, + NJACS(MXCLEV), NRESID(MXCLEV), NNIT(MXCLEV), + NLSIT(MXCLEV,MXCNIT) COMMON /STATS/ LUNPDS, LUNNLS, LUNLSS, LEVEL, NSTEPS, NREJS, + NJACS, NRESID, NNIT, NLSIT SAVE /STATS/ C C end INCLUDE 'CMNSTATS' C C C----------------------------------------------------------------------- C INTEGER LLPLN, NPLNS, LIPLN, LLROW, NROWS, NPTS, LIROW, LICOL, + LLLBND, NBNDS, NBDPTS, NBIPTS, LILBND, LLBNDP, + LLBLWY, LLABVY, LLBLWZ, LLABVZ, + LLLDG, LLUDG, LLSLP, LLLSL, LLSUP, LLLSU, LENU, LENGLU, + LUT, LUX, LUY, LUZ, LUXX, LUYY, LUZZ, LUXY, LUXZ, LUYZ, + LBCG1, LBCG2, LBCG3, LBCG4, LBCG5, LG, LGLU, LJACWK, + NJAC, NRES, I, NIT, ITER LOGICAL NEWJAC REAL ERR, CORNRM, OLDNRM, RATE, TOL, UNRM C IERR = 0 C IF (LUNNLS .NE. 0) THEN WRITE(LUNNLS,'(''Nonlinear system solver at T ='',E16.7)') + TN+DT ENDIF C LLPLN = 0 NPLNS = ISTRUC(LLPLN) LIPLN = LLPLN+NPLNS+2 LLROW = LIPLN+NPLNS NROWS = ISTRUC(LLPLN+NPLNS+1)-1 NPTS = ISTRUC(LLROW+NROWS)-1 LIROW = LLROW+NROWS+1 LICOL = LIROW+NROWS LLLBND = LICOL+NPTS NBNDS = ISTRUC(LLLBND) NBDPTS = ISTRUC(LLLBND+NBNDS+1)-1 NBIPTS = ISTRUC(LLLBND+NBNDS+2)-1 LILBND = LLLBND+NBNDS+3 LLBNDP = LILBND+NBNDS LLBLWY = LLBNDP+NBIPTS LLABVY = LLBLWY+NPTS+1 LLBLWZ = LLABVY+NPTS+1 LLABVZ = LLBLWZ+NPTS+1 C LLLDG = LLABVZ+NPTS+1 LLUDG = LLLDG+NPTS*8 LLSLP = LLUDG+NPTS*8 LLLSL = LLSLP+NPTS LLSUP = LLLSL+ISTRUC(LLLSL)+1 LLLSU = LLSUP+NPTS C LENU = NPTS*NPDE LENGLU = LENU*NPDE*19 C LUT = 1 LUX = LUT + LENU LUY = LUX + LENU LUZ = LUY + LENU LUXX = LUZ + LENU LUYY = LUXX + LENU LUZZ = LUYY + LENU LUXY = LUZZ + LENU LUXZ = LUXY + LENU LUYZ = LUXZ + LENU C LBCG1 = LUX LBCG2 = LBCG1 + LENU LBCG3 = LBCG2 + LENU LBCG4 = LBCG3 + LENU LBCG5 = LBCG4 + LENU C LG = MAX (LUYZ+LENU, LBCG5+LENU) LGLU = LG+LENGLU LJACWK = LGLU C Ccc Set error weights for use in Newton process CALL ERRWGT (NPTS, NPDE, UNP1(1), RELTOL, ABSTOL, WT) C Ccc Compute weighted norm of initial solution for convergence check UNRM = WSNRM2 (LENU, UNP1(1), WT) C Ccc Compute derivatives and residual CALL RESID (TN+DT, X, Y, Z, NPTS, NPDE, UNP1, UN, UNM1, DT, DTRAT, + UIB, ISTRUC(LLLBND), ISTRUC(LILBND), ISTRUC(LLBNDP), + ISTRUC(LLBLWY), ISTRUC(LLABVY), ISTRUC(LLBLWZ), ISTRUC(LLABVZ), + DX, DY, DZ, + RWORK(LUT), RWORK(LUX), RWORK(LUY), RWORK(LUZ), + RWORK(LUXX), RWORK(LUYY), RWORK(LUZZ), + RWORK(LUXY), RWORK(LUXZ), RWORK(LUYZ), F) NRES = 1 IF (LUNNLS .NE. 0) THEN WRITE(LUNNLS,'('' Max. and WRMS norm residual='',2E16.7)') + MAXNRM(LENU, F), WSNRM2 (LENU, F, WT) ENDIF C Ccc Compute Jacobian G = dF/dU and its incomplete factorization GLU CALL JAC (NPTS, NPDE, F, TN+DT, X, Y, Z, DT, DTRAT, DX, DY, DZ, + UNP1(1), ISTRUC(LLLBND), ISTRUC(LILBND), ISTRUC(LLBNDP), UIB, + RWORK(LUT), RWORK(LUX), RWORK(LUY), RWORK(LUZ), + RWORK(LUXX), RWORK(LUYY), RWORK(LUZZ), + RWORK(LUXY), RWORK(LUXZ), RWORK(LUYZ), + ABSTOL, RWORK(LJACWK), RWORK(LG)) C Copy Jacobian for factorization CALL RCOPY (LENGLU, RWORK(LG), RWORK(LGLU)) C Compute ILU CALL JACPB (NPTS, NPDE, RWORK(LGLU), ISTRUC(LLLDG), + ISTRUC(LLLBND), ISTRUC(LILBND), ISTRUC(LLBNDP), + ISTRUC(LLSLP), ISTRUC(LLLSL)) NEWJAC = .TRUE. NJAC = 1 C Ccc Newton iteration loop 9 CONTINUE DO 10 NIT = 1, MAXNIT C Cccccc Solve G.corr = F. Store the residual in F. TOL = TOLLSB / (2**NIT) CALL BICGST (NPTS, NPDE, RWORK(LG), CORR, F, WT, TOL, + MAXLIT, RWORK(LGLU), ISTRUC(LLLDG), ISTRUC(LLUDG), + ISTRUC(LLSLP), ISTRUC(LLLSL), ISTRUC(LLSUP), ISTRUC(LLLSU), + LUNLSS, RWORK(LBCG1), RWORK(LBCG2), RWORK(LBCG3), + RWORK(LBCG4), RWORK(LBCG5), ITER, ERR, IERR) NLSIT(LEVEL,NIT) = NLSIT(LEVEL,NIT)+ ITER IF (IERR .NE. 0) GOTO 100 C Cccccc Test for convergence CORNRM = WSNRM2 (LENU, CORR, WT) IF (LUNNLS .NE. 0) THEN WRITE(LUNNLS,'('' NI:'',I3,'', NLI:'',I4,'', ERLI'':,E16.7, + '', ERNI:'',E16.7)') NIT, ITER, ERR, CORNRM ENDIF IF (CORNRM .LE. 100*UROUND*UNRM) GOTO 900 IF (.NOT. NEWJAC) THEN RATE = SQRT(CORNRM/OLDNRM) IF (RATE .GT. 0.9) THEN C Divergence GOTO 100 ELSE IF (RATE/(1-RATE)*CORNRM .LE. TOLNEW) THEN C Convergence GOTO 900 ENDIF ENDIF OLDNRM = CORNRM C Ccccc Update solution DO 20 I = 1, LENU UNP1(I) = UNP1(I) - CORR(I) 20 CONTINUE C Ccc Compute derivatives and residual and start next iteration CALL RESID (TN+DT, X, Y, Z, NPTS, NPDE, UNP1, UN, UNM1, + DT, DTRAT, UIB, + ISTRUC(LLLBND), ISTRUC(LILBND), ISTRUC(LLBNDP), + ISTRUC(LLBLWY), ISTRUC(LLABVY), + ISTRUC(LLBLWZ), ISTRUC(LLABVZ), + DX, DY, DZ, + RWORK(LUT), RWORK(LUX), RWORK(LUY), RWORK(LUZ), + RWORK(LUXX), RWORK(LUYY), RWORK(LUZZ), + RWORK(LUXY), RWORK(LUXZ), RWORK(LUYZ), F) NRES = NRES+1 NEWJAC = .FALSE. IF (LUNNLS .NE. 0) THEN WRITE(LUNNLS,'('' Max. and WRMS norm residual='',2E16.7)') + MAXNRM(LENU, F), WSNRM2 (LENU, F, WT) ENDIF 10 CONTINUE Ccc End Newton iteration loop C Ccc No convergence in max. # iterations C Ccccc Check if Jacobian is recent 100 CONTINUE IF (.NOT. NEWJAC .AND. NJAC .LT. MAXJAC) THEN IF (LUNNLS .NE. 0) THEN WRITE(LUNNLS,'('' New Jacobian, NIT='',I4)') NIT ENDIF C Compute new Jacobian and retry CALL DERIVS (NPTS, NPDE, UNP1, + ISTRUC(LLLBND), ISTRUC(LILBND), ISTRUC(LLBNDP), + ISTRUC(LLBLWY), ISTRUC(LLABVY), + ISTRUC(LLBLWZ), ISTRUC(LLABVZ), + DX, DY, DZ, + RWORK(LUX), RWORK(LUY), RWORK(LUZ), + RWORK(LUXX), RWORK(LUYY), RWORK(LUZZ), + RWORK(LUXY), RWORK(LUXZ), RWORK(LUYZ)) CALL JAC (NPTS, NPDE, F, TN+DT, X, Y, Z, DT, DTRAT, + DX, DY, DZ, UNP1(1), + ISTRUC(LLLBND),ISTRUC(LILBND),ISTRUC(LLBNDP), UIB, + RWORK(LUT), RWORK(LUX), RWORK(LUY), RWORK(LUZ), + RWORK(LUXX), RWORK(LUYY), RWORK(LUZZ), + RWORK(LUXY), RWORK(LUXZ), RWORK(LUYZ), + ABSTOL, RWORK(LJACWK), RWORK(LG)) C Copy Jacobian for factorization CALL RCOPY (LENGLU, RWORK(LG), RWORK(LGLU)) C Compute ILU CALL JACPB (NPTS, NPDE, RWORK(LGLU), ISTRUC(LLLDG), + ISTRUC(LLLBND), ISTRUC(LILBND), ISTRUC(LLBNDP), + ISTRUC(LLSLP), ISTRUC(LLLSL)) C NEWJAC = .TRUE. NJAC = NJAC + 1 GOTO 9 ELSE C Newton failure IERR = 10 NNIT(LEVEL) = NNIT(LEVEL)+NIT NRESID(LEVEL) = NRESID(LEVEL)+NRES NJACS(LEVEL) = NJACS(LEVEL)+NJAC IF (LUNNLS .NE. 0) THEN WRITE(LUNNLS,'(''Newton failure, NIT='',I4)') NIT ENDIF RETURN ENDIF C Ccc Nonlinear proces has been solved 900 CONTINUE C Update solution DO 30 I = 1, LENU UNP1(I) = UNP1(I) - CORR(I) 30 CONTINUE C NNIT(LEVEL) = NNIT(LEVEL)+NIT NRESID(LEVEL) = NRESID(LEVEL)+NRES NJACS(LEVEL) = NJACS(LEVEL)+NJAC C RETURN END SUBROUTINE JAC (NPTS, NPDE, F, T, X, Y, Z, DT, DTRAT, + DX, DY, DZ, U, LLBND, ILBND, LBND, UIB, + UT, UX, UY, UZ, UXX, UYY, UZZ, UXY, UXZ, UYZ, ABSTOL, WORK, G) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE, LLBND(0:*), ILBND(*), LBND(*) REAL F(*), T, X(*), Y(*), Z(*), DT, DTRAT, DX, DY, DZ, + U(*), UIB(*), UT(*), UX(*), UY(*), UZ(*), + UXX(*), UYY(*), UZZ(*), UXY(*), UXZ(*), UYZ(*), + ABSTOL(*), WORK(*), G(*) C Ccc PURPOSE: C Compute Jacobian G = dF/dU and store in block 19-diagonal mode. C C PARAMETER DESCRIPTION: C NPTS : IN. # grid points C NPDE : IN. # PDE components C F : IN. Residual F(t,U,Ut) C T : IN. Current time C X,Y,Z : IN. Physical coordinates of gridpoints C DT : IN. Current time stepsize C DTRAT : IN. 0 or DT/DT_old C DX : IN. Current grid width in X-direction C DY : IN. Current grid width in Y-direction C DZ : IN. Current grid width in Z-direction C U : IN. Solution at T on current grid C LLBND : IN. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C UIB : IN. Solution at T on internal boundaries C UT : OUT. Time derivative of U on current grid C UX : OUT. -I C UY : OUT. I C UZ : OUT. I C UXX : OUT. I Space derivatives of U on current grid C UYY : OUT. I C UZZ : OUT. I C UXY : OUT. I C UXZ : OUT. I C UYZ : OUT. - C ABSTOL : IN. Absolute tolerance for Newton process C WORK : WORK. (10*LENFU+2*LENU+NPTS) C G : OUT. Jacobian stored in block 19-diagonal mode C Ccc EXTERNALS USED: EXTERNAL DERIVF, JACG C C----------------------------------------------------------------------- C INTEGER LENU, LENFU, LFU, LFUX, LFUY, LFUZ, LFUXX, LFUYY, LFUZZ, + LFUXY, LFUXZ, LFUYZ, LDEL, LRWK REAL A0 C LENU = NPTS*NPDE LENFU = LENU*NPDE C LFU = 1 LFUX = LFU + LENFU LFUY = LFUX + LENFU LFUZ = LFUY + LENFU LFUXX = LFUZ + LENFU LFUYY = LFUXX + LENFU LFUZZ = LFUYY + LENFU LFUXY = LFUZZ + LENFU LFUXZ = LFUXY + LENFU LFUYZ = LFUXZ + LENFU LDEL = LFUYZ + LENFU LRWK = LDEL + NPTS C Ccc Compute dF/dU, dF/dUx, dF/dUy, dF/dUz, dF/dUxx, dF/dUyy, dF/dUzz, C dF/dUxy, dF/dUxz, dF/dUyz A0 = (1+2*DTRAT) / ((1+DTRAT)*DT) CALL DERIVF (F, T, X, Y, Z, NPTS, NPDE, U, A0, DT, DX, DY, DZ, + LLBND, ILBND, LBND, UIB, UT, UX, UY, UZ, UXX, UYY, UZZ, + UXY, UXZ, UYZ, ABSTOL, WORK(LDEL), WORK(LRWK), + WORK(LFU), WORK(LFUX), WORK(LFUY), WORK(LFUZ), + WORK(LFUXX), WORK(LFUYY), WORK(LFUZZ), + WORK(LFUXY), WORK(LFUXZ), WORK(LFUYZ)) C Ccc Compute G = dF/dU + dF/dUx.dUx/dU + ... CALL JACG (NPTS, NPDE, DX, DY, DZ, LLBND, ILBND, LBND, + WORK(LFU), WORK(LFUX), WORK(LFUY), WORK(LFUZ), + WORK(LFUXX), WORK(LFUYY), WORK(LFUZZ), + WORK(LFUXY), WORK(LFUXZ), WORK(LFUYZ), G) C RETURN END SUBROUTINE PRTRBU (ICPTB, NPTS, NPDE, U, A0, DT, UT, TOL, DEL, + UBAR, UTBAR) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER ICPTB, NPTS, NPDE REAL U(NPTS,NPDE), A0, DT, UT(NPTS,NPDE), TOL, DEL(NPTS), + UBAR(NPTS,NPDE), UTBAR(NPTS,NPDE) C Ccc PURPOSE: C Perturb the ICPTB-th component of U. Return perturbance in DEL and C perturbed U in UBAR. C Ccc PARAMETER DESCRIPTION: C ICPTB : IN. Component of U to be perturbed C NPTS : IN. # gridpoints C NPDE : IN. # PDE components C U : IN. Solution or derivative of solution to be perturbed C TOL : IN. Threshold for perturbation C DEL : OUT. Perturbation values C UBAR : OUT. Perturbed values of U C Ccc EXTERNALS USED: EXTERNAL RCOPY C C Ccc INCLUDE 'CMNCMMACH' C C CMNCMMACH C C COMMON with `machine numbers' C LUNOUT : Logical unit # standard output -I C LUNERR : Logical unit # standard error I Set in the routine C UROUND : Smallest machine number such that I MACNUM C 1.0+UROUND > 1.0 and 1.0-UROUND < 1.0 I C XMIN : Smallest floating-point number -I INTEGER LUNOUT, LUNERR REAL UROUND, XMIN COMMON /IMACH/ LUNOUT, LUNERR COMMON /RMACH/ UROUND, XMIN SAVE /IMACH/, /RMACH/ C C end INCLUDE 'CMNCMMACH' C C C----------------------------------------------------------------------- C INTEGER IPT REAL DELI, EPS CALL RCOPY (NPTS*NPDE, U, UBAR) CALL RCOPY (NPTS*NPDE, UT, UTBAR) EPS = SQRT(UROUND) DO 10 IPT = 1, NPTS C Compute perturbance, if U=0, U(T+dt)=dtUt, if both are zero take C threshold DELI = EPS*MAX(ABS(U(IPT,ICPTB)),ABS(DT*UT(IPT,ICPTB)),TOL) DELI = SIGN(DELI,DT*UT(IPT,ICPTB)) C To ensure that the perturbance is the same machine number as the C denominator DEL(IPT) = (U(IPT,ICPTB)+DELI)-U(IPT,ICPTB) UBAR(IPT,ICPTB) = U(IPT,ICPTB) + DEL(IPT) UTBAR(IPT,ICPTB) = UT(IPT,ICPTB) + A0*DEL(IPT) 10 CONTINUE RETURN END SUBROUTINE PERTRB (ICPTB, NPTS, NPDE, U, TOL, DEL, UBAR) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER ICPTB, NPTS, NPDE REAL U(NPTS,NPDE), TOL, DEL(NPTS), UBAR(NPTS,NPDE) C Ccc PURPOSE: C Perturb the ICPTB-th component of U. Return perturbance in DEL and C perturbed U in UBAR. C Ccc PARAMETER DESCRIPTION: C ICPTB : IN. Component of U to be perturbed C NPTS : IN. # gridpoints C NPDE : IN. # PDE components C U : IN. Solution or derivative of solution to be perturbed C TOL : IN. Threshold for perturbation C DEL : OUT. Perturbation values C UBAR : OUT. Perturbed values of U C Ccc EXTERNALS USED: EXTERNAL RCOPY C C Ccc INCLUDE 'CMNCMMACH' C C CMNCMMACH C C COMMON with `machine numbers' C LUNOUT : Logical unit # standard output -I C LUNERR : Logical unit # standard error I Set in the routine C UROUND : Smallest machine number such that I MACNUM C 1.0+UROUND > 1.0 and 1.0-UROUND < 1.0 I C XMIN : Smallest floating-point number -I INTEGER LUNOUT, LUNERR REAL UROUND, XMIN COMMON /IMACH/ LUNOUT, LUNERR COMMON /RMACH/ UROUND, XMIN SAVE /IMACH/, /RMACH/ C C end INCLUDE 'CMNCMMACH' C C C----------------------------------------------------------------------- C INTEGER IPT REAL DELI, EPS CALL RCOPY (NPTS*NPDE, U, UBAR) EPS = SQRT(UROUND) DO 10 IPT = 1, NPTS C Compute perturbance DELI = EPS*MAX(ABS(U(IPT,ICPTB)),TOL) C To ensure that UBAR has the same sign as U DELI = SIGN(DELI,U(IPT,ICPTB)) C To ensure that the perturbance is the same machine number as the C denominator DEL(IPT) = (U(IPT,ICPTB)+DELI)-U(IPT,ICPTB) UBAR(IPT,ICPTB) = U(IPT,ICPTB) + DEL(IPT) 10 CONTINUE RETURN END SUBROUTINE JACG (NPTS, NPDE, DX, DY, DZ, LLBND, ILBND, LBND, + FU, FUX, FUY, FUZ, FUXX, FUYY, FUZZ, FUXY, FUXZ, FUYZ, G) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE, LLBND(0:*), ILBND(*), LBND(*) REAL DX, DY, DZ, + FU(NPTS*NPDE,NPDE), + FUX(NPTS*NPDE,NPDE), FUY(NPTS*NPDE,NPDE), FUZ(NPTS*NPDE,NPDE), + FUXX(NPTS*NPDE,NPDE),FUYY(NPTS*NPDE,NPDE),FUZZ(NPTS*NPDE,NPDE), + FUXY(NPTS*NPDE,NPDE),FUXZ(NPTS*NPDE,NPDE),FUYZ(NPTS*NPDE,NPDE), + G(NPTS*NPDE,NPDE,-9:9) C Ccc PURPOSE: C Compute Jacobian G = dF/dU using derivatives of residual wrt C (derivatives of) U C C PARAMETER DESCRIPTION: C NPTS : IN. # grid points C NPDE : IN. # PDE components C DX : IN. Current grid width in X-direction C DY : IN. Current grid width in Y-direction C DZ : IN. Current grid width in Z-direction C LLBND : IN. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C FU : IN. Derivative residual F(.,U,Ut,.) wrt U C FUX : IN. Derivative residual F(.,Ux,.) wrt Ux C FUY : IN. Derivative residual F(.,Uy,.) wrt Uy C FUZ : IN. Derivative residual F(.,Uz,.) wrt Uz C FUXX : IN. Derivative residual F(.,Uxx,.) wrt Uxx C FUYY : IN. Derivative residual F(.,Uyy,.) wrt Uyy C FUZZ : IN. Derivative residual F(.,Uzz,.) wrt Uzz C FUXY : IN. Derivative residual F(.,Uxy,.) wrt Uxy C FUXZ : IN. Derivative residual F(.,Uxz,.) wrt Uxz C FUYZ : IN. Derivative residual F(.,Uyz,.) wrt Uyz C G : OUT. Jacobian stored in block 19-diagonal mode C Ccc EXTERNALS USED: EXTERNAL JACGBD C C----------------------------------------------------------------------- C INTEGER I, JC, LENU REAL FACX, FACY, FACZ, FACXX, FACYY, FACZZ, FACXY, FACXZ, FACYZ C LENU = NPTS*NPDE C FACX = 1/(2*DX) FACY = 1/(2*DY) FACZ = 1/(2*DZ) FACXX = 1/DX**2 FACYY = 1/DY**2 FACZZ = 1/DZ**2 FACXY = 1/(2*DX*2*DY) FACXZ = 1/(2*DX*2*DZ) FACYZ = 1/(2*DY*2*DZ) C Ccc First internal domain DO 10 JC = 1, NPDE DO 10 I = 1, LENU C dF(ipt,ic)/dU(blwz(blwy(ipt)),jc) G(I,JC,-9) = FUYZ(I,JC)*(+FACYZ) C dF(ipt,ic)/dU(blwz(ipt-1),jc) G(I,JC,-8) = FUXZ(I,JC)*(+FACXZ) C dF(ipt,ic)/dU(blwz(ipt),jc) G(I,JC,-7) = + FUZ(I,JC)*(-FACZ) + FUZZ(I,JC)*(+FACZZ) C dF(ipt,ic)/dU(blwz(ipt+1),jc) G(I,JC,-6) = FUXZ(I,JC)*(-FACXZ) C dF(ipt,ic)/dU(blwz(abvy(ipt)),jc) G(I,JC,-5) = FUYZ(I,JC)*(-FACYZ) C dF(ipt,ic)/dU(blwy(ipt)-1,jc) G(I,JC,-4) = FUXY(I,JC)*(+FACXY) C dF(ipt,ic)/dU(blwy(ipt),jc) G(I,JC,-3) = + FUY(I,JC)*(-FACY) + FUYY(I,JC)*(+FACYY) C dF(ipt,ic)/dU(blwy(ipt)+1,jc) G(I,JC,-2) = FUXY(I,JC)*(-FACXY) C dF(ipt,ic)/dU(ipt-1,jc) G(I,JC,-1) = + FUX(I,JC)*(-FACX) + FUXX(I,JC)*(+FACXX) C dF(ipt,ic)/dU(ipt,jc) G(I,JC, 0) = FU(I,JC) + + FUXX(I,JC)*(-2*FACXX) + FUYY(I,JC)*(-2*FACYY) + + FUZZ(I,JC)*(-2*FACZZ) C dF(ipt,ic)/dU(ipt+1,jc) G(I,JC,+1) = + FUX(I,JC)*(+FACX) + FUXX(I,JC)*(+FACXX) C dF(ipt,ic)/dU(abvy(ipt)-1,jc) G(I,JC,+2) = FUXY(I,JC)*(-FACXY) C dF(ipt,ic)/dU(abvy(ipt),jc) G(I,JC,+3) = + FUY(I,JC)*(+FACY) + FUYY(I,JC)*(+FACYY) C dF(ipt,ic)/dU(abvy(ipt)+1,jc) G(I,JC,+4) = FUXY(I,JC)*(+FACXY) C dF(ipt,ic)/dU(abvz(blwy(ipt)),jc) G(I,JC,+5) = FUYZ(I,JC)*(-FACYZ) C dF(ipt,ic)/dU(abvz(ipt-1),jc) G(I,JC,+6) = FUXZ(I,JC)*(-FACXZ) C dF(ipt,ic)/dU(abvz(ipt),jc) G(I,JC,+7) = + FUZ(I,JC)*(+FACZ) + FUZZ(I,JC)*(+FACZZ) C dF(ipt,ic)/dU(abvz(ipt+1),jc) G(I,JC,+8) = FUXZ(I,JC)*(+FACXZ) C dF(ipt,ic)/dU(abvz(abvy(ipt)),jc) G(I,JC,+9) = FUYZ(I,JC)*(+FACYZ) 10 CONTINUE C C Correct boundaries CALL JACGBD (NPTS, NPDE, FACX, FACY, FACZ, + LLBND, ILBND, LBND, FUX, FUY, FUZ, G) C RETURN END SUBROUTINE JACGBD (NPTS, NPDE, FACX, FACY, FACZ, + LLBND, ILBND, LBND, FUX, FUY, FUZ, G) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE, LLBND(0:*), ILBND(*), LBND(*) REAL FACX, FACY, FACZ, + FUX(NPTS,NPDE,NPDE), FUY(NPTS,NPDE,NPDE), FUZ(NPTS,NPDE,NPDE), + G(NPTS,NPDE,NPDE,-9:9) C Ccc PURPOSE: C Correct Jacobian G = dF/dU for second order approximation of C first order derivatives at boundaries C C PARAMETER DESCRIPTION: C NPTS : IN. # grid points C NPDE : IN. # PDE components C FACX : IN. 1/(2*DX) C FACY : IN. 1/(2*DY) C FACZ : IN. 1/(2*DZ) C LLBND : IN. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C FUX : IN. Derivative residual C F(t,U,Ut,Ux,Uy,Uz,Uxx,Uyy,Uzz,Uxy,Uxz,Uyz) wrt Ux C FUY : IN. Derivative residual C F(t,U,Ut,Ux,Uy,Uz,Uxx,Uyy,Uzz,Uxy,Uxz,Uyz) wrt Uy C FUZ : IN. Derivative residual C F(t,U,Ut,Ux,Uy,Uz,Uxx,Uyy,Uzz,Uxy,Uxz,Uyz) wrt Uz C G : INOUT. C IN: Jacobian stored in block 19-diagonal mode C OUT: Jacobian corrected for first order derivatives at C boundaries C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER IPT, IC, JC, IB, LB C Ccc Boundary corrections, no corrections needed for internal boundaries DO 10 IB = 1, LLBND(0) IF (ILBND(IB) .EQ. 1) THEN C Left plane, correction needed for dF/dUx DO 20 JC = 1, NPDE DO 20 IC = 1, NPDE CDIR$ IVDEP DO 25 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) G(IPT,IC,JC,-1) = 0.0 G(IPT,IC,JC, 0) = G(IPT,IC,JC,0) + + FUX(IPT,IC,JC)*(-3*FACX) G(IPT,IC,JC,+1) = FUX(IPT,IC,JC)*(+4*FACX) C dF(ipt,ic)/dU(ipt+2),jc) G(IPT,IC,JC,+2) = FUX(IPT,IC,JC)*(-FACX) 25 CONTINUE 20 CONTINUE ELSE IF (ILBND(IB) .EQ. 2) THEN C Down plane, correction needed for dF/dUz DO 30 JC = 1, NPDE DO 30 IC = 1, NPDE CDIR$ IVDEP DO 35 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) G(IPT,IC,JC,-7) = 0.0 G(IPT,IC,JC, 0) = G(IPT,IC,JC,0) + + FUZ(IPT,IC,JC)*(-3*FACZ) G(IPT,IC,JC,+7) = FUZ(IPT,IC,JC)*(+4*FACZ) C dF(ipt,ic)/dU(above(above(ipt)),jc) G(IPT,IC,JC,+9) = FUZ(IPT,IC,JC)*(-FACZ) 35 CONTINUE 30 CONTINUE ELSE IF (ILBND(IB) .EQ. 3) THEN C Right plane, correction needed for dF/dUx DO 40 JC = 1, NPDE DO 40 IC = 1, NPDE CDIR$ IVDEP DO 45 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) C dF(ipt,ic)/dU(ipt-2),jc) G(IPT,IC,JC,-2) = FUX(IPT,IC,JC)*(+FACX) G(IPT,IC,JC,-1) = FUX(IPT,IC,JC)*(-4*FACX) G(IPT,IC,JC, 0) = G(IPT,IC,JC,0) + + FUX(IPT,IC,JC)*(+3*FACX) G(IPT,IC,JC,+1) = 0.0 45 CONTINUE 40 CONTINUE ELSE IF (ILBND(IB) .EQ. 4) THEN C Up plane, correction needed for dF/dUz DO 50 JC = 1, NPDE DO 50 IC = 1, NPDE CDIR$ IVDEP DO 55 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) C dF(ipt,ic)/dU(below(below(ipt)),jc) G(IPT,IC,JC,-9) = FUZ(IPT,IC,JC)*(+FACZ) G(IPT,IC,JC,-7) = FUZ(IPT,IC,JC)*(-4*FACZ) G(IPT,IC,JC, 0) = G(IPT,IC,JC,0) + + FUZ(IPT,IC,JC)*(+3*FACZ) G(IPT,IC,JC,+7) = 0.0 55 CONTINUE 50 CONTINUE ELSE IF (ILBND(IB) .EQ. 5) THEN C Front plane, correction needed for dF/dUy DO 60 JC = 1, NPDE DO 60 IC = 1, NPDE CDIR$ IVDEP DO 65 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) G(IPT,IC,JC,-3) = 0.0 G(IPT,IC,JC, 0) = G(IPT,IC,JC,0) + + FUY(IPT,IC,JC)*(-3*FACY) G(IPT,IC,JC,+3) = FUY(IPT,IC,JC)*(+4*FACY) C dF(ipt,ic)/dU(above(above(ipt)),jc) G(IPT,IC,JC,+4) = FUY(IPT,IC,JC)*(-FACY) 65 CONTINUE 60 CONTINUE ELSE IF (ILBND(IB) .EQ. 6) THEN C Back plane, correction needed for dF/dUy DO 70 JC = 1, NPDE DO 70 IC = 1, NPDE CDIR$ IVDEP DO 75 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) C dF(ipt,ic)/dU(below(below(ipt)),jc) G(IPT,IC,JC,-4) = FUY(IPT,IC,JC)*(+FACY) G(IPT,IC,JC,-3) = FUY(IPT,IC,JC)*(-4*FACY) G(IPT,IC,JC, 0) = G(IPT,IC,JC,0) + + FUY(IPT,IC,JC)*(+3*FACY) G(IPT,IC,JC,+3) = 0.0 75 CONTINUE 70 CONTINUE ENDIF 10 CONTINUE C RETURN END SUBROUTINE JACSDP (NPTS, LLBND, ILBND, LBND, + LBLWY, LABVY, LBLWZ, LABVZ, LLDG, LUDG) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, LLBND(0:*), ILBND(*), LBND(*), + LBLWY(0:NPTS), LABVY(0:NPTS), LBLWZ(0:NPTS), LABVZ(0:NPTS), + LLDG(NPTS,-9:-2), LUDG(NPTS,2:9) C Ccc PURPOSE: C Set pointers to nodes of lower 8 subdiagonals of Jacobian in LLDG and C to nodes of upper 8 superdiagonals in LUDG. All nonexisting diagonals C should point to the main diagonal nodes. C C PARAMETER DESCRIPTION: C NPTS : IN. # grid points C LLBND : IN. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C LBLWY : IN. (0:NPTS) C LBLWY(IPT): pointer to node below in Y-direction in C actual grid C 0, if index node is front-plane boundary point C LABVY : IN. (0:NPTS) C LABVY(IPT): pointer to node above in Y-direction in C actual grid C 0, if index node is back-plane boundary point C LBLWZ : IN. (0:NPTS) C LBLWZ(IPT): pointer to node below in Z-direction in C actual grid C 0, if index node is down-plane boundary point C LABVZ : IN. (0:NPTS) C LABVZ(IPT): pointer to node above in Z-direction in C actual grid C 0, if index node is up-plane boundary point C LLDG : OUT. (NPTS,-9:-2) C LLDG(IPT,-9): pointer to node Y-below Z-below C or to node Z-below Z-below C LLDG(IPT,-8): pointer to node left of Z-below C LLDG(IPT,-7): pointer to node Z-below C LLDG(IPT,-6): pointer to node right of Z-below C LLDG(IPT,-5): pointer to node Y-above Z-below C LLDG(IPT,-4): pointer to node left of Y-below C or to node Y-below Y-below C LLDG(IPT,-3): pointer to node Y-below C LLDG(IPT,-2): pointer to node right of Y-below C or to node left of the node left C LUDG : OUT. (NPTS,2:9) C LUDG(IPT,2): pointer to node left of Y-above C or to node right of the node right C LUDG(IPT,3): pointer to node Y-above C LUDG(IPT,4): pointer to node right of node Y-above C or to node Y-above Y-above C LUDG(IPT,5): pointer to node Y-below Z-above C LUDG(IPT,6): pointer to node left of Z-above C LUDG(IPT,7): pointer to node Z-above C LUDG(IPT,8): pointer to node right of Z-above C LUDG(IPT,9): pointer to node Y-above Z-above C or to node Z-above Z-above C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER IPT, NBNDS, IB, LB C Ccc First internal domain DO 10 IPT = 1, NPTS-1 LLDG(IPT,-9) = LBLWZ(LBLWY(IPT)) LLDG(IPT,-8) = LBLWZ(IPT-1) LLDG(IPT,-7) = LBLWZ(IPT) LLDG(IPT,-6) = LBLWZ(IPT+1) LLDG(IPT,-5) = LBLWZ(LABVY(IPT)) LLDG(IPT,-4) = LBLWY(IPT-1) LLDG(IPT,-3) = LBLWY(IPT) LLDG(IPT,-2) = LBLWY(IPT+1) LUDG(IPT,+2) = LABVY(IPT-1) LUDG(IPT,+3) = LABVY(IPT) LUDG(IPT,+4) = LABVY(IPT+1) LUDG(IPT,+5) = LABVZ(LBLWY(IPT)) LUDG(IPT,+6) = LABVZ(IPT-1) LUDG(IPT,+7) = LABVZ(IPT) LUDG(IPT,+8) = LABVZ(IPT+1) LUDG(IPT,+9) = LABVZ(LABVY(IPT)) 10 CONTINUE IPT = NPTS LLDG(IPT,-9) = LBLWZ(LBLWY(IPT)) LLDG(IPT,-8) = LBLWZ(IPT-1) LLDG(IPT,-7) = LBLWZ(IPT) LLDG(IPT,-5) = LBLWZ(LABVY(IPT)) LLDG(IPT,-4) = LBLWY(IPT-1) LLDG(IPT,-3) = LBLWY(IPT) LUDG(IPT,+2) = LABVY(IPT-1) LUDG(IPT,+3) = LABVY(IPT) LUDG(IPT,+5) = LABVZ(LBLWY(IPT)) LUDG(IPT,+6) = LABVZ(IPT-1) LUDG(IPT,+7) = LABVZ(IPT) LUDG(IPT,+9) = LABVZ(LABVY(IPT)) C Ccc Correct boundaries NBNDS = LLBND(0) DO 20 IB = 1, NBNDS IF (ILBND(IB) .EQ. 1) THEN C Left plane C I / C O - - C / I DO 30 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) LLDG(IPT,-8) = IPT IF (LLDG(IPT,-4) .EQ. LBLWY(IPT-1)) LLDG(IPT,-4) = IPT LUDG(IPT,+2) = IPT+2 LUDG(IPT,+6) = IPT 30 CONTINUE ELSE IF (ILBND(IB) .EQ. 2) THEN C Down plane C I C I / C - O - C / DO 40 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) LLDG(IPT,-9) = IPT LLDG(IPT,-8) = IPT LLDG(IPT,-7) = IPT LLDG(IPT,-6) = IPT LLDG(IPT,-5) = IPT LUDG(IPT,+9) = LABVZ(LABVZ(IPT)) 40 CONTINUE ELSE IF (ILBND(IB) .EQ. 3) THEN C Right plane C I / C - - O C / I DO 50 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) LLDG(IPT,-6) = IPT LLDG(IPT,-2) = IPT-2 IF (IPT .EQ. NPTS) THEN LUDG(IPT,+4) = IPT ELSE IF (LUDG(IPT,+4) .EQ. LABVY(IPT+1)) THEN LUDG(IPT,+4) = IPT ENDIF LUDG(IPT,+8) = IPT 50 CONTINUE ELSE IF (ILBND(IB) .EQ. 4) THEN C Up plane C / C - O - C / I C I DO 60 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) LLDG(IPT,-9) = LBLWZ(LBLWZ(IPT)) LUDG(IPT,+5) = IPT LUDG(IPT,+6) = IPT LUDG(IPT,+7) = IPT LUDG(IPT,+8) = IPT LUDG(IPT,+9) = IPT 60 CONTINUE ELSE IF (ILBND(IB) .EQ. 5) THEN C Front plane C / C I / C - O - C I DO 70 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) IF (LLDG(IPT,-9) .EQ. LBLWZ(LBLWY(IPT))) + LLDG(IPT,-9) = IPT LLDG(IPT,-4) = IPT LLDG(IPT,-3) = IPT IF (LLDG(IPT,-2) .EQ. LBLWY(IPT+1)) LLDG(IPT,-2) = IPT LUDG(IPT,+4) = LABVY(LABVY(IPT)) LUDG(IPT,+5) = IPT 70 CONTINUE ELSE IF (ILBND(IB) .EQ. 6) THEN C Back plane C I C - O - C / I C / DO 80 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) LLDG(IPT,-5) = IPT LLDG(IPT,-4) = LBLWY(LBLWY(IPT)) IF (LUDG(IPT,+2) .EQ. LABVY(IPT-1)) LUDG(IPT,+2) = IPT LUDG(IPT,+3) = IPT LUDG(IPT,+4) = IPT IF (LUDG(IPT,+9) .EQ. LABVZ(LABVY(IPT))) + LUDG(IPT,+9) = IPT 80 CONTINUE ENDIF 20 CONTINUE C IB = NBNDS+1 CDIR$ VECTOR C Internal boundary, Dirichlet condition, no off diagonals C . . . C . O . C . . . DO 200 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) LLDG(IPT,-9) = IPT LLDG(IPT,-8) = IPT LLDG(IPT,-7) = IPT LLDG(IPT,-6) = IPT LLDG(IPT,-5) = IPT LLDG(IPT,-4) = IPT LLDG(IPT,-3) = IPT LLDG(IPT,-2) = IPT LUDG(IPT,+2) = IPT LUDG(IPT,+3) = IPT LUDG(IPT,+4) = IPT LUDG(IPT,+5) = IPT LUDG(IPT,+6) = IPT LUDG(IPT,+7) = IPT LUDG(IPT,+8) = IPT LUDG(IPT,+9) = IPT 200 CONTINUE C RETURN END SUBROUTINE JACPB (NPTS, NPDE, GLU, LLDG, + LLBND, ILBND, LBND, LSL, LLSL) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE, LLDG(*), + LLBND(0:*), ILBND(*), LBND(*), LSL(*), LLSL(0:*) REAL GLU(*) C Ccc PURPOSE: C Compute ILU factorization of the Jacobian in block 19-diagonal mode. C C PARAMETER DESCRIPTION: C NPTS : IN. # grid points C NPDE : IN. # PDE components C GLU : INOUT. C IN: Jacobian stored in block 19-diagonal mode C OUT: ILU factorization of Jacobian stored in block C 19-diagonal mode C LLDG : IN. (NPTS,-9:-2) C LLDG(IPT,-9): pointer to node Y-below Z-below C or to node Z-below Z-below C LLDG(IPT,-8): pointer to node left of Z-below C LLDG(IPT,-7): pointer to node Z-below C LLDG(IPT,-6): pointer to node right of Z-below C LLDG(IPT,-5): pointer to node Y-above Z-below C LLDG(IPT,-4): pointer to node left of Y-below C or to node Y-below Y-below C LLDG(IPT,-3): pointer to node Y-below C LLDG(IPT,-2): pointer to node right of Y-below C or to node left of the node left C LLBND : IN. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C LSL : IN. (NPTS) C LSL(ISLPT): pointer to node in actual grid C LLSL : IN. (0:LLSL(0)) C LLSL(0) = # independent data dependency lists in ILU C factorization and forward sweep C LLSL(1:LLSL(0)): pointers to the start of a list in LSL C Ccc EXTERNALS USED: EXTERNAL ILU, JAC19 C C----------------------------------------------------------------------- C Ccc Adapt Jacobian to real block 19-diagonal structure by replacing C second-order boundary discretization by first-order CALL JAC19 (NPTS, NPDE, GLU, LLBND, ILBND, LBND) C Ccc Incomplete LU factorization CALL ILU (NPTS, NPDE, GLU, LLDG, LSL, LLSL) C RETURN END SUBROUTINE JAC19 (NPTS, NPDE, A, LLBND, ILBND, LBND) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE, LLBND(0:*), ILBND(*), LBND(*) REAL A(NPTS,NPDE,NPDE,-9:9) C Ccc PURPOSE: C Replace second-order boundary discretization by first-order in C Jacobian to get real block 19-diagonal structure C C PARAMETER DESCRIPTION: C NPTS : IN. # grid points C NPDE : IN. # PDE components C A : INOUT. C IN: Jacobian C OUT: Jacobian with second-order boundary discretization C replaced by first-order C LLBND : IN. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER IPT, IC, JC, IB, LB C DO 10 IB = 1, LLBND(0) IF (ILBND(IB) .EQ. 1) THEN C Left plane, correction needed for dF/dUx DO 20 IC = 1, NPDE DO 20 JC = 1, NPDE CDIR$ IVDEP DO 25 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) A(IPT,IC,JC,0) = A(IPT,IC,JC,0) + A(IPT,IC,JC,2) A(IPT,IC,JC,2) = 0.0 25 CONTINUE 20 CONTINUE ELSE IF (ILBND(IB) .EQ. 2) THEN C Down plane, correction needed for dF/dUz DO 30 IC = 1, NPDE DO 30 JC = 1, NPDE CDIR$ IVDEP DO 35 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) A(IPT,IC,JC,0) = A(IPT,IC,JC,0) + A(IPT,IC,JC,9) A(IPT,IC,JC,9) = 0.0 35 CONTINUE 30 CONTINUE ELSE IF (ILBND(IB) .EQ. 3) THEN C Right plane, correction needed for dF/dUx DO 40 IC = 1, NPDE DO 40 JC = 1, NPDE CDIR$ IVDEP DO 45 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) A(IPT,IC,JC,0) = A(IPT,IC,JC,0) + A(IPT,IC,JC,-2) A(IPT,IC,JC,-2) = 0.0 45 CONTINUE 40 CONTINUE ELSE IF (ILBND(IB) .EQ. 4) THEN C Up plane, correction needed for dF/dUz DO 50 IC = 1, NPDE DO 50 JC = 1, NPDE CDIR$ IVDEP DO 55 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) A(IPT,IC,JC,0) = A(IPT,IC,JC,0) + A(IPT,IC,JC,-9) A(IPT,IC,JC,-9) = 0.0 55 CONTINUE 50 CONTINUE ELSE IF (ILBND(IB) .EQ. 5) THEN C Front plane, correction needed for dF/dUy DO 60 IC = 1, NPDE DO 60 JC = 1, NPDE DO 65 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) A(IPT,IC,JC,0) = A(IPT,IC,JC,0) + A(IPT,IC,JC,4) A(IPT,IC,JC,4) = 0.0 65 CONTINUE 60 CONTINUE ELSE IF (ILBND(IB) .EQ. 6) THEN C Back plane, correction needed for dF/dUy DO 70 IC = 1, NPDE DO 70 JC = 1, NPDE DO 75 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) A(IPT,IC,JC,0) = A(IPT,IC,JC,0) + A(IPT,IC,JC,-4) A(IPT,IC,JC,-4) = 0.0 75 CONTINUE 70 CONTINUE ENDIF 10 CONTINUE C RETURN END SUBROUTINE JACSLP (NPTS, LLBND, ILBND, LBND, LLDG, M, LLS, LS) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, LLBND(0:*), ILBND(*), LBND(*), LLDG(NPTS,-9:-2), + M(NPTS), LLS(0:*), LS(NPTS) C Ccc PURPOSE: C Make data-dependency list for ILU factorization and forward sweep of C backsolve. C C C PARAMETER DESCRIPTION: C NPTS : IN. # grid points C LLBND : IN. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C LLDG : IN. (NPTS,-9:-2) C LLDG(IPT,-9): pointer to node Y-below Z-below C or to node Z-below Z-below C LLDG(IPT,-8): pointer to node left of Z-below C LLDG(IPT,-7): pointer to node Z-below C LLDG(IPT,-6): pointer to node right of Z-below C LLDG(IPT,-5): pointer to node Y-above Z-below C LLDG(IPT,-4): pointer to node left of Y-below C or to node Y-below Y-below C LLDG(IPT,-3): pointer to node Y-below C LLDG(IPT,-2): pointer to node right of Y-below C or to node left of the node left C M : WORK. (NPTS) C M(IPT) contains list # of node IPT C LLS : OUT. (0:LLS(0)) C LLS(0) = # independent data dependency lists in ILU C factorization and forward sweep C LLS(1:LLS(0)): pointers to the start of a list in LS C LS : OUT. (NPTS) C LS(ISPT): pointer to node in actual grid C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER IBP, IPT, NBNDS, IB, LB, IDS, IDW, ID, IDE, IDN, + IW, ISW, IS, ISE, LDF, MAXM, MI C Ccc Determine for each grid point the # of its data dependency list. C LLS(MI) contains # nodes in list MI C M(IPT) contains list # of node IPT C C Initialize LLS and M DO 1 IPT = 1, NPTS LLS(IPT-1) = 0 M(IPT) = 0 1 CONTINUE C C First list contains independent points, i.e., left/down/front corners C and internal boundary points. C For first list the pointers to the nodes in the grid can already be C stored in LS NBNDS = LLBND(0) DO 10 IB = 1, NBNDS C Store boundary info into work array M IBP = 8**ILBND(IB) DO 20 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) M(IPT) = M(IPT)+IBP 20 CONTINUE 10 CONTINUE LDF = 8**1+8**2+8**5 DO 30 IPT = 1, NPTS IF (M(IPT) .EQ. LDF) THEN C left/down/front corner, node in starting list LLS(1) = LLS(1)+1 LS(LLS(1)) = IPT M(IPT) = 1 ELSE IF (MOD(INT(M(IPT)/8),8) .EQ. 1) THEN C Left boundary, mark node M(IPT) = -1 ELSE M(IPT) = 0 ENDIF 30 CONTINUE IB = NBNDS+1 C Internal boundary, Dirichlet condition, node in starting list DO 40 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) LLS(1) = LLS(1)+1 LS(LLS(1)) = IPT M(IPT) = 1 40 CONTINUE C C C Compute for rest of nodes their list #; a node is dependent from C its neighbors at compass points W, SW, S and SE in the same plane and C in the plane below the point directly below and the points C S, W, E, and N of it. MAXM = 0 DO 50 IPT = 1, NPTS IF (M(IPT) .GT. 0) THEN C Node already in list GOTO 50 ELSE IF (M(IPT) .LT. 0) THEN C Left boundary IW = IPT M(IPT) = 0 ELSE IW = IPT-1 ENDIF IDS = LLDG(IPT,-9) IDW = LLDG(IPT,-8) ID = LLDG(IPT,-7) IDE = LLDG(IPT,-6) IDN = LLDG(IPT,-5) ISW = LLDG(IPT,-4) IS = LLDG(IPT,-3) ISE = LLDG(IPT,-2) MI = MAX(M(IDS),M(IDW),M(ID),M(IDE),M(IDN), + M(IW),M(ISW),M(IS),M(ISE)) + 1 M(IPT) = MI LLS(MI) = LLS(MI) + 1 MAXM = MAX(MAXM,MI) 50 CONTINUE C Ccc Store list pointers in LLS and grid pointers in LS C C LLS(i):=SUM (# nodes in list_j) C j=1,i DO 60 IS = 2, MAXM LLS(IS) = LLS(IS) + LLS(IS-1) 60 CONTINUE C C Store grid pointers C LLS(i-1) is pointer to next free place in list i-1 in LS LLS(0) = LLS(1) DO 70 IPT = 2, NPTS IF (M(IPT) .NE. 1) THEN MI = M(IPT) LLS(MI-1) = LLS(MI-1) + 1 LS(LLS(MI-1)) = IPT ENDIF 70 CONTINUE C LLS(i-1) points to list i in LS, should be i-1 DO 80 IS = MAXM, 1, -1 LLS(IS) = LLS(IS-1) 80 CONTINUE C Ccc Store # lists in LLS(0) LLS(0) = MAXM RETURN END SUBROUTINE JACSUP (NPTS, LLBND, ILBND, LBND, LUDG, M, LLS, LS) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, LLBND(0:*), ILBND(*), LBND(*), LUDG(NPTS,2:9), + M(NPTS), LLS(0:*), LS(NPTS) C Ccc PURPOSE: C Make data-dependency list for backward sweep of backsolve. C C PARAMETER DESCRIPTION: C NPTS : IN. # grid points C LLBND : IN. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C LUDG : IN. (NPTS,2:9) C LUDG(IPT,2): pointer to node left of Y-above C or to node right of the node right C LUDG(IPT,3): pointer to node Y-above C LUDG(IPT,4): pointer to node right of node Y-above C or to node Y-above Y-above C LUDG(IPT,5): pointer to node Y-below Z-above C LUDG(IPT,6): pointer to node left of Z-above C LUDG(IPT,7): pointer to node Z-above C LUDG(IPT,8): pointer to node right of Z-above C LUDG(IPT,9): pointer to node Y-above Z-above C or to node Z-above Z-above C M : WORK. (NPTS) C M(IPT) contains list # of node IPT C LLS : OUT. (0:LLS(0)) C LLS(0) = # independent data dependency lists in C backward sweep C LLS(1:LLS(0)): pointers to the start of a list in LS C LS : OUT. (NPTS) C LS(ISPT): pointer to node in actual grid C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER IBP, IPT, NBNDS, IB, LB, IUS, IUW, IU, IUE, IUN, + IE, INW, IN, INE, IS, RUB, MAXM, MI C Ccc Determine for each grid point the # of its data dependency list. C LLS(MI) contains # nodes in list MI C M(IPT) contains list # of node IPT C C Initialize LLS and M DO 1 IPT = 1, NPTS LLS(IPT-1) = 0 M(IPT) = 0 1 CONTINUE C C First list contains independent points, i.e., right/up/back corners C and internal boundary points. C For first list the pointers to the nodes in the grid can already be C stored in LS NBNDS = LLBND(0) DO 10 IB = 1, NBNDS C Store boundary info into work array M IBP = 8**ILBND(IB) DO 20 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) M(IPT) = M(IPT)+IBP 20 CONTINUE 10 CONTINUE RUB = 8**3+8**4+8**6 DO 30 IPT = 1, NPTS IF (M(IPT) .EQ. RUB) THEN C right/up/back corner, node in starting list LLS(1) = LLS(1)+1 LS(LLS(1)) = IPT M(IPT) = 1 ELSE IF (MOD(INT(M(IPT)/8**3),8) .EQ. 1) THEN C Right plane, mark node M(IPT) = -1 ELSE M(IPT) = 0 ENDIF 30 CONTINUE IB = NBNDS+1 C Internal boundary, Dirichlet condition, node in starting list DO 40 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) LLS(1) = LLS(1)+1 LS(LLS(1)) = IPT M(IPT) = 1 40 CONTINUE C C C Compute for rest of nodes their list #; a node is dependent from C its neighbors at compass points E, NW, N and NE in the same plane and C in the plane above the point directly below and the points C S, W, E, and N of it. MAXM = 0 DO 50 IPT = NPTS, 1, -1 IF (M(IPT) .GT. 0) THEN C Node already in list GOTO 50 ELSE IF (M(IPT) .LT. 0) THEN C Right boundary IE = IPT M(IPT) = 0 ELSE IE = IPT+1 ENDIF INW = LUDG(IPT,2) IN = LUDG(IPT,3) INE = LUDG(IPT,4) IUS = LUDG(IPT,5) IUW = LUDG(IPT,6) IU = LUDG(IPT,7) IUE = LUDG(IPT,8) IUN = LUDG(IPT,9) MI = MAX(M(IE),M(INW),M(IN),M(INE), + M(IUS),M(IUW),M(IU),M(IUE),M(IUN)) + 1 M(IPT) = MI LLS(MI) = LLS(MI) + 1 MAXM = MAX(MAXM,MI) 50 CONTINUE C Ccc Store list pointers in LLS and grid pointers in LS C C LLS(i):=SUM (# nodes in list_j) C j=1,i DO 60 IS = 2, MAXM LLS(IS) = LLS(IS) + LLS(IS-1) 60 CONTINUE C C Store grid pointers C LLS(i-1) is pointer to next free place in list i-1 in LS LLS(0) = LLS(1) DO 70 IPT = NPTS-1, 1, -1 IF (M(IPT) .NE. 1) THEN MI = M(IPT) LLS(MI-1) = LLS(MI-1) + 1 LS(LLS(MI-1)) = IPT ENDIF 70 CONTINUE C LLS(i-1) points to list i in LS, should be i-1 DO 80 IS = MAXM, 1, -1 LLS(IS) = LLS(IS-1) 80 CONTINUE C Ccc Store # lists in LLS(0) LLS(0) = MAXM RETURN END SUBROUTINE BICGST (NPTS, NPDE, A, X, B, WT, TOL, ITMAX, + ALU, LLDG, LUDG, LSL, LLSL, LSU, LLSU, + LUN, R, R0, P, T, V, ITER, ERR, IERR) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE, ITMAX, + LLDG(*), LUDG(*), LSL(*), LLSL(*), LSU(*), LLSU(*), + LUN, ITER, IERR REAL A(*), X(NPTS*NPDE), B(NPTS*NPDE), WT(NPTS*NPDE), TOL, ALU(*), + R(NPTS*NPDE), R0(NPTS*NPDE), P(NPTS*NPDE), + T(NPTS*NPDE), V(NPTS*NPDE), ERR C Ccc PURPOSE: C Solve a Non-Symmetric linear system Ax = b using the Preconditioned C BiConjugate Gradient STAB method. Preconditioning is done with an C Incomplete LU factorization of A. C Actually solved is the system [P^(-1).A].x = [P^(-1).b] C until ||residual||_WRMS < TOL. C Ccc PARAMETER DESCRIPTION: C NPTS : IN. # grid points C NPDE : IN. # PDE components C A : IN. -I C LLDG : IN I These arrays hold the matrix A in block diagonal C LUDG : IN -I storage mode (see description in MVDIAG) C X : OUT. Final approximate solution. C B : IN. Right-hand side vector. C WT : IN. Contains weight factors to compute weighted norm. C TOL : IN. System is considered to be solved if C weighted max. norm < TOL C ITMAX : IN. Maximum number of iterations. C ALU : IN. -I C LSL : IN I These arrays should hold the ILU factorization of A in C LLSL : IN I diagonal storage mode and the data dependency lists C LSU : IN I for the forward and the backward solve C LLSU : IN. -I (see description in BCKSLV) C LUN : IN. Logical unit # of file on which to write the error at C each iteration, if this is desired for monitoring convergence C If LUN = 0, no writing will occur. C R : WORK. (NPTS*NPDE) C R0 : WORK. (NPTS*NPDE) C P : WORK. (NPTS*NPDE) C T : WORK. (NPTS*NPDE) C V : WORK. (NPTS*NPDE) C ITER : OUT. Number of iterations required to reach convergence, or C ITMAX+1 if convergence criterion could not be achieved in C ITMAX iterations. C ERR : OUT. Weighted max. norm of error estimate in final C approximate solution C IERR : OUT. Error return flag C 0: OK C 1: Method failed to converge in ITMAX steps C 2: Breakdown of the method detected ( ~ 0.0) C Ccc EXTERNALS USED: REAL WSNRM2, SDOT EXTERNAL MVDIAG, BCKSLV, RCOPY, WSNRM2, SDOT, SAXPY C C Ccc INCLUDE 'CMNCMMACH' C C CMNCMMACH C C COMMON with `machine numbers' C LUNOUT : Logical unit # standard output -I C LUNERR : Logical unit # standard error I Set in the routine C UROUND : Smallest machine number such that I MACNUM C 1.0+UROUND > 1.0 and 1.0-UROUND < 1.0 I C XMIN : Smallest floating-point number -I INTEGER LUNOUT, LUNERR REAL UROUND, XMIN COMMON /IMACH/ LUNOUT, LUNERR COMMON /RMACH/ UROUND, XMIN SAVE /IMACH/, /RMACH/ C C end INCLUDE 'CMNCMMACH' C C C----------------------------------------------------------------------- C INTEGER I, N REAL ALPHA, BETA, OMEGA, RHOIM1, RHOI, SXMIN, TNRM2 C N = NPTS*NPDE ITER = 0 IERR = 0 SXMIN = SQRT(XMIN) C Ccc Initialize X and set initial residual to B CALL ZERO (N, X) DO 10 I = 1, N R0(I) = B(I) 10 CONTINUE CALL BCKSLV (NPTS, NPDE, ALU, LLDG, LUDG, LSL, LLSL, LSU, LLSU, + R0) C Ccc Check stopping criterion ERR = WSNRM2 (N, R0, WT) IF (LUN .NE. 0) THEN WRITE(LUN,'(''ILU preconditioned BiCGStab for N ='',I6)') N WRITE(LUN,'('' ITER Error Estimate Alpha'', + '' Beta Omega'')') WRITE(LUN,'(I5,E16.7)') ITER, ERR ENDIF IF (ERR .LT. TOL) RETURN C Ccc BiCGStab loop CALL RCOPY (N, R0, R) DO 100 ITER = 1, ITMAX C Compute innerproduct original residual with previous residual RHOI = SDOT(N, R0, 1, R, 1) C Calculate coefficient Beta and direction vector Pi IF( ITER.EQ.1 ) THEN DO 110 I = 1, N BETA = 0.0 P(I) = R(I) 110 CONTINUE ELSE BETA = RHOI/RHOIM1*ALPHA/OMEGA DO 120 I = 1, N P(I) = R(I) + BETA*(P(I)-OMEGA*V(I)) 120 CONTINUE ENDIF C Calculate Vi and coefficient Alfa CALL MVDIAG (NPTS, NPDE, A, P, LLDG, LUDG, V) CALL BCKSLV (NPTS, NPDE, ALU, LLDG, LUDG, LSL, LLSL, LSU, LLSU, + V) ALPHA = RHOI / SDOT(N, R0, 1, V, 1) C Calculate polynomial coefficient Omega_i C store intermediate vector S in R DO 130 I = 1, N R(I) = R(I) - ALPHA*V(I) 130 CONTINUE CALL MVDIAG (NPTS, NPDE, A, R, LLDG, LUDG, T) CALL BCKSLV (NPTS, NPDE, ALU, LLDG, LUDG, LSL, LLSL, LSU, LLSU, + T) TNRM2 = SDOT(N,T,1,T,1) IF (TNRM2 .LT. SXMIN) THEN C Lucky breakdown OMEGA = 0.0 ELSE OMEGA = SDOT(N,T,1,R,1) / TNRM2 ENDIF C Adapt Xi = Xi-1 + Alfa*Pi + Omega_i*S. CALL SAXPY (N, ALPHA, P, 1, X, 1) CALL SAXPY (N, OMEGA, R, 1, X, 1) C Compute residual R = S - Omega_i*T DO 140 I = 1, N R(I) = R(I) - OMEGA*T(I) 140 CONTINUE C C Check stopping criterion. ERR = WSNRM2 (N, R, WT) IF(LUN .NE. 0) + WRITE(LUN,'(I5,4E16.7)') ITER, ERR, ALPHA, BETA, OMEGA IF (ERR .LT. TOL) RETURN C C Check if last residual is not parallel to original residual IF (ABS(RHOI) .LT. SXMIN) GOTO 990 RHOIM1 = RHOI 100 CONTINUE C Ccc end of BiCGStab loop C Ccc Stopping criterion not satisfied ITER = ITMAX + 1 IERR = 1 RETURN C Ccc Breakdown of method detected. 990 IERR = 2 RETURN C END SUBROUTINE MVDIAG (NPTS, NPDE, AD, X, LLDG, LUDG, Y) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE, LLDG(NPTS,-9:-2), LUDG(NPTS,2:9) REAL AD(NPTS,NPDE,NPDE,-9:9), X(NPTS,NPDE), Y(NPTS,NPDE) C Ccc PURPOSE: C Compute y = Ax where A is stored in block 19-diagonal mode. C Ccc PARAMETER DESCRIPTION: C NPTS : IN. # grid points C NPDE : IN. # PDE components C AD : IN. A(.,1:NPDE,1:NPDE,-9:-1) : lower block diagonals C A(.,1:NPDE,1:NPDE,0) : main block diagonal C A(.,1:NPDE,1:NPDE, 1: 9) : upper block diagonals C X : IN. Multiplying vector C LLDG : IN. (NPTS,-9:-2) C LLDG(IPT,-4): pointer to node left of node below C or to node below the node below C LLDG(IPT,-3): pointer to node below C LLDG(IPT,-2): pointer to node right of node below C or to node left of the node left C LUDG : IN. (NPTS,2:4) C LUDG(IPT,2): pointer to node left of node above C or to node right of the node right C LUDG(IPT,3): pointer to node above C LUDG(IPT,4): pointer to node right of node above C or to node above the node above C If one of the above nodes does not exist, the pointer is C to the node itself. C Y : OUT. Result vector C Ccc EXTERNALS USED: EXTERNAL ZERO C C ---------------------------------------------------------------------- C INTEGER IC, JC, IPT, JD C CALL ZERO (NPTS*NPDE, Y) C DO 10 JC = 1, NPDE DO 10 IC = 1, NPDE DO 20 IPT = 1, NPTS Y(IPT,IC) = Y(IPT,IC) + AD(IPT,IC,JC, 0)*X(IPT,JC) 20 CONTINUE DO 30 IPT = 1, NPTS-1 Y(IPT,IC) = Y(IPT,IC) + AD(IPT,IC,JC,+1)*X(IPT+1,JC) 30 CONTINUE DO 40 IPT = 2, NPTS Y(IPT,IC) = Y(IPT,IC) + AD(IPT,IC,JC,-1)*X(IPT-1,JC) 40 CONTINUE C C The next loops can be done for all points, because if an entry C in the Jacobian does not exist in reality the value in AD is zero C and the pointer in LUDG or LLDG points to the node itself. DO 60 JD = 2, 9 DO 60 IPT = 1, NPTS Y(IPT,IC) = Y(IPT,IC) + AD(IPT,IC,JC,JD)*X(LUDG(IPT,JD),JC) 60 CONTINUE DO 70 JD = -2, -9, -1 DO 70 IPT = 1, NPTS Y(IPT,IC) = Y(IPT,IC) + AD(IPT,IC,JC,JD)*X(LLDG(IPT,JD),JC) 70 CONTINUE 10 CONTINUE RETURN END SUBROUTINE INTGRC (ISTRUC, X, Y, Z, NPDE, UIB, UNP1, UN, UNM1, + RELTOL, ABSTOL, TN, DT, DTRAT, DX, DY, DZ, WT, F, CORR, RWORK, + IERR) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER ISTRUC(0:*), NPDE, IERR REAL X(*), Y(*), Z(*), UIB(*), UNP1(0:*), UN(0:*), UNM1(0:*), + RELTOL(NPDE), ABSTOL(NPDE), + TN, DT, DTRAT, DX, DY, DZ, + WT(*), F(*), CORR(*), RWORK(*) C Ccc PURPOSE: C Integration in time with BDF2 (first timestep BE). C Solve nonlinear system F(Tn+1, Un+1, Udot) = 0 with matrix-free C Newton. C Solve linear systems with (block) diagonally scaled GCRO. C Ccc PARAMETER DESCRIPTION: C ISTRUC : IN. Data structure Un+1 grid. C X,Y,Z : IN. Physical coordinates grid. C NPDE : IN. # PDE components C UIB : IN. Dirichlet boundary values on internal boundary. C UNP1 : INOUT. On entry: Initial solution, on exit final solution C Newton converged C UN : IN. Solution at Tn on Un+1 grid C UNM1 : IN. Solution at Tn-1 on Un+1 grid C RELTOL : IN. Relative tolerance for Newton process C ABSTOL : IN. Absolute tolerance for Newton process C TN : IN. Previous time C DT : IN. Current time step C DX : IN. Current grid spacing in X-direction C DY : IN. Current grid spacing in Y-direction C DZ : IN. Current grid spacing in Z-direction C DTRAT : IN. If BE: 0, if BDF2: DT/DT_old C WT : WORK. (NPTS*NPDE) C Weight function for norm computation C F : WORK. (NPTS*NPDE) C Residual C CORR : WORK. (NPTS*NPDE) C Correction in Newton iteration C RWORK : WORK. (RESWRK+LSSWRK) C RESWRK: LENU.10 C LSSWRK: MAX(LENPWK,LENU.(2.MAXLR+MAXL+6))+LENPRE+ C MAXLR.MAXLR+(MAXL+3).MAXL+1 C LENPRE: ( IDIAGP <= 1 ! LENU.NPDE ! LENU ) C LENPWK: ( IDIAGP = 0 ! LENU.(NPDE.7+2)+NPTS C |:IDIAGP = 1 ! LENU.(NPDE.4+2)+NPTS C |:IDIAGP = 2 ! LENU.10 C |:IDIAGP = 3 ! LENU.7 ) C LENU : NPTS.NPDE C IERR : OUT. C 0: OK. C 10: Newton process did not converge C C Ccc EXTERNALS USED: REAL MAXNRM, WSNRM2 EXTERNAL ERRWGT, GCRO, PINIT, MAXNRM, RESID, WSNRM2 C C Ccc INCLUDE 'PARNEWTON' C C PARNEWTON C C Parameters for Newton process C MAXNIT : Max. number of Newton iterations C MAXJAC : Max. number of Jacobian / preconditioner evaluations during C a Newton process C TOLNEW : Tolerance for Newton process: C rho/(1-rho)*|| corr.||_w < TOLNEW INTEGER MAXNIT, MAXJAC REAL TOLNEW PARAMETER (MAXNIT = 10, MAXJAC = 2, TOLNEW = 1.0) C C end INCLUDE 'PARNEWTON' C C Ccc INCLUDE 'PARGCRO' C C PARGCRO C C Parameters for linear system solver GCRO + (block-)diagonal C preconditioner C IDIAGP : 0: block-diagonal + first order derivatives C 1: block-diagonal neglecting first order derivatives C 2: diagonal + first order derivatives C 3: diagonal neglecting first order derivatives C NRRMAX : Max. number of restarts of outer loop C MAXLR : Max. number of iterations in outer loop C MAXL : Max. number of iterations in GMRES inner loop C TOLLSC : Tolerance for linear system solver INTEGER IDIAGP, NRRMAX, MAXLR, MAXL REAL TOLLSC PARAMETER (NRRMAX = 1, MAXLR = 5, MAXL = 20) C PARAMETER (NRRMAX = 1, MAXLR = 3, MAXL = 15) PARAMETER (TOLLSC = TOLNEW/10) COMMON /IGCRO/ IDIAGP SAVE /IGCRO/ C C end INCLUDE 'PARGCRO' C C Ccc INCLUDE 'CMNCMMACH' C C CMNCMMACH C C COMMON with `machine numbers' C LUNOUT : Logical unit # standard output -I C LUNERR : Logical unit # standard error I Set in the routine C UROUND : Smallest machine number such that I MACNUM C 1.0+UROUND > 1.0 and 1.0-UROUND < 1.0 I C XMIN : Smallest floating-point number -I INTEGER LUNOUT, LUNERR REAL UROUND, XMIN COMMON /IMACH/ LUNOUT, LUNERR COMMON /RMACH/ UROUND, XMIN SAVE /IMACH/, /RMACH/ C C end INCLUDE 'CMNCMMACH' C C Ccc INCLUDE 'CMNSTATS' C C CMNSTATS C C COMMON with integration statistics INTEGER MXCLEV, MXCNIT PARAMETER (MXCLEV = 10, MXCNIT = 20) INTEGER LUNPDS, LUNNLS, LUNLSS, LEVEL, NSTEPS, NREJS, + NJACS(MXCLEV), NRESID(MXCLEV), NNIT(MXCLEV), + NLSIT(MXCLEV,MXCNIT) COMMON /STATS/ LUNPDS, LUNNLS, LUNLSS, LEVEL, NSTEPS, NREJS, + NJACS, NRESID, NNIT, NLSIT SAVE /STATS/ C C end INCLUDE 'CMNSTATS' C C C----------------------------------------------------------------------- C INTEGER LLPLN, NPLNS, LIPLN, LLROW, NROWS, NPTS, LIROW, LICOL, + LLLBND, NBNDS, NBDPTS, NBIPTS, LILBND, LLBNDP, + LLBLWY, LLABVY, LLBLWZ, LLABVZ, + LIWK, LENU, + LUT, LUX, LUY, LUZ, LUXX, LUYY, LUZZ, LUXY, LUXZ, LUYZ, + LPREC, LR, LU, LC, LZW, LRWK, + NPRE, NRES, I, NIT, ITER LOGICAL BDPREC, NEWPRE REAL A0, ERR, CORNRM, OLDNRM, RATE, TOL, UNRM C IERR = 0 C A0 = (1+2*DTRAT) / ((1+DTRAT)*DT) BDPREC = IDIAGP .LE. 1 C IF (LUNNLS .NE. 0) THEN WRITE(LUNNLS,'(''Nonlinear system solver at T ='',E16.7)') + TN+DT ENDIF C LLPLN = 0 NPLNS = ISTRUC(LLPLN) LIPLN = LLPLN+NPLNS+2 LLROW = LIPLN+NPLNS NROWS = ISTRUC(LLPLN+NPLNS+1)-1 NPTS = ISTRUC(LLROW+NROWS)-1 LIROW = LLROW+NROWS+1 LICOL = LIROW+NROWS LLLBND = LICOL+NPTS NBNDS = ISTRUC(LLLBND) NBDPTS = ISTRUC(LLLBND+NBNDS+1)-1 NBIPTS = ISTRUC(LLLBND+NBNDS+2)-1 LILBND = LLLBND+NBNDS+3 LLBNDP = LILBND+NBNDS LLBLWY = LLBNDP+NBIPTS LLABVY = LLBLWY+NPTS+1 LLBLWZ = LLABVY+NPTS+1 LLABVZ = LLBLWZ+NPTS+1 C LIWK = LLABVZ+NPTS+1 C LENU = NPTS*NPDE C LUT = 1 LUX = LUT + LENU LUY = LUX + LENU LUZ = LUY + LENU LUXX = LUZ + LENU LUYY = LUXX + LENU LUZZ = LUYY + LENU LUXY = LUZZ + LENU LUXZ = LUXY + LENU LUYZ = LUXZ + LENU C LPREC = LUYZ+LENU IF (BDPREC) THEN C Block-diagonal preconditioner LR = LPREC + LENU*NPDE ELSE C Diagonal preconditioner LR = LPREC + LENU ENDIF LU = LR + LENU LC = LU + (LENU*MAXLR) LZW = LC + (LENU*MAXLR) LRWK = LZW+ (MAXLR*MAXLR) C Ccc Set error weights for use in Newton process CALL ERRWGT (NPTS, NPDE, UNP1(1), RELTOL, ABSTOL, WT) C Ccc Compute weighted norm of initial solution for convergence check UNRM = WSNRM2 (LENU, UNP1(1), WT) C Ccc Compute derivatives and residual CALL RESID (TN+DT, X, Y, Z, NPTS, NPDE, UNP1, UN, UNM1, DT, DTRAT, + UIB, ISTRUC(LLLBND), ISTRUC(LILBND), ISTRUC(LLBNDP), + ISTRUC(LLBLWY), ISTRUC(LLABVY), ISTRUC(LLBLWZ), ISTRUC(LLABVZ), + DX, DY, DZ, + RWORK(LUT), RWORK(LUX), RWORK(LUY), RWORK(LUZ), + RWORK(LUXX), RWORK(LUYY), RWORK(LUZZ), + RWORK(LUXY), RWORK(LUXZ), RWORK(LUYZ), F) NRES = 1 IF (LUNNLS .NE. 0) THEN WRITE(LUNNLS,'('' Max. and WRMS norm residual='',2E16.7)') + MAXNRM(LENU, F), WSNRM2 (LENU, F, WT) ENDIF C Ccc Compute preconditioner: (block-)diagonal of Jacobian G = dF/dU. C Store LU-decomposition in PREC, main diagonal inverted. CALL PINIT (NPTS, NPDE, F, TN+DT, X, Y, Z, DT, DTRAT, DX, DY, DZ, + UNP1(1), ISTRUC(LLLBND), ISTRUC(LILBND), ISTRUC(LLBNDP), UIB, + RWORK(LUT), RWORK(LUX), RWORK(LUY), RWORK(LUZ), + RWORK(LUXX), RWORK(LUYY), RWORK(LUZZ), + RWORK(LUXY), RWORK(LUXZ), RWORK(LUYZ), + ABSTOL, RWORK(LR), IDIAGP, RWORK(LPREC)) NEWPRE = .TRUE. NPRE = 1 C Ccc Newton iteration loop 9 CONTINUE DO 10 NIT = 1, MAXNIT C Cccccc Solve G.corr = F. Store the residual in F. TOL = TOLLSC / (2**NIT) CALL GCRO (LENU, CORR, F, WT, TOL, BDPREC, RWORK(LPREC), + ISTRUC, X, Y, Z, NPDE, UIB, UNP1, + TN+DT, A0, DX, DY, DZ, RWORK, + NRRMAX, MAXLR, MAXL, LUNLSS, + RWORK(LR), RWORK(LU), RWORK(LC), RWORK(LZW), RWORK(LRWK), + ITER, ERR, IERR) NLSIT(LEVEL,NIT) = NLSIT(LEVEL,NIT)+ ITER IF (IERR .NE. 0) GOTO 100 C Cccccc Test for convergence CORNRM = WSNRM2 (LENU, CORR, WT) IF (LUNNLS .NE. 0) THEN WRITE(LUNNLS,'('' NI:'',I3,'', NLI:'',I4,'', ERLI'':,E16.7, + '', ERNI:'',E16.7)') NIT, ITER, ERR, CORNRM ENDIF IF (CORNRM .LE. 100*UROUND*UNRM) GOTO 900 IF (.NOT. NEWPRE) THEN RATE = SQRT(CORNRM/OLDNRM) IF (RATE .GT. 0.9) THEN C Divergence GOTO 100 ELSE IF (RATE/(1-RATE)*CORNRM .LE. TOLNEW) THEN C Convergence GOTO 900 ENDIF ENDIF OLDNRM = CORNRM C Ccccc Update solution DO 20 I = 1, LENU UNP1(I) = UNP1(I) - CORR(I) 20 CONTINUE C Ccc Compute derivatives and residual and start next iteration CALL RESID (TN+DT, X, Y, Z, NPTS, NPDE, UNP1, UN, UNM1, + DT, DTRAT, UIB, + ISTRUC(LLLBND), ISTRUC(LILBND), ISTRUC(LLBNDP), + ISTRUC(LLBLWY), ISTRUC(LLABVY), + ISTRUC(LLBLWZ), ISTRUC(LLABVZ), + DX, DY, DZ, + RWORK(LUT), RWORK(LUX), RWORK(LUY), RWORK(LUZ), + RWORK(LUXX), RWORK(LUYY), RWORK(LUZZ), + RWORK(LUXY), RWORK(LUXZ), RWORK(LUYZ), F) NRES = NRES+1 NEWPRE = .FALSE. IF (LUNNLS .NE. 0) THEN WRITE(LUNNLS,'('' Max. and WRMS norm residual='',2E16.7)') + MAXNRM(LENU, F), WSNRM2 (LENU, F, WT) ENDIF 10 CONTINUE Ccc End Newton iteration loop C Ccc No convergence in max. # iterations C Ccccc Check if preconditioner is recent 100 CONTINUE IF (.NOT. NEWPRE .AND. NPRE .LT. MAXJAC) THEN IF (LUNNLS .NE. 0) THEN WRITE(LUNNLS,'('' New preconditioner, NIT='',I4)') NIT ENDIF C Compute new preconditioner and retry C Compute space derivatives anew since they are disturbed by C MVDIFF CALL DERIVS (NPTS, NPDE, UNP1, + ISTRUC(LLLBND), ISTRUC(LILBND), ISTRUC(LLBNDP), + ISTRUC(LLBLWY), ISTRUC(LLABVY), + ISTRUC(LLBLWZ), ISTRUC(LLABVZ), + DX, DY, DZ, + RWORK(LUX), RWORK(LUY), RWORK(LUZ), + RWORK(LUXX), RWORK(LUYY), RWORK(LUZZ), + RWORK(LUXY), RWORK(LUXZ), RWORK(LUYZ)) CALL PINIT (NPTS, NPDE, F, TN+DT, X, Y, Z, DT, DTRAT, + DX, DY, DZ, UNP1(1), + ISTRUC(LLLBND), ISTRUC(LILBND), ISTRUC(LLBNDP), UIB, + RWORK(LUT), RWORK(LUX), RWORK(LUY), RWORK(LUZ), + RWORK(LUXX), RWORK(LUYY), RWORK(LUZZ), + RWORK(LUXY), RWORK(LUXZ), RWORK(LUYZ), + ABSTOL, RWORK(LR), IDIAGP, RWORK(LPREC)) NEWPRE = .TRUE. NPRE = NPRE + 1 GOTO 9 ELSE C Newton failure IERR = 10 NNIT(LEVEL) = NNIT(LEVEL)+NIT NRESID(LEVEL) = NRESID(LEVEL)+NRES NJACS(LEVEL) = NJACS(LEVEL)+NPRE IF (LUNNLS .NE. 0) THEN WRITE(LUNNLS,'(''Newton failure, NIT='',I4)') NIT ENDIF RETURN ENDIF C Ccc Nonlinear proces has been solved 900 CONTINUE C Update solution DO 30 I = 1, LENU UNP1(I) = UNP1(I) - CORR(I) 30 CONTINUE C NNIT(LEVEL) = NNIT(LEVEL)+NIT NRESID(LEVEL) = NRESID(LEVEL)+NRES NJACS(LEVEL) = NJACS(LEVEL)+NPRE C RETURN END SUBROUTINE PINIT (NPTS, NPDE, F, T, X, Y, Z, DT, DTRAT, + DX, DY, DZ, U, LLBND, ILBND, LBND, UIB, + UT, UX, UY, UZ, UXX, UYY, UZZ, UXY, UXZ, UYZ, ABSTOL, WORK, + IDIAGP, PREC) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE, LLBND(0:*), ILBND(*), LBND(*), IDIAGP REAL F(*), T, X(*), Y(*), Z(*), DT, DTRAT, DX, DY, DZ, + U(*), UIB(*), UT(*), UX(*), UY(*), UZ(*), + UXX(*), UYY(*), UZZ(*), UXY(*), UXZ(*), UYZ(*), + ABSTOL(*), WORK(*), PREC(NPTS,NPDE,*) C Ccc PURPOSE: C Store the LU-decomposition of the (block-)diagonal of the Jacobian C G = dF/dU in PREC, main diagonal inverted. C C PARAMETER DESCRIPTION: C NPTS : IN. # grid points C NPDE : IN. # PDE components C F : IN. Residual F(t,U,Ut) C T : IN. Current time C X,Y,Z : IN. Physical coordinates of gridpoints C DT : IN. Current time stepsize C DTRAT : IN. 0 or DT/DT_old C DX : IN. Current grid width in X-direction C DY : IN. Current grid width in Y-direction C DZ : IN. Current grid width in Z-direction C U : IN. Solution at T on current grid C LLBND : IN. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C UIB : IN. Solution at T on internal boundaries C LBLWY : IN. (0:NPTS) C LBLWY(IPT): pointer to node below in Y-direction in C actual grid C 0, if index node is front-plane boundary point C LABVY : IN. (0:NPTS) C LABVY(IPT): pointer to node above in Y-direction in C actual grid C 0, if index node is back-plane boundary point C LBLWZ : IN. (0:NPTS) C LBLWZ(IPT): pointer to node below in Z-direction in C actual grid C 0, if index node is down-plane boundary point C LABVZ : IN. (0:NPTS) C LABVZ(IPT): pointer to node above in Z-direction in C actual grid C 0, if index node is up-plane boundary point C UT : IN. Time derivative of U on current grid C UX : IN. -I C UY : IN. I C UZ : IN. I C UXX : IN. I C UYY : IN. I Space derivatives of U on current grid C UZZ : IN. I C UXY : IN. I C UXZ : IN. I C UYZ : IN. -I C ABSTOL : IN. Absolute tolerance for Newton process C WORK : WORK. ( ( IDIAGP = 0 ! LENU.(NPDE.7+2)+NPTS C |:IDIAGP = 1 ! LENU.(NPDE.4+2)+NPTS C |:IDIAGP = 2 ! LENU.10 C |:IDIAGP = 3 ! LENU.7 ) ) C IDIAGP : IN. Type of preconditioner C 0: block-diagonal + first order derivatives C 1: block-diagonal neglecting first order derivatives C 2: diagonal + first order derivatives C 3: diagonal neglecting first order derivatives C PREC : OUT. LU-decomposition of the (block-)diagonal of the Jacobian C G = dF/dU in PREC, main diagonal inverted. C Ccc EXTERNALS USED: EXTERNAL BLU, DERVF, DERVFB, PREG, PREGB C C----------------------------------------------------------------------- C INTEGER LENDEL, LENU, LENFU, LENFU1, + LFU, LFUX, LFUY, LFUZ, LFUXX, LFUYY, LFUZZ, LDEL, LRWK LOGICAL PRECFO REAL A0 C PRECFO = IDIAGP .EQ. 0 .OR. IDIAGP .EQ. 2 LENU = NPTS*NPDE IF (IDIAGP .LE. 1) THEN LENDEL = NPTS LENFU = LENU*NPDE ELSE LENDEL = LENU LENFU = LENU ENDIF IF (PRECFO) THEN LENFU1 = LENFU ELSE LENFU1 = 0 ENDIF C LFU = 1 LFUX = LFU + LENFU LFUY = LFUX + LENFU1 LFUZ = LFUY + LENFU1 LFUXX = LFUZ + LENFU1 LFUYY = LFUXX + LENFU LFUZZ = LFUYY + LENFU LDEL = LFUZZ + LENFU LRWK = LDEL + LENDEL A0 = (1+2*DTRAT) / ((1+DTRAT)*DT) IF (IDIAGP .LE. 1) THEN C Ccc Compute dF/dU, (dF/dUx, dF/dUy, dF/dUz,) dF/dUxx, dF/dUyy, dF/dUzz CALL DERVFB (F, T, X, Y, Z, NPTS, NPDE, U, A0, DT, DX, DY, DZ, + LLBND, ILBND, LBND, UIB, UT, UX, UY, UZ, UXX, UYY, UZZ, + UXY, UXZ, UYZ, ABSTOL, WORK(LDEL), WORK(LRWK), + PRECFO, WORK(LFU), WORK(LFUX), WORK(LFUY), WORK(LFUZ), + WORK(LFUXX), WORK(LFUYY), WORK(LFUZZ)) C Ccc Compute block-diagonal C G = dF/dU + (dF/dUx.dUx/dU + ...) + dF/dUxx.dUxx/dU + ... CALL PREGB (NPTS, NPDE, DX, DY, DZ, + LLBND, ILBND, LBND, + WORK(LFU), WORK(LFUX), WORK(LFUY), WORK(LFUZ), + WORK(LFUXX), WORK(LFUYY), WORK(LFUZZ), + PRECFO, PREC) C Ccc Store LU of G in PREC, invert main diagonal CALL BLU (NPTS, NPDE, PREC) ELSE C Ccc Compute dF/dU, (dF/dUx, dF/dUy, dF/dUz,) dF/dUxx, dF/dUyy, dF/dUzz CALL DERVF (F, T, X, Y, Z, NPTS, NPDE, U, A0, DT, DX, DY, DZ, + LLBND, ILBND, LBND, UIB, UT, UX, UY, UZ, UXX, UYY, UZZ, + UXY, UXZ, UYZ, ABSTOL, WORK(LDEL), WORK(LRWK), + PRECFO, WORK(LFU), WORK(LFUX), WORK(LFUY), WORK(LFUZ), + WORK(LFUXX), WORK(LFUYY), WORK(LFUZZ)) C Ccc Compute G = dF/dU + (dF/dUx.dUx/dU + ...) + dF/dUxx.dUxx/dU + ... C Store inverted in PREC CALL PREG (NPTS, NPDE, DX, DY, DZ, + LLBND, ILBND, LBND, + WORK(LFU), WORK(LFUX), WORK(LFUY), WORK(LFUZ), + WORK(LFUXX), WORK(LFUYY), WORK(LFUZZ), + PRECFO, PREC) ENDIF C RETURN END SUBROUTINE DERVFB (F, T, X, Y, Z, NPTS, NPDE, U, + A0, DT, DX, DY, DZ, + LLBND, ILBND, LBND, UIB, UT, UX, UY, UZ, UXX, UYY, UZZ, + UXY, UXZ, UYZ, ABSTOL, DEL, WORK, + PRECFO, FU, FUX, FUY, FUZ, FUXX, FUYY, FUZZ) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE, LLBND(0:*), ILBND(*), LBND(*) LOGICAL PRECFO REAL F(NPTS*NPDE), T, X(*), Y(*), Z(*), U(*), A0, DT, DX, DY, DZ, + UIB(*), UT(*), UX(*), UY(*), UZ(*), UXX(*), UYY(*), UZZ(*), + UXY(*), UXZ(*), UYZ(*), ABSTOL(*), + DEL(NPTS), WORK(2*NPTS*NPDE), + FU(NPTS*NPDE,NPDE), + FUX(NPTS*NPDE,NPDE), FUY(NPTS*NPDE,NPDE), FUZ(NPTS*NPDE,NPDE), + FUXX(NPTS*NPDE,NPDE), FUYY(NPTS*NPDE,NPDE), + FUZZ(NPTS*NPDE,NPDE) C Ccc PURPOSE: C Compute derivatives of residual wrt (derivatives of) U by numerical C differencing C C PARAMETER DESCRIPTION: C F : IN. Residual F(t,U,Ut) C T : IN. Current time C X,Y,Z : IN. Physical coordinates of gridpoints C NPTS : IN. # grid points C NPDE : IN. # PDE components C U : IN. Solution at T on current grid C A0 : IN. Coefficient of U_n+1 in time derivative C DT : IN. Current time step size C DX : IN. Cell width in X-direction for current grid C DY : IN. Cell width in Y-direction for current grid C DZ : IN. Cell width in Z-direction for current grid C LLBND : IN. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C UIB : IN. Solution at T on internal boundaries C UT : IN. Time derivative of U on current grid C UX : IN. -I C UY : IN. I C UZ : IN. I C UXX : IN. I C UYY : IN. I Space derivatives of U on current grid C UZZ : IN. I C UXY : IN. I C UXZ : IN. I C UYZ : IN. -I C ABSTOL : IN. Absolute tolerance for Newton process C DEL : WORK. (NPTS) C WORK : WORK. (2.LENU) C PRECFO : IN. If FALSE first order derivatives may be neglected C FU : OUT. dF(U,Ut)dU C FUX : OUT. dF(Ux)dUx C FUY : OUT. dF(Uy)dUy C FUZ : OUT. dF(Uz)dUz C FUXX : OUT. dF(Uxx)dUxx C FUYY : OUT. dF(Uyy)dUyy C FUZZ : OUT. dF(Uzz)dUzz C Ccc EXTERNALS USED: EXTERNAL PERTRB, PRTRBU, RES C C----------------------------------------------------------------------- C INTEGER I, IC, ICPTB, IPT, LUTBAR REAL FACX, FACY, FACZ, FACXX, FACYY, FACZZ, TOL LUTBAR = 1 + NPTS*NPDE C Ccc How to decide if derivatives are `zero'? C Take `zero'-value of U divided by the grid width FACX = 1/(2*DX) FACY = 1/(2*DY) FACZ = 1/(2*DZ) FACXX = 1/DX**2 FACYY = 1/DY**2 FACZZ = 1/DZ**2 C Ccc Loop over the components of the (derivatives of) U DO 10 ICPTB = 1, NPDE C C dF(U,Ut)/dU TOL = ABSTOL(ICPTB) CALL PRTRBU (ICPTB, NPTS, NPDE, U, A0, DT, UT, TOL, DEL, + WORK, WORK(LUTBAR)) CALL RES (T, X, Y, Z, NPTS, NPDE, WORK, + LLBND, ILBND, LBND, UIB, + WORK(LUTBAR), UX, UY, UZ, + UXX, UYY, UZZ, UXY, UXZ, UYZ, FU(1,ICPTB)) DO 20 IC = 1, NPDE DO 20 IPT = 1, NPTS I = IPT + (IC-1)*NPTS FU(I,ICPTB) = (FU(I,ICPTB) - F(I)) / DEL(IPT) 20 CONTINUE IF (PRECFO) THEN C C dF(Ux)/dUx TOL = ABSTOL(ICPTB)*FACX CALL PERTRB (ICPTB, NPTS, NPDE, UX, TOL, DEL, WORK) CALL RES (T, X, Y, Z, NPTS, NPDE, U, + LLBND, ILBND, LBND, UIB, + UT, WORK, UY, UZ, + UXX, UYY, UZZ, UXY, UXZ, UYZ, FUX(1,ICPTB)) DO 21 IC = 1, NPDE DO 21 IPT = 1, NPTS I = IPT + (IC-1)*NPTS FUX(I,ICPTB) = (FUX(I,ICPTB) - F(I)) / DEL(IPT) 21 CONTINUE C C dF(Uy)/dUy TOL = ABSTOL(ICPTB)*FACY CALL PERTRB (ICPTB, NPTS, NPDE, UY, TOL, DEL, WORK) CALL RES (T, X, Y, Z, NPTS, NPDE, U, + LLBND, ILBND, LBND, UIB, + UT, UX, WORK, UZ, + UXX, UYY, UZZ, UXY, UXZ, UYZ, FUY(1,ICPTB)) DO 22 IC = 1, NPDE DO 22 IPT = 1, NPTS I = IPT + (IC-1)*NPTS FUY(I,ICPTB) = (FUY(I,ICPTB) - F(I)) / DEL(IPT) 22 CONTINUE C C dF(Uz)/dUz TOL = ABSTOL(ICPTB)*FACZ CALL PERTRB (ICPTB, NPTS, NPDE, UZ, TOL, DEL, WORK) CALL RES (T, X, Y, Z, NPTS, NPDE, U, + LLBND, ILBND, LBND, UIB, + UT, UX, UY, WORK, + UXX, UYY, UZZ, UXY, UXZ, UYZ, FUZ(1,ICPTB)) DO 23 IC = 1, NPDE DO 23 IPT = 1, NPTS I = IPT + (IC-1)*NPTS FUZ(I,ICPTB) = (FUZ(I,ICPTB) - F(I)) / DEL(IPT) 23 CONTINUE ENDIF C C dF(Uxx)/dUxx TOL = ABSTOL(ICPTB)*FACXX CALL PERTRB (ICPTB, NPTS, NPDE, UXX, TOL, DEL, WORK) CALL RES (T, X, Y, Z, NPTS, NPDE, U, + LLBND, ILBND, LBND, UIB, + UT, UX, UY, UZ, + WORK, UYY, UZZ, UXY, UXZ, UYZ, FUXX(1,ICPTB)) DO 70 IC = 1, NPDE DO 70 IPT = 1, NPTS I = IPT + (IC-1)*NPTS FUXX(I,ICPTB) = (FUXX(I,ICPTB) - F(I)) / DEL(IPT) 70 CONTINUE C C dF(Uyy)/dUyy TOL = ABSTOL(ICPTB)*FACYY CALL PERTRB (ICPTB, NPTS, NPDE, UYY, TOL, DEL, WORK) CALL RES (T, X, Y, Z, NPTS, NPDE, U, + LLBND, ILBND, LBND, UIB, + UT, UX, UY, UZ, + UXX, WORK, UZZ, UXY, UXZ, UYZ, FUYY(1,ICPTB)) DO 80 IC = 1, NPDE DO 80 IPT = 1, NPTS I = IPT + (IC-1)*NPTS FUYY(I,ICPTB) = (FUYY(I,ICPTB) - F(I)) / DEL(IPT) 80 CONTINUE C C dF(Uzz)/dUzz TOL = ABSTOL(ICPTB)*FACZZ CALL PERTRB (ICPTB, NPTS, NPDE, UZZ, TOL, DEL, WORK) CALL RES (T, X, Y, Z, NPTS, NPDE, U, + LLBND, ILBND, LBND, UIB, + UT, UX, UY, UZ, + UXX, UYY, WORK, UXY, UXZ, UYZ, FUZZ(1,ICPTB)) DO 90 IC = 1, NPDE DO 90 IPT = 1, NPTS I = IPT + (IC-1)*NPTS FUZZ(I,ICPTB) = (FUZZ(I,ICPTB) - F(I)) / DEL(IPT) 90 CONTINUE 10 CONTINUE RETURN END SUBROUTINE PREGB (NPTS, NPDE, DX, DY, DZ, + LLBND, ILBND, LBND, + FU, FUX, FUY, FUZ, FUXX, FUYY, FUZZ, PRECFO, PREC) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE, LLBND(0:*), ILBND(*), LBND(*) LOGICAL PRECFO REAL DX, DY, DZ, + FU(NPTS*NPDE,NPDE), + FUX(NPTS*NPDE,NPDE), FUY(NPTS*NPDE,NPDE), FUZ(NPTS*NPDE,NPDE), + FUXX(NPTS*NPDE,NPDE), FUYY(NPTS*NPDE,NPDE), + FUZZ(NPTS*NPDE,NPDE), PREC(NPTS*NPDE,NPDE) C Ccc PURPOSE: C Compute block-diagonal of Jacobian G = dF/dU using derivatives C of residual wrt (derivatives of) U. C C PARAMETER DESCRIPTION: C NPTS : IN. # grid points C NPDE : IN. # PDE components C DX : IN. Current grid width in X-direction C DY : IN. Current grid width in Y-direction C DZ : IN. Current grid width in Z-direction C LLBND : IN. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C FU : IN. Derivative residual F(.,U,Ut,.) wrt U C FUX : IN. Derivative residual F(.,Ux,.) wrt Ux C FUY : IN. Derivative residual F(.,Uy,.) wrt Uy C FUZ : IN. Derivative residual F(.,Uz,.) wrt Uz C FUXX : IN. Derivative residual F(.,Uxx,.) wrt Uxx C FUYY : IN. Derivative residual F(.,Uyy,.) wrt Uyy C FUZZ : IN. Derivative residual F(.,Uzz,.) wrt Uzz C PRECFO : IN. If FALSE first order derivatives may be neglected C PREC : OUT. Block-diagonal of Jacobian. C Ccc EXTERNALS USED: EXTERNAL PRGBBD C C Ccc INCLUDE 'CMNCMMACH' C C CMNCMMACH C C COMMON with `machine numbers' C LUNOUT : Logical unit # standard output -I C LUNERR : Logical unit # standard error I Set in the routine C UROUND : Smallest machine number such that I MACNUM C 1.0+UROUND > 1.0 and 1.0-UROUND < 1.0 I C XMIN : Smallest floating-point number -I INTEGER LUNOUT, LUNERR REAL UROUND, XMIN COMMON /IMACH/ LUNOUT, LUNERR COMMON /RMACH/ UROUND, XMIN SAVE /IMACH/, /RMACH/ C C end INCLUDE 'CMNCMMACH' C C C----------------------------------------------------------------------- C INTEGER I, JC, LENU REAL FACX, FACY, FACZ, FACXX, FACYY, FACZZ C LENU = NPTS*NPDE C FACXX = 1/DX**2 FACYY = 1/DY**2 FACZZ = 1/DZ**2 C DO 10 JC = 1, NPDE DO 10 I = 1, LENU C dF(ipt,ic)/dU(ipt,ic) PREC(I,JC) = FU(I,JC) + + FUXX(I,JC)*(-2*FACXX) + FUYY(I,JC)*(-2*FACYY) + + FUZZ(I,JC)*(-2*FACZZ) 10 CONTINUE C IF (PRECFO) THEN FACX = 1/(2*DX) FACY = 1/(2*DY) FACZ = 1/(2*DZ) CALL PRGBBD (NPTS, NPDE, FACX, FACY, FACZ, + LLBND, ILBND, LBND, FUX, FUY, FUZ, PREC) ENDIF C RETURN END SUBROUTINE PRGBBD (NPTS, NPDE, FACX, FACY, FACZ, + LLBND, ILBND, LBND, FUX, FUY, FUZ, G) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE, LLBND(0:*), ILBND(*), LBND(*) REAL FACX, FACY, FACZ, + FUX(NPTS,NPDE,NPDE), FUY(NPTS,NPDE,NPDE), FUZ(NPTS,NPDE,NPDE), + G(NPTS,NPDE,NPDE) C Ccc PURPOSE: C Correct Jacobian G = dF/dU for second order approximation of C first order derivatives at boundaries C C PARAMETER DESCRIPTION: C NPTS : IN. # grid points C NPDE : IN. # PDE components C FACX : IN. 1/(2*DX) C FACY : IN. 1/(2*DY) C FACZ : IN. 1/(2*DZ) C LLBND : IN. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C FUX : IN. Derivative residual C F(t,U,Ut,Ux,Uy,Uz,Uxx,Uyy,Uzz,Uxy,Uxz,Uyz) wrt Ux C FUY : IN. Derivative residual C F(t,U,Ut,Ux,Uy,Uz,Uxx,Uyy,Uzz,Uxy,Uxz,Uyz) wrt Uy C FUZ : IN. Derivative residual C F(t,U,Ut,Ux,Uy,Uz,Uxx,Uyy,Uzz,Uxy,Uxz,Uyz) wrt Uz C G : INOUT. C IN: block-diagonal of Jacobian C OUT: corrected for first order derivatives at boundaries C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER IPT, IC, JC, IB, LB C Ccc Boundary corrections, no corrections needed for internal boundaries DO 10 IB = 1, LLBND(0) IF (ILBND(IB) .EQ. 1) THEN C Left plane, correction needed for dF/dUx DO 20 JC = 1, NPDE DO 20 IC = 1, NPDE CDIR$ IVDEP DO 25 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) G(IPT,IC,JC) = G(IPT,IC,JC) + + FUX(IPT,IC,JC)*(-3*FACX) 25 CONTINUE 20 CONTINUE ELSE IF (ILBND(IB) .EQ. 2) THEN C Down plane, correction needed for dF/dUz DO 30 JC = 1, NPDE DO 30 IC = 1, NPDE CDIR$ IVDEP DO 35 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) G(IPT,IC,JC) = G(IPT,IC,JC) + + FUZ(IPT,IC,JC)*(-3*FACZ) 35 CONTINUE 30 CONTINUE ELSE IF (ILBND(IB) .EQ. 3) THEN C Right plane, correction needed for dF/dUx DO 40 JC = 1, NPDE DO 40 IC = 1, NPDE CDIR$ IVDEP DO 45 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) G(IPT,IC,JC) = G(IPT,IC,JC) + + FUX(IPT,IC,JC)*(+3*FACX) 45 CONTINUE 40 CONTINUE ELSE IF (ILBND(IB) .EQ. 4) THEN C Up plane, correction needed for dF/dUz DO 50 JC = 1, NPDE DO 50 IC = 1, NPDE CDIR$ IVDEP DO 55 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) C dF(ipt,ic)/dU(below(below(ipt)),jc) G(IPT,IC,JC) = G(IPT,IC,JC) + + FUZ(IPT,IC,JC)*(+3*FACZ) 55 CONTINUE 50 CONTINUE ELSE IF (ILBND(IB) .EQ. 5) THEN C Front plane, correction needed for dF/dUy DO 60 JC = 1, NPDE DO 60 IC = 1, NPDE CDIR$ IVDEP DO 65 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) G(IPT,IC,JC) = G(IPT,IC,JC) + + FUY(IPT,IC,JC)*(-3*FACY) 65 CONTINUE 60 CONTINUE ELSE IF (ILBND(IB) .EQ. 6) THEN C Back plane, correction needed for dF/dUy DO 70 JC = 1, NPDE DO 70 IC = 1, NPDE CDIR$ IVDEP DO 75 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) G(IPT,IC,JC) = G(IPT,IC,JC) + + FUY(IPT,IC,JC)*(+3*FACY) 75 CONTINUE 70 CONTINUE ENDIF 10 CONTINUE C RETURN END SUBROUTINE BLU (NPTS, NPDE, A) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE REAL A(NPTS,NPDE,NPDE) C Ccc PURPOSE: C LU decomposition of block-diagonal A C Ccc PARAMETER DESCRIPTION: C NPTS : IN. # gridpoints C NPDE : IN. # components of the PDE C A : INOUT. C IN: main block diagonal C OUT: A(.,ic,jc): jc < ic: block diagonal of L C diagonal L == I C jc >=ic: block diagonal of U C diagonal U inverted C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER IC, JC, LC, N REAL D C DO 550 IC = 1, NPDE DO 554 LC = 1, IC-1 DO 555 JC = IC, NPDE CDIR$ IVDEP DO 551 N = 1, NPTS A(N,IC,JC) = A(N,IC,JC) + - A(N,IC,LC)*A(N,LC,JC) 551 CONTINUE 555 CONTINUE DO 556 JC = IC+1, NPDE CDIR$ IVDEP DO 552 N = 1, NPTS A(N,JC,IC) = A(N,JC,IC) + - A(N,JC,LC)*A(N,LC,IC) 552 CONTINUE 556 CONTINUE 554 CONTINUE CDIR$ IVDEP DO 553 N = 1, NPTS D = A(N,IC,IC) IF (ABS(D) .LT. 1E-7) THEN A(N,IC,IC) = 1.0 ELSE A(N,IC,IC) = 1.0 / D ENDIF 553 CONTINUE DO 557 JC = IC+1, NPDE CDIR$ IVDEP DO 559 N = 1, NPTS A(N,JC,IC) = A(N,JC,IC) * A(N,IC,IC) 559 CONTINUE 557 CONTINUE 550 CONTINUE C RETURN END SUBROUTINE BCKBDI (NPTS, NPDE, A, B, X) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE REAL A(NPTS,NPDE,NPDE), X(NPTS,NPDE), B(NPTS,NPDE) C Ccc PURPOSE: C Solve LUx = b C A is a block-diagonal matrix C A((i,j,k),1:NPDE,1:NPDE) contains a block of NPDE.NPDE elements C corresponding with node (i,j,k) C Ccc PARAMETER DESCRIPTION: C NPTS : IN. # gridpoints C NPDE : IN. # components of the PDE C A : IN. A(.,ic,jc): jc < ic: block diagonal of L C diagonal L == I C jc >=ic: block diagonal of U C diagonal U inverted C X : OUT: solution vector x C B : IN: right-hand side vector b C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER IC, JC, N C CALL RCOPY (NPTS*NPDE, B, X) C CCC Ly = b C DO 100 IC = 2, NPDE DO 101 JC = 1, IC-1 CDIR$ IVDEP DO 1 N = 1, NPTS X(N,IC) = X(N,IC) - A(N,IC,JC)*X(N,JC) 1 CONTINUE 101 CONTINUE 100 CONTINUE C CCC Ux = y C DO 130 IC = NPDE, 1, -1 DO 131 JC = NPDE, IC+1, -1 CDIR$ IVDEP DO 132 N = 1, NPTS X(N,IC) = X(N,IC) - A(N,IC,JC)*X(N,JC) 132 CONTINUE 131 CONTINUE CDIR$ IVDEP DO 133 N = 1, NPTS X(N,IC) = X(N,IC) * A(N,IC,IC) 133 CONTINUE 130 CONTINUE C RETURN END SUBROUTINE DERVF (F, T, X, Y, Z, NPTS, NPDE, U, + A0, DT, DX, DY, DZ, + LLBND, ILBND, LBND, UIB, UT, UX, UY, UZ, UXX, UYY, UZZ, + UXY, UXZ, UYZ, ABSTOL, DEL, WORK, + PRECFO, FU, FUX, FUY, FUZ, FUXX, FUYY, FUZZ) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE, LLBND(0:*), ILBND(*), LBND(*) LOGICAL PRECFO REAL F(NPTS*NPDE), T, X(*), Y(*), Z(*), U(*), A0, DT, DX, DY, DZ, + UIB(*), UT(*), UX(*), UY(*), UZ(*), UXX(*), UYY(*), UZZ(*), + UXY(*), UXZ(*), UYZ(*), ABSTOL(*), + DEL(NPTS*NPDE), WORK(2*NPTS*NPDE), + FU(NPTS*NPDE), + FUX(NPTS*NPDE), FUY(NPTS*NPDE), FUZ(NPTS*NPDE), + FUXX(NPTS*NPDE), FUYY(NPTS*NPDE), FUZZ(NPTS*NPDE) C Ccc PURPOSE: C Compute derivatives of residual wrt (derivatives of) U by numerical C differencing C C PARAMETER DESCRIPTION: C F : IN. Residual F(t,U,Ut) C T : IN. Current time C X,Y,Z : IN. Physical coordinates of gridpoints C NPTS : IN. # grid points C NPDE : IN. # PDE components C U : IN. Solution at T on current grid C A0 : IN. Coefficient of U_n+1 in time derivative C DT : IN. Current time step size C DX : IN. Cell width in X-direction for current grid C DY : IN. Cell width in Y-direction for current grid C DZ : IN. Cell width in Z-direction for current grid C LLBND : IN. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C UIB : IN. Solution at T on internal boundaries C UT : IN. Time derivative of U on current grid C UX : IN. -I C UY : IN. I C UZ : IN. I C UXX : IN. I C UYY : IN. I Space derivatives of U on current grid C UZZ : IN. I C UXY : IN. I C UXZ : IN. I C UYZ : IN. -I C ABSTOL : IN. Absolute tolerance for Newton process C DEL : WORK. (LENU) C WORK : WORK. (2.LENU) C PRECFO : IN. If FALSE first order derivatives may be neglected C FU : OUT. dF(U,Ut)dU C FUX : OUT. dF(Ux)dUx C FUY : OUT. dF(Uy)dUy C FUZ : OUT. dF(Uz)dUz C FUXX : OUT. dF(Uxx)dUxx C FUYY : OUT. dF(Uyy)dUyy C FUZZ : OUT. dF(Uzz)dUzz C Ccc EXTERNALS USED: EXTERNAL PERTRG, PRTRGU, RES C C----------------------------------------------------------------------- C INTEGER I, LENU, LUTBAR REAL FACX, FACY, FACZ, FACXX, FACYY, FACZZ LENU = NPTS*NPDE LUTBAR = 1 + LENU C Ccc How to decide if derivatives are `zero'? C Take `zero'-value of U divided by the grid width FACXX = 1/DX**2 FACYY = 1/DY**2 FACZZ = 1/DZ**2 C C dF(U,Ut)/dU CALL PRTRGU (NPTS, NPDE, U, A0, DT, UT, ABSTOL, DEL, + WORK, WORK(LUTBAR)) CALL RES (T, X, Y, Z, NPTS, NPDE, WORK, + LLBND, ILBND, LBND, UIB, + WORK(LUTBAR), UX, UY, UZ, + UXX, UYY, UZZ, UXY, UXZ, UYZ, FU) DO 10 I = 1, LENU FU(I) = (FU(I) - F(I)) / DEL(I) 10 CONTINUE IF (PRECFO) THEN C FACX = 1/(2*DX) FACY = 1/(2*DY) FACZ = 1/(2*DZ) C C dF(Ux)/dUx CALL PERTRG (NPTS, NPDE, UX, ABSTOL, FACX, DEL, WORK) CALL RES (T, X, Y, Z, NPTS, NPDE, U, + LLBND, ILBND, LBND, UIB, + UT, WORK, UY, UZ, + UXX, UYY, UZZ, UXY, UXZ, UYZ, FUX) DO 11 I = 1, LENU FUX(I) = (FUX(I) - F(I)) / DEL(I) 11 CONTINUE C C dF(Uy)/dUy CALL PERTRG (NPTS, NPDE, UY, ABSTOL, FACY, DEL, WORK) CALL RES (T, X, Y, Z, NPTS, NPDE, U, + LLBND, ILBND, LBND, UIB, + UT, UX, WORK, UZ, + UXX, UYY, UZZ, UXY, UXZ, UYZ, FUY) DO 12 I = 1, LENU FUY(I) = (FUY(I) - F(I)) / DEL(I) 12 CONTINUE C C dF(Uz)/dUz CALL PERTRG (NPTS, NPDE, UZ, ABSTOL, FACZ, DEL, WORK) CALL RES (T, X, Y, Z, NPTS, NPDE, U, + LLBND, ILBND, LBND, UIB, + UT, UX, UY, WORK, + UXX, UYY, UZZ, UXY, UXZ, UYZ, FUZ) DO 13 I = 1, LENU FUZ(I) = (FUZ(I) - F(I)) / DEL(I) 13 CONTINUE ENDIF C C dF(Uxx)/dUxx CALL PERTRG (NPTS, NPDE, UXX, ABSTOL, FACXX, DEL, WORK) CALL RES (T, X, Y, Z, NPTS, NPDE, U, + LLBND, ILBND, LBND, UIB, + UT, UX, UY, UZ, + WORK, UYY, UZZ, UXY, UXZ, UYZ, FUXX) DO 20 I = 1, LENU FUXX(I) = (FUXX(I) - F(I)) / DEL(I) 20 CONTINUE C C dF(Uyy)/dUyy CALL PERTRG (NPTS, NPDE, UYY, ABSTOL, FACYY, DEL, WORK) CALL RES (T, X, Y, Z, NPTS, NPDE, U, + LLBND, ILBND, LBND, UIB, + UT, UX, UY, UZ, + UXX, WORK, UZZ, UXY, UXZ, UYZ, FUYY) DO 30 I = 1, LENU FUYY(I) = (FUYY(I) - F(I)) / DEL(I) 30 CONTINUE C C dF(Uzz)/dUzz CALL PERTRG (NPTS, NPDE, UZZ, ABSTOL, FACZZ, DEL, WORK) CALL RES (T, X, Y, Z, NPTS, NPDE, U, + LLBND, ILBND, LBND, UIB, + UT, UX, UY, UZ, + UXX, UYY, WORK, UXY, UXZ, UYZ, FUZZ) DO 40 I = 1, LENU FUZZ(I) = (FUZZ(I) - F(I)) / DEL(I) 40 CONTINUE RETURN END SUBROUTINE PRTRGU (NPTS, NPDE, U, A0, DT, UT, ABSTOL, DEL, + UBAR, UTBAR) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE REAL U(NPTS,NPDE), A0, DT, UT(NPTS,NPDE), ABSTOL(NPDE), + DEL(NPTS,NPDE), UBAR(NPTS,NPDE), UTBAR(NPTS,NPDE) C Ccc PURPOSE: C Perturb U. Return perturbance in DEL and perturbed U in UBAR. C Ccc PARAMETER DESCRIPTION: C NPTS : IN. # gridpoints C NPDE : IN. # PDE components C U : IN. Solution or derivative of solution to be perturbed C A0 : IN. Coefficient of U_n+1 in time derivative C DT : IN. Current time step size C UT : IN. Time derivative of U on current grid C ABSTOL : IN. Absolute tolerance for Newton process C DEL : OUT. Perturbation values C UBAR : OUT. Perturbed values of U C UTBAR : OUT. Perturbed values of UT C Ccc EXTERNALS USED: EXTERNAL RCOPY C C Ccc INCLUDE 'CMNCMMACH' C C CMNCMMACH C C COMMON with `machine numbers' C LUNOUT : Logical unit # standard output -I C LUNERR : Logical unit # standard error I Set in the routine C UROUND : Smallest machine number such that I MACNUM C 1.0+UROUND > 1.0 and 1.0-UROUND < 1.0 I C XMIN : Smallest floating-point number -I INTEGER LUNOUT, LUNERR REAL UROUND, XMIN COMMON /IMACH/ LUNOUT, LUNERR COMMON /RMACH/ UROUND, XMIN SAVE /IMACH/, /RMACH/ C C end INCLUDE 'CMNCMMACH' C C C----------------------------------------------------------------------- C INTEGER IC, IPT REAL DELI, EPS, TOL CALL RCOPY (NPTS*NPDE, U, UBAR) CALL RCOPY (NPTS*NPDE, UT, UTBAR) EPS = SQRT(UROUND) DO 10 IC = 1, NPDE TOL = ABSTOL(IC) DO 20 IPT = 1, NPTS C Compute perturbance, if U=0, U(T+dt)=dtUt, if both are zero take C threshold DELI = EPS*MAX(ABS(U(IPT,IC)),ABS(DT*UT(IPT,IC)),TOL) DELI = SIGN(DELI,DT*UT(IPT,IC)) C To ensure that the perturbance is the same machine number as the C denominator DEL(IPT,IC) = (U(IPT,IC)+DELI)-U(IPT,IC) UBAR(IPT,IC) = U(IPT,IC) + DEL(IPT,IC) UTBAR(IPT,IC) = UT(IPT,IC) + A0*DEL(IPT,IC) 20 CONTINUE 10 CONTINUE RETURN END SUBROUTINE PERTRG (NPTS, NPDE, U, ABSTOL, FAC, DEL, UBAR) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE REAL U(NPTS,NPDE), ABSTOL(NPDE), FAC, DEL(NPTS,NPDE), + UBAR(NPTS,NPDE) C Ccc PURPOSE: C Perturb U. Return perturbance in DEL and perturbed U in UBAR. C Ccc PARAMETER DESCRIPTION: C NPTS : IN. # gridpoints C NPDE : IN. # PDE components C U : IN. Derivative of solution to be perturbed C ABSTOL : IN. Absolute tolerance for Newton process C FAC : IN. Grid factor for tolerance to get threshold C DEL : OUT. Perturbation values C UBAR : OUT. Perturbed values of U C Ccc EXTERNALS USED: EXTERNAL RCOPY C C Ccc INCLUDE 'CMNCMMACH' C C CMNCMMACH C C COMMON with `machine numbers' C LUNOUT : Logical unit # standard output -I C LUNERR : Logical unit # standard error I Set in the routine C UROUND : Smallest machine number such that I MACNUM C 1.0+UROUND > 1.0 and 1.0-UROUND < 1.0 I C XMIN : Smallest floating-point number -I INTEGER LUNOUT, LUNERR REAL UROUND, XMIN COMMON /IMACH/ LUNOUT, LUNERR COMMON /RMACH/ UROUND, XMIN SAVE /IMACH/, /RMACH/ C C end INCLUDE 'CMNCMMACH' C C C----------------------------------------------------------------------- C INTEGER IC, IPT REAL DELI, EPS, TOL CALL RCOPY (NPTS*NPDE, U, UBAR) EPS = SQRT(UROUND) DO 10 IC = 1, NPDE TOL = ABSTOL(IC)*FAC DO 20 IPT = 1, NPTS C Compute perturbance DELI = EPS*MAX(ABS(U(IPT,IC)),TOL) C To ensure that UBAR has the same sign as U DELI = SIGN(DELI,U(IPT,IC)) C To ensure that the perturbance is the same machine number as the C denominator DEL(IPT,IC) = (U(IPT,IC)+DELI)-U(IPT,IC) UBAR(IPT,IC) = U(IPT,IC) + DEL(IPT,IC) 20 CONTINUE 10 CONTINUE RETURN END SUBROUTINE PREG (NPTS, NPDE, DX, DY, DZ, + LLBND, ILBND, LBND, + FU, FUX, FUY, FUZ, FUXX, FUYY, FUZZ, PRECFO, DGINV) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE, LLBND(0:*), ILBND(*), LBND(*) LOGICAL PRECFO REAL DX, DY, DZ, + FU(NPTS*NPDE), + FUX(NPTS*NPDE), FUY(NPTS*NPDE), FUZ(NPTS*NPDE), + FUXX(NPTS*NPDE), FUYY(NPTS*NPDE), FUZZ(NPTS*NPDE), + DGINV(NPTS*NPDE) C Ccc PURPOSE: C Compute inverse of diagonal of Jacobian G = dF/dU using derivatives C of residual wrt (derivatives of) U. C C PARAMETER DESCRIPTION: C NPTS : IN. # grid points C NPDE : IN. # PDE components C DX : IN. Current grid width in X-direction C DY : IN. Current grid width in Y-direction C DZ : IN. Current grid width in Z-direction C LLBND : IN. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C FU : IN. Derivative residual F(.,U,Ut,.) wrt U C FUXX : IN. Derivative residual F(.,Uxx,.) wrt Uxx C FUYY : IN. Derivative residual F(.,Uyy,.) wrt Uyy C FUZZ : IN. Derivative residual F(.,Uzz,.) wrt Uzz C PRECFO : IN. If FALSE first order derivatives may be neglected C DGINV : OUT. Inverse of diagonal of Jacobian. C Ccc EXTERNALS USED: EXTERNAL PREGBD C C Ccc INCLUDE 'CMNCMMACH' C C CMNCMMACH C C COMMON with `machine numbers' C LUNOUT : Logical unit # standard output -I C LUNERR : Logical unit # standard error I Set in the routine C UROUND : Smallest machine number such that I MACNUM C 1.0+UROUND > 1.0 and 1.0-UROUND < 1.0 I C XMIN : Smallest floating-point number -I INTEGER LUNOUT, LUNERR REAL UROUND, XMIN COMMON /IMACH/ LUNOUT, LUNERR COMMON /RMACH/ UROUND, XMIN SAVE /IMACH/, /RMACH/ C C end INCLUDE 'CMNCMMACH' C C C----------------------------------------------------------------------- C INTEGER I, LENU REAL DG, EPS, FACX, FACY, FACZ, FACXX, FACYY, FACZZ C EPS = SQRT(UROUND) C LENU = NPTS*NPDE C FACXX = 1/DX**2 FACYY = 1/DY**2 FACZZ = 1/DZ**2 C DO 10 I = 1, LENU C dF(ipt,ic)/dU(ipt,ic) DGINV(I) = FU(I) + + FUXX(I)*(-2*FACXX) + FUYY(I)*(-2*FACYY) + + FUZZ(I)*(-2*FACZZ) 10 CONTINUE IF (PRECFO) THEN FACX = 1/(2*DX) FACY = 1/(2*DY) FACZ = 1/(2*DZ) CALL PREGBD (NPTS, NPDE, FACX, FACY, FACZ, + LLBND, ILBND, LBND, FUX, FUY, FUZ, DGINV) ENDIF DO 20 I = 1, LENU DG = DGINV(I) IF (ABS(DG) .LT. EPS) THEN DGINV(I) = 1.0 ELSE DGINV(I) = 1.0/DG ENDIF 20 CONTINUE C RETURN END SUBROUTINE PREGBD (NPTS, NPDE, FACX, FACY, FACZ, + LLBND, ILBND, LBND, FUX, FUY, FUZ, G) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER NPTS, NPDE, LLBND(0:*), ILBND(*), LBND(*) REAL FACX, FACY, FACZ, + FUX(NPTS,NPDE), FUY(NPTS,NPDE), FUZ(NPTS,NPDE), + G(NPTS,NPDE) C Ccc PURPOSE: C Correct Jacobian G = dF/dU for second order approximation of C first order derivatives at boundaries C C PARAMETER DESCRIPTION: C NPTS : IN. # grid points C NPDE : IN. # PDE components C FACX : IN. 1/(2*DX) C FACY : IN. 1/(2*DY) C FACZ : IN. 1/(2*DZ) C LLBND : IN. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : IN. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : IN. (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C FUX : IN. Derivative residual C F(t,U,Ut,Ux,Uy,Uz,Uxx,Uyy,Uzz,Uxy,Uxz,Uyz) wrt Ux C FUY : IN. Derivative residual C F(t,U,Ut,Ux,Uy,Uz,Uxx,Uyy,Uzz,Uxy,Uxz,Uyz) wrt Uy C FUZ : IN. Derivative residual C F(t,U,Ut,Ux,Uy,Uz,Uxx,Uyy,Uzz,Uxy,Uxz,Uyz) wrt Uz C G : INOUT. C IN: Main diagonal of Jacobian C OUT: G corrected for first order derivatives at C boundaries C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER IPT, IC, IB, LB C Ccc Boundary corrections, no corrections needed for internal boundaries DO 10 IB = 1, LLBND(0) IF (ILBND(IB) .EQ. 1) THEN C Left plane, correction needed for dF/dUx DO 20 IC = 1, NPDE CDIR$ IVDEP DO 25 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) G(IPT,IC) = G(IPT,IC) + FUX(IPT,IC)*(-3*FACX) 25 CONTINUE 20 CONTINUE ELSE IF (ILBND(IB) .EQ. 2) THEN C Down plane, correction needed for dF/dUz DO 30 IC = 1, NPDE CDIR$ IVDEP DO 35 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) G(IPT,IC) = G(IPT,IC) + FUZ(IPT,IC)*(-3*FACZ) 35 CONTINUE 30 CONTINUE ELSE IF (ILBND(IB) .EQ. 3) THEN C Right plane, correction needed for dF/dUx DO 40 IC = 1, NPDE CDIR$ IVDEP DO 45 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) G(IPT,IC) = G(IPT,IC) + FUX(IPT,IC)*(+3*FACX) 45 CONTINUE 40 CONTINUE ELSE IF (ILBND(IB) .EQ. 4) THEN C Up plane, correction needed for dF/dUz DO 50 IC = 1, NPDE CDIR$ IVDEP DO 55 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) G(IPT,IC) = G(IPT,IC) + FUZ(IPT,IC)*(+3*FACZ) 55 CONTINUE 50 CONTINUE ELSE IF (ILBND(IB) .EQ. 5) THEN C Front plane, correction needed for dF/dUy DO 60 IC = 1, NPDE CDIR$ IVDEP DO 65 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) G(IPT,IC) = G(IPT,IC) + FUY(IPT,IC)*(-3*FACY) 65 CONTINUE 60 CONTINUE ELSE IF (ILBND(IB) .EQ. 6) THEN C Back plane, correction needed for dF/dUy DO 70 IC = 1, NPDE CDIR$ IVDEP DO 75 LB = LLBND(IB), LLBND(IB+1)-1 IPT = LBND(LB) G(IPT,IC) = G(IPT,IC) + FUY(IPT,IC)*(+3*FACY) 75 CONTINUE 70 CONTINUE ENDIF 10 CONTINUE C RETURN END SUBROUTINE GCRO (N, XV, F, WT, TOL, BDPREC, PREC, + ISTRUC, X, Y, Z, NPDE, UIB, UNP1, + TNP1, A0, DX, DY, DZ, RWORK, + NRRMAX, MAXLR, MAXL, LUN, + R, U, C, ZW, WORK, ITER, ERR, IERR) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER N, ISTRUC(0:*), NPDE, NRRMAX, MAXLR, MAXL, LUN, + ITER, IERR LOGICAL BDPREC REAL XV(N), F(N), WT(N), TOL, PREC(N), + X(*), Y(*), Z(*), UIB(*), UNP1(0:*), + TNP1, A0, DX, DY, DZ, RWORK(*), + R(N), U(N,0:MAXLR-1), C(N,0:MAXLR-1), ZW(0:MAXLR-1,0:MAXLR-1), + WORK(*), ERR C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: C Ccc PURPOSE: C Solve a Non-Symmetric linear system Gx = F using the matrix-free C (block)-diagonally scaled GCRO(NRRMAX+1,MAXLR,(MAXL)) method. C Actually solved is the system [W.D^(-1).G.W^(-1)].[W.x] = [W.D^(-1).F] C where W = diag(WT(i)) and D is the (block) diagonal of G C until max(||residual||_2,||GM^(-1).residual||_2) < TOL, C with GM the projection of the matrix unto the Krylov base obtained C with the GMRES inner iteration. C Ccc PARAMETER DESCRIPTION: C N : IN. Dimension of the system C XV : OUT. Final approximate solution. C F : IN. Right-hand side vector. C WT : IN. Contains weight factors to compute weighted norm. C TOL : IN. System is considered to be solved if C weighted 2-norm < TOL C BDPREC : IN. if true a block-diagonal preconditioner is used C PREC : IN. LU decomposition of (block-)diagonal of G. main diagonal C inverted C ISTRUC : IN. -I Parameters C ... I for C RWORK : IN. -I residual evaluation C NRRMAX : IN. # restarts outer loop C MAXLR : IN. max. iterations outer loop C MAXL : IN. max. iterations GMRES (no restarts) C LUN : IN. Logical unit # of file on which to write the error at C each iteration, if this is desired for monitoring convergence C If LUN = 0, no writing will occur. C R : WORK. C U : WORK. C C : WORK. C ZW : WORK. C WORK : WORK. (N.(MAXL+1)+(MAXL+3).MAXL+4.N+1) C ITER : OUT. Number of iterations required to reach convergence, or C until (NRRMAX+1).MAXLR. outer loop iterations have been C performed. ITER is the sum of the number of outerloop C iterations + number of GMRES (preconditioner) iterations. C ERR : OUT. Weighted 2-norm of error estimate in final C approximate solution C IERR : OUT. Error return flag C 0: OK C 1: Method failed to converge in (NRRMAX+1).MAXLR. outer loop C iterations C 2: Break down in outer loop C Ccc EXTERNALS USED: REAL SDOT, SNRM2 EXTERNAL BCKBDI, GMRESO, MVDIFF, RCOPY, SAXPY, SDOT, SNRM2, ZERO C C Ccc INCLUDE 'CMNCMMACH' C C CMNCMMACH C C COMMON with `machine numbers' C LUNOUT : Logical unit # standard output -I C LUNERR : Logical unit # standard error I Set in the routine C UROUND : Smallest machine number such that I MACNUM C 1.0+UROUND > 1.0 and 1.0-UROUND < 1.0 I C XMIN : Smallest floating-point number -I INTEGER LUNOUT, LUNERR REAL UROUND, XMIN COMMON /IMACH/ LUNOUT, LUNERR COMMON /RMACH/ UROUND, XMIN SAVE /IMACH/, /RMACH/ C C end INCLUDE 'CMNCMMACH' C C C----------------------------------------------------------------------- C INTEGER I, IR, J, K, GRITER, PRITER, GMITER, + LV, LHES, LQ, LRWRK REAL RNRM, UNRM C Ccc Distribute workspace for GMRES LV = 1 LHES = LV + N*(MAXL+1) LQ = LHES + (MAXL+1)*MAXL LRWRK= LQ + 2*MAXL C ITER = 0 IERR = 0 GRITER = 0 PRITER = 0 C Ccc Initialize X and set initial residual to r_0 = W.D^(-1).F CALL ZERO (N, XV) IF (BDPREC) THEN CALL BCKBDI (N/NPDE, NPDE, PREC, F, R) DO 10 I = 1, N R(I) = WT(I)*R(I) 10 CONTINUE ELSE DO 11 I = 1, N R(I) = WT(I)*PREC(I)*F(I) 11 CONTINUE ENDIF C C Ccc Check stopping criterion ERR = SNRM2 (N, R, 1) IF (LUN .NE. 0) THEN WRITE(LUN,*) + 'Diag. scaled GCRO(NRRMAX,MAXLR))' WRITE(LUN,'(''NRRMAX, MAXLR, N:'',3I10)') + NRRMAX, MAXLR, N WRITE(LUN,*) '# it. GCRO # it.GMRES Error Estimate' WRITE(LUN,'(2I10,E20.7)') GRITER, PRITER, ERR ENDIF IF (ERR .LT. SQRT(UROUND)*TOL) RETURN C Ccc Restart loop DO 150 IR = 0, NRRMAX IERR = 0 C Ccc Outer loop DO 200 K = 0, MAXLR-1 C C Perform the diagonally scaled GMRES algorithm to solve C (I-C_k-1C_k-1^T).[W.D^(-1).G.W^(-1)].u_k = A_k-1.u_k = r_k-1, C r_k = r_k-1 - A_k-1.u_k C c_k = (r_k-1 - r_k)/ C to compute the initial preconditioner for the E-N process C If u_k is solved accurately enough ||u_k = H_k.r_k||_2 is a good C measure for the error when solving DAE systems. CALL GMRESO (N, U(1,K), R, WT, BDPREC, PREC, C, K, TOL, MAXL, + F, ISTRUC, X, Y, Z, NPDE, UIB, UNP1, + TNP1, A0, DX, DY, DZ, RWORK, + WORK(LV), WORK(LHES), WORK(LQ), WORK(LRWRK), + LUN, GMITER, ERR, IERR) PRITER = PRITER + GMITER IF (LUN .GT. 0) THEN WRITE(LUN,*) 'Result GMRES:', GMITER, TOL, ERR, IERR ENDIF IF (IERR .GT. 1) THEN PRINT *, 'wat nu?' STOP ENDIF IERR = 0 C Ccc Check stopping criterion UNRM = SNRM2 (N, U(1,K), 1) C C Compute v = [W.D^(-1).G.W^(-1)].u_k DO 210 I = 1, N WORK(LV+N-1+I) = U(I,K)/WT(I)/UNRM 210 CONTINUE CALL MVDIFF (N, F, WORK(LV+N), + ISTRUC, X, Y, Z, NPDE, UIB, UNP1, + TNP1, A0, DX, DY, DZ, RWORK, + WORK(LHES), WORK(LV)) IF (BDPREC) THEN CALL BCKBDI (N/NPDE, NPDE, PREC, WORK(LV), WORK(LV+N)) DO 220 I = 1, N WORK(LV-1+I) = WT(I)*WORK(LV+N-1+I)*UNRM 220 CONTINUE ELSE DO 221 I = 1, N WORK(LV-1+I) = WT(I)*PREC(I)*WORK(LV-1+I)*UNRM 221 CONTINUE ENDIF C C C Compute ZW[0:k-1,k] = C_k^T.v DO 300 I = 0, K-1 ZW(I,K) = SDOT(N, C(1,I),1, WORK(LV),1) 300 CONTINUE C GRITER = GRITER + 1 C Ccc Check stopping criterion RNRM = SNRM2 (N, R, 1) IF (LUN .NE. 0) THEN WRITE(LUN,'(2I10,2E20.7)') GRITER, PRITER, RNRM, UNRM ENDIF IF (MAX(RNRM,UNRM) .LT. TOL) THEN C Compute x = x + U_k.Z_k^(-1).1 DO 310 I = K, 0, -1 WORK(LV+I) = 1 DO 320 J = I+1, K WORK(LV+I) = WORK(LV+I) - ZW(I,J)*WORK(LV+J) 320 CONTINUE CALL SAXPY (N, WORK(LV+I), U(1,I), 1, XV, 1) 310 CONTINUE ITER = GRITER + PRITER GOTO 900 ENDIF 200 CONTINUE Ccc End outer loop C Compute x = x + U_k.Z_k^(-1).1 K = MAXLR-1 DO 330 I = K, 0, -1 WORK(LV+I) = 1 DO 340 J = I+1, K WORK(LV+I) = WORK(LV+I) - ZW(I,J)*WORK(LV+J) 340 CONTINUE CALL SAXPY (N, WORK(LV+I), U(1,I), 1, XV, 1) 330 CONTINUE C 150 CONTINUE Ccc End Restart loop C IERR = 1 ITER = GRITER + PRITER C 900 CONTINUE C Unscale x DO 910 I = 1, N XV(I) = XV(I) / WT(I) 910 CONTINUE RETURN END SUBROUTINE GMRESO (N, XV, BV, WT, BDPREC, PREC, CO, M, TOL, MAXL, + F, ISTRUC, X, Y, Z, NPDE, UIB, UNP1, + TNP1, A0, DX, DY, DZ, RWORK, + V, HES, Q, WORK, + LUN, ITER, ERR, IERR) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER N, M, ISTRUC(0:*), NPDE, MAXL, LUN, + ITER, IERR LOGICAL BDPREC REAL XV(N), BV(N), WT(N), PREC(N), CO(N,0:M), TOL, + F(*), X(*), Y(*), Z(*), UIB(*), UNP1(0:*), + TNP1, A0, DX, DY, DZ, RWORK(*), + V(N,MAXL+1), HES(MAXL+1,MAXL), + Q(2*MAXL), WORK(*), ERR C Ccc PURPOSE: C Solve a Non-Symmetric linear system C [W.D^(-1).G.W^(-1)].[Wx] = [W.D^(-1).b] C using the (block)-diagonally scaled GMRES(MAXL) method, orthogonalize C new V_k not only against previous ones but also against C's from C outer iteration. C W = diag(WT(i)) and D is the (block) diagonal of G. C The right hand-side W.D^(-1).b is stored in B, C the matrix G and the preconditioner are stored in RWORK and IWORK. C (Dx) is returned in X. C The routine MVDIFF (N, RWORK, IWORK, X, Y) should perform y = Gx C Ccc PARAMETER DESCRIPTION: C N : IN. # grid points C XV : OUT. Final approximate solution. C BV : IN. Preconditioned right-hand side vector. C OUT. Residual vector. C WT : IN. Contains weight factors to compute weighted norm. C BDPREC : IN. if true a block-diagonal preconditioner is used C PREC : IN. LU decomposition of (block-)diagonal of G. main diagonal C inverted C CO : IN. (.,0:M-1): vectors from outer iteration against which C V's should be orthogonalized. C OUT. (.,M) = Residual_outer_old - Residual C M : IN. Outer loop iteration count C TOL : IN. System is considered to be solved if C 2-norm < TOL C F : IN. -I Parameters C ... I for C RWORK : IN. -I residual evaluation C MAXL : IN. max. iterations GMRES (no restarts) C V : WORK. C HES : WORK. C Q : WORK. C WORK : WORK. 4.N+1 C LUN : IN. Logical unit # of file on which to write the error at C each iteration, if this is desired for monitoring convergence C If LUN = 0, no writing will occur. C ITER : OUT. Number of iterations required to reach convergence, or C MAXL+1 if convergence criterion could not be achieved in C MAXL iterations. C ERR : OUT. Weighted max. norm of error estimate in final C approximate solution C IERR : OUT. Error return flag C 0: OK C 1: Method failed to converge in MAXL iterations C Ccc EXTERNALS USED: REAL SDOT, SNRM2 EXTERNAL BCKBDI, MVDIFF, RCOPY, SAXPY, SDOT, SNRM2, ZERO C C----------------------------------------------------------------------- C INTEGER I, J, K REAL C, CNM2, R0NRM, PROD, RHO, S, TEM, T1, T2, T, VNRM C IERR = 0 ITER = 0 C Ccc Initialize solution on zero, the initial residual R0 is the C left preconditioned vector B CALL ZERO (N, XV) CALL RCOPY (N, BV, V(1,1)) R0NRM = SNRM2(N, V(1,1),1) C Ccc Check stopping criterion ERR = R0NRM IF (LUN .NE. 0) THEN WRITE(LUN,'(''Diagonally scaled GMRESO(MAXL)'',I5)') + MAXL WRITE(LUN, + '('' ITER Error Estimate'')') WRITE(LUN,'(I5,E20.7)') ITER, ERR ENDIF C Ccc Rescale so that the norm of V(1,1) is one DO 80 I = 1, N V(I,1) = V(I,1)/R0NRM 80 CONTINUE C Ccc Initialize HES array. CALL ZERO (MAXL*(MAXL+1), HES) C Ccc Main loop to compute the vectors V(*,2) to V(*,MAXL). C The running product PROD is needed for the convergence test. PROD = 1.0 DO 10 K = 1, MAXL ITER = K C C V(*,K+1) = [W.D^(-1).G.W^(-1)] . V(*,K) DO 11 I = 1, N WORK(I) = V(I,K)/WT(I) 11 CONTINUE CALL MVDIFF (N, F, WORK, + ISTRUC, X, Y, Z, NPDE, UIB, UNP1, + TNP1, A0, DX, DY, DZ, RWORK, + WORK(1+N), V(1,K+1)) IF (BDPREC) THEN CALL BCKBDI (N/NPDE, NPDE, PREC, V(1,K+1), WORK) DO 12 I = 1, N V(I,K+1) = WT(I)*WORK(I) 12 CONTINUE ELSE DO 13 I = 1, N V(I,K+1) = WT(I)*PREC(I)*V(I,K+1) 13 CONTINUE ENDIF C C Orthogonalize V(*,K+1) first against the previous C using C modified Gram-Schmidt DO 801 I = 0, M-1 TEM = SDOT (N, CO(1,I), 1, V(1,K+1), 1) / + SDOT (N, CO(1,I), 1, CO(1,I), 1) CALL SAXPY (N, -TEM, CO(1,I), 1, V(1,K+1), 1) 801 CONTINUE C C Orthogonalize V(*,K+1) against the previous V using C modified Gram-Schmidt DO 81 I = 1, K HES(I,K) = SDOT (N, V(1,I), 1, V(1,K+1), 1) CALL SAXPY (N, -HES(I,K), V(1,I), 1, V(1,K+1), 1) 81 CONTINUE VNRM = SNRM2(N, V(1,K+1), 1) HES(K+1,K) = VNRM C C Update the QR factors of HES (Q.HES = R) using Givens rotations C First, multiply new column by previous Givens rotations DO 82 I = 1, K-1 T1 = HES(I,K) T2 = HES(I+1,K) C = Q(2*I-1) S = Q(2*I) HES(I ,K) = C*T1 - S*T2 HES(I+1,K) = S*T1 + C*T2 82 CONTINUE C Form last Givens rotation and multiply it with last 2 elements of HES T1 = HES(K,K) T2 = HES(K+1,K) IF (T2 .EQ. 0.0) THEN C = 1.0 S = 0.0 ELSE IF (ABS(T2) .GE. ABS(T1)) THEN T = T1/T2 S = -1.0/SQRT(1.0+T*T) C = -S*T ELSE T = T2/T1 C = 1.0/SQRT(1.0+T*T) S = -C*T ENDIF Q(2*K-1) = C Q(2*K ) = S HES(K,K) = C*T1 - S*T2 IF (HES(K,K) .EQ. 0.0) THEN IERR = 2 RETURN ENDIF C C Update RHO, the estimate of the norm of the residual R0-A*XL. PROD = PROD*Q(2*K) RHO = ABS(PROD*R0NRM) C Ccc Check stopping criterion ERR = RHO IF (LUN .NE. 0) THEN WRITE(LUN,'(I5,2E20.7)') ITER, ERR, ERR/R0NRM ENDIF IF (ERR/R0NRM .LT. 0.001 .AND. ERR .LT. TOL) GOTO 100 IF (K .EQ. MAXL) GOTO 20 C C Rescale so that the norm of V(1,K+1) is one. DO 83 I = 1, N V(I,K+1) = V(I,K+1)/VNRM 83 CONTINUE 10 CONTINUE C 20 CONTINUE IF (RHO .GT. R0NRM) THEN IERR = 2 RETURN ELSE IERR = 1 ENDIF C Ccc Compute the approximation XL to the solution. C Min. ||beta.e1 - Hk+1k.y||_2 C X = X + Vk.y 100 CONTINUE K = ITER WORK(1) = R0NRM DO 110 I = 2, K+1 WORK(I) = 0.0 110 CONTINUE C Q.beta.e1 DO 84 I = 1, K C = Q(2*I-1) S = Q(2*I) T1 = WORK(I) T2 = WORK(I+1) WORK(I ) = C*T1 - S*T2 WORK(I+1) = S*T1 + C*T2 84 CONTINUE C Solve R.y = Q.beta.e1 DO 85 I = 1, K J = K+1-I WORK(J) = WORK(J) / HES(J,J) CALL SAXPY (J-1, -WORK(J), HES(1,J),1, WORK,1) 85 CONTINUE C C X = X + Vk.y DO 120 I = 1,K CALL SAXPY(N, WORK(I), V(1,I), 1, XV, 1) 120 CONTINUE C C Calculate the residual vector CALL RCOPY (N, V(1,1), WORK(K+1)) DO 86 I = 1, K-1 S = Q(2*I) C = Q(2*I-1) DO 87 J = 1, N WORK(K+J) = S*WORK(K+J) + C*V(J,I+1) 87 CONTINUE 86 CONTINUE I = K S = Q(2*I) C = Q(2*I-1)/VNRM DO 88 J = 1, N WORK(K+J) = S*WORK(K+J) + C*V(J,I+1) 88 CONTINUE DO 89 J = 1, N WORK(K+J) = WORK(K+J)*R0NRM*PROD 89 CONTINUE C C Compute c_m = (b - r) / DO 130 J = 1, N CO(J,M) = BV(J) - WORK(K+J) 130 CONTINUE CNM2 = 1 / SDOT (N, CO(1,M), 1, CO(1,M), 1) DO 140 J = 1, N CO(J,M) = CO(J,M) * CNM2 140 CONTINUE C C Inner residual = outer residual CALL RCOPY (N, WORK(K+1), BV) C RETURN END SUBROUTINE MVDIFF (N, F, XV, + ISTRUC, X, Y, Z, NPDE, UIB, UNP1, + TNP1, A0, DX, DY, DZ, RWORK, + WORK, YV) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER N, ISTRUC(0:*), NPDE REAL F(N), XV(N), + X(*), Y(*), Z(*), UIB(*), UNP1(0:*), + TNP1, A0, DX, DY, DZ, RWORK(*), + WORK(*), YV(N) C Ccc PURPOSE: C Compute y = Gx where Gx ~ F(t,U+x,(U+x)_t)-F(t,U,(U+x)_t) C Ccc PARAMETER DESCRIPTION: C N : IN. Dimension of x C F : IN. Residual F(t,U,Udot), U=UNP1, Udot = A0.U+UH C XV : IN. Multiplying vector C ISTRUC : IN. -I Parameters C ... I for C RWORK : IN. -I residual evaluation C WORK : WORK. (N+1 + 2N) C YV : OUT. Result vector C Ccc EXTERNALS USED: EXTERNAL RESID C C----------------------------------------------------------------------- C INTEGER LLPLN, NPLNS, LIPLN, LLROW, NROWS, NPTS, LIROW, LICOL, + LLLBND, NBNDS, NBDPTS, NBIPTS, LILBND, LLBNDP, + LLBLWY, LLABVY, LLBLWZ, LLABVZ, + LUT, LUX, LUY, LUZ, LUXX, LUYY, LUZZ, LUXY, LUXZ, LUYZ, + LUBAR, LUTBAR, LFBAR, I C LLPLN = 0 NPLNS = ISTRUC(LLPLN) LIPLN = LLPLN+NPLNS+2 LLROW = LIPLN+NPLNS NROWS = ISTRUC(LLPLN+NPLNS+1)-1 NPTS = ISTRUC(LLROW+NROWS)-1 LIROW = LLROW+NROWS+1 LICOL = LIROW+NROWS LLLBND = LICOL+NPTS NBNDS = ISTRUC(LLLBND) NBDPTS = ISTRUC(LLLBND+NBNDS+1)-1 NBIPTS = ISTRUC(LLLBND+NBNDS+2)-1 LILBND = LLLBND+NBNDS+3 LLBNDP = LILBND+NBNDS LLBLWY = LLBNDP+NBIPTS LLABVY = LLBLWY+NPTS+1 LLBLWZ = LLABVY+NPTS+1 LLABVZ = LLBLWZ+NPTS+1 C LUT = 1 LUX = LUT + N LUY = LUX + N LUZ = LUY + N LUXX = LUZ + N LUYY = LUXX + N LUZZ = LUYY + N LUXY = LUZZ + N LUXZ = LUXY + N LUYZ = LUXZ + N C LUBAR = 1 LUTBAR = LUBAR + 1+N LFBAR = LUTBAR + N C Ccc Store U+x in WORK(LUBAR), and d(U+x)/dt in WORK(LUTBAR) WORK(LUBAR) = 0.0 DO 10 I = 1, N WORK(LUBAR+I) = UNP1(I) + XV(I) WORK(LUTBAR-1+I) = RWORK(LUT-1+I) + A0*XV(I) 10 CONTINUE C Ccc Compute space derivatives and residual CALL DERIVS (NPTS, NPDE, WORK(LUBAR), + ISTRUC(LLLBND), ISTRUC(LILBND), ISTRUC(LLBNDP), + ISTRUC(LLBLWY), ISTRUC(LLABVY), ISTRUC(LLBLWZ), ISTRUC(LLABVZ), + DX, DY, DZ, + RWORK(LUX), RWORK(LUY), RWORK(LUZ), + RWORK(LUXX), RWORK(LUYY), RWORK(LUZZ), + RWORK(LUXY), RWORK(LUXZ), RWORK(LUYZ)) CALL RES (TNP1, X, Y, Z, NPTS, NPDE, WORK(LUBAR+1), + ISTRUC(LLLBND), ISTRUC(LILBND), ISTRUC(LLBNDP), UIB, + WORK(LUTBAR), RWORK(LUX), RWORK(LUY), RWORK(LUZ), + RWORK(LUXX), RWORK(LUYY), RWORK(LUZZ), + RWORK(LUXY), RWORK(LUXZ), RWORK(LUYZ), WORK(LFBAR)) C DO 20 I = 1, N YV(I) = WORK(LFBAR-1+I) - F(I) 20 CONTINUE RETURN END SUBROUTINE PRDOM (LPLN, IPLN, LROW, IROW, ICOL, + LLBND, ILBND, LBND, IDOM, NX, NY, NZ) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER LPLN(0:*), IPLN(*), LROW(*), IROW(*), ICOL(*), + LLBND(0:*), ILBND(*), LBND(*), IDOM(0:*), NX, NY, NZ C Ccc PURPOSE: C Print domain plane-wise. Internal points are .., external points XX, C physical plane-boundary points their ILBND value. Edges are given C both ILBND values, corners an explicated 2-character value, and C internal boundary values II. C Ccc PARAMETER DESCRIPTION: C LPLN : IN. (0:LPLN(0)+1) C LPLN(0) = NPLNS: Actual # planes in LROW C LPLN(1:NPLNS): pointers to the start of a plane in LROW C LPLN(NPLNS+1) = NROWS+1: Total # rows in grid + 1 C IPLN : IN. (NPLNS) C IPLN(IP): plane number of plane IP in virtual box C LROW : IN. (NROWS+1) C LROW(1:NROWS): pointers to the start of a row in the grid C LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 C IROW : IN. (NROWS) C IROW(IR): row number of row IR in virtual box C ICOL : IN. (NPTS) C ICOL(IPT): column number of grid point IPT in virtual box C LLBND : OUT. (0:LLBND(0)+2) C LLBND(0) = NBNDS: total # physical planes in actual domain. C NB. edges and corners are stored for each plane they C belong to. C LLBND(1:NBNDS): pointers to a specific boundary in LBND C LLBND(NBNDS+1) = NBDPTS+1: total # physical boundary points C in LBND + 1 C LLBND(NBNDS+1): pointer to internal boundary in LBND C LLBND(NBNDS+2) = NBIPTS+1: total # points in LBND + 1 C ILBND : OUT. (NBNDS) C ILBND(IB): type of boundary: C 1: Left plane -I C 2: Down plane I C 3: Right plane I max. first order derivative C 4: Up plane I C 5: Front plane I C 6: Back plane -I C LBND : (NBIPTS) C LBND(IBPT): pointer to boundary point in actual grid C IDOM : OUT. IDOM(IPT): location in domain of node IPT C 0: interior point C IB: on boundary C if not on edge or corner, or if internal boundary C then IB, IB = 1, NBNDS+1 C else | IB4 | IB3 | IB2 | IBYTE | if point is part of C the boundary planes IBYTE, IB2, IB3, and IB4 C Ccc EXTERNALS USED: EXTERNAL DOMFLG C INTEGER BYTE1, BYTE2 PARAMETER (BYTE1 = 2**8, BYTE2 = 2**16) C C----------------------------------------------------------------------- C INTEGER MAXC, MAXN PARAMETER (MAXC = 100, MAXN = 25) CHARACTER*80 LINE(0:MAXN) INTEGER I, J, K, L, IB, IP, IR, IPT, NPLNS, NROWS, NPTS, NBNDS INTEGER IA, IE, IEVAL(0:MAXC) C IF (NX .GE. MAXN .OR. NY .GE. MAXN) THEN PRINT *, 'Sorry, Nx, Ny should be < MAXN; adapt PRDOM' RETURN ENDIF C NPLNS = LPLN(0) NROWS = LPLN(NPLNS+1)-1 NPTS = LROW(NROWS+1)-1 NBNDS = LLBND(0) C C Set domain values CALL DOMFLG (NPTS, LLBND, LBND, IDOM) IA = ICHAR('a') IE = -1 DO 10 IP = 1, NPLNS K = IPLN(IP) LINE(0) = ' ' DO 20 I = 1, NX+1 WRITE(LINE(0)(3*I-2:3*I),'('' XX'')') 20 CONTINUE DO 30 J = 1, NY LINE(J) = LINE(0) 30 CONTINUE DO 40 IR = LPLN(IP), LPLN(IP+1)-1 J = IROW(IR) DO 50 IPT = LROW(IR), LROW(IR+1)-1 I = ICOL(IPT)+1 IF (IDOM(IPT) .EQ. 0) THEN WRITE(LINE(J)(3*I-2:3*I),'('' ..'')') ELSE IF (IDOM(IPT) .EQ. NBNDS+1) THEN WRITE(LINE(J)(3*I-2:3*I),'('' II'')') ELSE IB = IDOM(IPT) IF (IB .LT. BYTE1) THEN WRITE(LINE(J)(3*I-2:3*I),'(I3)') ILBND(IB) ELSE IF (IB .LT. BYTE2) THEN WRITE(LINE(J)(3*I-1:3*I),'(2I1)') + ILBND(IB/BYTE1), ILBND(MOD(IB,BYTE1)) ELSE DO 55 L = 0, IE IF (IB .EQ. IEVAL(L)) GOTO 56 55 CONTINUE IE = IE+1 IF (IE .GT. MAXC) THEN PRINT *, 'Sorry, # corners > MAXC; adapt PRDOM' RETURN ENDIF IEVAL(IE) = IB L = IE 56 WRITE(LINE(J)(3*I-1:3*I),'(2A)') + CHAR(MOD(L,26)+IA), CHAR(L/26+IA) ENDIF ENDIF 50 CONTINUE 40 CONTINUE PRINT '(/,''Plane:'',I3)', K DO 60 J = NY, 0, -1 PRINT '(A)', LINE(J) PRINT * 60 CONTINUE 10 CONTINUE IF (IE .EQ. -1) RETURN PRINT '(///,''Legenda corners:'')' DO 100 L = 0, IE LINE(0) = ' ' IB = MOD(IEVAL(L),BYTE1) WRITE(LINE(0)(1:2),'(I2.1)') ILBND(IB) IEVAL(L) = IEVAL(L)/BYTE1 IB = MOD(IEVAL(L),BYTE1) WRITE(LINE(0)(3:4),'(I2.1)') ILBND(IB) IF (IB .EQ. IEVAL(L)) GOTO 110 IEVAL(L) = IEVAL(L)/BYTE1 IB = MOD(IEVAL(L),BYTE1) WRITE(LINE(0)(5:6),'(I2.1)') ILBND(IB) IF (IB .EQ. IEVAL(L)) GOTO 110 IEVAL(L) = IEVAL(L)/BYTE1 IB = MOD(IEVAL(L),BYTE1) WRITE(LINE(0)(7:8),'(I2.1)') ILBND(IB) 110 PRINT '(X,2A,'':'',A8)', CHAR(MOD(L,26)+IA), CHAR(L/26+IA), + LINE(0)(1:8) 100 CONTINUE RETURN END SUBROUTINE SETXYZ (XL, YF, ZD, DX, DY, DZ, + LPLN, IPLN, LROW, IROW, ICOL, X, Y, Z) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER LPLN(0:*), IPLN(*), LROW(*), IROW(*), ICOL(*) REAL XL, YF, ZD, DX, DY, DZ, X(*), Y(*), Z(*) C Ccc PURPOSE: C Store X-, Y- and Z-coordinates of the grid points. C Ccc PARAMETER DESCRIPTION: C XL : IN. X-coordinate of left/front/down point of virtual box C YF : IN. Y-coordinate of left/front/down point of virtual box C ZD : IN. Z-coordinate of left/front/down point of virtual box C DX : IN. Grid width in X-direction C DY : IN. Grid width in Y-direction C DZ : IN. Grid width in Z-direction C LPLN : IN. (0:LPLN(0)+1) C LPLN(0) = NPLNS: Actual # planes in LROW C LPLN(1:NPLNS): pointers to the start of a plane in LROW C LPLN(NPLNS+1) = NROWS+1: Total # rows in grid + 1 C IPLN : IN. (NPLNS) C IPLN(IP): plane number of plane IP in virtual box C LROW : IN. (NROWS+1) C LROW(1:NROWS): pointers to the start of a row in the grid C LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 C IROW : IN. (NROWS) C IROW(IR): row number of row IR in virtual box C ICOL : IN. (NPTS) C ICOL(IPT): column number of grid point IPT in virtual box C X : OUT. Contains the X-coordinates for the grid C Y : OUT. Contains the Y-coordinates for the grid C Z : OUT. Contains the Z-coordinates for the grid C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER IP, IPT, IR, NPLNS REAL YIR, ZIP C NPLNS = LPLN(0) DO 10 IP = 1, NPLNS ZIP = ZD + IPLN(IP)*DZ DO 20 IR = LPLN(IP), LPLN(IP+1)-1 YIR = YF + IROW(IR)*DY DO 30 IPT = LROW(IR), LROW(IR+1)-1 X(IPT) = XL + ICOL(IPT)*DX Y(IPT) = YIR Z(IPT) = ZIP 30 CONTINUE 20 CONTINUE 10 CONTINUE RETURN END SUBROUTINE PRSOL (LUN, T, NPDE, XL, YF, ZD, DXB, DYB, DZB, + LGRID, ISTRUC, LSOL, SOL) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER LUN, NPDE, LGRID(0:*), ISTRUC(*), LSOL(*) REAL T, XL, YF, ZD, DXB, DYB, DZB, SOL(*) C Ccc PURPOSE: C Print solution and coordinate values at all grid levels. C Ccc PARAMETER DESCRIPTION: C LUN : IN. Logical unit number of print file C T : IN. Current value of time variable C NPDE : IN. # PDE components C XL : IN. X-coordinate of left/front/down point of virtual box C YF : IN. Y-coordinate of left/front/down point of virtual box C ZD : IN. Z-coordinate of left/front/down point of virtual box C DXB : IN. Cell width in X-direction of base grid C DYB : IN. Cell width in Y-direction of base grid C DZB : IN. Cell width in Z-direction of base grid C LGRID : IN. (0:*) C LGRID(0) = max. grid level used at T C LGRID(1): pointer to base grid structure ISTRUC C LGRID(LEVEL): pointer to grid structure C (LPLN,IPLN,LROW,IROW,ICOL) C of refinement level LEVEL for time T C ISTRUC : IN. (*) C ISTRUC(LGRID(LEVEL):.) contains (LPLN,IPLN,LROW,IROW,ICOL) C of grid level LEVEL, C LPLN : (0:LPLN(0)+1) C LPLN(0) = NPLNS: Actual # planes in grid C LPLN(1:NPLNS): pointers to the start of a plane in LROW C LPLN(NPLNS+1) = NROWS+1: Actual # rows in grid + 1 C IPLN : (NPLNS) C IPLN(IP): plane number of plane IP in virtual box C LROW : (NROWS+1) C LROW(1:NROWS): pointers to the start of a row in the grid C LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 C IROW : (NROWS) C IROW(IR): row number of row IR in virtual box C ICOL : (NPTS) C ICOL(IPT): column number of grid point IPT in virtual box C LSOL : IN. (*) C LSOL(LEVEL): pointer to (injected) solution at grid C of refinement level LEVEL for time T C SOL : IN. (*) C SOL(LSOL(LEVEL)+1:LSOL(LEVEL)+NPTS(LEVEL)*NPDE) contains C U_LEVEL(NPTS,NPDE) C Ccc EXTERNALS USED: EXTERNAL PRSOLL C C----------------------------------------------------------------------- C INTEGER MAXLEV, LEVEL, LLPLN, LIPLN, LLROW, LIROW, LICOL, + NPLNS, NROWS, NPTS REAL DX, DY, DZ MAXLEV = LGRID(0) DX = DXB DY = DYB DZ = DZB DO 10 LEVEL = 1, MAXLEV LLPLN = LGRID(LEVEL) NPLNS = ISTRUC(LLPLN) NROWS = ISTRUC(LLPLN+NPLNS+1)-1 LIPLN = LLPLN+NPLNS+2 LLROW = LIPLN+NPLNS NPTS = ISTRUC(LLROW+NROWS)-1 LIROW = LLROW+NROWS+1 LICOL = LIROW+NROWS CALL PRSOLL (LUN, LEVEL, T, NPTS, NPDE, XL, YF, ZD, DX, DY, DZ, + ISTRUC(LLPLN), ISTRUC(LIPLN), ISTRUC(LLROW), ISTRUC(LIROW), + ISTRUC(LICOL), SOL(LSOL(LEVEL)+1)) DX = DX/2 DY = DY/2 DZ = DZ/2 10 CONTINUE RETURN END SUBROUTINE PRSOLL (LUN, LEVEL, T, NPTS, NPDE, XL, YF, ZD, + DX, DY, DZ, LPLN, IPLN, LROW, IROW, ICOL, U) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER LUN, LEVEL, NPTS, NPDE, LPLN(0:*), IPLN(*), + LROW(*), IROW(*), ICOL(*) REAL T, XL, YF, ZD, DX, DY, DZ, U(NPTS,NPDE) C Ccc PURPOSE: C Print solution and X-, Y- and Z-coordinates of gridlevel LEVEL. C Ccc PARAMETER DESCRIPTION: C LUN : IN. Logical unit number of print file C LEVEL : IN. Grid level corresponding with solution U. C T : IN. Current value of time variable C NPTS : IN. # grid points at this level C NPDE : IN. # PDE components C XL : IN. X-coordinate of left/front/down point of virtual box C YF : IN. Y-coordinate of left/front/down point of virtual box C ZD : IN. Z-coordinate of left/front/down point of virtual box C DX : IN. Grid width in X-direction C DY : IN. Grid width in Y-direction C DZ : IN. Grid width in Z-direction C LPLN : IN. (0:LPLN(0)+1) C LPLN(0) = NPLNS: Actual # planes in LROW C LPLN(1:NPLNS): pointers to the start of a plane in LROW C LPLN(NPLNS+1) = NROWS+1: Total # rows in grid + 1 C IPLN : IN. (NPLNS) C IPLN(IP): plane number of plane IP in virtual box C LROW : IN. (NROWS+1) C LROW(1:NROWS): pointers to the start of a row in the grid C LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 C IROW : IN. (NROWS) C IROW(IR): row number of row IR in virtual box C ICOL : IN. (NPTS) C ICOL(IPT): column number of grid point IPT in virtual box C U : IN. Solution on this grid level C Ccc EXTERNALS USED: NONE C C----------------------------------------------------------------------- C INTEGER IC, IP, IPT, IR, NPLNS REAL X, Y, Z C NPLNS = LPLN(0) WRITE(LUN,'(//// A,T14,A,T30,A,T46,A,T62,A,T71,A //)') + 'Lev', 't', 'Z', 'Y', 'X', 'Solution' IP = 1 Z = ZD + IPLN(IP)*DZ IR = LPLN(IP) Y = YF + IROW(IR)*DY IPT = LROW(IR) X = XL + ICOL(IPT)*DX WRITE(LUN, + '(I3,T5,E12.5,T21,E12.5,T37,E12.5,T53,E12.5,T69,E12.5)') + LEVEL, T, Z, Y, X, U(IPT,1) DO 10 IC = 2, NPDE WRITE(LUN,'(T69,E12.5)') U(IPT,IC) 10 CONTINUE DO 14 IPT = LROW(IR)+1, LROW(IR+1)-1 X = XL + ICOL(IPT)*DX WRITE(LUN, + '(T53,E12.5,T69,E12.5)') + X, U(IPT,1) DO 15 IC = 2, NPDE WRITE(LUN,'(T69,E12.5)') U(IPT,IC) 15 CONTINUE 14 CONTINUE DO 20 IR = LPLN(IP)+1, LPLN(IP+1)-1 Y = YF + IROW(IR)*DY IPT = LROW(IR) X = XL + ICOL(IPT)*DX WRITE(LUN, + '(T37,E12.5,T53,E12.5,T69,E12.5)') + Y, X, U(IPT,1) DO 30 IC = 2, NPDE WRITE(LUN,'(T69,E12.5)') U(IPT,IC) 30 CONTINUE DO 40 IPT = LROW(IR)+1, LROW(IR+1)-1 X = XL + ICOL(IPT)*DX WRITE(LUN, + '(T53,E12.5,T69,E12.5)') + X, U(IPT,1) DO 50 IC = 2, NPDE WRITE(LUN,'(T69,E12.5)') U(IPT,IC) 50 CONTINUE 40 CONTINUE 20 CONTINUE DO 100 IP = 2, NPLNS Z = ZD + IPLN(IP)*DZ IR = LPLN(IP) Y = YF + IROW(IR)*DY IPT = LROW(IR) X = XL + ICOL(IPT)*DX WRITE(LUN, + '(T21,E12.5,T37,E12.5,T53,E12.5,T69,E12.5)') + Z, Y, X, U(IPT,1) DO 110 IC = 2, NPDE WRITE(LUN,'(T69,E12.5)') U(IPT,IC) 110 CONTINUE DO 114 IPT = LROW(IR)+1, LROW(IR+1)-1 X = XL + ICOL(IPT)*DX WRITE(LUN, + '(T53,E12.5,T69,E12.5)') + X, U(IPT,1) DO 115 IC = 2, NPDE WRITE(LUN,'(T69,E12.5)') U(IPT,IC) 115 CONTINUE 114 CONTINUE DO 120 IR = LPLN(IP)+1, LPLN(IP+1)-1 Y = YF + IROW(IR)*DY IPT = LROW(IR) X = XL + ICOL(IPT)*DX WRITE(LUN, + '(T37,E12.5,T53,E12.5,T69,E12.5)') + Y, X, U(IPT,1) DO 130 IC = 2, NPDE WRITE(LUN,'(T69,E12.5)') U(IPT,IC) 130 CONTINUE DO 140 IPT = LROW(IR)+1, LROW(IR+1)-1 X = XL + ICOL(IPT)*DX WRITE(LUN, + '(T53,E12.5,T69,E12.5)') + X, U(IPT,1) DO 150 IC = 2, NPDE WRITE(LUN,'(T69,E12.5)') U(IPT,IC) 150 CONTINUE 140 CONTINUE 120 CONTINUE 100 CONTINUE RETURN END SUBROUTINE WRUNI (LUNS, LUNG, UNILEV, + T, NPDE, XL, YF, ZD, DXB, DYB, DZB, NXB, NYB, NZB, + LGRID, ISTRUC, LSOL, SOL, UNIFRM, NX, NY, NZ) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER LUNS, LUNG, UNILEV, + NPDE, NXB, NYB, NZB, LGRID(0:*), ISTRUC(*), LSOL(*), NX, NY, NZ REAL T, XL, YF, ZD, DXB, DYB, DZB, SOL(*), + UNIFRM(0:NX,0:NY,0:NZ,NPDE) C Ccc PURPOSE: C Write (interpolated) solution values at grid level UNILEV to file C LUNS. C Write maximum gridlevel used in each point to file LUNG. C NB. The data will not be correct for a domain with holes in it with C a size of the width of the base grid. C Ccc PARAMETER DESCRIPTION: C LUNS : IN. Logical unit number of solution file C LUNG : IN. Logical unit number of grid level file C UNILEV : IN. Maximum grid level to be used to generate the data C T : IN. Value of time variable C NPDE : IN. # PDE components C XL : IN. X-coordinate of left/front/down point of virtual box C YF : IN. Y-coordinate of left/front/down point of virtual box C ZD : IN. Z-coordinate of left/front/down point of virtual box C DXB : IN. Cell width in X-direction of base grid C DYB : IN. Cell width in Y-direction of base grid C DZB : IN. Cell width in Z-direction of base grid C NXB,NYB,NZB: IN. # gridcells in X-, Y- and Z-direction, resp., on grid C of base level C LGRID : IN. (0:*) C LGRID(0) = max. grid level used at T C LGRID(1): pointer to base grid structure ISTRUC C LGRID(LEVEL): pointer to grid structure C (LPLN,IPLN,LROW,IROW,ICOL) C of refinement level LEVEL for time T C ISTRUC : IN. (*) C ISTRUC(LGRID(LEVEL):.) contains (LPLN,IPLN,LROW,IROW,ICOL) C of grid level LEVEL, C LPLN : (0:LPLN(0)+1) C LPLN(0) = NPLNS: Actual # planes in grid C LPLN(1:NPLNS): pointers to the start of a plane in LROW C LPLN(NPLNS+1) = NROWS+1: Actual # rows in grid + 1 C IPLN : (NPLNS) C IPLN(IP): plane number of plane IP in virtual box C LROW : (NROWS+1) C LROW(1:NROWS): pointers to the start of a row in the grid C LROW(NROWS+1) = NPTS+1: Actual # nodes in grid + 1 C IROW : (NROWS) C IROW(IR): row number of row IR in virtual box C ICOL : (NPTS) C ICOL(IPT): column number of grid point IPT in virtual box C LSOL : IN. (*) C LSOL(LEVEL): pointer to (injected) solution at grid C of refinement level LEVEL for time T C SOL : IN. (*) C SOL(LSOL(LEVEL)+1:LSOL(LEVEL)+NPTS(LEVEL)*NPDE) contains C U_LEVEL(NPTS,NPDE) C UNIFRM : WORK. (Interpolated) solution on level UNILEV / max. grid C level used. C NX,NY,NZ: IN. # gridcells in X-, Y- and Z-direction, resp., on grid C of level UNILEV C C----------------------------------------------------------------------- C C !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! C !!! !!! C !!! In subroutine WRUNI the constant NONVAL should be adjusted to !!! C !!! the data (NONVAL = impossible value for the first componenent) !!! C !!! !!! REAL NONVAL PARAMETER (NONVAL = -999.999) C !!! !!! C !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! C C----------------------------------------------------------------------- C INTEGER I, IC, ICOL, IMUL, IP, IPLN, IPT, IR, IROW, J, K, + LEVEL, LLPLN, LIPLN, LLROW, LIROW, LICOL, MAXLEV, + NPLNS, NROWS, NPTS DO 1 IC = 1, NPDE DO 1 IPLN = 0, NZ DO 1 IROW = 0, NY DO 1 ICOL = 0, NX UNIFRM(ICOL,IROW,IPLN,IC) = NONVAL 1 CONTINUE MAXLEV = LGRID(0) DO 10 LEVEL = 1, UNILEV IMUL = 2**(UNILEV-LEVEL) LLPLN = LGRID(LEVEL) NPLNS = ISTRUC(LLPLN) NROWS = ISTRUC(LLPLN+NPLNS+1)-1 LIPLN = LLPLN+NPLNS+2 LLROW = LIPLN+NPLNS NPTS = ISTRUC(LLROW+NROWS)-1 LIROW = LLROW+NROWS+1 LICOL = LIROW+NROWS DO 20 IP = 1, NPLNS IPLN = ISTRUC(LIPLN-1+IP)*IMUL DO 30 IR = ISTRUC(LLPLN+IP), ISTRUC(LLPLN+IP+1)-1 IROW = ISTRUC(LIROW-1+IR)*IMUL DO 40 IPT = ISTRUC(LLROW-1+IR), ISTRUC(LLROW+IR)-1 ICOL = ISTRUC(LICOL-1+IPT)*IMUL DO 50 IC = 1, NPDE UNIFRM(ICOL,IROW,IPLN,IC) = + SOL(LSOL(LEVEL)+(IC-1)*NPTS+IPT) 50 CONTINUE 40 CONTINUE 30 CONTINUE 20 CONTINUE 10 CONTINUE DO 100 LEVEL = 2, UNILEV IMUL = 2**(UNILEV-LEVEL) DO 110 K = IMUL, NZ, IMUL*2 DO 110 J = 0, NY, IMUL*2 DO 110 I = 0, NX, IMUL*2 IF (UNIFRM(I,J,K,1) .EQ. NONVAL) THEN DO 120 IC = 1, NPDE UNIFRM(I,J,K,IC) = + (UNIFRM(I,J,K-IMUL,IC)+UNIFRM(I,J,K+IMUL,IC))/2 120 CONTINUE ENDIF 110 CONTINUE DO 130 K = 0, NZ, IMUL DO 130 J = IMUL, NY, IMUL*2 DO 130 I = 0, NX, IMUL*2 IF (UNIFRM(I,J,K,1) .EQ. NONVAL) THEN DO 140 IC = 1, NPDE UNIFRM(I,J,K,IC) = + (UNIFRM(I,J-IMUL,K,IC)+UNIFRM(I,J+IMUL,K,IC))/2 140 CONTINUE ENDIF 130 CONTINUE DO 150 K = 0, NZ, IMUL DO 150 J = 0, NY, IMUL DO 150 I = IMUL, NX, IMUL*2 IF (UNIFRM(I,J,K,1) .EQ. NONVAL) THEN DO 160 IC = 1, NPDE UNIFRM(I,J,K,IC) = + (UNIFRM(I-IMUL,J,K,IC)+UNIFRM(I+IMUL,J,K,IC))/2 160 CONTINUE ENDIF 150 CONTINUE 100 CONTINUE DO 170 K = 0, NZ DO 170 J = 0, NY DO 170 I = 0, NX WRITE(LUNS,'(100E13.3)') (UNIFRM(I,J,K,IC), IC = 1, NPDE) 170 CONTINUE C C Grids DO 201 IPLN = 0, NZ DO 201 IROW = 0, NY DO 201 ICOL = 0, NX UNIFRM(ICOL,IROW,IPLN,1) = 0 201 CONTINUE DO 210 LEVEL = 1, UNILEV IMUL = 2**(UNILEV-LEVEL) LLPLN = LGRID(LEVEL) NPLNS = ISTRUC(LLPLN) NROWS = ISTRUC(LLPLN+NPLNS+1)-1 LIPLN = LLPLN+NPLNS+2 LLROW = LIPLN+NPLNS NPTS = ISTRUC(LLROW+NROWS)-1 LIROW = LLROW+NROWS+1 LICOL = LIROW+NROWS DO 220 IP = 1, NPLNS IPLN = ISTRUC(LIPLN-1+IP)*IMUL DO 230 IR = ISTRUC(LLPLN+IP), ISTRUC(LLPLN+IP+1)-1 IROW = ISTRUC(LIROW-1+IR)*IMUL DO 240 IPT = ISTRUC(LLROW-1+IR), ISTRUC(LLROW+IR)-1 ICOL = ISTRUC(LICOL-1+IPT)*IMUL UNIFRM(ICOL,IROW,IPLN,1) = LEVEL 240 CONTINUE 230 CONTINUE 220 CONTINUE 210 CONTINUE DO 300 LEVEL = 2, UNILEV IMUL = 2**(UNILEV-LEVEL) DO 310 K = IMUL, NZ, IMUL*2 DO 310 J = 0, NY, IMUL*2 DO 310 I = 0, NX, IMUL*2 IF (UNIFRM(I,J,K,1) .LT. LEVEL) THEN UNIFRM(I,J,K,1) = + MIN(UNIFRM(I,J,K-IMUL,1),UNIFRM(I,J,K+IMUL,1)) ENDIF 310 CONTINUE DO 320 K = 0, NZ, IMUL DO 320 J = IMUL, NY, IMUL*2 DO 320 I = 0, NX, IMUL*2 IF (UNIFRM(I,J,K,1) .LT. LEVEL) THEN UNIFRM(I,J,K,1) = + MIN(UNIFRM(I,J-IMUL,K,1),UNIFRM(I,J+IMUL,K,1)) ENDIF 320 CONTINUE DO 330 K = 0, NZ, IMUL DO 330 J = 0, NY, IMUL DO 330 I = IMUL, NX, IMUL*2 IF (UNIFRM(I,J,K,1) .LT. LEVEL) THEN UNIFRM(I,J,K,1) = + MIN(UNIFRM(I-IMUL,J,K,1),UNIFRM(I+IMUL,J,K,1)) ENDIF 330 CONTINUE 300 CONTINUE DO 350 K = 0, NZ DO 350 J = 0, NY DO 350 I = 0, NX WRITE(LUNG,'(I2)') NINT(UNIFRM(I,J,K,1)) 350 CONTINUE RETURN END SUBROUTINE DUMP (LUNDMP, RWK, IWK) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER LUNDMP, IWK(*) REAL RWK(*) C Ccc PURPOSE: C Dump all information necessary for a restart of VLUGR3 on file C Ccc PARAMETER DESCRIPTION: C LUNDMP : IN. Logical unit number of dumpfile. Should be opened as an C unformatted file. C RWK : IN. Real workstorage as returned from VLUGR3 C IWK : IN. Integer workstorage as returned from VLUGR3 C Ccc EXTERNALS USED: NONE C C Ccc INCLUDE 'CMNSTATS' C C CMNSTATS C C COMMON with integration statistics INTEGER MXCLEV, MXCNIT PARAMETER (MXCLEV = 10, MXCNIT = 20) INTEGER LUNPDS, LUNNLS, LUNLSS, LEVEL, NSTEPS, NREJS, + NJACS(MXCLEV), NRESID(MXCLEV), NNIT(MXCLEV), + NLSIT(MXCLEV,MXCNIT) COMMON /STATS/ LUNPDS, LUNNLS, LUNLSS, LEVEL, NSTEPS, NREJS, + NJACS, NRESID, NNIT, NLSIT SAVE /STATS/ C C end INCLUDE 'CMNSTATS' C C Ccc INCLUDE 'CMNWRITEF' C C CMNWRITEF C C COMMON needed for continuation calls INTEGER MAXLVW, NPDEW, LRWKPS, LIWKPS, LRWKB, LIWKB LOGICAL FIRST, SECOND REAL T0,TW,TEW,DTW, XLW,YFW,ZDW, XRW,YBW,ZUW, DXB,DYB,DZB, DTO COMMON /WRITIF/ MAXLVW, NPDEW, LRWKPS, LIWKPS, LRWKB, LIWKB COMMON /WRITLF/ FIRST, SECOND COMMON /WRITRF/ T0,TW,TEW,DTW, XLW,YFW,ZDW, XRW,YBW,ZUW, + DXB,DYB,DZB, DTO SAVE /WRITIF/, /WRITLF/, /WRITRF/ C C end INCLUDE 'CMNWRITEF' C C C----------------------------------------------------------------------- C INTEGER I, J WRITE(LUNDMP) MAXLVW, NPDEW, LRWKPS, LIWKPS, LRWKB, LIWKB, + FIRST, SECOND, + T0,TW,TEW,DTW, XLW,YFW,ZDW, XRW,YBW,ZUW, DXB,DYB,DZB, DTO WRITE(LUNDMP) LUNPDS, LUNNLS, LUNLSS, LEVEL, NSTEPS, NREJS, + (NJACS(I), I=1,MXCLEV), (NRESID(I), I=1,MXCLEV), + (NNIT(I), I=1,MXCLEV), ((NLSIT(I,J), I=1,MXCLEV), J=1,MXCNIT) WRITE(LUNDMP) (RWK(I), I=1,LRWKPS+LRWKB) WRITE(LUNDMP) (IWK(I), I=1,LIWKPS+LIWKB) RETURN END SUBROUTINE RDDUMP (LUNDMP, RWK, LENRWK, IWK, LENIWK) C C----------------------------------------------------------------------- C Ccc PARAMETER SPECIFICATION: INTEGER LENIWK INTEGER LUNDMP, LENRWK, IWK(LENIWK) REAL RWK(LENRWK) C Ccc PURPOSE: C Read all information necessary for a restart of VLUGR3 from file C Ccc PARAMETER DESCRIPTION: C LUNDMP : IN. Logical unit number of dumpfile. Should be opened as an C unformatted file. C RWK : OUT. Real workstorage intended to pass to VLUGR3 C LENRWK : IN. Dimension of RWK. C IWK : OUT. Integer workstorage intended to pass to VLUGR3 C LENIWK : IN. Dimension of IWK. C Ccc EXTERNALS USED: NONE C C Ccc INCLUDE 'CMNSTATS' C C CMNSTATS C C COMMON with integration statistics INTEGER MXCLEV, MXCNIT PARAMETER (MXCLEV = 10, MXCNIT = 20) INTEGER LUNPDS, LUNNLS, LUNLSS, LEVEL, NSTEPS, NREJS, + NJACS(MXCLEV), NRESID(MXCLEV), NNIT(MXCLEV), + NLSIT(MXCLEV,MXCNIT) COMMON /STATS/ LUNPDS, LUNNLS, LUNLSS, LEVEL, NSTEPS, NREJS, + NJACS, NRESID, NNIT, NLSIT SAVE /STATS/ C C end INCLUDE 'CMNSTATS' C C Ccc INCLUDE 'CMNWRITEF' C C CMNWRITEF C C COMMON needed for continuation calls INTEGER MAXLVW, NPDEW, LRWKPS, LIWKPS, LRWKB, LIWKB LOGICAL FIRST, SECOND REAL T0,TW,TEW,DTW, XLW,YFW,ZDW, XRW,YBW,ZUW, DXB,DYB,DZB, DTO COMMON /WRITIF/ MAXLVW, NPDEW, LRWKPS, LIWKPS, LRWKB, LIWKB COMMON /WRITLF/ FIRST, SECOND COMMON /WRITRF/ T0,TW,TEW,DTW, XLW,YFW,ZDW, XRW,YBW,ZUW, + DXB,DYB,DZB, DTO SAVE /WRITIF/, /WRITLF/, /WRITRF/ C C end INCLUDE 'CMNWRITEF' C C C----------------------------------------------------------------------- C INTEGER I, J READ(LUNDMP) MAXLVW, NPDEW, LRWKPS, LIWKPS, LRWKB, LIWKB, + FIRST, SECOND, + T0,TW,TEW,DTW, XLW,YFW,ZDW, XRW,YBW,ZUW, DXB,DYB,DZB, DTO IF (LENRWK .LT. LRWKPS+LRWKB .OR. LENIWK .LT. LIWKPS+LIWKB) THEN PRINT *, LENRWK, LRWKPS+LRWKB, LENIWK, LIWKPS+LIWKB STOP 'work space too small' ENDIF READ(LUNDMP) LUNPDS, LUNNLS, LUNLSS, LEVEL, NSTEPS, NREJS, + (NJACS(I), I=1,MXCLEV), (NRESID(I), I=1,MXCLEV), + (NNIT(I), I=1,MXCLEV), ((NLSIT(I,J), I=1,MXCLEV), J=1,MXCNIT) READ(LUNDMP) (RWK(I), I=1,LRWKPS+LRWKB) READ(LUNDMP) (IWK(I), I=1,LIWKPS+LIWKB) C RETURN END LOGICAL FUNCTION CHKWRK (LRWKN, LENRWK, LIWKN, LENIWK, + LLWKN, LENLWK) C----------------------------------------------------------------------- INTEGER LRWKN, LENRWK, LIWKN, LENIWK, LLWKN, LENLWK C C Ccc INCLUDE 'CMNCMMACH' C C CMNCMMACH C C COMMON with `machine numbers' C LUNOUT : Logical unit # standard output -I C LUNERR : Logical unit # standard error I Set in the routine C UROUND : Smallest machine number such that I MACNUM C 1.0+UROUND > 1.0 and 1.0-UROUND < 1.0 I C XMIN : Smallest floating-point number -I INTEGER LUNOUT, LUNERR REAL UROUND, XMIN COMMON /IMACH/ LUNOUT, LUNERR COMMON /RMACH/ UROUND, XMIN SAVE /IMACH/, /RMACH/ C C end INCLUDE 'CMNCMMACH' C C----------------------------------------------------------------------- CHKWRK = .TRUE. IF (LRWKN .GT. LENRWK) THEN WRITE(LUNERR, + '(''Real workspace too small, required at least:'',I10)') + LRWKN CHKWRK = .FALSE. ENDIF IF (LIWKN .GT. LENIWK) THEN WRITE(LUNERR, + '(''Integer workspace too small, required at least:'',I10)') + LIWKN CHKWRK = .FALSE. ENDIF IF (LLWKN .GT. LENLWK) THEN WRITE(LUNERR, + '(''Logical workspace too small, required at least:'',I10)') + LLWKN CHKWRK = .FALSE. ENDIF RETURN END SUBROUTINE ERRWGT (NPTS, NPDE, U, RELTOL, ABSTOL, WT) C----------------------------------------------------------------------- INTEGER NPTS, NPDE REAL U(NPTS,NPDE), RELTOL(NPDE), ABSTOL(NPDE), WT(NPTS,NPDE) C----------------------------------------------------------------------- INTEGER IC, IPT REAL SN SN = 1.0/SQRT(REAL(NPTS*NPDE)) DO 10 IC = 1, NPDE DO 20 IPT = 1, NPTS WT(IPT,IC) = SN/(RELTOL(IC)*ABS(U(IPT,IC)) + ABSTOL(IC)) 20 CONTINUE 10 CONTINUE RETURN END REAL FUNCTION MAXNRM (N, V) C----------------------------------------------------------------------- INTEGER N REAL V(N) C----------------------------------------------------------------------- INTEGER I MAXNRM = 0.0 DO 10 I = 1, N MAXNRM = MAX(MAXNRM, ABS(V(I))) 10 CONTINUE RETURN END REAL FUNCTION WMXNRM (N, V, W) C----------------------------------------------------------------------- INTEGER N REAL V(N), W(N) C----------------------------------------------------------------------- INTEGER I WMXNRM = 0.0 DO 10 I = 1, N WMXNRM = MAX(WMXNRM, ABS(V(I)*W(I))) 10 CONTINUE WMXNRM = WMXNRM*SQRT(REAL(N)) RETURN END REAL FUNCTION WSNRM2 (N, V, W) C----------------------------------------------------------------------- INTEGER N REAL V(N), W(N) C----------------------------------------------------------------------- INTEGER I WSNRM2 = 0.0 DO 10 I = 1, N WSNRM2 = WSNRM2 + (V(I)*W(I))**2 10 CONTINUE WSNRM2 = SQRT(WSNRM2) RETURN END SUBROUTINE ICOPY (LEN, A, B) C----------------------------------------------------------------------- INTEGER LEN INTEGER A(LEN), B(LEN) C----------------------------------------------------------------------- INTEGER I DO 10 I = 1, LEN B(I) = A(I) 10 CONTINUE RETURN END SUBROUTINE IYPOC (LEN, A, B) C----------------------------------------------------------------------- INTEGER LEN INTEGER A(LEN), B(LEN) C----------------------------------------------------------------------- INTEGER I DO 10 I = LEN, 1, -1 B(I) = A(I) 10 CONTINUE RETURN END SUBROUTINE RCOPY (LEN, A, B) C----------------------------------------------------------------------- INTEGER LEN REAL A(LEN), B(LEN) C----------------------------------------------------------------------- INTEGER I DO 10 I = 1, LEN B(I) = A(I) 10 CONTINUE RETURN END SUBROUTINE ZERO (LEN, A) C----------------------------------------------------------------------- INTEGER LEN REAL A(LEN) C----------------------------------------------------------------------- INTEGER I DO 10 I = 1, LEN A(I) = 0.0 10 CONTINUE RETURN END SUBROUTINE MACNUM C----------------------------------------------------------------------- C Ccc INCLUDE 'CMNCMMACH' C C CMNCMMACH C C COMMON with `machine numbers' C LUNOUT : Logical unit # standard output -I C LUNERR : Logical unit # standard error I Set in the routine C UROUND : Smallest machine number such that I MACNUM C 1.0+UROUND > 1.0 and 1.0-UROUND < 1.0 I C XMIN : Smallest floating-point number -I INTEGER LUNOUT, LUNERR REAL UROUND, XMIN COMMON /IMACH/ LUNOUT, LUNERR COMMON /RMACH/ UROUND, XMIN SAVE /IMACH/, /RMACH/ C C end INCLUDE 'CMNCMMACH' C Ccc EXTERNALS USED: INTEGER I1MACH REAL R1MACH EXTERNAL R1MACH, I1MACH C----------------------------------------------------------------------- C LUNOUT = I1MACH(2) LUNERR = I1MACH(4) UROUND = R1MACH(4) XMIN = R1MACH(1) RETURN END SHAR_EOF fi # end of overwriting check if test -f 'port.f' then echo shar: will not over-write existing file "'port.f'" else cat << \SHAR_EOF > 'port.f' INTEGER FUNCTION I1MACH(I) INTEGER I C C I/O UNIT NUMBERS. C C I1MACH( 1) = THE STANDARD INPUT UNIT. C C I1MACH( 2) = THE STANDARD OUTPUT UNIT. C C I1MACH( 3) = THE STANDARD PUNCH UNIT. C C I1MACH( 4) = THE STANDARD ERROR MESSAGE UNIT. C C WORDS. C C I1MACH( 5) = THE NUMBER OF BITS PER INTEGER STORAGE UNIT. C C I1MACH( 6) = THE NUMBER OF CHARACTERS PER CHARACTER STORAGE UNIT. C FOR FORTRAN 77, THIS IS ALWAYS 1. FOR FORTRAN 66, C CHARACTER STORAGE UNIT = INTEGER STORAGE UNIT. C C INTEGERS. C C ASSUME INTEGERS ARE REPRESENTED IN THE S-DIGIT, BASE-A FORM C C SIGN ( X(S-1)*A**(S-1) + ... + X(1)*A + X(0) ) C C WHERE 0 .LE. X(I) .LT. A FOR I=0,...,S-1. C C I1MACH( 7) = A, THE BASE. C C I1MACH( 8) = S, THE NUMBER OF BASE-A DIGITS. C C I1MACH( 9) = A**S - 1, THE LARGEST MAGNITUDE. C C FLOATING-POINT NUMBERS. C C ASSUME FLOATING-POINT NUMBERS ARE REPRESENTED IN THE T-DIGIT, C BASE-B FORM C C SIGN (B**E)*( (X(1)/B) + ... + (X(T)/B**T) ) C C WHERE 0 .LE. X(I) .LT. B FOR I=1,...,T, C 0 .LT. X(1), AND EMIN .LE. E .LE. EMAX. C C I1MACH(10) = B, THE BASE. C C SINGLE-PRECISION C C I1MACH(11) = T, THE NUMBER OF BASE-B DIGITS. C C I1MACH(12) = EMIN, THE SMALLEST EXPONENT E. C C I1MACH(13) = EMAX, THE LARGEST EXPONENT E. C C DOUBLE-PRECISION C C I1MACH(14) = T, THE NUMBER OF BASE-B DIGITS. C C I1MACH(15) = EMIN, THE SMALLEST EXPONENT E. C C I1MACH(16) = EMAX, THE LARGEST EXPONENT E. C C TO ALTER THIS FUNCTION FOR A PARTICULAR ENVIRONMENT, C THE DESIRED SET OF DATA STATEMENTS SHOULD BE ACTIVATED BY C REMOVING THE C FROM COLUMN 1. ALSO, THE VALUES OF C I1MACH(1) - I1MACH(4) SHOULD BE CHECKED FOR CONSISTENCY C WITH THE LOCAL OPERATING SYSTEM. FOR FORTRAN 77, YOU MAY WISH C TO ADJUST THE DATA STATEMENT SO IMACH(6) IS SET TO 1, AND C THEN TO COMMENT OUT THE EXECUTABLE TEST ON I .EQ. 6 BELOW. C C FOR IEEE-ARITHMETIC MACHINES (BINARY STANDARD), THE FIRST C SET OF CONSTANTS BELOW SHOULD BE APPROPRIATE, EXCEPT PERHAPS C FOR IMACH(1) - IMACH(4). C C COMMENTS JUST BEFORE THE END STATEMENT (LINES STARTING WITH *) C GIVE C SOURCE FOR I1MACH. C INTEGER CRAY1, IMACH(16), OUTPUT, SANITY, SMALL(2) COMMON /D8MACH/ CRAY1 C/6S C/7S SAVE IMACH, SANITY C/ REAL RMACH C EQUIVALENCE (IMACH(4),OUTPUT), (RMACH,SMALL(1)) C C MACHINE CONSTANTS FOR IEEE ARITHMETIC MACHINES, SUCH AS THE AT&T C 3B SERIES, MOTOROLA 68000 BASED MACHINES (E.G. SUN 3 AND AT&T C PC 7300), AND 8087 BASED MICROS (E.G. IBM PC AND AT&T 6300). C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 32 / C DATA IMACH( 6) / 4 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 31 / C DATA IMACH( 9) / 2147483647 / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 24 / C DATA IMACH(12) / -125 / C DATA IMACH(13) / 128 / C DATA IMACH(14) / 53 / C DATA IMACH(15) / -1021 / C DATA IMACH(16) / 1024 /, SANITY/987/ C C MACHINE CONSTANTS FOR AMDAHL MACHINES. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 32 / C DATA IMACH( 6) / 4 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 31 / C DATA IMACH( 9) / 2147483647 / C DATA IMACH(10) / 16 / C DATA IMACH(11) / 6 / C DATA IMACH(12) / -64 / C DATA IMACH(13) / 63 / C DATA IMACH(14) / 14 / C DATA IMACH(15) / -64 / C DATA IMACH(16) / 63 /, SANITY/987/ C C MACHINE CONSTANTS FOR THE BURROUGHS 1700 SYSTEM. C C DATA IMACH( 1) / 7 / C DATA IMACH( 2) / 2 / C DATA IMACH( 3) / 2 / C DATA IMACH( 4) / 2 / C DATA IMACH( 5) / 36 / C DATA IMACH( 6) / 4 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 33 / C DATA IMACH( 9) / Z1FFFFFFFF / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 24 / C DATA IMACH(12) / -256 / C DATA IMACH(13) / 255 / C DATA IMACH(14) / 60 / C DATA IMACH(15) / -256 / C DATA IMACH(16) / 255 /, SANITY/987/ C C MACHINE CONSTANTS FOR THE BURROUGHS 5700 SYSTEM. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 48 / C DATA IMACH( 6) / 6 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 39 / C DATA IMACH( 9) / O0007777777777777 / C DATA IMACH(10) / 8 / C DATA IMACH(11) / 13 / C DATA IMACH(12) / -50 / C DATA IMACH(13) / 76 / C DATA IMACH(14) / 26 / C DATA IMACH(15) / -50 / C DATA IMACH(16) / 76 /, SANITY/987/ C C MACHINE CONSTANTS FOR THE BURROUGHS 6700/7700 SYSTEMS. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 48 / C DATA IMACH( 6) / 6 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 39 / C DATA IMACH( 9) / O0007777777777777 / C DATA IMACH(10) / 8 / C DATA IMACH(11) / 13 / C DATA IMACH(12) / -50 / C DATA IMACH(13) / 76 / C DATA IMACH(14) / 26 / C DATA IMACH(15) / -32754 / C DATA IMACH(16) / 32780 /, SANITY/987/ C C MACHINE CONSTANTS FOR FTN4 ON THE CDC 6000/7000 SERIES. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 60 / C DATA IMACH( 6) / 10 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 48 / C DATA IMACH( 9) / 00007777777777777777B / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 47 / C DATA IMACH(12) / -929 / C DATA IMACH(13) / 1070 / C DATA IMACH(14) / 94 / C DATA IMACH(15) / -929 / C DATA IMACH(16) / 1069 /, SANITY/987/ C C MACHINE CONSTANTS FOR FTN5 ON THE CDC 6000/7000 SERIES. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 60 / C DATA IMACH( 6) / 10 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 48 / C DATA IMACH( 9) / O"00007777777777777777" / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 47 / C DATA IMACH(12) / -929 / C DATA IMACH(13) / 1070 / C DATA IMACH(14) / 94 / C DATA IMACH(15) / -929 / C DATA IMACH(16) / 1069 /, SANITY/987/ C C MACHINE CONSTANTS FOR CONVEX C-1. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 32 / C DATA IMACH( 6) / 4 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 31 / C DATA IMACH( 9) / 2147483647 / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 24 / C DATA IMACH(12) / -128 / C DATA IMACH(13) / 127 / C DATA IMACH(14) / 53 / C DATA IMACH(15) /-1024 / C DATA IMACH(16) / 1023 /, SANITY/987/ C C MACHINE CONSTANTS FOR THE CRAY 1, XMP, 2, AND 3. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 102 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 64 / C DATA IMACH( 6) / 8 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 63 / C DATA IMACH( 9) / 777777777777777777777B / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 47 / C DATA IMACH(12) / -8189 / C DATA IMACH(13) / 8190 / C DATA IMACH(14) / 94 / C DATA IMACH(15) / -8099 / C DATA IMACH(16) / 8190 /, SANITY/987/ C C MACHINE CONSTANTS FOR THE DATA GENERAL ECLIPSE S/200. C C DATA IMACH( 1) / 11 / C DATA IMACH( 2) / 12 / C DATA IMACH( 3) / 8 / C DATA IMACH( 4) / 10 / C DATA IMACH( 5) / 16 / C DATA IMACH( 6) / 2 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 15 / C DATA IMACH( 9) /32767 / C DATA IMACH(10) / 16 / C DATA IMACH(11) / 6 / C DATA IMACH(12) / -64 / C DATA IMACH(13) / 63 / C DATA IMACH(14) / 14 / C DATA IMACH(15) / -64 / C DATA IMACH(16) / 63 /, SANITY/987/ C C MACHINE CONSTANTS FOR THE HARRIS SLASH 6 AND SLASH 7. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 0 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 24 / C DATA IMACH( 6) / 3 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 23 / C DATA IMACH( 9) / 8388607 / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 23 / C DATA IMACH(12) / -127 / C DATA IMACH(13) / 127 / C DATA IMACH(14) / 38 / C DATA IMACH(15) / -127 / C DATA IMACH(16) / 127 /, SANITY/987/ C C MACHINE CONSTANTS FOR THE HONEYWELL DPS 8/70 SERIES. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 43 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 36 / C DATA IMACH( 6) / 4 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 35 / C DATA IMACH( 9) / O377777777777 / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 27 / C DATA IMACH(12) / -127 / C DATA IMACH(13) / 127 / C DATA IMACH(14) / 63 / C DATA IMACH(15) / -127 / C DATA IMACH(16) / 127 /, SANITY/987/ C C MACHINE CONSTANTS FOR THE IBM 360/370 SERIES, C THE XEROX SIGMA 5/7/9 AND THE SEL SYSTEMS 85/86. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 32 / C DATA IMACH( 6) / 4 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 31 / C DATA IMACH( 9) / Z7FFFFFFF / C DATA IMACH(10) / 16 / C DATA IMACH(11) / 6 / C DATA IMACH(12) / -64 / C DATA IMACH(13) / 63 / C DATA IMACH(14) / 14 / C DATA IMACH(15) / -64 / C DATA IMACH(16) / 63 /, SANITY/987/ C C MACHINE CONSTANTS FOR THE INTERDATA 8/32 C WITH THE UNIX SYSTEM FORTRAN 77 COMPILER. C C FOR THE INTERDATA FORTRAN VII COMPILER REPLACE C THE Z'S SPECIFYING HEX CONSTANTS WITH Y'S. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 6 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 32 / C DATA IMACH( 6) / 4 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 31 / C DATA IMACH( 9) / Z'7FFFFFFF' / C DATA IMACH(10) / 16 / C DATA IMACH(11) / 6 / C DATA IMACH(12) / -64 / C DATA IMACH(13) / 62 / C DATA IMACH(14) / 14 / C DATA IMACH(15) / -64 / C DATA IMACH(16) / 62 /, SANITY/987/ C C MACHINE CONSTANTS FOR THE PDP-10 (KA PROCESSOR). C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 36 / C DATA IMACH( 6) / 5 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 35 / C DATA IMACH( 9) / "377777777777 / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 27 / C DATA IMACH(12) / -128 / C DATA IMACH(13) / 127 / C DATA IMACH(14) / 54 / C DATA IMACH(15) / -101 / C DATA IMACH(16) / 127 /, SANITY/987/ C C MACHINE CONSTANTS FOR THE PDP-10 (KI PROCESSOR). C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 36 / C DATA IMACH( 6) / 5 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 35 / C DATA IMACH( 9) / "377777777777 / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 27 / C DATA IMACH(12) / -128 / C DATA IMACH(13) / 127 / C DATA IMACH(14) / 62 / C DATA IMACH(15) / -128 / C DATA IMACH(16) / 127 /, SANITY/987/ C C MACHINE CONSTANTS FOR PDP-11 FORTRANS SUPPORTING C 32-BIT INTEGER ARITHMETIC. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 32 / C DATA IMACH( 6) / 4 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 31 / C DATA IMACH( 9) / 2147483647 / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 24 / C DATA IMACH(12) / -127 / C DATA IMACH(13) / 127 / C DATA IMACH(14) / 56 / C DATA IMACH(15) / -127 / C DATA IMACH(16) / 127 /, SANITY/987/ C C MACHINE CONSTANTS FOR PDP-11 FORTRANS SUPPORTING C 16-BIT INTEGER ARITHMETIC. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 16 / C DATA IMACH( 6) / 2 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 15 / C DATA IMACH( 9) / 32767 / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 24 / C DATA IMACH(12) / -127 / C DATA IMACH(13) / 127 / C DATA IMACH(14) / 56 / C DATA IMACH(15) / -127 / C DATA IMACH(16) / 127 /, SANITY/987/ C C MACHINE CONSTANTS FOR THE PRIME 50 SERIES SYSTEMS C WTIH 32-BIT INTEGERS AND 64V MODE INSTRUCTIONS, C SUPPLIED BY IGOR BRAY. C C DATA IMACH( 1) / 1 / C DATA IMACH( 2) / 1 / C DATA IMACH( 3) / 2 / C DATA IMACH( 4) / 1 / C DATA IMACH( 5) / 32 / C DATA IMACH( 6) / 4 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 31 / C DATA IMACH( 9) / :17777777777 / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 23 / C DATA IMACH(12) / -127 / C DATA IMACH(13) / +127 / C DATA IMACH(14) / 47 / C DATA IMACH(15) / -32895 / C DATA IMACH(16) / +32637 /, SANITY/987/ C C MACHINE CONSTANTS FOR THE SEQUENT BALANCE 8000. C C DATA IMACH( 1) / 0 / C DATA IMACH( 2) / 0 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 0 / C DATA IMACH( 5) / 32 / C DATA IMACH( 6) / 1 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 31 / C DATA IMACH( 9) / 2147483647 / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 24 / C DATA IMACH(12) / -125 / C DATA IMACH(13) / 128 / C DATA IMACH(14) / 53 / C DATA IMACH(15) / -1021 / C DATA IMACH(16) / 1024 /, SANITY/987/ C C MACHINE CONSTANTS FOR THE UNIVAC 1100 SERIES. C C NOTE THAT THE PUNCH UNIT, I1MACH(3), HAS BEEN SET TO 7 C WHICH IS APPROPRIATE FOR THE UNIVAC-FOR SYSTEM. C IF YOU HAVE THE UNIVAC-FTN SYSTEM, SET IT TO 1. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 36 / C DATA IMACH( 6) / 6 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 35 / C DATA IMACH( 9) / O377777777777 / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 27 / C DATA IMACH(12) / -128 / C DATA IMACH(13) / 127 / C DATA IMACH(14) / 60 / C DATA IMACH(15) /-1024 / C DATA IMACH(16) / 1023 /, SANITY/987/ C C MACHINE CONSTANTS FOR VAX. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 32 / C DATA IMACH( 6) / 4 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 31 / C DATA IMACH( 9) / 2147483647 / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 24 / C DATA IMACH(12) / -127 / C DATA IMACH(13) / 127 / C DATA IMACH(14) / 56 / C DATA IMACH(15) / -127 / C DATA IMACH(16) / 127 /, SANITY/987/ C C *** ISSUE STOP 775 IF ALL DATA STATEMENTS ARE COMMENTED... IF (SANITY .NE. 987) THEN * *** CHECK FOR AUTODOUBLE *** SMALL(2) = 0 RMACH = 1E13 IF (SMALL(2) .NE. 0) THEN * *** AUTODOUBLED *** IF ( (SMALL(1) .EQ. 1117925532 * .AND. SMALL(2) .EQ. -448790528) * .OR. (SMALL(2) .EQ. 1117925532 * .AND. SMALL(1) .EQ. -448790528)) THEN * *** IEEE *** IMACH(10) = 2 IMACH(14) = 53 IMACH(15) = -1021 IMACH(16) = 1024 ELSE IF ( SMALL(1) .EQ. -2065213935 * .AND. SMALL(2) .EQ. 10752) THEN * *** VAX WITH D_FLOATING *** IMACH(10) = 2 IMACH(14) = 56 IMACH(15) = -127 IMACH(16) = 127 ELSE IF ( SMALL(1) .EQ. 1267827943 * .AND. SMALL(2) .EQ. 704643072) THEN * *** IBM MAINFRAME *** IMACH(10) = 16 IMACH(14) = 14 IMACH(15) = -64 IMACH(16) = 63 ELSE WRITE(*,9010) STOP 777 END IF IMACH(11) = IMACH(14) IMACH(12) = IMACH(15) IMACH(13) = IMACH(16) ELSE RMACH = 1234567. IF (SMALL(1) .EQ. 1234613304) THEN * *** IEEE *** IMACH(10) = 2 IMACH(11) = 24 IMACH(12) = -125 IMACH(13) = 128 IMACH(14) = 53 IMACH(15) = -1021 IMACH(16) = 1024 SANITY = 987 ELSE IF (SMALL(1) .EQ. -1271379306) THEN * *** VAX *** IMACH(10) = 2 IMACH(11) = 24 IMACH(12) = -127 IMACH(13) = 127 IMACH(14) = 56 IMACH(15) = -127 IMACH(16) = 127 SANITY = 987 ELSE IF (SMALL(1) .EQ. 1175639687) THEN * *** IBM MAINFRAME *** IMACH(10) = 16 IMACH(11) = 6 IMACH(12) = -64 IMACH(13) = 63 IMACH(14) = 14 IMACH(15) = -64 IMACH(16) = 63 SANITY = 987 ELSE IF (SMALL(1) .EQ. 1251390520) THEN * *** CONVEX C-1 *** IMACH(10) = 2 IMACH(11) = 24 IMACH(12) = -128 IMACH(13) = 127 IMACH(14) = 53 IMACH(15) = -1024 IMACH(16) = 1023 SANITY = 987 ELSE * CRAY1 = 4617762693716115456 CRAY1 = 4617762 CRAY1 = 1000000*CRAY1 + 693716 CRAY1 = 1000000*CRAY1 + 115456 IF (SMALL(1) .NE. CRAY1) THEN WRITE(*,9020) STOP 777 END IF * *** CRAY 1, XMP, 2, AND 3 *** IMACH(1) = 5 IMACH(2) = 6 IMACH(3) = 102 IMACH(4) = 6 IMACH(5) = 64 IMACH(6) = 8 IMACH(7) = 2 IMACH(8) = 63 * IMACH(9) = 9223372036854775807 IMACH(9) = 9223372 IMACH(9) = 1000000*IMACH(9) + 36854 IMACH(9) = 1000000*IMACH(9) + 775807 IMACH(10) = 2 IMACH(11) = 47 IMACH(12) = -8189 IMACH(13) = 8190 IMACH(14) = 94 IMACH(15) = -8099 IMACH(16) = 8190 SANITY = 987 GO TO 10 END IF END IF IMACH( 1) = 5 IMACH( 2) = 6 IMACH( 3) = 7 IMACH( 4) = 6 IMACH( 5) = 32 IMACH( 6) = 4 IMACH( 7) = 2 IMACH( 8) = 31 IMACH( 9) = 2147483647 SANITY = 987 END IF C/6S C9010 FORMAT(/47H Adjust autodoubled I1MACH by uncommenting data/ C * 52H statements appropriate for your machine and setting/ C * 46H IMACH(I) = IMACH(I+3) for I = 11, 12, and 13.) C9020 FORMAT(/46H Adjust I1MACH by uncommenting data statements/ C * 30H appropriate for your machine.) C/7S 9010 FORMAT(/' Adjust autodoubled I1MACH by uncommenting data'/ * ' statements appropriate for your machine and setting'/ * ' IMACH(I) = IMACH(I+3) for I = 11, 12, and 13.') 9020 FORMAT(/' Adjust I1MACH by uncommenting data statements'/ * ' appropriate for your machine.') C/ 10 IF (I .LT. 1 .OR. I .GT. 16) GO TO 30 C I1MACH = IMACH(I) C/6S C/7S IF (I .EQ. 6) I1MACH = 1 C/ RETURN C 30 WRITE(*,*) 'I1MACH(I): I =',I,' is out of bounds.' C * CALL FDUMP C STOP C * /* C source for I1MACH -- remove the * in column 1 */ * /* Note that some values may need changing -- see the comments below. */ *#include *#include *#include *#include * *long i1mach_(long *i) *{ * switch(*i){ * case 1: return 5; /* standard input unit -- may need changing */ * case 2: return 6; /* standard output unit -- may need changing */ * case 3: return 7; /* standard punch unit -- may need changing */ * case 4: return 0; /* standard error unit -- may need changing */ * case 5: return 32; /* bits per integer -- may need changing */ * case 6: return 1; /* Fortran 77 value: 1 character */ * /* per character storage unit */ * case 7: return 2; /* base for integers -- may need changing */ * case 8: return 31; /* digits of integer base -- may need changing */ * case 9: return LONG_MAX; * case 10: return FLT_RADIX; * case 11: return FLT_MANT_DIG; * case 12: return FLT_MIN_EXP; * case 13: return FLT_MAX_EXP; * case 14: return DBL_MANT_DIG; * case 15: return DBL_MIN_EXP; * case 16: return DBL_MAX_EXP; * } * * fprintf(stderr, "invalid argument: i1mach(%ld)\n", *i); * exit(1); * return 0; /* for compilers that complain of missing return values */ * } END REAL FUNCTION R1MACH(I) INTEGER I C C SINGLE-PRECISION MACHINE CONSTANTS C C R1MACH(1) = B**(EMIN-1), THE SMALLEST POSITIVE MAGNITUDE. C C R1MACH(2) = B**EMAX*(1 - B**(-T)), THE LARGEST MAGNITUDE. C C R1MACH(3) = B**(-T), THE SMALLEST RELATIVE SPACING. C C R1MACH(4) = B**(1-T), THE LARGEST RELATIVE SPACING. C C R1MACH(5) = LOG10(B) C C TO ALTER THIS FUNCTION FOR A PARTICULAR ENVIRONMENT, C THE DESIRED SET OF DATA STATEMENTS SHOULD BE ACTIVATED BY C REMOVING THE C FROM COLUMN 1. C C FOR IEEE-ARITHMETIC MACHINES (BINARY STANDARD), THE FIRST C SET OF CONSTANTS BELOW SHOULD BE APPROPRIATE. C C WHERE POSSIBLE, DECIMAL, OCTAL OR HEXADECIMAL CONSTANTS ARE USED C TO SPECIFY THE CONSTANTS EXACTLY. SOMETIMES THIS REQUIRES USING C EQUIVALENT INTEGER ARRAYS. IF YOUR COMPILER USES HALF-WORD C INTEGERS BY DEFAULT (SOMETIMES CALLED INTEGER*2), YOU MAY NEED TO C CHANGE INTEGER TO INTEGER*4 OR OTHERWISE INSTRUCT YOUR COMPILER C TO USE FULL-WORD INTEGERS IN THE NEXT 5 DECLARATIONS. C C COMMENTS JUST BEFORE THE END STATEMENT (LINES STARTING WITH *) C GIVE C SOURCE FOR R1MACH. C INTEGER SMALL(2) INTEGER LARGE(2) INTEGER RIGHT(2) INTEGER DIVER(2) INTEGER LOG10(2) INTEGER CRAY1, SC COMMON /D8MACH/ CRAY1 C/6S C/7S SAVE SMALL, LARGE, RIGHT, DIVER, LOG10, SC C/ REAL RMACH(5) C EQUIVALENCE (RMACH(1),SMALL(1)) EQUIVALENCE (RMACH(2),LARGE(1)) EQUIVALENCE (RMACH(3),RIGHT(1)) EQUIVALENCE (RMACH(4),DIVER(1)) EQUIVALENCE (RMACH(5),LOG10(1)) C C MACHINE CONSTANTS FOR IEEE ARITHMETIC MACHINES, SUCH AS THE AT&T C 3B SERIES, MOTOROLA 68000 BASED MACHINES (E.G. SUN 3 AND AT&T C PC 7300), AND 8087 BASED MICROS (E.G. IBM PC AND AT&T 6300). C C DATA SMALL(1) / 8388608 / C DATA LARGE(1) / 2139095039 / C DATA RIGHT(1) / 864026624 / C DATA DIVER(1) / 872415232 / C DATA LOG10(1) / 1050288283 /, SC/987/ C C MACHINE CONSTANTS FOR AMDAHL MACHINES. C C DATA SMALL(1) / 1048576 / C DATA LARGE(1) / 2147483647 / C DATA RIGHT(1) / 990904320 / C DATA DIVER(1) / 1007681536 / C DATA LOG10(1) / 1091781651 /, SC/987/ C C MACHINE CONSTANTS FOR THE BURROUGHS 1700 SYSTEM. C C DATA RMACH(1) / Z400800000 / C DATA RMACH(2) / Z5FFFFFFFF / C DATA RMACH(3) / Z4E9800000 / C DATA RMACH(4) / Z4EA800000 / C DATA RMACH(5) / Z500E730E8 /, SC/987/ C C MACHINE CONSTANTS FOR THE BURROUGHS 5700/6700/7700 SYSTEMS. C C DATA RMACH(1) / O1771000000000000 / C DATA RMACH(2) / O0777777777777777 / C DATA RMACH(3) / O1311000000000000 / C DATA RMACH(4) / O1301000000000000 / C DATA RMACH(5) / O1157163034761675 /, SC/987/ C C MACHINE CONSTANTS FOR FTN4 ON THE CDC 6000/7000 SERIES. C C DATA RMACH(1) / 00564000000000000000B / C DATA RMACH(2) / 37767777777777777776B / C DATA RMACH(3) / 16414000000000000000B / C DATA RMACH(4) / 16424000000000000000B / C DATA RMACH(5) / 17164642023241175720B /, SC/987/ C C MACHINE CONSTANTS FOR FTN5 ON THE CDC 6000/7000 SERIES. C C DATA RMACH(1) / O"00564000000000000000" / C DATA RMACH(2) / O"37767777777777777776" / C DATA RMACH(3) / O"16414000000000000000" / C DATA RMACH(4) / O"16424000000000000000" / C DATA RMACH(5) / O"17164642023241175720" /, SC/987/ C C MACHINE CONSTANTS FOR CONVEX C-1. C C DATA RMACH(1) / '00800000'X / C DATA RMACH(2) / '7FFFFFFF'X / C DATA RMACH(3) / '34800000'X / C DATA RMACH(4) / '35000000'X / C DATA RMACH(5) / '3F9A209B'X /, SC/987/ C C MACHINE CONSTANTS FOR THE CRAY 1, XMP, 2, AND 3. C C DATA RMACH(1) / 200034000000000000000B / C DATA RMACH(2) / 577767777777777777776B / C DATA RMACH(3) / 377224000000000000000B / C DATA RMACH(4) / 377234000000000000000B / C DATA RMACH(5) / 377774642023241175720B /, SC/987/ C C MACHINE CONSTANTS FOR THE DATA GENERAL ECLIPSE S/200. C C NOTE - IT MAY BE APPROPRIATE TO INCLUDE THE FOLLOWING LINE - C STATIC RMACH(5) C C DATA SMALL/20K,0/,LARGE/77777K,177777K/ C DATA RIGHT/35420K,0/,DIVER/36020K,0/ C DATA LOG10/40423K,42023K/, SC/987/ C C MACHINE CONSTANTS FOR THE HARRIS SLASH 6 AND SLASH 7. C C DATA SMALL(1),SMALL(2) / '20000000, '00000201 / C DATA LARGE(1),LARGE(2) / '37777777, '00000177 / C DATA RIGHT(1),RIGHT(2) / '20000000, '00000352 / C DATA DIVER(1),DIVER(2) / '20000000, '00000353 / C DATA LOG10(1),LOG10(2) / '23210115, '00000377 /, SC/987/ C C MACHINE CONSTANTS FOR THE HONEYWELL DPS 8/70 SERIES. C C DATA RMACH(1) / O402400000000 / C DATA RMACH(2) / O376777777777 / C DATA RMACH(3) / O714400000000 / C DATA RMACH(4) / O716400000000 / C DATA RMACH(5) / O776464202324 /, SC/987/ C C MACHINE CONSTANTS FOR THE IBM 360/370 SERIES, C THE XEROX SIGMA 5/7/9 AND THE SEL SYSTEMS 85/86. C C DATA RMACH(1) / Z00100000 / C DATA RMACH(2) / Z7FFFFFFF / C DATA RMACH(3) / Z3B100000 / C DATA RMACH(4) / Z3C100000 / C DATA RMACH(5) / Z41134413 /, SC/987/ C C MACHINE CONSTANTS FOR THE INTERDATA 8/32 C WITH THE UNIX SYSTEM FORTRAN 77 COMPILER. C C FOR THE INTERDATA FORTRAN VII COMPILER REPLACE C THE Z'S SPECIFYING HEX CONSTANTS WITH Y'S. C C DATA RMACH(1) / Z'00100000' / C DATA RMACH(2) / Z'7EFFFFFF' / C DATA RMACH(3) / Z'3B100000' / C DATA RMACH(4) / Z'3C100000' / C DATA RMACH(5) / Z'41134413' /, SC/987/ C C MACHINE CONSTANTS FOR THE PDP-10 (KA OR KI PROCESSOR). C C DATA RMACH(1) / "000400000000 / C DATA RMACH(2) / "377777777777 / C DATA RMACH(3) / "146400000000 / C DATA RMACH(4) / "147400000000 / C DATA RMACH(5) / "177464202324 /, SC/987/ C C MACHINE CONSTANTS FOR PDP-11 FORTRANS SUPPORTING C 32-BIT INTEGERS (EXPRESSED IN INTEGER AND OCTAL). C C DATA SMALL(1) / 8388608 / C DATA LARGE(1) / 2147483647 / C DATA RIGHT(1) / 880803840 / C DATA DIVER(1) / 889192448 / C DATA LOG10(1) / 1067065499 /, SC/987/ C C DATA RMACH(1) / O00040000000 / C DATA RMACH(2) / O17777777777 / C DATA RMACH(3) / O06440000000 / C DATA RMACH(4) / O06500000000 / C DATA RMACH(5) / O07746420233 /, SC/987/ C C MACHINE CONSTANTS FOR PDP-11 FORTRANS SUPPORTING C 16-BIT INTEGERS (EXPRESSED IN INTEGER AND OCTAL). C C DATA SMALL(1),SMALL(2) / 128, 0 / C DATA LARGE(1),LARGE(2) / 32767, -1 / C DATA RIGHT(1),RIGHT(2) / 13440, 0 / C DATA DIVER(1),DIVER(2) / 13568, 0 / C DATA LOG10(1),LOG10(2) / 16282, 8347 /, SC/987/ C C DATA SMALL(1),SMALL(2) / O000200, O000000 / C DATA LARGE(1),LARGE(2) / O077777, O177777 / C DATA RIGHT(1),RIGHT(2) / O032200, O000000 / C DATA DIVER(1),DIVER(2) / O032400, O000000 / C DATA LOG10(1),LOG10(2) / O037632, O020233 /, SC/987/ C C MACHINE CONSTANTS FOR THE SEQUENT BALANCE 8000. C C DATA SMALL(1) / $00800000 / C DATA LARGE(1) / $7F7FFFFF / C DATA RIGHT(1) / $33800000 / C DATA DIVER(1) / $34000000 / C DATA LOG10(1) / $3E9A209B /, SC/987/ C C MACHINE CONSTANTS FOR THE UNIVAC 1100 SERIES. C C DATA RMACH(1) / O000400000000 / C DATA RMACH(2) / O377777777777 / C DATA RMACH(3) / O146400000000 / C DATA RMACH(4) / O147400000000 / C DATA RMACH(5) / O177464202324 /, SC/987/ C C MACHINE CONSTANTS FOR THE VAX UNIX F77 COMPILER. C C DATA SMALL(1) / 128 / C DATA LARGE(1) / -32769 / C DATA RIGHT(1) / 13440 / C DATA DIVER(1) / 13568 / C DATA LOG10(1) / 547045274 /, SC/987/ C C MACHINE CONSTANTS FOR THE VAX-11 WITH C FORTRAN IV-PLUS COMPILER. C C DATA RMACH(1) / Z00000080 / C DATA RMACH(2) / ZFFFF7FFF / C DATA RMACH(3) / Z00003480 / C DATA RMACH(4) / Z00003500 / C DATA RMACH(5) / Z209B3F9A /, SC/987/ C C MACHINE CONSTANTS FOR VAX/VMS VERSION 2.2. C C DATA RMACH(1) / '80'X / C DATA RMACH(2) / 'FFFF7FFF'X / C DATA RMACH(3) / '3480'X / C DATA RMACH(4) / '3500'X / C DATA RMACH(5) / '209B3F9A'X /, SC/987/ C C *** ISSUE STOP 777 IF ALL DATA STATEMENTS ARE COMMENTED... IF (SC .NE. 987) THEN * *** CHECK FOR AUTODOUBLE *** SMALL(2) = 0 RMACH(1) = 1E13 IF (SMALL(2) .NE. 0) THEN * *** AUTODOUBLED *** IF ( SMALL(1) .EQ. 1117925532 * .AND. SMALL(2) .EQ. -448790528) THEN * *** IEEE BIG ENDIAN *** SMALL(1) = 1048576 SMALL(2) = 0 LARGE(1) = 2146435071 LARGE(2) = -1 RIGHT(1) = 1017118720 RIGHT(2) = 0 DIVER(1) = 1018167296 DIVER(2) = 0 LOG10(1) = 1070810131 LOG10(2) = 1352628735 ELSE IF ( SMALL(2) .EQ. 1117925532 * .AND. SMALL(1) .EQ. -448790528) THEN * *** IEEE LITTLE ENDIAN *** SMALL(2) = 1048576 SMALL(1) = 0 LARGE(2) = 2146435071 LARGE(1) = -1 RIGHT(2) = 1017118720 RIGHT(1) = 0 DIVER(2) = 1018167296 DIVER(1) = 0 LOG10(2) = 1070810131 LOG10(1) = 1352628735 ELSE IF ( SMALL(1) .EQ. -2065213935 * .AND. SMALL(2) .EQ. 10752) THEN * *** VAX WITH D_FLOATING *** SMALL(1) = 128 SMALL(2) = 0 LARGE(1) = -32769 LARGE(2) = -1 RIGHT(1) = 9344 RIGHT(2) = 0 DIVER(1) = 9472 DIVER(2) = 0 LOG10(1) = 546979738 LOG10(2) = -805796613 ELSE IF ( SMALL(1) .EQ. 1267827943 * .AND. SMALL(2) .EQ. 704643072) THEN * *** IBM MAINFRAME *** SMALL(1) = 1048576 SMALL(2) = 0 LARGE(1) = 2147483647 LARGE(2) = -1 RIGHT(1) = 856686592 RIGHT(2) = 0 DIVER(1) = 873463808 DIVER(2) = 0 LOG10(1) = 1091781651 LOG10(2) = 1352628735 ELSE WRITE(*,9010) STOP 777 END IF ELSE RMACH(1) = 1234567. IF (SMALL(1) .EQ. 1234613304) THEN * *** IEEE *** SMALL(1) = 8388608 LARGE(1) = 2139095039 RIGHT(1) = 864026624 DIVER(1) = 872415232 LOG10(1) = 1050288283 ELSE IF (SMALL(1) .EQ. -1271379306) THEN * *** VAX *** SMALL(1) = 128 LARGE(1) = -32769 RIGHT(1) = 13440 DIVER(1) = 13568 LOG10(1) = 547045274 ELSE IF (SMALL(1) .EQ. 1175639687) THEN * *** IBM MAINFRAME *** SMALL(1) = 1048576 LARGE(1) = 2147483647 RIGHT(1) = 990904320 DIVER(1) = 1007681536 LOG10(1) = 1091781651 ELSE IF (SMALL(1) .EQ. 1251390520) THEN * *** CONVEX C-1 *** SMALL(1) = 8388608 LARGE(1) = 2147483647 RIGHT(1) = 880803840 DIVER(1) = 889192448 LOG10(1) = 1067065499 ELSE * CRAY1 = 4617762693716115456 CRAY1 = 4617762 CRAY1 = 1000000*CRAY1 + 693716 CRAY1 = 1000000*CRAY1 + 115456 IF (SMALL(1) .NE. CRAY1) THEN WRITE(*,9020) STOP 777 END IF * *** CRAY 1, XMP, 2, AND 3 *** * SMALL(1) = 2306828171632181248 SMALL(1) = 2306828 SMALL(1) = 1000000*SMALL(1) + 171632 SMALL(1) = 1000000*SMALL(1) + 181248 * LARGE(1) = 6917247552664371198 LARGE(1) = 6917247 LARGE(1) = 1000000*LARGE(1) + 552664 LARGE(1) = 1000000*LARGE(1) + 371198 * RIGHT(1) = 4598878906987053056 RIGHT(1) = 4598878 RIGHT(1) = 1000000*RIGHT(1) + 906987 RIGHT(1) = 1000000*RIGHT(1) + 053056 * DIVER(1) = 4599160381963763712 DIVER(1) = 4599160 DIVER(1) = 1000000*DIVER(1) + 381963 DIVER(1) = 1000000*DIVER(1) + 763712 * LOG10(1) = 4611574008272714704 LOG10(1) = 4611574 LOG10(1) = 1000000*LOG10(1) + 008272 LOG10(1) = 1000000*LOG10(1) + 714704 END IF END IF SC = 987 END IF C C *** ISSUE STOP 776 IF ALL DATA STATEMENTS ARE OBVIOUSLY WRONG... IF (RMACH(4) .GE. 1.0) STOP 776 *C/6S *C IF (I .LT. 1 .OR. I .GT. 5) *C 1 CALL SETERR(24HR1MACH - I OUT OF BOUNDS,24,1,2) *C/7S * IF (I .LT. 1 .OR. I .GT. 5) * 1 CALL SETERR('R1MACH - I OUT OF BOUNDS',24,1,2) *C/ C IF (I .LT. 1 .OR. I .GT. 5) THEN WRITE(*,*) 'R1MACH(I): I =',I,' is out of bounds.' STOP END IF R1MACH = RMACH(I) RETURN C/6S C9010 FORMAT(/42H Adjust autodoubled R1MACH by getting data/ C *42H appropriate for your machine from D1MACH.) C9020 FORMAT(/46H Adjust R1MACH by uncommenting data statements/ C *30H appropriate for your machine.) C/7S 9010 FORMAT(/' Adjust autodoubled R1MACH by getting data'/ *' appropriate for your machine from D1MACH.') 9020 FORMAT(/' Adjust R1MACH by uncommenting data statements'/ *' appropriate for your machine.') C/ C * /* C source for R1MACH -- remove the * in column 1 */ *#include *#include *#include * *float r1mach_(long *i) *{ * switch(*i){ * case 1: return FLT_MIN; * case 2: return FLT_MAX; * case 3: return FLT_EPSILON/FLT_RADIX; * case 4: return FLT_EPSILON; * case 5: return log10(FLT_RADIX); * } * * fprintf(stderr, "invalid argument: r1mach(%ld)\n", *i); * exit(1); * return 0; /* for compilers that complain of missing return values */ * } END SHAR_EOF fi # end of overwriting check if test -f 'blas1.f' then echo shar: will not over-write existing file "'blas1.f'" else cat << \SHAR_EOF > 'blas1.f' real function sdot(n,sx,incx,sy,incy) c c forms the dot product of two vectors. c uses unrolled loop for increments equal to one. c jack dongarra, linpack, 3/11/78. c real sx(1),sy(1),stemp integer i,incx,incy,ix,iy,m,mp1,n c sdot = 0.0e0 stemp = 0.0e0 if(n.le.0)return if(incx.eq.1.and.incy.eq.1)go to 20 c c code for unequal increments or equal increments c not equal to 1 c ix = 1 iy = 1 if(incx.lt.0)ix = (-n+1)*incx + 1 if(incy.lt.0)iy = (-n+1)*incy + 1 do 10 i = 1,n stemp = stemp + sx(ix)*sy(iy) ix = ix + incx iy = iy + incy 10 continue sdot = stemp return c c code for both increments equal to 1 c c c clean-up loop c 20 m = mod(n,5) if( m .eq. 0 ) go to 40 do 30 i = 1,m stemp = stemp + sx(i)*sy(i) 30 continue if( n .lt. 5 ) go to 60 40 mp1 = m + 1 do 50 i = mp1,n,5 stemp = stemp + sx(i)*sy(i) + sx(i + 1)*sy(i + 1) + * sx(i + 2)*sy(i + 2) + sx(i + 3)*sy(i + 3) + sx(i + 4)*sy(i + 4) 50 continue 60 sdot = stemp return end subroutine saxpy(n,sa,sx,incx,sy,incy) c c constant times a vector plus a vector. c uses unrolled loop for increments equal to one. c jack dongarra, linpack, 3/11/78. c real sx(1),sy(1),sa integer i,incx,incy,ix,iy,m,mp1,n c if(n.le.0)return if (sa .eq. 0.0e0) return if(incx.eq.1.and.incy.eq.1)go to 20 c c code for unequal increments or equal increments c not equal to 1 c ix = 1 iy = 1 if(incx.lt.0)ix = (-n+1)*incx + 1 if(incy.lt.0)iy = (-n+1)*incy + 1 do 10 i = 1,n sy(iy) = sy(iy) + sa*sx(ix) ix = ix + incx iy = iy + incy 10 continue return c c code for both increments equal to 1 c c c clean-up loop c 20 m = mod(n,4) if( m .eq. 0 ) go to 40 do 30 i = 1,m sy(i) = sy(i) + sa*sx(i) 30 continue if( n .lt. 4 ) return 40 mp1 = m + 1 do 50 i = mp1,n,4 sy(i) = sy(i) + sa*sx(i) sy(i + 1) = sy(i + 1) + sa*sx(i + 1) sy(i + 2) = sy(i + 2) + sa*sx(i + 2) sy(i + 3) = sy(i + 3) + sa*sx(i + 3) 50 continue return end REAL FUNCTION SNRM2 ( N, SX, INCX) INTEGER NEXT REAL SX(1), CUTLO, CUTHI, HITEST, SUM, XMAX, ZERO, ONE DATA ZERO, ONE /0.0E0, 1.0E0/ C C EUCLIDEAN NORM OF THE N-VECTOR STORED IN SX() WITH STORAGE C INCREMENT INCX . C IF N .LE. 0 RETURN WITH RESULT = 0. C IF N .GE. 1 THEN INCX MUST BE .GE. 1 C C C.L.LAWSON, 1978 JAN 08 C C FOUR PHASE METHOD USING TWO BUILT-IN CONSTANTS THAT ARE C HOPEFULLY APPLICABLE TO ALL MACHINES. C CUTLO = MAXIMUM OF SQRT(U/EPS) OVER ALL KNOWN MACHINES. C CUTHI = MINIMUM OF SQRT(V) OVER ALL KNOWN MACHINES. C WHERE C EPS = SMALLEST NO. SUCH THAT EPS + 1. .GT. 1. C U = SMALLEST POSITIVE NO. (UNDERFLOW LIMIT) C V = LARGEST NO. (OVERFLOW LIMIT) C C BRIEF OUTLINE OF ALGORITHM.. C C PHASE 1 SCANS ZERO COMPONENTS. C MOVE TO PHASE 2 WHEN A COMPONENT IS NONZERO AND .LE. CUTLO C MOVE TO PHASE 3 WHEN A COMPONENT IS .GT. CUTLO C MOVE TO PHASE 4 WHEN A COMPONENT IS .GE. CUTHI/M C WHERE M = N FOR X() REAL AND M = 2*N FOR COMPLEX. C C VALUES FOR CUTLO AND CUTHI.. C FROM THE ENVIRONMENTAL PARAMETERS LISTED IN THE IMSL CONVERTER C DOCUMENT THE LIMITING VALUES ARE AS FOLLOWS.. C CUTLO, S.P. U/EPS = 2**(-102) FOR HONEYWELL. CLOSE SECONDS ARE C UNIVAC AND DEC AT 2**(-103) C THUS CUTLO = 2**(-51) = 4.44089E-16 C CUTHI, S.P. V = 2**127 FOR UNIVAC, HONEYWELL, AND DEC. C THUS CUTHI = 2**(63.5) = 1.30438E19 C CUTLO, D.P. U/EPS = 2**(-67) FOR HONEYWELL AND DEC. C THUS CUTLO = 2**(-33.5) = 8.23181D-11 C CUTHI, D.P. SAME AS S.P. CUTHI = 1.30438D19 C DATA CUTLO, CUTHI / 8.232D-11, 1.304D19 / C DATA CUTLO, CUTHI / 4.441E-16, 1.304E19 / DATA CUTLO, CUTHI / 4.441E-16, 1.304E19 / C IF(N .GT. 0) GO TO 10 SNRM2 = ZERO GO TO 300 C 10 ASSIGN 30 TO NEXT SUM = ZERO NN = N * INCX C BEGIN MAIN LOOP I = 1 20 GO TO NEXT,(30, 50, 70, 110) 30 IF( ABS(SX(I)) .GT. CUTLO) GO TO 85 ASSIGN 50 TO NEXT XMAX = ZERO C C PHASE 1. SUM IS ZERO C 50 IF( SX(I) .EQ. ZERO) GO TO 200 IF( ABS(SX(I)) .GT. CUTLO) GO TO 85 C C PREPARE FOR PHASE 2. ASSIGN 70 TO NEXT GO TO 105 C C PREPARE FOR PHASE 4. C 100 I = J ASSIGN 110 TO NEXT SUM = (SUM / SX(I)) / SX(I) 105 XMAX = ABS(SX(I)) GO TO 115 C C PHASE 2. SUM IS SMALL. C SCALE TO AVOID DESTRUCTIVE UNDERFLOW. C 70 IF( ABS(SX(I)) .GT. CUTLO ) GO TO 75 C C COMMON CODE FOR PHASES 2 AND 4. C IN PHASE 4 SUM IS LARGE. SCALE TO AVOID OVERFLOW. C 110 IF( ABS(SX(I)) .LE. XMAX ) GO TO 115 SUM = ONE + SUM * (XMAX / SX(I))**2 XMAX = ABS(SX(I)) GO TO 200 C 115 SUM = SUM + (SX(I)/XMAX)**2 GO TO 200 C C C PREPARE FOR PHASE 3. C 75 SUM = (SUM * XMAX) * XMAX C C C FOR REAL OR D.P. SET HITEST = CUTHI/N C FOR COMPLEX SET HITEST = CUTHI/(2*N) C 85 HITEST = CUTHI/FLOAT( N ) C C PHASE 3. SUM IS MID-RANGE. NO SCALING. C DO 95 J =I,NN,INCX IF(ABS(SX(J)) .GE. HITEST) GO TO 100 95 SUM = SUM + SX(J)**2 SNRM2 = SQRT( SUM ) GO TO 300 C 200 CONTINUE I = I + INCX IF ( I .LE. NN ) GO TO 20 C C END OF MAIN LOOP. C C COMPUTE SQUARE ROOT AND ADJUST FOR SCALING. C SNRM2 = XMAX * SQRT(SUM) 300 CONTINUE RETURN END SHAR_EOF fi # end of overwriting check cd .. cd .. # End of shell archive exit 0