├── .gitignore ├── _src ├── tfcn.f90 ├── fluxFunction.f90 ├── commonTestParameters.f90 ├── evaluateExpansion.f90 ├── forcingCoeffODE.f90 ├── reactiveForcing.f90 ├── projectAverages.f90 ├── fluxCorrection.f90 ├── numFlux.f90 ├── reactiveJacobian.f90 ├── evalVelocities.f90 ├── forwardStep.f90 ├── positivityLimiter.f90 ├── updateVelocities.f90 ├── qinit.f90 ├── output2d.f90 ├── computeErrors.f90 ├── reactiveStep.f90 ├── init2d.f90 ├── strangSplit.f90 ├── mDGmod.f90 ├── updateSoln1d.f90 ├── nDGmod.f90 └── driver.f90 ├── runMultiDegree.sh ├── plot_2dadv.m ├── inputs.nl ├── Makefile ├── reactiveExact.m ├── split_2d_nodal.f90 └── plotter2d.m /.gitignore: -------------------------------------------------------------------------------- 1 | _obj 2 | test_2d_modal 3 | .DS_Store 4 | *.m~ 5 | *.pdf 6 | *.o 7 | *.mod 8 | *.nc 9 | -------------------------------------------------------------------------------- /_src/tfcn.f90: -------------------------------------------------------------------------------- 1 | function tfcn(t) 2 | USE commonTestParameters 3 | ! Inputs 4 | DOUBLE PRECISION, intent(in) :: t 5 | ! Outputs 6 | DOUBLE PRECISION :: tfcn 7 | ! Local variables 8 | DOUBLE PRECISION, parameter :: t_period = 5.d0 9 | 10 | tfcn = dcos(pi*t/t_period) 11 | 12 | end function tfcn 13 | -------------------------------------------------------------------------------- /_src/fluxFunction.f90: -------------------------------------------------------------------------------- 1 | SUBROUTINE fluxFunction(qvals,uvals,nx,nelem,fluxVals) 2 | USE commonTestParameters 3 | IMPLICIT NONE 4 | ! Inputs 5 | INTEGER, INTENT(IN) :: nelem,nx 6 | DOUBLE PRECISION, DIMENSION(1:nx,1:nelem,1:meqn), INTENT(IN) :: qvals 7 | DOUBLE PRECISION, DIMENSION(1:nx,1:nelem), INTENT(IN) :: uvals 8 | ! Outputs 9 | DOUBLE PRECISION, DIMENSION(1:nx,1:nelem,1:meqn), INTENT(OUT) :: fluxVals 10 | ! Local variables 11 | INTEGER :: m,j,i 12 | 13 | ! Advective flux: f(q) = u*q 14 | DO m=1,meqn 15 | DO j=1,nelem 16 | fluxVals(:,j,m) = uvals(:,j)*qvals(:,j,m) 17 | ENDDO !j 18 | ENDDO !m 19 | 20 | END SUBROUTINE fluxFunction 21 | -------------------------------------------------------------------------------- /_src/commonTestParameters.f90: -------------------------------------------------------------------------------- 1 | MODULE commonTestParameters 2 | ! ======================================================================== 3 | ! This module will contain information about the current physical domain and test parameters. 4 | ! Used to simplify passing of this information throughout modal subroutines and functions 5 | ! ======================================================================== 6 | IMPLICIT NONE 7 | INTEGER :: nex,ney,nQuad,nxOut,nyOut,meqn,testID,maxPolyDegree,limitingType 8 | INTEGER :: cdfID 9 | INTEGER :: inUnit 10 | DOUBLE PRECISION, DIMENSION(1:2) :: xDomain,yDomain 11 | DOUBLE PRECISION :: PI,tfinal,uMean,vMean 12 | LOGICAL :: transient,doposlimit,doreactive,debug 13 | CHARACTER(len=30) :: outdir 14 | SAVE 15 | 16 | END MODULE commonTestParameters 17 | -------------------------------------------------------------------------------- /runMultiDegree.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | echo 'What are maxPolyDegree Values?' 3 | read -a maxPolyVals 4 | echo 'What are startRes Values?' 5 | read -a startResVals 6 | 7 | echo "maxPolyDegree Values: ${maxPolyVals[*]}" 8 | echo "startRes Values: ${startResVals[*]}" 9 | 10 | ind=${!maxPolyVals[*]} 11 | for i in $ind; 12 | do 13 | echo "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" 14 | echo " Starting run using maxPolyDegree = ${maxPolyVals[$i]}" 15 | echo " startRes = ${startResVals[$i]}" 16 | echo "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" 17 | newMaxPoly="maxPolyDegree = ${maxPolyVals[$i]}" 18 | newStartRes="startRes = ${startResVals[$i]}" 19 | 20 | sed -i '' 's/maxPolyDegree = ./'"$newMaxPoly"'/' inputs.nl 21 | sed -i '' 's/startRes = [0-9][0-9]/'"$newStartRes"'/' inputs.nl 22 | 23 | make 2d_test 24 | done 25 | -------------------------------------------------------------------------------- /plot_2dadv.m: -------------------------------------------------------------------------------- 1 | % Data Extraction and plotting function for 2d unsplit modal DG 2 | % By Devin Light 5/1/14 3 | % --- 4 | 5 | function out = plot_2dadv(methname,which_test,ncfilename,res,meqn) 6 | 7 | Qname = strcat('Q',res{1}); 8 | xname = strcat('x',res{1}); 9 | yname = strcat('y',res{1}); 10 | muname = strcat('mu',res{1}); 11 | maxPolyName = 'maxPoly'; 12 | tname = 'time'; 13 | 14 | data = nc_varget(ncfilename, Qname); 15 | if(ndims(data) > 3) 16 | for m=1:meqn 17 | qname = ['q',num2str(m)]; 18 | out.(qname) = squeeze(data(m,:,:,:)); 19 | end 20 | else 21 | qname = ['q',num2str(1)]; 22 | out.(qname) = data; 23 | end 24 | out.x = nc_varget(ncfilename, xname); 25 | out.y = nc_varget(ncfilename, yname); 26 | out.t = nc_varget(ncfilename, tname); 27 | out.mu = nc_varget(ncfilename,muname); 28 | out.N = nc_varget(ncfilename,maxPolyName); 29 | out.method = methname; 30 | out.test = which_test; 31 | 32 | end -------------------------------------------------------------------------------- /_src/evaluateExpansion.f90: -------------------------------------------------------------------------------- 1 | SUBROUTINE evaluateExpansion(coeffs,nelem,basisVals,qvals) 2 | ! =========================================================================== 3 | ! Evaluates polynomial expansion phi = \sum coeffs_k * P_k at local quad nodes 4 | ! Used for outputting solution values 5 | ! INPUTS: 6 | ! coeffs(0:maxPolyDegree,1:nelem,1:meqn) 7 | ! basisVals(0:maxPolyDegree,0:nQuad) 8 | ! 9 | ! OUTPUTS: qvals 10 | ! =========================================================================== 11 | USE commonTestParameters 12 | IMPLICIT NONE 13 | ! Inputs 14 | INTEGER, INTENT(IN) :: nelem 15 | DOUBLE PRECISION, DIMENSION(0:maxPolyDegree,1:nelem,1:meqn), INTENT(IN) :: coeffs 16 | DOUBLE PRECISION, DIMENSION(0:maxPolyDegree,0:nQuad), INTENT(IN) :: basisVals 17 | ! Outputs 18 | DOUBLE PRECISION, DIMENSION(0:nQuad,1:nelem,1:meqn), INTENT(OUT) :: qvals 19 | ! Local valriables 20 | INTEGER :: i,j,m 21 | 22 | DO m=1,meqn 23 | DO j=1,nelem 24 | DO i=0,nQuad 25 | qVals(i,j,m) = SUM(coeffs(:,j,m)*basisVals(:,i)) 26 | ENDDO !i 27 | ENDDO!j 28 | ENDDO !m 29 | 30 | END SUBROUTINE evaluateExpansion 31 | -------------------------------------------------------------------------------- /_src/forcingCoeffODE.f90: -------------------------------------------------------------------------------- 1 | FUNCTION forcingCoeffODE(fluxR,fluxL,fluxQuadVals,quadWeights,basisDeriv) 2 | ! ============================================================================== 3 | ! Computes RHS forcing for all coefficients in current element and equation 4 | ! ============================================================================== 5 | USE commonTestParameters 6 | IMPLICIT NONE 7 | ! Inputs 8 | DOUBLE PRECISION, DIMENSION(0:nQuad), INTENT(IN) :: quadWeights,fluxQuadVals 9 | DOUBLE PRECISION, DIMENSION(0:maxPolyDegree,0:nQuad), INTENT(IN) :: basisDeriv 10 | DOUBLE PRECISION, INTENT(IN) :: fluxR,fluxL 11 | ! Outputs 12 | DOUBLE PRECISION, DIMENSION(0:maxPolyDegree) :: forcingCoeffODE 13 | ! Local variables 14 | INTEGER :: k 15 | 16 | forcingCoeffODE = 0D0 17 | DO k=0,maxPolyDegree 18 | forcingCoeffODE(k) = SUM(quadWeights(:)*basisDeriv(k,:)*fluxQuadVals(:)) 19 | ENDDO !k 20 | 21 | !write(*,*) 'b4-1',maxval(abs(forcingCoeffODE)) 22 | 23 | forcingCoeffODE(0) = forcingCoeffODE(0)+fluxL 24 | 25 | !write(*,*) 'b4-2',maxval(abs(forcingCoeffODE)) 26 | 27 | forcingCoeffODE(maxPolyDegree) = forcingCoeffODE(maxPolyDegree)-fluxR 28 | 29 | !write(*,*) 'b4-3',maxval(abs(forcingCoeffODE)) 30 | 31 | forcingCoeffODE(:) = 2D0*forcingCoeffODE(:)/quadWeights(:) 32 | 33 | !write(*,*) 'after',maxval(abs(forcingCoeffODE)) 34 | 35 | END FUNCTION forcingCoeffODE 36 | -------------------------------------------------------------------------------- /inputs.nl: -------------------------------------------------------------------------------- 1 | &inputs 2 | ! Spatial element parameters 3 | startRes = 20, ! Which resolution is run first 4 | nRuns = 2, ! How many runs are done 5 | nScale = 2, ! Ratio between number of elements in successive runs 6 | maxPolyDegree = 5, ! Degree of reconstructing polynomial 7 | 8 | ! Time stepping paramteters 9 | cflCoeff = 0.45D0 ! Ratio of used CFL number to maximum stable CFL 10 | 11 | ! Outputting parameters 12 | noutput = 30 ! Number of times to output output, including final time (must be >= 1) (automatically includes ICs) 13 | 14 | ! Testing parmeters 15 | meqn = 1 ! Number of tracers being simulated 16 | 17 | testID = 5 ! 0 = Consistency test 18 | ! 1 = Uniform diagonal advection 19 | ! 2 = Reactive def. ICs 20 | ! 5 = LeVeque deformation of C^3 cosinebell 21 | ! 6 = LeVeque deformation of C^5 cosinebell 22 | ! 7 = LeVeque deformation of slotted cylinder 23 | ! 8 = Solid body rotation of cylinder 24 | 25 | tfinal = 5D0 ! Final time of integration 26 | 27 | TRANSIENT = .TRUE. ! Time-dependent flow 28 | DOREACTIVE = .FALSE. ! Reactive flow 29 | 30 | ! Misc parameters 31 | DEBUG = .FALSE. 32 | uMean = 0D0 33 | vMean = 0D0 34 | 35 | / 36 | -------------------------------------------------------------------------------- /_src/reactiveForcing.f90: -------------------------------------------------------------------------------- 1 | SUBROUTINE reactiveForcing(forcing,qVals,forcingCoeffs) 2 | ! ============================================================================== 3 | ! Computes right hand side forcing term for chemical reaction equation 4 | ! INPUTS: 5 | ! qVals(1:meqn) - solution values at given points 6 | ! forcingCoeffs(1:meqn) - forcing coefficients multiplying fields q1,..qmeqn 7 | ! OUTPUTS: forcing(1:meqn) - RHS forcing function for fields q1,...,qmeqn 8 | ! 9 | ! ============================================================================== 10 | USE commonTestParameters 11 | IMPLICIT NONE 12 | ! Inputs 13 | DOUBLE PRECISION, DIMENSION(1:meqn), INTENT(IN) :: qVals,forcingCoeffs 14 | ! Outputs 15 | DOUBLE PRECISION, DIMENSION(1:meqn), INTENT(OUT) :: forcing 16 | ! Local variables 17 | INTEGER :: j 18 | 19 | if(meqn > 3) then 20 | write(*,*) 'in reactiveForcing: warning! not set up for more than three reacting tracers' 21 | STOP 22 | endif 23 | forcing = 0D0 24 | ! Evaluate forcing function at grid points 25 | ! forcing(1) = -forcingCoeffs(1)*qVals(1)+forcingCoeffs(2)*qVals(2)**2 26 | ! forcing(2) = -2D0*forcing(1) 27 | 28 | ! ==== 29 | ! dq1/dt = -r*q1*q2 30 | ! dq2/dt = -dq1/dt 31 | ! ==== 32 | ! forcing(1) = -forcingCoeffs(1)*qVals(1)*qvals(2) 33 | ! forcing(2) = -1D0*forcing(1) 34 | 35 | ! ==== 36 | ! dq1/dt = r*q2^2 37 | ! dq2/dt = -dq1/dt 38 | ! ==== 39 | forcing(1) = forcingCoeffs(1)*qVals(2)*qVals(2) 40 | forcing(2) = -1D0*forcing(1) 41 | 42 | ! forcing(1) = -forcingCoeffs(1)*qVals(1)*qvals(2) 43 | ! forcing(2) = forcing(1) 44 | ! forcing(3) = -2D0*forcing(1) 45 | 46 | END SUBROUTINE reactiveForcing 47 | -------------------------------------------------------------------------------- /_src/projectAverages.f90: -------------------------------------------------------------------------------- 1 | SUBROUTINE projectAverages(coeffs,avgOP_LU,IPIV,avgs,nelem) 2 | USE commonTestParameters 3 | IMPLICIT NONE 4 | ! -- Inputs 5 | INTEGER, INTENT(IN) :: nelem 6 | DOUBLE PRECISION, DIMENSION(0:maxPolyDegree,0:maxPolyDegree), INTENT(IN) :: avgOP_LU 7 | DOUBLE PRECISION, DIMENSION(0:maxPolyDegree,1:nelem,1:meqn), INTENT(IN) :: avgs 8 | INTEGER, DIMENSION(0:maxPolyDegree), INTENT(IN) :: IPIV 9 | ! -- Outputs 10 | DOUBLE PRECISION, DIMENSION(0:maxPolyDegree,1:nelem,1:meqn) :: coeffs 11 | ! -- Local variables 12 | INTEGER :: i,j,k,m 13 | DOUBLE PRECISION, DIMENSION(1:nelem) :: hold 14 | DOUBLE PRECISION, DIMENSION(0:maxPolyDegree,1:nelem) :: fooBAR 15 | DOUBLE PRECISION, DIMENSION(0:maxPolyDegree) :: FOO_y 16 | 17 | DO m=1,meqn 18 | fooBAR = avgs(:,:,m) 19 | 20 | DO i=0,maxPolyDegree ! Reorder RHS according to IPIV 21 | hold = fooBAR(i,1:nelem) 22 | fooBAR(i,:) = fooBAR(IPIV(i)-1,:) 23 | fooBAR(IPIV(i)-1,1:nelem) = hold 24 | ENDDO 25 | 26 | DO j=1,nelem 27 | FOO_y = 0D0 28 | ! Solve Ly=RHS for y 29 | FOO_y(0) = fooBAR(0,j) 30 | DO k=1,maxPolyDegree 31 | FOO_y(k) = fooBAR(k,j) - SUM(avgOP_LU(k,0:k-1)*FOO_y(0:k-1)) 32 | ENDDO 33 | ! Solve Ux=y for x 34 | coeffs(maxPolyDegree,j,m) = (1D0/avgOP_LU(maxPolyDegree,maxPolyDegree))*FOO_y(maxPolyDegree) 35 | DO k=maxPolyDegree-1,0,-1 36 | coeffs(k,j,m) = (1D0/avgOP_LU(k,k))*(FOO_y(k) - SUM(avgOP_LU(k,k+1:maxPolyDegree)*coeffs(k+1:maxPolyDegree,j,m))) 37 | ENDDO 38 | 39 | IF(coeffs(0,j,m) .lt. 0D0) coeffs(0,j,m) = coeffs(0,j,m)+epsilon(1D0) ! To prevent numerical roundoff from causing negatives 40 | ENDDO !j 41 | ENDDO !m 42 | 43 | END SUBROUTINE projectAverages 44 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | PROCESSOR := $(shell uname -m) 2 | F90=gfortran 3 | FFLAGS=-g -C -O3 -ffree-form -I/opt/local/include #-fbounds-check -Wtabs -fcheck=all 4 | 5 | OBJFLAGS ?=$(FFLAGS) 6 | LDFLAGS= -L/opt/local/lib -lnetcdf -lnetcdff -framework vecLib 7 | 8 | SRCDIR = _src 9 | 10 | SOURCES = $(SRCDIR)/tfcn.f90 \ 11 | $(SRCDIR)/driver.f90 \ 12 | $(SRCDIR)/qinit.f90 \ 13 | $(SRCDIR)/init2d.f90 \ 14 | $(SRCDIR)/output2d.f90\ 15 | $(SRCDIR)/strangSplit.f90\ 16 | $(SRCDIR)/updateVelocities.f90\ 17 | $(SRCDIR)/updateSoln1d.f90\ 18 | $(SRCDIR)/projectAverages.f90\ 19 | $(SRCDIR)/numFlux.f90\ 20 | $(SRCDIR)/fluxFunction.f90\ 21 | $(SRCDIR)/evaluateExpansion.f90\ 22 | $(SRCDIR)/forwardStep.f90\ 23 | $(SRCDIR)/forcingCoeffODE.f90\ 24 | $(SRCDIR)/computeErrors.f90\ 25 | $(SRCDIR)/positivityLimiter.f90\ 26 | $(SRCDIR)/fluxCorrection.f90\ 27 | $(SRCDIR)/reactiveForcing.f90\ 28 | $(SRCDIR)/reactiveJacobian.f90\ 29 | $(SRCDIR)/reactiveStep.f90\ 30 | $(SRCDIR)/updateVelocities.f90\ 31 | $(SRCDIR)/evalVelocities.f90\ 32 | 33 | MODULES = $(SRCDIR)/nDGmod.f90 \ 34 | $(SRCDIR)/commonTestParameters.f90 \ 35 | 36 | INPUTS = inputs.nl 37 | 38 | .PHONY= 2d_test clean 39 | 40 | OBJECTS :=$(notdir $(SOURCES:.f90=.o)) 41 | MODOBJ :=$(notdir $(MODULES:.f90=.o)) 42 | 43 | # Set the order in which directories are searched when looking for targets 44 | VPATH = $(SRCDIR) 45 | 46 | all: $(SOURCES) $(INPUTS) test_2d 47 | 48 | 2d_test: test_2d 49 | ./test_2d 50 | 51 | test_2d: $(MODOBJ) $(OBJECTS) $(INPUTS) split_2d_nodal.f90 52 | $(F90) $(FFLAGS) $^ -o $@ $(LDFLAGS) 53 | 54 | clean: 55 | rm -f $(OBJECTS) $(MODOBJ) *.mod test_2d 56 | 57 | %.o: %.f90 58 | $(F90) $(OBJFLAGS) -c -o $@ $^ 59 | -------------------------------------------------------------------------------- /reactiveExact.m: -------------------------------------------------------------------------------- 1 | %% Reactive chemistry exact solution at t=0,T,2T,... 2 | function qOut = reactiveExact(r,q_ic,t) 3 | qOut = 0.*q_ic; 4 | stat = size(q_ic,3); 5 | disp(['Reading ' num2str(stat) ' equations...']); 6 | if(stat==2) 7 | q1_ic = q_ic(:,:,1); 8 | q2_ic = q_ic(:,:,2); 9 | 10 | a = r.*(q1_ic+q2_ic); 11 | % qOut(:,:,1) = q1_ic.*(q1_ic+q2_ic)./(q1_ic+q2_ic.*exp(-a.*t)); 12 | % qOut(:,:,2) = -a.*q2_ic./(r.*(q2_ic+q1_ic.*exp(a.*t))); 13 | 14 | % qOut(:,:,1) = q1_ic.*(q1_ic+q2_ic)./(q1_ic+q2_ic.*exp(a.*t)); 15 | % qOut(:,:,2) = q1_ic+q2_ic-qOut(:,:,1); 16 | 17 | % ==== 18 | % dq1/dt = r*q2^2 19 | % dq2/dt = -dq1/dt 20 | % ==== 21 | c = 1./q2_ic; 22 | qOut(:,:,2) = 1./(r.*t+c); 23 | qOut(:,:,1) = (q1_ic+q2_ic)-qOut(:,:,2); 24 | 25 | %q1 = (q1_ic.*qT)./(q1_ic+(qT-q1_ic).*exp(r.*qT*t)); 26 | %q2 = qT-q1; 27 | elseif(stat==3) 28 | q1_ic = q_ic(:,:,1); 29 | q2_ic = q_ic(:,:,2); 30 | qT = q1_ic+q2_ic+q_ic(:,:,3); 31 | 32 | q1Out = 0.*q1_ic; 33 | q2Out = 0.*q2_ic; 34 | q3Out = 0.*q2_ic; 35 | 36 | qBar = q1_ic-q2_ic; 37 | loc = qBar == 0; 38 | q1Out(loc) = q1_ic(loc)./(q1_ic(loc).*r.*t+1); 39 | q2Out(loc) = q2_ic(loc)./(q2_ic(loc).*r.*t+1); 40 | 41 | a = q2_ic(~loc)./q1_ic(~loc); 42 | beta = r.*qBar(~loc); 43 | q1Out(~loc) = (qBar(~loc))./(1-a.*exp(-beta.*t)); 44 | q2Out(~loc) = -a.*qBar(~loc)./(a-exp(beta.*t)); 45 | 46 | q3Out = qT-(q1Out+q2Out); 47 | 48 | qOut(:,:,1) = q1Out; 49 | qOut(:,:,2) = q2Out; 50 | qOut(:,:,3) = q3Out; 51 | 52 | end 53 | end -------------------------------------------------------------------------------- /_src/fluxCorrection.f90: -------------------------------------------------------------------------------- 1 | SUBROUTINE fluxCorrection(coeffs,flx,quadWeights,dxel,dt,nelem) 2 | ! Computes flux reductions factors to prevent total mass within each element from going negative 3 | ! Outputs fluxcf. fluxcf(j) is the reduction factor for the right face of element j, 4 | ! with fluxcf(0) being the factor for the left domain interface 5 | USE commonTestParameters 6 | IMPLICIT NONE 7 | ! -- Inputs 8 | INTEGER, INTENT(IN) :: nelem 9 | DOUBLE PRECISION, DIMENSION(0:maxPolyDegree,1:nelem,1:meqn), INTENT(IN) :: coeffs 10 | DOUBLE PRECISION, DIMENSION(0:nQuad), INTENT(IN) :: quadWeights 11 | DOUBLE PRECISION, INTENT(IN) :: dxel,dt 12 | ! -- Outputs 13 | DOUBLE PRECISION, DIMENSION(0:nelem,1:meqn), INTENT(INOUT) :: flx 14 | ! -- Local variables 15 | DOUBLE PRECISION :: Pj,Qj,eps,avgj 16 | DOUBLE PRECISION :: fluxcf 17 | DOUBLE PRECISION, DIMENSION(0:nelem+1) :: R ! Reduction ratio for outward fluxes so that element j has non-negative values (1D0 indicates no limiting needed) 18 | INTEGER :: j,m 19 | 20 | eps = 1D-6 ! Small parameter used to ensure no division by 0 21 | 22 | DO m=1,meqn 23 | DO j=1,nelem 24 | ! Compute maximum allowable flux out of element j 25 | avgj = 0.5D0*SUM(quadWeights(:)*coeffs(:,j,m)) 26 | Qj = (dxel/dt)*avgj 27 | 28 | Qj = MAX(Qj-epsilon(1D0),0D0) 29 | 30 | ! Compute actual flux out of element j 31 | Pj = MAX(0D0,flx(j,m)) - MIN(0D0,flx(j-1,m)) + eps 32 | 33 | ! Compute reduction ratio 34 | R(j) = MIN(1D0,Qj/Pj) 35 | END DO!j 36 | ! Periodicity 37 | R(0) = R(nelem) 38 | R(nelem+1) = R(1) 39 | ! Compute corrected factors 40 | DO j=0,nelem 41 | ! If flux at right edge is negative, use limiting ratio in element to the right of current one 42 | ! (since that is where we are pulling mass from) 43 | fluxcf = R(j) - 0.5D0*(1D0-INT(SIGN(1D0,flx(j,m))))*(R(j)-R(j+1)) 44 | flx(j,m) = flx(j,m)*fluxcf 45 | END DO!j 46 | ENDDO !m 47 | END SUBROUTINE fluxCorrection 48 | -------------------------------------------------------------------------------- /_src/numFlux.f90: -------------------------------------------------------------------------------- 1 | SUBROUTINE numFlux(coeffs,uEdge,nelem,fluxes) 2 | ! =========================================================================== 3 | ! Returns upwind numerical fluxes 4 | ! =========================================================================== 5 | USE commonTestParameters 6 | IMPLICIT NONE 7 | ! Inputs 8 | INTEGER, INTENT(IN) :: nelem 9 | DOUBLE PRECISION, DIMENSION(0:maxPolyDegree,1:nelem,1:meqn), INTENT(IN):: coeffs 10 | DOUBLE PRECISION, DIMENSION(0:nelem+1), INTENT(IN) :: uEdge 11 | ! Outputs 12 | DOUBLE PRECISION, DIMENSION(0:nelem,1:meqn), INTENT(OUT) :: fluxes 13 | ! Local Variables 14 | INTEGER :: i,m,j,whichSign,whichEl 15 | DOUBLE PRECISION, DIMENSION(0:1,1:nelem,1:meqn) :: qvals,fluxVals 16 | DOUBLE PRECISION, DIMENSION(0:1,0:nelem+1,1:meqn) :: fluxValsPeriodic 17 | DOUBLE PRECISION, DIMENSION(0:1,1:nelem) :: uTmp 18 | 19 | INTERFACE 20 | SUBROUTINE fluxFunction(qvals,uvals,nx,nelem,fluxVals) 21 | USE commonTestParameters 22 | IMPLICIT NONE 23 | ! Inputs 24 | INTEGER, INTENT(IN) :: nelem,nx 25 | DOUBLE PRECISION, DIMENSION(1:nx,1:nelem,1:meqn), INTENT(IN) :: qvals 26 | DOUBLE PRECISION, DIMENSION(1:nx,1:nelem), INTENT(IN) :: uvals 27 | ! Outputs 28 | DOUBLE PRECISION, DIMENSION(1:nx,1:nelem,1:meqn), INTENT(OUT) :: fluxVals 29 | END SUBROUTINE fluxFunction 30 | END INTERFACE 31 | 32 | DO m=1,meqn 33 | DO j=1,nelem 34 | qvals(1,j,m) = coeffs(maxPolyDegree,j,m) 35 | qvals(0,j,m) = coeffs(0,j,m) 36 | 37 | uTmp(1,j) = uEdge(j) 38 | uTmp(0,j) = uEdge(j-1) 39 | ENDDO !j 40 | ENDDO !m 41 | 42 | CALL fluxFunction(qvals,uTmp,2,nelem,fluxVals) 43 | 44 | ! Form periodic extension of flux values at element edges 45 | fluxValsPeriodic(:,1:nelem,:) = fluxVals 46 | fluxValsPeriodic(:,0,:) = fluxVals(:,nelem,:) 47 | fluxValsPeriodic(:,nelem+1,:) = fluxVals(:,1,:) 48 | 49 | ! NOTE: As written this is not as general as it should be. 50 | ! Only valid for fluxes of the form F(q) = u*g(q) for some function g 51 | DO j=0,nelem 52 | whichSign = 1-0.5D0*(1-(SIGN(1D0,uEdge(j))) ) 53 | whichEl = j+0.5D0*(1-(SIGN(1D0,uEdge(j))) ) 54 | fluxes(j,:) = fluxValsPeriodic(whichSign,whichEl,:) 55 | ENDDO 56 | END SUBROUTINE numFlux 57 | -------------------------------------------------------------------------------- /_src/reactiveJacobian.f90: -------------------------------------------------------------------------------- 1 | SUBROUTINE reactiveJacobian(jacobian,qVals,forcingCoeffs,nx,ny) 2 | ! ============================================================================== 3 | ! Computes right hand side forcing term for chemical reaction equation 4 | ! INPUTS: 5 | ! qVals(1:nx,1:ny,1:meqn) - solution values at given points 6 | ! forcingCoeffs(1:nx,1:ny,1:meqn) - forcing coefficients multiplying fields q1,..qmeqn 7 | ! evaluated at given grid 8 | ! OUTPUTS: 9 | ! jacobian(1:nx,1:ny,1:meqn,1:meqn) - jacobian matrix evaluated at grid points 10 | ! ============================================================================== 11 | 12 | USE commonTestParameters 13 | IMPLICIT NONE 14 | ! Inputs 15 | INTEGER, INTENT(IN) :: nx,ny 16 | DOUBLE PRECISION, DIMENSION(1:nx,1:ny,1:meqn), INTENT(IN) ::qVals,forcingCoeffs 17 | ! Outputs 18 | DOUBLE PRECISION, DIMENSION(1:nx,1:ny,1:meqn,1:meqn), INTENT(OUT) :: jacobian 19 | ! Local variables 20 | INTEGER :: i,j 21 | 22 | ! Evaluate jacobian at grid points 23 | DO i=1,nx 24 | DO j=1,ny 25 | ! jacobian(i,j,1,1) = -forcingCoeffs(i,j,1) 26 | ! jacobian(i,j,1,2) = 2D0*forcingCoeffs(i,j,2)*qVals(i,j,2) 27 | ! jacobian(i,j,2,1) = -2D0*jacobian(i,j,1,1) 28 | ! jacobian(i,j,1,2) = -2D0*jacobian(i,j,1,2) 29 | 30 | ! ==== 31 | ! dq1/dt = -r*q1*q2 32 | ! dq2/dt = -dq1/dt 33 | ! ==== 34 | ! jacobian(i,j,1,1) = -forcingCoeffs(i,j,1)*qVals(i,j,2) 35 | ! jacobian(i,j,1,2) = -forcingCoeffs(i,j,1)*qVals(i,j,1) 36 | ! jacobian(i,j,2,1) = forcingCoeffs(i,j,1)*qVals(i,j,2) 37 | ! jacobian(i,j,2,2) = forcingCoeffs(i,j,1)*qVals(i,j,1) 38 | 39 | ! ==== 40 | ! dq1/dt = r*q2^2 41 | ! dq2/dt = -dq1/dt 42 | ! ==== 43 | jacobian(i,j,1,1) = 0D0 44 | jacobian(i,j,1,2) = 2D0*forcingCoeffs(i,j,1)*qVals(i,j,2) 45 | jacobian(i,j,2,1) = 0D0 46 | jacobian(i,j,2,2) = -2D0*forcingCoeffs(i,j,1)*qVals(i,j,2) 47 | 48 | ! jacobian(i,j,:,:) = 0D0 49 | ! jacobian(i,j,1,1) = -qVals(i,j,2) 50 | ! jacobian(i,j,1,2) = -qVals(i,j,1) 51 | ! jacobian(i,j,2,:) = jacobian(i,j,1,:) 52 | ! jacobian(i,j,3,:) = -2D0*jacobian(i,j,1,:) 53 | ! jacobian(i,j,:,:) = forcingCoeffs(i,j,1)*jacobian(i,j,:,:) 54 | ENDDO !j 55 | ENDDO !i 56 | 57 | END SUBROUTINE reactiveJacobian 58 | -------------------------------------------------------------------------------- /_src/evalVelocities.f90: -------------------------------------------------------------------------------- 1 | SUBROUTINE evalHorizVelocities(u,x,y,nx,ny,t) 2 | ! ====================================================== 3 | ! User-specified subroutine which defines the non-divergent 4 | ! velocity field (u) 5 | ! ====================================================== 6 | USE commonTestParameters 7 | IMPLICIT NONE 8 | ! Inputs 9 | INTEGER, INTENT(IN) :: nx,ny 10 | DOUBLE PRECISION, INTENT(IN) :: t 11 | DOUBLE PRECISION, DIMENSION(1:nx), INTENT(IN) :: x 12 | DOUBLE PRECISION, DIMENSION(1:ny), INTENT(IN) :: y 13 | 14 | ! Outputs 15 | DOUBLE PRECISION, DIMENSION(1:nx,1:ny), INTENT(OUT) :: u 16 | 17 | ! Local variables 18 | INTEGER :: j 19 | DOUBLE PRECISION :: timeFac 20 | 21 | INTERFACE 22 | function tfcn(t) 23 | USE commonTestParameters 24 | ! Inputs 25 | DOUBLE PRECISION, intent(in) :: t 26 | ! Outputs 27 | DOUBLE PRECISION :: tfcn 28 | END FUNCTION tfcn 29 | END INTERFACE 30 | 31 | timeFac = tfcn(t) 32 | 33 | SELECT CASE(testID) 34 | CASE(2,5:7) ! LeVeque deformation flow 35 | DO j=1,ny 36 | ! Horizontal velocities -- u 37 | u(:,j) = uMean + (SIN(PI*(x(:)-uMean*t))**2)*SIN(2D0*PI*(y(j)-vMean*t))& 38 | *timeFac 39 | ENDDO !j 40 | END SELECT !testID 41 | END SUBROUTINE evalHorizVelocities 42 | 43 | SUBROUTINE evalVertVelocities(v,x,y,nx,ny,t) 44 | ! ====================================================== 45 | ! User-specified subroutine which defines the non-divergent 46 | ! velocity field (v) 47 | ! ====================================================== 48 | USE commonTestParameters 49 | IMPLICIT NONE 50 | ! Inputs 51 | INTEGER, INTENT(IN) :: nx,ny 52 | DOUBLE PRECISION, INTENT(IN) :: t 53 | DOUBLE PRECISION, DIMENSION(1:nx), INTENT(IN) :: x 54 | DOUBLE PRECISION, DIMENSION(1:ny), INTENT(IN) :: y 55 | 56 | ! Outputs 57 | DOUBLE PRECISION, DIMENSION(1:nx,1:ny), INTENT(OUT) :: v 58 | 59 | ! Local variables 60 | INTEGER :: j 61 | DOUBLE PRECISION :: timeFac 62 | 63 | INTERFACE 64 | function tfcn(t) 65 | USE commonTestParameters 66 | ! Inputs 67 | DOUBLE PRECISION, intent(in) :: t 68 | ! Outputs 69 | DOUBLE PRECISION :: tfcn 70 | END FUNCTION tfcn 71 | END INTERFACE 72 | 73 | timeFac = tfcn(t) 74 | 75 | SELECT CASE(testID) 76 | CASE(2,5:7) ! LeVeque deformation flow 77 | DO j=1,ny 78 | ! Vertical velocities -- v 79 | v(:,j) = vMean - (SIN(PI*(y(j)-vMean*t))**2)*SIN(2D0*PI*(x(:)-uMean*t))& 80 | *timeFac 81 | ENDDO !j 82 | END SELECT !testID 83 | END SUBROUTINE evalVertVelocities 84 | -------------------------------------------------------------------------------- /_src/forwardStep.f90: -------------------------------------------------------------------------------- 1 | SUBROUTINE forwardStep(coeffs,fluxQuad,flx,quadWeights,basisDeriv,dxel,dt,nelem) 2 | ! ================================================================================ 3 | ! Takes single forward Euler step applied to coefficient odes 4 | ! d a_kj / dt = forcingCoeffODE() 5 | ! Inputs: 6 | ! fluxQuad - flux function F(q) evaluated at quadrature nodes 7 | ! flx - numerical fluxes through interfaces 8 | ! quadWeghts - quadrature weights 9 | ! basisDeriv - derivative of Legendre basis at quadrature nodes 10 | ! dxel - element spacing 11 | ! dt - time step size 12 | ! nelem - number of elements 13 | ! Outputs: 14 | ! coeffs - Legendre expansion coefficients 15 | ! ================================================================================ 16 | USE commonTestParameters 17 | IMPLICIT NONE 18 | ! Inputs 19 | INTEGER, INTENT(IN) :: nelem 20 | DOUBLE PRECISION, INTENT(IN) :: dt,dxel 21 | DOUBLE PRECISION, DIMENSION(0:nelem,1:meqn), INTENT(IN) :: flx 22 | DOUBLE PRECISION, DIMENSION(0:nQuad,1:nelem,1:meqn), INTENT(IN) :: fluxQuad 23 | DOUBLE PRECISION, DIMENSION(0:nQuad), INTENT(IN) :: quadWeights 24 | DOUBLE PRECISION, DIMENSION(0:maxPolyDegree,0:nQuad), INTENT(IN) :: basisDeriv 25 | ! Outputs 26 | DOUBLE PRECISION, DIMENSION(0:maxPolyDegree,1:nelem,1:meqn), INTENT(INOUT) :: coeffs 27 | ! Local variables 28 | INTEGER :: j,m 29 | DOUBLE PRECISION :: lam,fluxR,fluxL,foo 30 | DOUBLE PRECISION, DIMENSION(0:nQuad) :: localFluxQuad,tmp 31 | 32 | INTERFACE 33 | FUNCTION forcingCoeffODE(fluxR,fluxL,fluxQuadVals,quadWeights,basisDeriv) 34 | ! ============================================================================== 35 | ! Computes RHS forcing for all coefficients in current element and equation 36 | ! ============================================================================== 37 | USE commonTestParameters 38 | IMPLICIT NONE 39 | ! Inputs 40 | DOUBLE PRECISION, DIMENSION(0:nQuad), INTENT(IN) :: quadWeights,fluxQuadVals 41 | DOUBLE PRECISION, DIMENSION(0:maxPolyDegree,0:nQuad), INTENT(IN) :: basisDeriv 42 | DOUBLE PRECISION, INTENT(IN) :: fluxR,fluxL 43 | ! Outputs 44 | DOUBLE PRECISION, DIMENSION(0:maxPolyDegree) :: forcingCoeffODE 45 | END FUNCTION forcingCoeffODE 46 | END INTERFACE 47 | 48 | lam = dt/dxel 49 | 50 | DO m=1,meqn 51 | DO j=1,nelem 52 | fluxR = flx(j,m) 53 | fluxL = flx(j-1,m) 54 | localFluxQuad = fluxQuad(:,j,m) 55 | tmp = coeffs(:,j,m) 56 | coeffs(:,j,m) = coeffs(:,j,m) + & 57 | lam*forcingCoeffODE(fluxR,fluxL,localFluxQuad,quadWeights,basisDeriv) 58 | ENDDO !j 59 | ENDDO !m 60 | 61 | END SUBROUTINE forwardStep 62 | -------------------------------------------------------------------------------- /_src/positivityLimiter.f90: -------------------------------------------------------------------------------- 1 | SUBROUTINE positivityLimiter(qBar,nelem,avgVals,quadWeights) 2 | ! Subroutine for mass filling within an element to remove negative cell averaged values 3 | USE commonTestParameters 4 | IMPLICIT NONE 5 | ! Inputs 6 | INTEGER, INTENT(IN) :: nelem 7 | DOUBLE PRECISION, DIMENSION(0:nQuad), INTENT(IN) :: quadWeights 8 | DOUBLE PRECISION, DIMENSION(1:nelem,1:meqn), INTENT(IN) :: avgVals 9 | ! Outputs 10 | DOUBLE PRECISION, DIMENSION(0:maxPolyDegree,1:nelem,1:meqn), INTENT(INOUT) :: qBar 11 | ! Local Variables 12 | INTEGER :: j,k,m 13 | DOUBLE PRECISION :: r,Mp,Mt,s,valMin,avg 14 | DOUBLE PRECISION, DIMENSION(1:meqn) :: rTmp 15 | 16 | IF(limitingType .eq. 1) THEN 17 | ! =============================================================================================== 18 | ! TYPE 1: TMAR (2015) Limiting 19 | ! =============================================================================================== 20 | DO m=1,meqn 21 | DO j=1,nelem 22 | Mp = 0D0 23 | Mt = 0D0 24 | 25 | DO k=0,maxPolyDegree 26 | Mt = Mt + quadWeights(k)*qBar(k,j,m) 27 | qBar(k,j,m) = MAX(0D0,qBar(k,j,m)) ! Zero out negative masses 28 | Mp = Mp + quadWeights(k)*qBar(k,j,m) 29 | ENDDO !k 30 | r = MAX(Mt,0D0)/MAX(Mp,TINY(1D0)) 31 | qBar(:,j,m) = r*qBar(:,j,m) ! Reduce remaining positive masses by reduction factor 32 | ENDDO !j 33 | ENDDO !m 34 | ELSEIF(limitingType .eq. 2) THEN 35 | ! =============================================================================================== 36 | ! TYPE 2: Linear rescaling similar to Zhang and Shu (2010) 37 | ! =============================================================================================== 38 | DO m=1,meqn 39 | DO j=1,nelem 40 | avg = avgVals(j,m) !SUM(qBar(:,j))/(N+1) 41 | valMin = MINVAL(qBar(:,j,m))-epsilon(1D0) 42 | r = MIN(avg/abs(valMin-avg),1D0) 43 | qBar(:,j,m) = r*(qBar(:,j,m)-avg)+avg 44 | ENDDO !j 45 | ENDDO !m 46 | ELSEIF(limitingType .eq. 3) THEN 47 | ! =============================================================================================== 48 | ! TYPE 3: 'Strict' ZS Rescaling 49 | ! =============================================================================================== 50 | DO j=1,nelem 51 | rTmp = 0D0 52 | ! Let each field determine its 'desired' limiting ratio 53 | DO m=1,meqn 54 | avg = avgVals(j,m) !SUM(qBar(:,j))/(N+1) 55 | valMin = MINVAL(qBar(:,j,m))-epsilon(1D0) 56 | rTmp(m) = MIN(avg/abs(valMin-avg),1D0) 57 | ENDDO!m 58 | ! Set ratio used to be most strict ratio 59 | r = MINVAL(rTmp) 60 | 61 | ! Apply worst ratio to all fields 62 | DO m=1,meqn 63 | avg = avgVals(j,m) 64 | qBar(:,j,m) = r*(qBar(:,j,m)-avg)+avg 65 | ENDDO !m 66 | ENDDO!j 67 | ENDIF 68 | 69 | END SUBROUTINE positivityLimiter 70 | -------------------------------------------------------------------------------- /_src/updateVelocities.f90: -------------------------------------------------------------------------------- 1 | SUBROUTINE updateVelocities(uOut,vOut,uEdge,vEdge,xOut,elemEdgeX,DGx,yOut,elemEdgeY,DGy,time,dt) 2 | ! ========================================================= 3 | ! Updates horizontal and vertical velocities 4 | ! at necessary grid points to time levels required by integrator 5 | ! ========================================================= 6 | USE commonTestParameters 7 | IMPLICIT NONE 8 | ! Inputs 9 | DOUBLE PRECISION, INTENT(IN) :: time,dt 10 | DOUBLE PRECISION, DIMENSION(1:nxOut), INTENT(IN) :: xOut,DGx 11 | DOUBLE PRECISION, DIMENSION(1:nyOut), INTENT(IN) :: yOut,DGy 12 | DOUBLE PRECISION, DIMENSION(1:nex), INTENT(IN) :: elemEdgeX 13 | DOUBLE PRECISION, DIMENSION(1:ney), INTENT(IN) :: elemEdgeY 14 | ! Outputs 15 | DOUBLE PRECISION, DIMENSION(1:3,1:nxOut,1:nyOut), INTENT(INOUT) :: uOut,vOut 16 | DOUBLE PRECISION, DIMENSION(1:3,1:nex,1:nyOut), INTENT(INOUT) :: uEdge 17 | DOUBLE PRECISION, DIMENSION(1:3,1:nxOut,1:ney), INTENT(INOUT) :: vEdge 18 | 19 | ! Local Variables 20 | INTEGER :: stage 21 | DOUBLE PRECISION, DIMENSION(1:nxOut,1:nyOut) :: uTmp,vTmp 22 | DOUBLE PRECISION, DIMENSION(1:nex,1:nyOut) :: uEdgeTmp 23 | DOUBLE PRECISION, DIMENSION(1:nxOut,1:ney) :: vEdgeTmp 24 | DOUBLE PRECISION :: t_temp 25 | 26 | INTERFACE 27 | SUBROUTINE evalHorizVelocities(u,x,y,nx,ny,t) 28 | ! ====================================================== 29 | ! User-specified subroutine which defines the non-divergent 30 | ! velocity field (u) 31 | ! ====================================================== 32 | USE commonTestParameters 33 | IMPLICIT NONE 34 | ! Inputs 35 | INTEGER, INTENT(IN) :: nx,ny 36 | DOUBLE PRECISION, INTENT(IN) :: t 37 | DOUBLE PRECISION, DIMENSION(1:nx), INTENT(IN) :: x 38 | DOUBLE PRECISION, DIMENSION(1:ny), INTENT(IN) :: y 39 | 40 | ! Outputs 41 | DOUBLE PRECISION, DIMENSION(1:nx,1:ny), INTENT(OUT) :: u 42 | END SUBROUTINE evalHorizVelocities 43 | 44 | SUBROUTINE evalVertVelocities(v,x,y,nx,ny,t) 45 | ! ====================================================== 46 | ! User-specified subroutine which defines the non-divergent 47 | ! velocity field (v) 48 | ! ====================================================== 49 | USE commonTestParameters 50 | IMPLICIT NONE 51 | ! Inputs 52 | INTEGER, INTENT(IN) :: nx,ny 53 | DOUBLE PRECISION, INTENT(IN) :: t 54 | DOUBLE PRECISION, DIMENSION(1:nx), INTENT(IN) :: x 55 | DOUBLE PRECISION, DIMENSION(1:ny), INTENT(IN) :: y 56 | 57 | ! Outputs 58 | DOUBLE PRECISION, DIMENSION(1:nx,1:ny), INTENT(OUT) :: v 59 | END SUBROUTINE evalVertVelocities 60 | 61 | END INTERFACE 62 | 63 | DO stage = 1,3 64 | SELECT CASE(stage) 65 | CASE(1) 66 | t_temp = time 67 | CASE(2) 68 | t_temp = time + dt 69 | CASE(3) 70 | t_temp = time + 0.5D0*dt 71 | END SELECT 72 | ! Velocities at quadrature nodes 73 | CALL evalHorizVelocities(uTmp,DGx,yOut,nxOut,nyOut,t_temp) 74 | CALL evalVertVelocities(vTmp,xOut,DGy,nxOut,nyOut,t_temp) 75 | uOut(stage,:,:) = uTmp 76 | vOut(stage,:,:) = vTmp 77 | 78 | ! Velocities at element edges 79 | CALL evalHorizVelocities(uEdgeTmp,elemEdgeX,yOut,nex,nyOut,t_temp) 80 | CALL evalVertVelocities(vEdgeTmp,xOut,elemEdgeY,nxOut,ney,t_temp) 81 | uEdge(stage,:,:) = uEdgeTmp 82 | vEdge(stage,:,:) = vEdgeTmp 83 | 84 | ENDDO !stage 85 | END SUBROUTINE updateVelocities 86 | -------------------------------------------------------------------------------- /_src/qinit.f90: -------------------------------------------------------------------------------- 1 | SUBROUTINE qinit(xVals,yVals,nx,ny,q,reactiveCoeffs) 2 | ! ============================================================================== 3 | ! Computes initial conditions for q fields 4 | ! INPUTS: meqn - number of fields to evaluate 5 | ! nx,ny - number of points to evaluate q at 6 | ! 7 | ! OUTPUTS: q(i,j,neq) - initial conditions evaluated at xvals(i) for neqth field 8 | ! reactiveCoeffs(i,j,neq) - reactive flow coefficient at xval(i),yval(j) 9 | ! ============================================================================== 10 | USE commonTestParameters 11 | IMPLICIT NONE 12 | ! Inputs 13 | INTEGER,INTENT(IN) :: nx,ny 14 | DOUBLE PRECISION, DIMENSION(1:nx), INTENT(IN) :: xVals 15 | DOUBLE PRECISION, DIMENSION(1:ny), INTENT(IN) :: yVals 16 | ! Outputs 17 | DOUBLE PRECISION, DIMENSION(1:nx,1:ny,1:meqn), INTENT(OUT) :: q,reactiveCoeffs 18 | ! Local variables 19 | INTEGER :: i,j 20 | DOUBLE PRECISION, DIMENSION(1:nx,1:ny) :: r,d 21 | DOUBLE PRECISION :: x0,y0,qT 22 | 23 | reactiveCoeffs = 0D0 24 | IF(doreactive) THEN 25 | qT = 4D-6 26 | x0 = 0.25D0 27 | IF(meqn > 3) then 28 | write(*,*) 'ERROR! In qinit().. reactive test only supports meqn <= 3' 29 | STOP 30 | ENDIF 31 | 32 | reactiveCoeffs(:,:,1) = 1D0 33 | reactiveCoeffs(:,:,2) = 0D0 34 | reactiveCoeffs(:,:,3) = 0D0 35 | ! DO i=1,nx 36 | ! IF(abs(xVals(i)-x0) .le. 0.25D0) THEN 37 | ! reactiveCoeffs(i,:,1) = COS(2D0*PI*(xVals(i)-x0)) 38 | ! ENDIF 39 | ! ENDDO !i 40 | ENDIF 41 | 42 | q = 0D0 43 | SELECT CASE(testID) 44 | CASE(0) ! Uniform field 45 | q = 1D0 46 | CASE(1) ! Sine wave 47 | DO j=1,ny 48 | q(:,j,1) = sin(2.d0*PI*xVals(:))*sin(2.d0*PI*yVals(j)) 49 | ENDDO !j 50 | CASE(2) ! Terminator ics 51 | DO j=1,ny 52 | r(:,j) = 0.25D0*reactiveCoeffs(:,j,1)/reactiveCoeffs(:,j,2)!ABS(xVals(:)-0.25D0) 53 | d(:,j) = sqrt(r(:,j)*r(:,j)+2D0*qT*r(:,j)) 54 | ENDDO !j 55 | q = 0D0 56 | q(:,:,2) = d-r 57 | q(:,:,1) = 0.5D0*qT-0.5D0*(d-r) 58 | ! WHERE(r .lt. 0.25D0) 59 | ! q(:,:,1) = 1D0 60 | ! END WHERE 61 | ! q(:,:,2) = 1D0-q(:,:,1) 62 | ! q(:,:,2) = 2D0*q(:,:,2) 63 | CASE(5) ! Cosbell deformation from LeVeque 64 | DO j=1,ny 65 | r(:,j) = 4D0*SQRT( (xVals-0.25D0)**2 + (yVals(j)-0.25D0)**2 ) 66 | ENDDO !j 67 | q = 0D0 68 | WHERE(r .lt. 1D0) 69 | q(:,:,1) = 0.25D0*(1D0+DCOS(PI*r))**2 70 | END WHERE 71 | !q(:,:,2) = 1D0 72 | 73 | ! q(:,:,3) = 0D0 74 | 75 | CASE(6) ! Smoother cosbell 76 | DO j=1,ny 77 | r(:,j) = 4D0*SQRT( (xVals-0.25D0)**2 + (yVals(j)-0.25D0)**2 ) 78 | ENDDO !j 79 | q = 0D0 80 | WHERE(r .lt. 1D0) 81 | q(:,:,1) = (0.5D0*(1D0+DCOS(PI*r)))**3 82 | END WHERE 83 | 84 | CASE(7) ! Slotted cylinder in deformation flow 85 | x0 = 0.25D0 86 | y0 = 0.5D0 87 | DO j=1,ny 88 | r(:,j) = SQRT((xVals-x0)**2 + (yVals(j)-y0)**2) 89 | ENDDO !j 90 | q = 0D0 91 | WHERE(r .lt. .15D0) 92 | q(:,:,1) = 1D0 93 | END WHERE 94 | 95 | DO j=1,ny 96 | DO i=1,nx 97 | IF(ABS(xVals(i)-x0) .lt. 0.025D0 .AND. yVals(j) .gt.(y0-0.0625D0)) THEN 98 | q(i,j,1) = 0D0 99 | ENDIF 100 | ENDDO !i 101 | ENDDO !j 102 | END SELECT !testID 103 | END SUBROUTINE qinit 104 | -------------------------------------------------------------------------------- /split_2d_nodal.f90: -------------------------------------------------------------------------------- 1 | ! ===================================== 2 | ! Split 2D modal algorithm for tracer transport 3 | ! Strang splitting and Legendre basis to simulate 2D tracer transport equations with variable windspeeds 4 | ! 5 | ! Dependencies: 6 | ! netCDF 7 | ! LAPACK 8 | ! 9 | ! By: Devin Light ; Mar. 2015 10 | ! ===================================== 11 | 12 | PROGRAM EXECUTE 13 | USE commonTestParameters 14 | USE netCDF 15 | 16 | IMPLICIT NONE 17 | INTEGER :: startRes,noutput,nRuns,nScale 18 | REAL(KIND=8) :: muMAX,cflCoeff 19 | 20 | INTERFACE 21 | SUBROUTINE DRIVER(nex0,ney0,nscale,nruns,noutput,maxCFL) 22 | INTEGER, INTENT(IN) :: nex0,ney0,nscale,nruns,noutput 23 | REAL(KIND=8), INTENT(IN) :: maxCFL 24 | END SUBROUTINE DRIVER 25 | END INTERFACE 26 | 27 | NAMELIST /inputs/ startRes,nRuns,nScale,maxPolyDegree,cflCoeff,noutput,meqn, & 28 | testID,tfinal,TRANSIENT,DOREACTIVE,DEBUG,uMean,vMean 29 | inUnit=20 30 | OPEN(unit=inUnit,file="inputs.nl",action="read") 31 | READ(inUnit,NML=inputs) 32 | 33 | doposlimit = .FALSE. 34 | 35 | write(*,*) meqn 36 | muMAX = determineCFL(maxPolyDegree,cflCoeff) 37 | 38 | write(*,*) '======================================================' 39 | write(*,*) ' BEGINNING RUN OF NODAL TESTS ' 40 | write(*,'(A27,F7.4)') 'muMAX=',muMAX 41 | write(*,'(A13,L5)') 'TRANSIENT =',transient 42 | write(*,'(A13,L5)') 'REACTIVE =',doreactive 43 | write(*,'(A9,I5)') 'meqn = ',meqn 44 | write(*,'(A20,2F7.4)') 'mean flow (U,V) = ',uMean,vMean 45 | write(*,*) '======================================================' 46 | 47 | write(*,*) '======' 48 | SELECT CASE(testID) 49 | CASE(0) 50 | write(*,*) 'TEST 0: Consistency test' 51 | CASE(1) 52 | write(*,*) 'TEST 1: Uniform advection (u=v=1)' 53 | CASE(2) 54 | write(*,*) 'TEST 2: Reactive Half-plane flow' 55 | CASE(5) 56 | write(*,*) 'TEST 5: LeVeque Cosbell Deformation Test' 57 | CASE(6) 58 | write(*,*) 'TEST 6: LeVeque Smoother Cosbell Deformation Test' 59 | CASE(7) 60 | write(*,*) 'TEST 7: Slotted Cylinder Deformation Test' 61 | CASE(99) 62 | write(*,*) 'TEST 99: Non-advective Flow' 63 | CASE DEFAULT 64 | write(*,*) ' ******** WARNING:: TEST NOT AVAILABLE *******' 65 | STOP 66 | END SELECT 67 | write(*,*) 'WARNING: Only periodic BCs are implemented' 68 | write(*,*) '======' 69 | CALL driver(startRes,startRes,nScale,nRuns,noutput,muMAX) 70 | CLOSE(inUnit) 71 | WRITE(*,*) 'PROGRAM COMPLETE!' 72 | 73 | CONTAINS 74 | FUNCTION determineCFL(maxPolyDegree,cflCoeff) 75 | ! =============================================================== 76 | ! Determines max CFL for SSPRK3 timestepping as a function of 77 | ! maximum reconstructing polynomial degree 78 | ! =============================================================== 79 | IMPLICIT NONE 80 | ! Inputs 81 | INTEGER, INTENT(IN) :: maxPolyDegree 82 | DOUBLE PRECISION :: cflCoeff 83 | ! Outputs 84 | DOUBLE PRECISION determineCFL 85 | ! Local variables 86 | 87 | SELECT CASE(maxPolyDegree) 88 | CASE(2) 89 | determineCFL = 0.450D0 90 | CASE(3) 91 | determineCFL = 0.255D0 92 | CASE(4) 93 | determineCFL = 0.168D0 94 | CASE(5) 95 | determineCFL = 0.120D0 96 | CASE(6) 97 | determineCFL = 0.091D0 98 | CASE(7) 99 | determineCFL = 0.073D0 100 | CASE(8) 101 | determineCFL = 0.059D0 102 | CASE(9) 103 | determineCFL = 0.049D0 104 | END SELECT 105 | determineCFL = determineCFL*cflCoeff 106 | 107 | END FUNCTION determineCFL 108 | 109 | END PROGRAM EXECUTE 110 | -------------------------------------------------------------------------------- /_src/output2d.f90: -------------------------------------------------------------------------------- 1 | SUBROUTINE output2d(q,xOut,yOut,timeOut,muOut,cdfOut,ilvl,stat) 2 | ! ============================================================================ 3 | ! output2d - Creates netCDF output files and writes out different output fields 4 | ! INPUTS: q(nx,ny,meqn) 5 | ! xOut(nx),yOut(ny) 6 | ! timeOut,muOut 7 | ! OUTPUTS: -None- 8 | ! ============================================================================ 9 | USE commonTestParameters 10 | USE netCDF 11 | IMPLICIT NONE 12 | ! Inputs 13 | INTEGER, INTENT(IN) :: ilvl,stat 14 | CHARACTER(len=60), INTENT(IN) :: cdfOut 15 | DOUBLE PRECISION, INTENT(IN) :: muOut,timeOut 16 | DOUBLE PRECISION, DIMENSION(1:nxOut), INTENT(IN) :: xOut 17 | DOUBLE PRECISION, DIMENSION(1:nyOut), INTENT(IN) :: yOut 18 | DOUBLE PRECISION, DIMENSION(1:nxOut,1:nyOut,1:meqn), INTENT(IN) :: q 19 | ! Outputs 20 | ! Local variables 21 | INTEGER, PARAMETER :: NDIMS = 4 22 | INTEGER :: idt, meqn_dimid, x_dimid, y_dimid, t_dimid,idx, idy, idmu, idmpd,idq 23 | CHARACTER(len=8) :: nxname,xname,nyname,yname,qname,muname,meqnName 24 | INTEGER, DIMENSION(1:NDIMS) :: start, count,dimids(NDIMS) 25 | INTEGER :: i,ierr,m,j 26 | DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: tmp 27 | DOUBLE PRECISION, DIMENSION(1:nxOut) :: qSlice 28 | 29 | SAVE start,count,idq,t_dimid,meqn_dimid 30 | 31 | IF(stat == -1) THEN 32 | ! Create netCDF file and time variables 33 | ierr = NF90_CREATE(TRIM(cdfOut),NF90_CLOBBER,cdfID) 34 | 35 | ierr = NF90_REDEF(cdfID) 36 | ierr = NF90_DEF_DIM(cdfID, "nt", ilvl+1, t_dimid) 37 | ierr = NF90_DEF_DIM(cdfID, "meqn", meqn, meqn_dimid) 38 | ierr = NF90_DEF_VAR(cdfID, "time", NF90_FLOAT, t_dimid,idt) 39 | ierr = NF90_DEF_VAR(cdfID, "maxPoly",NF90_INT,idmpd) 40 | 41 | ierr = NF90_ENDDEF(cdfID) 42 | 43 | ! Calculate time at output levels (note ilvl=noutput) 44 | ALLOCATE(tmp(1:ilvl+1), STAT=ierr) 45 | DO i=0,ilvl 46 | tmp(i+1) = DBLE(i)*timeOut/DBLE(ilvl) 47 | ENDDO 48 | 49 | ! Write t values 50 | ierr = NF90_PUT_VAR(cdfID,idt,tmp) 51 | ierr = NF90_PUT_VAR(cdfID,idmpd,maxPolyDegree) 52 | 53 | DEALLOCATE(tmp, STAT=ierr) 54 | RETURN 55 | ELSEIF(stat == 0) THEN 56 | ! Create dimensions and variables for this level of runs (ilvl = p) 57 | start = 1 58 | count = 1 59 | ! Define names of variables 60 | WRITE(nxname,'(a2,i1)') 'nx',ilvl 61 | WRITE(nyname,'(a2,i1)') 'ny',ilvl 62 | WRITE(xname, '(a1,i1)') 'x',ilvl 63 | WRITE(yname, '(a1,i1)') 'y',ilvl 64 | WRITE(qname, '(a1,i1)') 'Q',ilvl 65 | WRITE(muname, '(a2,i1)') 'mu',ilvl 66 | 67 | ierr = NF90_REDEF(cdfID) 68 | 69 | ierr = NF90_DEF_DIM(cdfID, TRIM(nxname), nxOut, x_dimid) 70 | ierr = NF90_DEF_DIM(cdfID, TRIM(nyname), nyOut, y_dimid) 71 | 72 | dimids(1) = x_dimid 73 | dimids(2) = y_dimid 74 | dimids(3) = t_dimid 75 | dimids(4) = meqn_dimid 76 | 77 | ierr = NF90_DEF_VAR(cdfid, TRIM(qname),NF90_FLOAT,dimids,idq) 78 | ierr = NF90_DEF_VAR(cdfid, TRIM(xname),NF90_FLOAT,x_dimid,idx) 79 | ierr = NF90_DEF_VAR(cdfid, TRIM(yname),NF90_FLOAT,y_dimid,idy) 80 | ierr = NF90_DEF_VAR(cdfid, TRIM(muname),NF90_FLOAT,idmu) 81 | 82 | ierr = NF90_ENDDEF(cdfid) 83 | 84 | ! Write x and y values 85 | ierr = NF90_PUT_VAR(cdfid, idx, xOut) 86 | ierr = NF90_PUT_VAR(cdfid, idy, yOut) 87 | ierr = NF90_PUT_VAR(cdfid,idmu,muOut) 88 | 89 | start(3) = 1 90 | ELSEIF(stat == 1) THEN 91 | ! Close netCDF output file 92 | ierr = NF90_CLOSE(cdfid) 93 | RETURN 94 | ENDIF ! stat 95 | ! Write out concentration field 96 | count(1) = nxOut 97 | DO m=1,meqn 98 | start(4) = m 99 | DO j=1,nyOut 100 | start(2) = j 101 | qSlice = q(:,j,m) 102 | ierr = NF90_PUT_VAR(cdfid,idq,qSlice,start,count) 103 | ENDDO !ylvl 104 | ENDDO !meqn 105 | 106 | ! Increment t level 107 | start(3) = start(3) + 1 108 | 109 | 110 | END SUBROUTINE output2d 111 | -------------------------------------------------------------------------------- /_src/computeErrors.f90: -------------------------------------------------------------------------------- 1 | SUBROUTINE computeErrors(qOut,q0,quadWeights,e1,e2,ei,cons,qMax,qMin,tf,nRuns,nex0,ney0,nscale,stat) 2 | ! ============================================================================= 3 | ! Prints error estimates and other useful information to screen 4 | ! INPUTS: qOut - current estimate solution 5 | ! q0 - initial conditions 6 | ! quadWeights - quadrature weights (used in conservation estimation) 7 | ! tf(p) - cput time for pth run 8 | ! stat - status integer 9 | ! ovrshoot(p,m) - maximum overshoot in appx soln at plotting times 10 | ! undrshoot(p,m) - maximum undershoot in appx soln at plotting times 11 | ! OUTPUTS: e1(p,m) - L1 error estimate 12 | ! e2(p,m) - L2 error estimate 13 | ! ei(p,m) - Linf error estimate 14 | ! cons(p,m) - conservation estimate 15 | ! ============================================================================= 16 | USE commonTestParameters 17 | IMPLICIT NONE 18 | ! Inputs 19 | INTEGER, INTENT(IN) :: nRuns,stat,nscale,nex0,ney0 20 | DOUBLE PRECISION, DIMENSION(1:nxOut,1:nyOut,1:meqn), INTENT(IN) :: q0,qOut 21 | DOUBLE PRECISION, DIMENSION(1:nRuns,1:meqn), INTENT(IN) :: qMax,qMin 22 | DOUBLE PRECISION, DIMENSION(0:nQuad), INTENT(IN) :: quadWeights 23 | REAL(KIND=4), DIMENSION(1:nRuns),INTENT(IN) :: tf 24 | ! Outputs 25 | DOUBLE PRECISION, DIMENSION(1:nRuns,1:meqn),INTENT(INOUT) :: e1,e2,ei,cons 26 | ! Local variables 27 | INTEGER :: p,m,startHoriz,startVert,endHoriz,endVert,i,j,l,currnex,currney 28 | DOUBLE PRECISION, DIMENSION(0:maxPolyDegree,0:maxPolyDegree) :: coeffs,tmp 29 | CHARACTER(len=2) :: qname 30 | DOUBLE PRECISION :: cnvg1,cnvg2,cnvgi 31 | 32 | IF(stat == -1) THEN 33 | ! Write error output to screen 34 | DO m=1,meqn 35 | WRITE(qname,'(a,i1)') 'q',m 36 | WRITE(*,*) '====================' 37 | WRITE(*,'(a12)') qname 38 | WRITE(*,*) '====================' 39 | WRITE(*,'(A115)') & 40 | 'nex ney E1 E2 Einf convergence rate maximum minimum cons cputime tf' 41 | 42 | cnvg1 = 0D0 43 | cnvg2 = 0D0 44 | cnvgi = 0D0 45 | 46 | DO p=1,nRuns 47 | IF(p.gt.1) THEN 48 | cnvg1 = -log(e1(p,m)/e1(p-1,m))/log(dble(nscale)) 49 | cnvg2 = -log(e2(p,m)/e2(p-1,m))/log(dble(nscale)) 50 | cnvgi = -log(ei(p,m)/ei(p-1,m))/log(dble(nscale)) 51 | ENDIF 52 | 53 | currnex = nex0*nscale**(p-1) 54 | currney = ney0*nscale**(p-1) 55 | 56 | WRITE(*,990) currnex, currney, e1(p,m), e2(p,m), ei(p,m), & 57 | cnvg1, cnvg2, cnvgi, & 58 | qMax(p,m), & 59 | qMin(p,m), & 60 | cons(p,m), tf(p),tfinal 61 | ENDDO!p 62 | ENDDO !m 63 | 990 format(2i6,3e12.4,3f5.2,3e12.4,2f8.2) 64 | ELSE 65 | ! Compute error estimates for this run 66 | DO m=1,meqn 67 | ! Conservation estimate 68 | cons(stat,m) = 0D0 69 | e1(stat,m) = 0D0 70 | e2(stat,m) = 0D0 71 | DO i=1,nex 72 | DO j=1,ney 73 | startHoriz = 1+(maxPolyDegree+1)*(i-1) 74 | startVert = 1+(maxPolyDegree+1)*(j-1) 75 | endHoriz = startHoriz + maxPolyDegree 76 | endVert = startVert + maxPolyDegree 77 | 78 | coeffs(:,:) = qOut(startHoriz:endHoriz,startVert:endVert,m)-q0(startHoriz:endHoriz,startVert:endVert,m) 79 | DO l=0,maxPolyDegree 80 | tmp(:,l) = 0.25D0*coeffs(:,l)*quadWeights(:)*quadWeights(l) 81 | ENDDO !l 82 | cons(stat,m) = cons(stat,m) + SUM(tmp) 83 | 84 | DO l=0,maxPolyDegree 85 | tmp(:,l) = 0.25D0*abs(coeffs(:,l))*quadWeights(:)*quadWeights(l) 86 | ENDDO !l 87 | e1(stat,m) = e1(stat,m) + SUM(tmp) 88 | 89 | DO l=0,maxPolyDegree 90 | tmp(:,l) = 0.25D0*quadWeights(:)*quadWeights(l)*coeffs(:,l)**2 91 | ENDDO !l 92 | e2(stat,m) = e2(stat,m) + SUM(tmp) 93 | ENDDO !j 94 | ENDDO!i 95 | cons(stat,m) = cons(stat,m)/DBLE(nex*ney) 96 | e1(stat,m) = e1(stat,m)/DBLE(nex*ney) 97 | e2(stat,m) = SQRT(e2(stat,m)/DBLE(nex*ney)) 98 | ei(stat,m) = MAXVAL(ABS( qOut(:,:,m)-q0(:,:,m) )) 99 | ENDDO !m 100 | 101 | ENDIF 102 | 103 | END SUBROUTINE computeErrors 104 | -------------------------------------------------------------------------------- /_src/reactiveStep.f90: -------------------------------------------------------------------------------- 1 | SUBROUTINE reactiveStep(q,dt,forcingCoeffs) 2 | ! ================================================================================ 3 | ! Takes a single time step to update subcell average values to tn+1 4 | ! for "toy chemistry problem" 5 | ! dq1/dt = -k1 q1 + k2 q2^2 6 | ! dq2/dt = 2 k1 q1 - 2 k2 q2^2 7 | ! Currently uses 2-stage, 2nd order Rosenbock Runge-Kutta method with the following parameters: 8 | ! (see Durran "Numerical Methods for Fluid Dynamics") 9 | ! b1 = b2 = 0.5 ; alpha = 1+0.5*sqrt(2) ; a21 = 1 ; alpha21 = -2 alpha 10 | ! 11 | ! INPUTS: 12 | ! OUTPUTS: q(i,j,m) - mth field subcell averages updated to new time 13 | ! ================================================================================ 14 | USE commonTestParameters 15 | IMPLICIT NONE 16 | ! Inputs 17 | DOUBLE PRECISION, INTENT(IN) :: dt 18 | DOUBLE PRECISION, DIMENSION(1:nxOut,1:nyOut,1:meqn), INTENT(IN) :: forcingCoeffs 19 | ! Outputs 20 | DOUBLE PRECISION, DIMENSION(1:nxOut,1:nyOut,1:meqn), INTENT(INOUT) :: q 21 | ! Local variables 22 | INTEGER i,j,m,ierr 23 | DOUBLE PRECISION, DIMENSION(1:nxOut,1:nyOut,1:meqn,1:meqn) :: jac 24 | DOUBLE PRECISION, DIMENSION(1:meqn) :: fRHS,localCoeffs,IPIV 25 | DOUBLE PRECISION, DIMENSION(1:meqn,1:meqn) :: A,eye 26 | DOUBLE PRECISION, DIMENSION(1:meqn) :: localQ,localQ1,localQ2 27 | DOUBLE PRECISION :: alpha,alpha21 28 | 29 | INTERFACE 30 | SUBROUTINE reactiveJacobian(jacobian,qVals,forcingCoeffs,nx,ny) 31 | ! ============================================================================== 32 | ! Computes right hand side forcing term for chemical reaction equation 33 | ! INPUTS: 34 | ! qVals(1:nx,1:ny,1:meqn) - solution values at given points 35 | ! forcingCoeffs(1:nx,1:ny,1:meqn) - forcing coefficients multiplying fields q1,..qmeqn 36 | ! evaluated at given grid 37 | ! OUTPUTS: 38 | ! jacobian(1:nx,1:ny,1:meqn,1:meqn) - jacobian matrix evaluated at grid points 39 | ! ============================================================================== 40 | 41 | USE commonTestParameters 42 | IMPLICIT NONE 43 | ! Inputs 44 | INTEGER, INTENT(IN) :: nx,ny 45 | DOUBLE PRECISION, DIMENSION(1:nx,1:ny,1:meqn), INTENT(IN) ::qVals,forcingCoeffs 46 | ! Outputs 47 | DOUBLE PRECISION, DIMENSION(1:nx,1:ny,1:meqn,1:meqn), INTENT(OUT) :: jacobian 48 | END SUBROUTINE reactiveJacobian 49 | 50 | SUBROUTINE reactiveForcing(forcing,qVals,forcingCoeffs) 51 | ! ============================================================================== 52 | ! Computes right hand side forcing term for chemical reaction equation 53 | ! INPUTS: 54 | ! qVals(1:meqn) - solution values at given points 55 | ! forcingCoeffs(1:meqn) - forcing coefficients multiplying fields q1,..qmeqn 56 | ! OUTPUTS: forcing(1:meqn) - RHS forcing function for fields q1,...,qmeqn 57 | ! 58 | ! ============================================================================== 59 | USE commonTestParameters 60 | IMPLICIT NONE 61 | ! Inputs 62 | DOUBLE PRECISION, DIMENSION(1:meqn), INTENT(IN) :: qVals,forcingCoeffs 63 | ! Outputs 64 | DOUBLE PRECISION, DIMENSION(1:meqn), INTENT(OUT) :: forcing 65 | END SUBROUTINE reactiveForcing 66 | END INTERFACE 67 | 68 | !alpha = 1D0+0.5D0/sqrt(2D0) 69 | alpha = 1D0+0.5D0*sqrt(2D0) 70 | alpha21 = -2D0*alpha 71 | 72 | eye = 0D0 73 | DO m=1,meqn 74 | eye(m,m) = 1D0 75 | ENDDO !m 76 | 77 | ! Fill in jacobian for this time 78 | jac = 0D0 79 | CALL reactiveJacobian(jac,q,forcingCoeffs,nxOut,nyOut) 80 | 81 | DO i=1,nxOut 82 | DO j=1,nyOut 83 | ! Form LHS A matrix 84 | A = eye - alpha*dt*jac(i,j,:,:) 85 | localCoeffs = forcingCoeffs(i,j,:) 86 | localQ = q(i,j,:) 87 | ! write(*,*) 'calling reactiveForcing 1..' 88 | CALL reactiveForcing(fRHS,localQ,localCoeffs) 89 | ! write(*,*) '..after reactiveForcing 1' 90 | ! Solve for first stage 91 | CALL DGESV(meqn,1,A,meqn,IPIV,fRHS,meqn,ierr) 92 | localQ1 = fRHS 93 | 94 | ! write(*,*) 'calling reactiveForcing 2..' 95 | CALL reactiveForcing(fRHS,localQ+dt*localQ1,localCoeffs) 96 | ! write(*,*) '..after reactiveForcing 2' 97 | fRHS = fRHS-2D0*localQ1 98 | ! Solve for second stage 99 | CALL DGESV(meqn,1,A,meqn,IPIV,fRHS,meqn,ierr) 100 | localQ2 = fRHS 101 | 102 | q(i,j,:) = q(i,j,:)+0.5D0*dt*(3D0*localQ1+localQ2) 103 | ENDDO !j 104 | ENDDO !i 105 | END SUBROUTINE reactiveStep 106 | -------------------------------------------------------------------------------- /_src/init2d.f90: -------------------------------------------------------------------------------- 1 | SUBROUTINE init2d(q,u,v,uEdge,vEdge,xPlot,yPlot,DGx,DGy,quadNodes,dxel,dyel,& 2 | dxPlot,dyPlot,elemCenterX,elemCenterY,reactiveCoeffs) 3 | ! ============================================================================== 4 | ! Computes initial conditions for q,u,v fields 5 | ! INPUTS: meqn - number of fields to evaluate 6 | ! nx,ny - number of points to evaluate q,u,v at 7 | ! quadNodes - local locations to evaluate velocities at 8 | ! elemCenterX, elemCenterY - element center locations 9 | ! 10 | ! OUTPUTS: q(i,j,neq) - initial conditions evaluated for neqth field 11 | ! u(i,j),v(i,j) - velocities evaluated at quadrature locations 12 | ! uEdge,vEdge - velocities at edges of each element 13 | ! reactiveCoeffs - reaction coefficients at x(i),y(j) 14 | ! ============================================================================== 15 | USE commonTestParameters 16 | IMPLICIT NONE 17 | ! Inputs 18 | DOUBLE PRECISION, INTENT(IN) :: dxel, dyel,dxPlot,dyPlot 19 | DOUBLE PRECISION, DIMENSION(0:nQuad), INTENT(IN) :: quadNodes 20 | DOUBLE PRECISION, DIMENSION(1:nxOut), INTENT(IN) :: xPlot 21 | DOUBLE PRECISION, DIMENSION(1:nyOut), INTENT(IN) :: yPlot 22 | DOUBLE PRECISION, DIMENSION(1:nex), INTENT(IN) :: elemCenterX 23 | DOUBLE PRECISION, DIMENSION(1:ney), INTENT(IN) :: elemCenterY 24 | ! Outputs 25 | DOUBLE PRECISION, DIMENSION(1:nxOut,1:nyOut,1:meqn) :: q,reactiveCoeffs 26 | DOUBLE PRECISION, DIMENSION(1:nxOut,1:nyOut) :: u,v 27 | DOUBLE PRECISION, DIMENSION(1:nex,1:nyOut), INTENT(OUT) :: uEdge 28 | DOUBLE PRECISION, DIMENSION(1:nxOut,1:ney), INTENT(OUT) :: vEdge 29 | DOUBLE PRECISION, DIMENSION(1:nxOut), INTENT(OUT) :: DGx 30 | DOUBLE PRECISION, DIMENSION(1:nyOut), INTENT(OUT) :: DGy 31 | 32 | ! Local Variables 33 | INTEGER :: i,j,l 34 | DOUBLE PRECISION, DIMENSION(1:nxOut,0:1) :: xtilde 35 | DOUBLE PRECISION, DIMENSION(1:nyOut,0:1) :: ytilde 36 | DOUBLE PRECISION, DIMENSION(1:nxOut,1:nyOut,0:1) :: psiu,psiv 37 | DOUBLE PRECISION, DIMENSION(1:nex,1:nyOut,0:1) :: psiuEdge 38 | DOUBLE PRECISION, DIMENSION(1:nxOut,1:ney,0:1) :: psivEdge 39 | 40 | INTERFACE 41 | SUBROUTINE qinit(xVals,yVals,nx,ny,q,reactiveCoeffs) 42 | USE commonTestParameters 43 | IMPLICIT NONE 44 | ! Inputs 45 | INTEGER,INTENT(IN) :: nx,ny 46 | DOUBLE PRECISION, DIMENSION(1:nx) :: xVals 47 | DOUBLE PRECISION, DIMENSION(1:ny) :: yVals 48 | ! Outputs 49 | DOUBLE PRECISION, DIMENSION(1:nx,1:ny,1:meqn) :: q,reactiveCoeffs 50 | END SUBROUTINE 51 | END INTERFACE 52 | 53 | ! Compute ICs on plotting grid 54 | CALL qinit(xPlot,yPlot,nxOut,nyOut,q,reactiveCoeffs) 55 | 56 | ! ==================================================== 57 | ! Compute velocities at quad nodes from streamfunction 58 | ! ==================================================== 59 | xtilde(:,0) = xPlot(:)-0.5D0*dxPlot 60 | xtilde(:,1) = xPlot(:)+0.5D0*dxPlot 61 | 62 | ytilde(:,0) = yPlot(:)-0.5D0*dyPlot 63 | ytilde(:,1) = yPlot(:)+0.5D0*dyPlot 64 | 65 | DO i=1,nex 66 | DGx(1+(i-1)*(maxPolyDegree+1):i*(maxPolyDegree+1)) = elemCenterX(i)+0.5D0*dxel*quadNodes(0:nQuad) 67 | ENDDO 68 | 69 | DO i=1,ney 70 | DGy(1+(i-1)*(maxPolyDegree+1):i*(maxPolyDegree+1)) = elemCenterY(i)+0.5D0*dyel*quadNodes(0:nQuad) 71 | ENDDO 72 | 73 | SELECT CASE(testID) 74 | CASE(0,1) ! uniform diagonal advection of a sine wave 75 | ! Evaluate stream function for horizontal velocities 76 | DO j=1,nyOut 77 | psiu(:,j,0) = -DGx(:) + ytilde(j,0) 78 | psiu(:,j,1) = -DGx(:) + ytilde(j,1) 79 | psiuEdge(:,j,0) = -(elemCenterX(:)+0.5D0*dxel) + ytilde(j,0) 80 | psiuEdge(:,j,1) = -(elemCenterX(:)+0.5D0*dxel) + ytilde(j,1) 81 | ENDDO!j 82 | 83 | ! Evaluate stream function for vertical velocities 84 | DO i=1,nxOut 85 | psiv(i,:,0) = -xtilde(i,0)+DGy(:) 86 | psiv(i,:,1) = -xtilde(i,1)+DGy(:) 87 | psivEdge(i,:,0) = -xtilde(i,0)+(elemCenterY(:)+0.5D0*dyel) 88 | psivEdge(i,:,1) = -xtilde(i,1)+(elemCenterY(:)+0.5D0*dyel) 89 | ENDDO!i 90 | CASE(99) ! no flow 91 | psiu = 0D0 92 | psiv = 0D0 93 | psiuEdge = 0d0 94 | psivEdge = 0d0 95 | CASE(2,5:7) ! LeVeque deformation flow 96 | ! Evaluate stream function for horizontal velocities (1/pi)*sin(pi*xf(i))**2 * sin(pi*yf(j))**2 97 | DO j=1,nyOut 98 | psiu(:,j,0) = (SIN(PI*DGx(:))**2 * SIN(PI*ytilde(j,0))**2 )/PI 99 | psiu(:,j,1) = (SIN(PI*DGx(:))**2 * SIN(PI*ytilde(j,1))**2 )/PI 100 | psiuEdge(:,j,0) = (SIN(PI*(elemCenterX(:)+0.5D0*dxel))**2 * SIN(PI*ytilde(j,0))**2)/PI 101 | psiuEdge(:,j,1) = (SIN(PI*(elemCenterX(:)+0.5D0*dxel))**2 * SIN(PI*ytilde(j,1))**2)/PI 102 | ENDDO!j 103 | 104 | ! Evaluate stream function for vertical velocities 105 | DO i=1,nxOut 106 | psiv(i,:,0) = (SIN(PI*xtilde(i,0))**2 * SIN(PI*DGy(:))**2)/PI 107 | psiv(i,:,1) = (SIN(PI*xtilde(i,1))**2 * SIN(PI*DGy(:))**2)/PI 108 | psivEdge(i,:,0) = (SIN(PI*xtilde(i,0))**2 * SIN(PI*(elemCenterY(:)+0.5D0*dyel))**2)/PI 109 | psivEdge(i,:,1) = (SIN(PI*xtilde(i,1))**2 * SIN(PI*(elemCenterY(:)+0.5D0*dyel))**2)/PI 110 | ENDDO!i 111 | END SELECT !testID 112 | 113 | ! Compute u velocities from stream function 114 | DO j=1,nyOut 115 | u(:,j) = uMean+(psiu(:,j,1)-psiu(:,j,0))/dyPlot 116 | uEdge(:,j) = uMean+(psiuEdge(:,j,1)-psiuEdge(:,j,0))/dyPlot 117 | ENDDO!j 118 | 119 | ! Compute v velocities from stream function 120 | DO i=1,nxOut 121 | v(i,:) = vMean-1D0*(psiv(i,:,1)-psiv(i,:,0))/dxPlot 122 | vEdge(i,:) = vMean-1D0*(psivEdge(i,:,1)-psivEdge(i,:,0))/dxPlot 123 | ENDDO!i 124 | 125 | END SUBROUTINE init2d 126 | -------------------------------------------------------------------------------- /_src/strangSplit.f90: -------------------------------------------------------------------------------- 1 | SUBROUTINE strangSplit(q,u,v,uEdge,vEdge,quadNodes,quadWeights,time,& 2 | basisPolyVal,basisPolyDeriv,avgOP,avgOP_LU,IPIV,& 3 | dt,dxel,dyel,reactiveCoeffs,oddstep) 4 | ! ===================================================================================================== 5 | ! strangSplitUpdate is responsible for selecting which slice of subcell volumes is sent to mDGsweep for update to time 6 | ! level tn+1 following a Strang splitting. 7 | ! For Strang splitting: 8 | ! - Each slice is updated 9 | ! - Odd steps: x-slices are updated first (horizontal advection) then y-slices are updated (vertical advection) 10 | ! - Even steps: y-slices are updated first then x-slices are updated (vertical advection) 11 | ! ===================================================================================================== 12 | USE commonTestParameters 13 | IMPLICIT NONE 14 | ! Inputs 15 | DOUBLE PRECISION, INTENT(IN) :: dt,dxel,dyel,time 16 | DOUBLE PRECISION, DIMENSION(1:3,1:nxOut,1:nyOut), INTENT(IN) :: u,v 17 | DOUBLE PRECISION, DIMENSION(1:3,1:nex,1:nyOut), INTENT(IN) :: uEdge 18 | DOUBLE PRECISION, DIMENSION(1:3,1:nxOut,1:ney), INTENT(IN) :: vEdge 19 | DOUBLE PRECISION, DIMENSION(0:nQuad), INTENT(IN) :: quadNodes,quadWeights 20 | DOUBLE PRECISION, DIMENSION(0:maxPolyDegree,0:nQuad), INTENT(IN) :: basisPolyVal,basisPolyDeriv 21 | DOUBLE PRECISION, DIMENSION(0:maxPolyDegree,0:maxPolyDegree),INTENT(IN) :: avgOP,avgOp_LU 22 | DOUBLE PRECISION, DIMENSION(1:nxOut,1:nyOut,1:meqn), INTENT(IN) :: reactiveCoeffs 23 | INTEGER, DIMENSION(0:maxPolyDegree), INTENT(IN) :: IPIV 24 | LOGICAL, INTENT(IN) :: oddstep 25 | ! Outputs 26 | DOUBLE PRECISION, DIMENSION(1:nxOut,1:nyOut,1:meqn), INTENT(INOUT) :: q 27 | ! Local variables 28 | INTEGER :: i,j,k 29 | DOUBLE PRECISION, DIMENSION(1:nxOut,1:meqn) :: q1dx 30 | DOUBLE PRECISION, DIMENSION(1:nyOut,1:meqn) :: q1dy 31 | DOUBLE PRECISION, DIMENSION(1:3,1:nxOut) :: u1dx 32 | DOUBLE PRECISION, DIMENSION(1:3,1:nyOut) :: v1dy 33 | DOUBLE PRECISION, DIMENSION(1:3,1:nex) :: uEdge1dx 34 | DOUBLE PRECISION, DIMENSION(1:3,1:ney) :: vEdge1dy 35 | 36 | INTERFACE 37 | SUBROUTINE updateSoln1d(q,u,uEdge,dt,dxel,nelem,nx,quadWeights,& 38 | basisVals,basisDeriv) 39 | ! =========================================================================== 40 | ! Takes full dt time step for one dimensional slice of subcell averages using SSPRK3 41 | ! integrator 42 | ! =========================================================================== 43 | USE commonTestParameters 44 | IMPLICIT NONE 45 | ! Inputs 46 | INTEGER, INTENT(IN) :: nelem,nx 47 | DOUBLE PRECISION, INTENT(IN) :: dxel,dt 48 | DOUBLE PRECISION, DIMENSION(0:nQuad), INTENT(IN) :: quadWeights 49 | DOUBLE PRECISION, DIMENSION(0:maxPolyDegree,0:nQuad), INTENT(IN) :: basisVals,& 50 | basisDeriv 51 | DOUBLE PRECISION, DIMENSION(1:3,1:nx), INTENT(IN) :: u 52 | DOUBLE PRECISION, DIMENSION(1:3,1:nelem), INTENT(IN) :: uEdge 53 | ! Outputs 54 | DOUBLE PRECISION, DIMENSION(1:nx,1:meqn), INTENT(INOUT) :: q 55 | END SUBROUTINE updateSoln1d 56 | 57 | SUBROUTINE reactiveStep(q,dt,reactiveCoeffs) 58 | ! ================================================================================ 59 | ! Takes a single time step to update subcell average values to tn+1 60 | ! for "toy chemistry problem" 61 | ! dq1/dt = -k1 q1 + k2 q2^2 62 | ! dq2/dt = 2 k1 q1 - 2 k2 q2^2 63 | ! Currently uses 2-stage, 2nd order Rosenbock Runge-Kutta method with the following parameters: 64 | ! (see Durran "Numerical Methods for Fluid Dynamics") 65 | ! b1 = b2 = 0.5 ; alpha = 1+1/(2 sqrt(2)) ; a21 = 1 ; alpha21 = -2 alpha 66 | ! 67 | ! INPUTS: 68 | ! OUTPUTS: q(i,j,m) - mth field subcell averages updated to new time 69 | ! ================================================================================ 70 | USE commonTestParameters 71 | IMPLICIT NONE 72 | ! Inputs 73 | DOUBLE PRECISION, INTENT(IN) :: dt 74 | DOUBLE PRECISION, DIMENSION(1:nxOut,1:nyOut,1:meqn), INTENT(IN) :: reactiveCoeffs 75 | ! Outputs 76 | DOUBLE PRECISION, DIMENSION(1:nxOut,1:nyOut,1:meqn), INTENT(INOUT) :: q 77 | END SUBROUTINE reactiveStep 78 | END INTERFACE 79 | 80 | IF(oddstep) THEN 81 | ! =================================== 82 | ! Perform sweeps in x-direction first 83 | ! =================================== 84 | DO j=1,nyOut 85 | q1dx = q(:,j,:) 86 | u1dx(1:3,:) = u(1:3,:,j) 87 | uEdge1dx(1:3,:) = uEdge(1:3,:,j) 88 | CALL updateSoln1d(q1dx,u1dx,uEdge1dx,dt,dxel,nex,nxOut,quadWeights,& 89 | basisPolyVal,basisPolyDeriv) 90 | ! Update solution 91 | q(:,j,:) = q1dx 92 | ENDDO!j 93 | 94 | DO i=1,nxOut 95 | q1dy = q(i,:,:) 96 | v1dy(1:3,:) = v(1:3,i,:) 97 | vEdge1dy(1:3,:) = vEdge(1:3,i,:) 98 | CALL updateSoln1d(q1dy,v1dy,vEdge1dy,dt,dyel,ney,nyOut,quadWeights,& 99 | basisPolyVal,basisPolyDeriv) 100 | ! Update solution 101 | q(i,:,:) = q1dy 102 | ENDDO !i 103 | 104 | IF(doreactive) CALL reactiveStep(q,dt,reactiveCoeffs) 105 | 106 | ELSE 107 | ! =================================== 108 | ! Perform sweeps in y-direction first 109 | ! =================================== 110 | IF(doreactive) CALL reactiveStep(q,dt,reactiveCoeffs) 111 | 112 | DO i=1,nxOut 113 | q1dy = q(i,:,:) 114 | v1dy(1:3,:) = v(1:3,i,:) 115 | vEdge1dy(1:3,:) = vEdge(1:3,i,:) 116 | CALL updateSoln1d(q1dy,v1dy,vEdge1dy,dt,dyel,ney,nyOut,quadWeights,& 117 | basisPolyVal,basisPolyDeriv) 118 | ! Update solution 119 | q(i,:,:) = q1dy 120 | ENDDO !i 121 | 122 | DO j=1,nyOut 123 | q1dx = q(:,j,:) 124 | u1dx(1:3,:) = u(1:3,:,j) 125 | uEdge1dx(1:3,:) = uEdge(1:3,:,j) 126 | CALL updateSoln1d(q1dx,u1dx,uEdge1dx,dt,dxel,nex,nxOut,quadWeights,& 127 | basisPolyVal,basisPolyDeriv) 128 | ! Update solution 129 | q(:,j,:) = q1dx 130 | ENDDO!j 131 | ENDIF !oddstep 132 | END SUBROUTINE strangSplit 133 | -------------------------------------------------------------------------------- /_src/mDGmod.f90: -------------------------------------------------------------------------------- 1 | ! ############################################################## 2 | ! Module containing Modal Discontinuous Galerkin basis functions, quadrature data 3 | ! and transformation matrix for use in 1D simulations. 4 | ! By : Devin Light 04.18.2013 5 | ! ############################################################## 6 | 7 | MODULE mDGmod 8 | IMPLICIT NONE 9 | INTEGER, PARAMETER, PRIVATE :: DOUBLE=KIND(1D0) 10 | 11 | CONTAINS 12 | 13 | ! ######################################################################## 14 | ! N-choose-k Function 15 | ! ######################################################################## 16 | REAL(KIND=DOUBLE) FUNCTION choose(alpha,k) 17 | IMPLICIT NONE 18 | INTEGER, INTENT(IN) :: k 19 | REAL(KIND=DOUBLE), INTENT(IN) :: alpha 20 | INTEGER :: i 21 | REAL(KIND=DOUBLE) :: HOLDER 22 | 23 | HOLDER = 1D0 24 | 25 | DO i = 1,k 26 | HOLDER = HOLDER*((alpha-DBLE(k-i))/(DBLE(i))) 27 | END DO 28 | choose = HOLDER 29 | END FUNCTION choose 30 | 31 | ! ######################################################################## 32 | ! Legendre Polynomial function of degree N 33 | ! ######################################################################## 34 | REAL(KIND=DOUBLE) FUNCTION legendre(x,N) 35 | IMPLICIT NONE 36 | REAL(KIND=DOUBLE), INTENT(IN) :: x 37 | REAL(KIND=DOUBLE) :: HOLDER 38 | INTEGER, INTENT(IN) :: N 39 | INTEGER :: k 40 | 41 | HOLDER = 0.D0 42 | DO k = 0,N 43 | HOLDER = HOLDER + choose(DBLE(N),k)*choose((N+k-1)/2D0,N)*x**k 44 | END DO 45 | 46 | legendre = HOLDER*(2**N) 47 | 48 | END FUNCTION legendre 49 | 50 | ! ######################################################################## 51 | ! Derivative of Legendre Polyomial of degree N 52 | ! ######################################################################## 53 | REAL(KIND=DOUBLE) FUNCTION dlegendre(x,N) 54 | IMPLICIT NONE 55 | REAL(KIND=DOUBLE),INTENT(IN) :: x 56 | REAL(KIND=DOUBLE) :: HOLDER 57 | INTEGER, INTENT(IN) :: N ! Order of legendre polynomial 58 | INTEGER :: k 59 | 60 | HOLDER = 0.D0 61 | DO k = 1,N 62 | HOLDER = HOLDER + k*choose(DBLE(N),k)*choose((N+k-1)/2D0,N)*x**(k-1) 63 | END DO 64 | 65 | dlegendre = HOLDER*(2**N) 66 | 67 | END FUNCTION dlegendre 68 | 69 | ! ########################################################################################################### 70 | ! Subroutine for computing Gaussian quadrature nodes based on the derivative of Mth Order Legendre Polynomial 71 | ! For Modal DG, we require M=N+1 nodes, where N is the highest order of Legendre polynomial being used 72 | ! ########################################################################################################### 73 | SUBROUTINE quad_nodes(M,nodes) 74 | IMPLICIT NONE 75 | INTEGER, INTENT(IN) :: M 76 | REAL(KIND=DOUBLE), DIMENSION(0:M-1), INTENT(OUT) :: nodes 77 | REAL(KIND=DOUBLE) :: xnew,xold,error,tol, PI 78 | INTEGER :: k 79 | 80 | PI = DACOS(-1D0) 81 | 82 | tol = 10D-10 83 | 84 | DO k = 0,M-1 85 | error = 1D0 86 | xold = -1D0*DCOS(((2*k+1)/(2D0*M))*PI) 87 | 88 | DO WHILE (error>tol) 89 | xnew = xold - (legendre(xold,M))/(1D0*dlegendre(xold,M)) 90 | error = DABS(xnew-xold) 91 | xold = xnew 92 | END DO 93 | nodes(k) = xold 94 | END DO 95 | END SUBROUTINE quad_nodes 96 | 97 | ! ####################################################################################################### 98 | ! Computing weights associated with N+1 nodes for quadratures on [-1,1] 99 | ! For Modal DG, we require M=N+1 weights, where N is the highest order of Legendre polynomial being used 100 | ! ####################################################################################################### 101 | SUBROUTINE quad_weights(M,nodes,wghts) 102 | IMPLICIT NONE 103 | INTEGER, INTENT(IN) :: M 104 | REAL(KIND=DOUBLE), DIMENSION(0:M-1), INTENT(IN) :: nodes 105 | REAL(KIND=DOUBLE), DIMENSION(0:M-1), INTENT(OUT) :: wghts 106 | INTEGER :: k 107 | 108 | DO k = 0,M-1 109 | wghts(k) = 2D0*(1-nodes(k)**2)/((M*legendre(nodes(k),M-1))**2) 110 | !wghts(k) = 2D0/( (1-nodes(k)**2)*(dlegendre(nodes(k),M))**2 ) 111 | END DO 112 | 113 | END SUBROUTINE quad_weights 114 | 115 | ! ####################################################################### 116 | ! Subroutine for filling in the C-matrix. Used for interchanging solution 117 | ! between DG and PPM, computed using Gaussian quadrature 118 | ! ####################################################################### 119 | SUBROUTINE Cmat_FILL(N,nodes,wghts,dx,dxelem,output,stat) 120 | IMPLICIT NONE 121 | INTEGER, INTENT(IN) :: N 122 | REAL(KIND=DOUBLE), DIMENSION(0:N), INTENT(IN) :: nodes, wghts 123 | REAL(KIND=DOUBLE), DIMENSION(0:N,0:N), INTENT(OUT) :: output 124 | CHARACTER(len=*), INTENT(IN) :: stat 125 | REAL(KIND=DOUBLE), INTENT(IN) :: dx,dxelem 126 | INTEGER :: i,k,m 127 | REAL(KIND=DOUBLE) :: dz,zi 128 | REAL(KIND=DOUBLE), DIMENSION(0:N) :: foo 129 | 130 | dz = dx/dxelem 131 | 132 | foo = 0D0 133 | 134 | IF(TRIM(stat) .eq. 'gll') THEN 135 | DO k=0,N 136 | DO m=0,N 137 | output(k,m) = legendre(nodes(k),m) 138 | ENDDO 139 | ENDDO 140 | 141 | ELSE 142 | DO k=0,N 143 | DO m=0,N 144 | foo = 0D0 145 | DO i=0,N 146 | zi = -1D0 + dz*(2*k+nodes(i)+1D0) 147 | foo(i) = wghts(i)*legendre(zi,m) 148 | ENDDO 149 | output(k,m) = 0.5D0*SUM(foo) 150 | ENDDO 151 | ENDDO 152 | ENDIF 153 | 154 | END SUBROUTINE Cmat_FILL 155 | 156 | ! ############################################################################################################### 157 | ! phitld(xi,j,A,N,nelem) computes the complete series expansion form of solution based on given coefficents and element 158 | ! ############################################################################################################### 159 | 160 | REAL(KIND=DOUBLE) FUNCTION phitld(xi,j,Ain,N,nelem) 161 | IMPLICIT NONE 162 | REAL(KIND=DOUBLE), INTENT(IN) :: xi 163 | INTEGER, INTENT(IN) :: j, N, nelem 164 | REAL(KIND=DOUBLE), DIMENSION(0:N,0:nelem+1), INTENT(IN) :: Ain 165 | INTEGER :: i ! Looping variable 166 | REAL(KIND=DOUBLE), DIMENSION(0:N) :: foo 167 | 168 | DO i = 0,N 169 | foo(i) = Ain(i,j)*legendre(xi,i) 170 | END DO 171 | 172 | phitld = SUM(foo) 173 | 174 | END FUNCTION phitld 175 | 176 | 177 | 178 | END MODULE mDGmod 179 | -------------------------------------------------------------------------------- /_src/updateSoln1d.f90: -------------------------------------------------------------------------------- 1 | SUBROUTINE updateSoln1d(q,u,uEdge,dt,dxel,nelem,nx,quadWeights,& 2 | basisVals,basisDeriv) 3 | ! =========================================================================== 4 | ! Takes full dt time step for one dimensional slice of subcell averages using SSPRK3 5 | ! integrator 6 | ! =========================================================================== 7 | USE commonTestParameters 8 | IMPLICIT NONE 9 | ! Inputs 10 | INTEGER, INTENT(IN) :: nelem,nx 11 | DOUBLE PRECISION, INTENT(IN) :: dxel,dt 12 | DOUBLE PRECISION, DIMENSION(0:nQuad), INTENT(IN) :: quadWeights 13 | DOUBLE PRECISION, DIMENSION(0:maxPolyDegree,0:nQuad), INTENT(IN) :: basisVals,& 14 | basisDeriv 15 | DOUBLE PRECISION, DIMENSION(1:3,1:nx), INTENT(IN) :: u 16 | DOUBLE PRECISION, DIMENSION(1:3,1:nelem), INTENT(IN) :: uEdge 17 | ! Outputs 18 | DOUBLE PRECISION, DIMENSION(1:nx,1:meqn), INTENT(INOUT) :: q 19 | ! Local variables 20 | DOUBLE PRECISION, DIMENSION(0:maxPolyDegree,1:nelem,1:meqn) :: coeffs,coeffsTmp,& 21 | qBar 22 | DOUBLE PRECISION, DIMENSION(1:3,0:nQuad,1:nelem) :: uTilde 23 | DOUBLE PRECISION, DIMENSION(1:3,0:nelem+1) :: uEdgeTilde 24 | DOUBLE PRECISION, DIMENSION(0:nQuad,1:nelem) :: uQuadTmp 25 | DOUBLE PRECISION, DIMENSION(0:nQuad,1:nelem,1:meqn) :: quadVals,fluxQuad 26 | DOUBLE PRECISION, DIMENSION(0:nelem+1) :: uEdgeTmp 27 | DOUBLE PRECISION, DIMENSION(0:nelem,1:meqn) :: fluxes 28 | DOUBLE PRECISION, DIMENSION(0:nQuad,1:meqn) :: localSolnQuad 29 | DOUBLE PRECISION, DIMENSION(0:nQuad) :: localVel 30 | DOUBLE PRECISION, DIMENSION(1:nelem,1:meqn) :: elemAverages 31 | DOUBLE PRECISION :: cons0,consf 32 | INTEGER :: i,j,k,m,stage 33 | 34 | INTERFACE 35 | SUBROUTINE evaluateExpansion(coeffs,nelem,basisVals,qvals) 36 | ! =========================================================================== 37 | ! Evaluates polynomial expansion phi = \sum coeffs_k * P_k at local quad nodes 38 | ! Used for outputting solution values 39 | ! INPUTS: 40 | ! coeffs(0:maxPolyDegree,1:nelem,1:meqn) 41 | ! basisVals(0:maxPolyDegree,0:nQuad) 42 | ! 43 | ! OUTPUTS: qvals 44 | ! =========================================================================== 45 | USE commonTestParameters 46 | IMPLICIT NONE 47 | ! Inputs 48 | INTEGER, INTENT(IN) :: nelem 49 | DOUBLE PRECISION, DIMENSION(0:maxPolyDegree,1:nelem,1:meqn), INTENT(IN) :: coeffs 50 | DOUBLE PRECISION, DIMENSION(0:maxPolyDegree,0:nQuad), INTENT(IN) :: basisVals 51 | ! Outputs 52 | DOUBLE PRECISION, DIMENSION(0:nQuad,1:nelem,1:meqn), INTENT(OUT) :: qvals 53 | END SUBROUTINE evaluateExpansion 54 | 55 | SUBROUTINE fluxFunction(qvals,uvals,nx,nelem,fluxVals) 56 | USE commonTestParameters 57 | IMPLICIT NONE 58 | ! Inputs 59 | INTEGER, INTENT(IN) :: nelem,nx 60 | DOUBLE PRECISION, DIMENSION(1:nx,1:nelem,1:meqn), INTENT(IN) :: qvals 61 | DOUBLE PRECISION, DIMENSION(1:nx,1:nelem), INTENT(IN) :: uvals 62 | ! Outputs 63 | DOUBLE PRECISION, DIMENSION(1:nx,1:nelem,1:meqn), INTENT(OUT) :: fluxVals 64 | END SUBROUTINE fluxFunction 65 | 66 | SUBROUTINE numFlux(coeffs,uEdge,nelem,fluxes) 67 | ! =========================================================================== 68 | ! Returns upwind numerical fluxes 69 | ! =========================================================================== 70 | USE commonTestParameters 71 | IMPLICIT NONE 72 | ! Inputs 73 | INTEGER, INTENT(IN) :: nelem 74 | DOUBLE PRECISION, DIMENSION(0:maxPolyDegree,1:nelem,1:meqn), INTENT(IN):: coeffs 75 | DOUBLE PRECISION, DIMENSION(0:nelem+1), INTENT(IN) :: uEdge 76 | ! Outputs 77 | DOUBLE PRECISION, DIMENSION(0:nelem,1:meqn), INTENT(OUT) :: fluxes 78 | END SUBROUTINE numFlux 79 | 80 | SUBROUTINE forwardStep(coeffs,fluxQuad,flx,quadWeights,basisDeriv,dxel,dt,nelem) 81 | ! ================================================================================ 82 | ! Takes single forward Euler step applied to coefficient odes 83 | ! d a_kj / dt = forcingCoeffODE() 84 | ! Inputs: 85 | ! fluxQuad - flux function F(q) evaluated at quadrature nodes 86 | ! flx - numerical fluxes through interface 87 | ! quadWeghts - Gauss quadrature weights 88 | ! basisDeriv - derivative of Legendre basis at quadrature nodes 89 | ! dxel - element spacing 90 | ! dt - time step size 91 | ! nelem - number of elements 92 | ! Outputs: 93 | ! coeffs - Legendre expansion coefficients 94 | ! ================================================================================ 95 | USE commonTestParameters 96 | IMPLICIT NONE 97 | ! Inputs 98 | INTEGER, INTENT(IN) :: nelem 99 | DOUBLE PRECISION, INTENT(IN) :: dt,dxel 100 | DOUBLE PRECISION, DIMENSION(0:nelem,1:meqn), INTENT(IN) :: flx 101 | DOUBLE PRECISION, DIMENSION(0:nQuad,1:nelem,1:meqn), INTENT(IN) :: fluxQuad 102 | DOUBLE PRECISION, DIMENSION(0:nQuad), INTENT(IN) :: quadWeights 103 | DOUBLE PRECISION, DIMENSION(0:maxPolyDegree,0:nQuad), INTENT(IN) :: basisDeriv 104 | ! Outputs 105 | DOUBLE PRECISION, DIMENSION(0:maxPolyDegree,1:nelem,1:meqn), INTENT(INOUT) :: coeffs 106 | END SUBROUTINE forwardStep 107 | 108 | SUBROUTINE positivityLimiter(qBar,nelem,avgVals,quadWeights) 109 | ! Subroutine for mass filling within an element to remove negative cell averaged values 110 | USE commonTestParameters 111 | IMPLICIT NONE 112 | ! Inputs 113 | INTEGER, INTENT(IN) :: nelem 114 | DOUBLE PRECISION, DIMENSION(0:nQuad), INTENT(IN) :: quadWeights 115 | DOUBLE PRECISION, DIMENSION(1:nelem,1:meqn), INTENT(IN) :: avgVals 116 | ! Outputs 117 | DOUBLE PRECISION, DIMENSION(0:maxPolyDegree,1:nelem,1:meqn), INTENT(INOUT) :: qBar 118 | END SUBROUTINE positivityLimiter 119 | 120 | SUBROUTINE fluxCorrection(coeffs,flx,quadWeights,dxel,dt,nelem) 121 | ! Computes flux reductions factors to prevent total mass within each element from going negative 122 | ! Outputs fluxcf. fluxcf(j) is the reduction factor for the right face of element j, 123 | ! with fluxcf(0) being the factor for the left domain interface 124 | USE commonTestParameters 125 | IMPLICIT NONE 126 | ! -- Inputs 127 | INTEGER, INTENT(IN) :: nelem 128 | DOUBLE PRECISION, DIMENSION(0:maxPolyDegree,1:nelem,1:meqn), INTENT(IN) :: coeffs 129 | DOUBLE PRECISION, DIMENSION(0:nQuad), INTENT(IN) :: quadWeights 130 | DOUBLE PRECISION, INTENT(IN) :: dxel,dt 131 | ! -- Outputs 132 | DOUBLE PRECISION, DIMENSION(0:nelem,1:meqn), INTENT(INOUT) :: flx 133 | END SUBROUTINE fluxCorrection 134 | END INTERFACE 135 | 136 | ! Reshape incoming values 137 | DO j=1,nelem 138 | coeffs(:,j,:) = q(1+(maxPolyDegree+1)*(j-1):(maxPolyDegree+1)*j,:) 139 | utilde(1:3,:,j) = u(1:3,1+(maxPolyDegree+1)*(j-1):(maxPolyDegree+1)*j) 140 | END DO 141 | ! Periodically extend edge velocities 142 | uedgeTilde(1:3,1:nelem) = uEdge(1:3,1:nelem) 143 | uedgeTilde(1:3,0) = uEdge(1:3,nelem) 144 | uedgeTilde(1:3,nelem+1) = uEdge(1:3,1) 145 | 146 | coeffsTmp = coeffs 147 | 148 | ! ! Est. conservation 149 | ! DO j=1,nelem 150 | ! elemAverages(j,2) = 0.5D0*SUM(quadWeights(:)*coeffs(:,j,2)) 151 | ! ENDDO !j 152 | ! cons0 = SUM(elemAverages(:,2))/DBLE(nelem) 153 | 154 | DO stage=1,3 155 | uQuadTmp = uTilde(stage,:,:) 156 | uEdgeTmp = uEdgeTilde(stage,:) 157 | 158 | ! Evaluate expansion and fluxes at quadrature nodes, compute numerical fluxes at interfaces 159 | CALL evaluateExpansion(coeffsTmp,nelem,basisVals,quadVals) 160 | CALL fluxFunction(quadVals,uQuadTmp,nQuad+1,nelem,fluxQuad) 161 | CALL numFlux(coeffsTmp,uEdgeTmp,nelem,fluxes) 162 | 163 | IF(doposlimit) CALL fluxCorrection(coeffsTmp,fluxes,quadWeights,dxel,dt,nelem) 164 | 165 | ! Take forward step 166 | CALL forwardStep(coeffsTmp,fluxQuad,fluxes,quadWeights,basisDeriv,dxel,dt,nelem) 167 | 168 | ! Update coefficients 169 | SELECT CASE(stage) 170 | CASE(2) 171 | coeffsTmp = 0.75D0*coeffs + 0.25D0*coeffsTmp 172 | CASE(3) 173 | coeffsTmp = coeffs/3d0 + 2D0*coeffsTmp/3D0 174 | END SELECT !stage 175 | ENDDO !stage 176 | 177 | ! Check conservation 178 | ! DO m=1,meqn 179 | ! DO j=1,nelem 180 | ! elemAverages(j,m) = 0.5D0*SUM(quadWeights(:)*coeffsTmp(:,j,m)) 181 | ! ENDDO !j 182 | ! ENDDO !m 183 | ! consf = SUM(elemAverages(:,2))/DBLE(nelem) 184 | ! write(*,*) 'cons estm =',consf-cons0 185 | 186 | 187 | IF(doposlimit) THEN 188 | DO m=1,meqn 189 | DO j=1,nelem 190 | elemAverages(j,m) = 0.5D0*SUM(quadWeights(:)*coeffsTmp(:,j,m)) 191 | ENDDO !j 192 | ENDDO !m 193 | CALL positivityLimiter(coeffsTmp,nelem,elemAverages,quadWeights) 194 | ENDIF!doposlimit 195 | 196 | ! Reform original shaped arrays 197 | DO m=1,meqn 198 | DO j=1,nelem 199 | q(1+(maxPolyDegree+1)*(j-1):(maxPolyDegree+1)*j,m) = coeffsTmp(:,j,m) 200 | END DO !j 201 | ENDDO !m 202 | 203 | END SUBROUTINE updateSoln1d 204 | -------------------------------------------------------------------------------- /_src/nDGmod.f90: -------------------------------------------------------------------------------- 1 | ! ############################################################## 2 | ! Module containing 4th and 5th order Legendre polynomials 3 | ! and their derivatives used in ppmwrap.f90 as part of test_advection_slskam_2d.f90 4 | ! By : Devin Light 11.29.2012 5 | ! ############################################################## 6 | 7 | MODULE nDGmod 8 | IMPLICIT NONE 9 | INTEGER, PARAMETER :: DOUBLE = KIND(1D0) 10 | 11 | 12 | PRIVATE :: DOUBLE 13 | 14 | ! ####################################################################### 15 | ! node4 is vector of zeros of Jacobi polynomial 16 | ! associated with the problem, and are also the location of the GLL nodes 17 | ! ####################################################################### 18 | 19 | REAL(KIND = DOUBLE), DIMENSION(0:4) :: node4 = (/ & 20 | -1D0, & 21 | -0.654653670707978D0, & 22 | 0D0, & 23 | 0.654653670707977D0, & 24 | 1D0 /) 25 | 26 | 27 | ! ########################################################## 28 | ! w4 is the weights used in the GLL quadrature 29 | ! with w4(i) being the weight of the ith term in the sum 30 | ! ########################################################## 31 | 32 | REAL(KIND = DOUBLE), DIMENSION(0:4) :: w4 = (/ & 33 | 1D0/10D0, & 34 | 0.5444444444444456D0, & 35 | 32D0/45D0,& 36 | 0.5444444444444456D0,& 37 | 1D0/10D0 /) 38 | 39 | CONTAINS 40 | 41 | ! ######################################################################## 42 | ! N-choose-k Function 43 | ! ######################################################################## 44 | REAL(KIND=DOUBLE) FUNCTION choose(alpha,k) 45 | IMPLICIT NONE 46 | INTEGER, INTENT(IN) :: k 47 | REAL(KIND=DOUBLE), INTENT(IN) :: alpha 48 | INTEGER :: i 49 | REAL(KIND=DOUBLE) :: HOLDER 50 | 51 | HOLDER = 1D0 52 | 53 | DO i = 1,k 54 | HOLDER = HOLDER*((alpha-DBLE(k-i))/(DBLE(i))) 55 | END DO 56 | choose = HOLDER 57 | END FUNCTION choose 58 | 59 | ! ######################################################################## 60 | ! Legendre Polynomial function of degree N 61 | ! ######################################################################## 62 | REAL(KIND=DOUBLE) FUNCTION legendre(x,N) 63 | IMPLICIT NONE 64 | REAL(KIND=DOUBLE), INTENT(IN) :: x 65 | REAL(KIND=DOUBLE) :: HOLDER 66 | INTEGER, INTENT(IN) :: N 67 | INTEGER :: k 68 | 69 | HOLDER = 0.D0 70 | DO k = 0,N 71 | HOLDER = HOLDER + choose(DBLE(N),k)*choose((N+k-1)/2D0,N)*x**k 72 | END DO 73 | 74 | legendre = HOLDER*(2**N) 75 | 76 | END FUNCTION legendre 77 | 78 | ! ######################################################################## 79 | ! Derivative of Legendre Polyomial of degree N 80 | ! ######################################################################## 81 | REAL(KIND=DOUBLE) FUNCTION dlegendre(x,N) 82 | IMPLICIT NONE 83 | REAL(KIND=DOUBLE),INTENT(IN) :: x 84 | REAL(KIND=DOUBLE) :: HOLDER 85 | INTEGER, INTENT(IN) :: N 86 | INTEGER :: k 87 | 88 | HOLDER = 0.D0 89 | DO k = 1,N 90 | HOLDER = HOLDER + k*choose(DBLE(N),k)*choose((N+k-1)/2D0,N)*x**(k-1) 91 | END DO 92 | 93 | dlegendre = HOLDER*(2**N) 94 | 95 | END FUNCTION dlegendre 96 | 97 | ! ######################################################################## 98 | ! 2nd Derivative of Legendre Polyomial of degree N 99 | ! ######################################################################## 100 | REAL(KIND=DOUBLE) FUNCTION ddlegendre(x,N) 101 | IMPLICIT NONE 102 | REAL(KIND=DOUBLE), INTENT(IN) :: x 103 | REAL(KIND=DOUBLE) :: HOLDER 104 | INTEGER, INTENT(IN) :: N 105 | INTEGER :: k 106 | 107 | HOLDER = 0.D0 108 | DO k = 2,N 109 | HOLDER = HOLDER + k*(k-1)*choose(DBLE(N),k)*choose((N+k-1)/2D0,N)*x**(k-2) 110 | END DO 111 | 112 | ddlegendre = HOLDER*(2**N) 113 | 114 | END FUNCTION ddlegendre 115 | 116 | ! ######################################################################## 117 | ! Subroutine for computing GLL nodes based on the derivative of N'th Order Legendre Polynomial 118 | ! ######################################################################## 119 | SUBROUTINE gllquad_nodes(N,nodes) 120 | IMPLICIT NONE 121 | INTEGER, INTENT(IN) :: N 122 | REAL(KIND=DOUBLE), DIMENSION(0:N), INTENT(OUT) :: nodes 123 | REAL(KIND=DOUBLE) :: xnew,xold,error,tol, PI 124 | INTEGER :: k 125 | 126 | PI = DACOS(-1D0) 127 | 128 | tol = 10.D0**(-8) 129 | 130 | nodes(0) = -1D0 131 | nodes(N) = 1D0 132 | 133 | DO k = 1,N-1 134 | error = 1D0 135 | xold = -1D0*DCOS( ((2*k-1)/(2D0*(N-1)))*PI) 136 | 137 | DO WHILE (error>tol) 138 | xnew = xold - (dlegendre(xold,N))/(1D0*ddlegendre(xold,N)) 139 | error = DABS(xnew-xold) 140 | xold = xnew 141 | END DO 142 | nodes(k) = xold 143 | END DO 144 | END SUBROUTINE gllquad_nodes 145 | 146 | ! ########################################################################################################### 147 | ! Subroutine for computing Gaussian quadrature nodes based on the derivative of Mth Order Legendre Polynomial 148 | ! For Modal DG, we require M=N+1 nodes, where N is the highest order of Legendre polynomial being used 149 | ! ########################################################################################################### 150 | SUBROUTINE gaussquad_nodes(M,nodes) 151 | IMPLICIT NONE 152 | INTEGER, INTENT(IN) :: M 153 | REAL(KIND=DOUBLE), DIMENSION(0:M-1), INTENT(OUT) :: nodes 154 | REAL(KIND=DOUBLE) :: xnew,xold,error,tol, PI 155 | INTEGER :: k 156 | 157 | PI = DACOS(-1D0) 158 | 159 | tol = 10D-10 160 | 161 | DO k = 0,M-1 162 | error = 1D0 163 | xold = -1D0*DCOS(((2*k+1)/(2D0*M))*PI) 164 | 165 | DO WHILE (error>tol) 166 | xnew = xold - (legendre(xold,M))/(1D0*dlegendre(xold,M)) 167 | error = DABS(xnew-xold) 168 | xold = xnew 169 | END DO 170 | nodes(k) = xold 171 | END DO 172 | END SUBROUTINE gaussquad_nodes 173 | 174 | ! ######################################################################## 175 | ! Computing weights associated with N+1 nodes for quadratures on [-1,1] 176 | ! ######################################################################## 177 | SUBROUTINE gllquad_weights(N,nodes,wghts) 178 | IMPLICIT NONE 179 | INTEGER, INTENT(IN) :: N 180 | REAL(KIND=DOUBLE), DIMENSION(0:N), INTENT(IN) :: nodes 181 | REAL(KIND=DOUBLE), DIMENSION(0:N), INTENT(OUT) :: wghts 182 | INTEGER :: k 183 | 184 | DO k = 0,N 185 | wghts(k) = 2D0/(N*(N+1)*(legendre(nodes(k),N))**2) 186 | END DO 187 | 188 | END SUBROUTINE gllquad_weights 189 | 190 | ! ####################################################################################################### 191 | ! Computing weights associated with N+1 nodes for quadratures on [-1,1] 192 | ! For Modal DG, we require M=N+1 weights, where N is the highest order of Legendre polynomial being used 193 | ! ####################################################################################################### 194 | SUBROUTINE gaussquad_weights(M,nodes,wghts) 195 | IMPLICIT NONE 196 | INTEGER, INTENT(IN) :: M 197 | REAL(KIND=DOUBLE), DIMENSION(0:M-1), INTENT(IN) :: nodes 198 | REAL(KIND=DOUBLE), DIMENSION(0:M-1), INTENT(OUT) :: wghts 199 | INTEGER :: k 200 | 201 | DO k = 0,M-1 202 | wghts(k) = 2D0*(1-nodes(k)**2)/((M*legendre(nodes(k),M-1))**2) 203 | !wghts(k) = 2D0/( (1-nodes(k)**2)*(dlegendre(nodes(k),M))**2 ) 204 | END DO 205 | 206 | END SUBROUTINE gaussquad_weights 207 | 208 | 209 | ! ########################################################### 210 | ! baryWeights computes the set of barycentric weights for the Lagrange interpolating polynomial, 211 | ! used to evaluate the basis functions 212 | ! ########################################################### 213 | 214 | SUBROUTINE fillBaryWeights(lambda,nodes,N) 215 | IMPLICIT NONE 216 | ! Inputs 217 | INTEGER, INTENT(IN) :: N 218 | REAL(KIND=DOUBLE), DIMENSION(0:N), INTENT(IN) :: nodes 219 | ! Outputs 220 | REAL(KIND=DOUBLE), DIMENSION(0:N), INTENT(OUT) :: lambda ! lambda(k) is the kth barycentric weight 221 | ! Local variables 222 | INTEGER :: k 223 | LOGICAL, DIMENSION(0:N) :: MASK 224 | 225 | DO k=0,N 226 | MASK = .TRUE. 227 | MASK(k) = .FALSE. 228 | 229 | lambda(k) = 1D0/PRODUCT(nodes(k)-nodes,MASK) 230 | ENDDO !k 231 | 232 | END SUBROUTINE fillBaryWeights 233 | 234 | ! ########################################################### 235 | ! phi computes the k'th basis function, a Lagrange interpolating 236 | ! polynomial, for a given set of nodes 237 | ! ########################################################### 238 | REAL(KIND=DOUBLE) FUNCTION lagrange(xi,k,N,nodes,lambda) 239 | IMPLICIT NONE 240 | REAL(KIND=DOUBLE), INTENT(IN) :: xi 241 | INTEGER, INTENT(IN) :: k,N 242 | REAL(KIND=DOUBLE), DIMENSION(0:N), INTENT(IN) :: nodes,lambda 243 | LOGICAL, DIMENSION(0:N) :: MASK 244 | REAL(KIND=DOUBLE), DIMENSION(0:N) :: l 245 | INTEGER :: i = 0 246 | 247 | MASK = .TRUE. 248 | MASK(k) = .FALSE. 249 | 250 | l = xi - nodes 251 | lagrange = PRODUCT(l,MASK)*lambda(k) 252 | 253 | END FUNCTION lagrange 254 | 255 | 256 | ! ############################################################################# 257 | ! Subroutine D(N,nodes,output) computes the matrix of values of diff(phi(k,x),x) 258 | ! evaluated at x = nodes(n); Used in calc of the Galerkin step 259 | ! ############################################################################# 260 | SUBROUTINE Dmat(N,nodes,output) 261 | IMPLICIT NONE 262 | INTEGER, INTENT(IN) :: N 263 | REAL(KIND=DOUBLE), DIMENSION(0:N), INTENT(IN) :: nodes 264 | REAL(KIND=DOUBLE), DIMENSION(0:N, 0:N), INTENT(OUT) :: output 265 | INTEGER :: i = 0, j = 0 266 | 267 | DO i = 0, N 268 | DO j = 0, N 269 | IF (i /= j) THEN 270 | output(i,j) = (legendre(nodes(j),N))/(legendre(nodes(i),N)*(nodes(j)-nodes(i))) 271 | ELSE 272 | output(i,j) = 0.D0 273 | END IF 274 | END DO 275 | END DO 276 | 277 | output(0,0) = -(N)*(N+1)/4D0 278 | output(N,N) = (N)*(N+1)/4D0 279 | 280 | END SUBROUTINE Dmat 281 | 282 | SUBROUTINE GEPP_INV (M,N,Minv) 283 | ! 284 | ! Subroutine to perform the partial-pivoting Gaussian elimination. 285 | ! A(N,N) is the original matrix in the input and transformed matrix 286 | ! plus the pivoting element ratios below the diagonal in the output. 287 | ! INDX(N) records the pivoting order. 288 | ! Ainv is found by performing the same operations on I(N,N) and then 289 | ! solving the related systems for each column of Ainv. [A|I] -> [A|Y] 290 | ! 291 | IMPLICIT NONE 292 | INTEGER, INTENT (IN) :: N 293 | INTEGER :: I,J,K,ITMP 294 | INTEGER, DIMENSION (N) :: INDX 295 | REAL :: C1,PI,PI1,PJ 296 | REAL(KIND=DOUBLE), INTENT (IN), DIMENSION (N,N) :: M 297 | REAL(KIND=DOUBLE), INTENT(OUT), DIMENSION(N,N) :: Minv 298 | REAL(KIND=DOUBLE), DIMENSION(N,N) :: Y,Tmp1,Tmp2,A 299 | REAL, DIMENSION (N) :: C 300 | 301 | ! Initialize A and Minv 302 | A(:,:) = M(:,:) 303 | Minv(:,:) = 0.D0 304 | 305 | ! Initialize Y as I(N,N) 306 | Y(:,:) = 0D0 307 | DO I = 1,N 308 | Y(I,I) = 1D0 309 | END DO 310 | 311 | ! 312 | ! Initialize the index 313 | ! 314 | DO I = 1, N 315 | INDX(I) = I 316 | END DO 317 | ! 318 | ! Select largest absval element, one from each row 319 | ! 320 | ! DO I = 1, N 321 | ! C1= 0.0 322 | ! DO J = 1, N 323 | ! C1 = DMAX1(C1,ABS(A(I,J))) 324 | ! END DO 325 | ! C(I) = C1 326 | ! END DO 327 | 328 | 329 | DO J = 1, N-1 330 | 331 | ! Select pivoting (largest) element from each column 332 | PI1 = 0.0 333 | DO I = J, N 334 | PI = DABS(A(INDX(I),J)) !/C(INDX(I)) 335 | IF (PI.GT.PI1) THEN 336 | PI1 = PI 337 | K = I 338 | END IF 339 | END DO 340 | ! 341 | ! Interchange the rows via INDX(N) to record pivoting order 342 | ! 343 | ITMP = INDX(J) 344 | INDX(J) = INDX(K) 345 | INDX(K) = ITMP 346 | DO I = J+1, N 347 | PJ = A(INDX(I),J)/A(INDX(J),J) 348 | ! 349 | ! Record pivoting ratios below the diagonal 350 | ! 351 | A(INDX(I),J) = 0D0!PJ 352 | ! 353 | ! Modify other elements accordingly 354 | ! 355 | DO K = J+1, N 356 | A(INDX(I),K) = A(INDX(I),K)-PJ*A(INDX(J),K) 357 | END DO 358 | DO K = 1,N 359 | Y(INDX(I),K) = Y(INDX(I),K)-PJ*Y(INDX(J),K) 360 | END DO 361 | END DO 362 | END DO 363 | 364 | ! Swap rows to get it back to the correct form 365 | Tmp1 = A 366 | Tmp2 = Y 367 | DO I=1,N 368 | A(I,:) = Tmp1(INDX(I),:) 369 | Y(I,:) = Tmp2(INDX(I),:) 370 | END DO 371 | 372 | ! To find Minv (for the PIVOTED matrix), solve n-systems using back substitution 373 | ! Anew*Ainv(:,k) = Y(:,k) k=1..n 374 | DO K = 1,N 375 | Minv(N,K) = Y(N,K)/A(N,N) 376 | DO I = N-1,1,-1 377 | Minv(I,K) = Y(I,K) 378 | DO J = I+1,N 379 | Minv(I,K) = Minv(I,K) - A(I,J)*Minv(J,K) 380 | END DO 381 | Minv(I,K) = Minv(I,K)/A(I,I) 382 | END DO 383 | END DO 384 | 385 | END SUBROUTINE GEPP_INV 386 | 387 | END MODULE nDGmod 388 | -------------------------------------------------------------------------------- /_src/driver.f90: -------------------------------------------------------------------------------- 1 | SUBROUTINE DRIVER(nex0,ney0,nscale,nruns,noutput,maxCFL) 2 | ! =============================================================== 3 | ! Main driver subroutine for DG simulations 4 | ! Inputs: 5 | ! testID : which test is being run 6 | ! nex0,ney0 : number of initial spatial cells 7 | ! nscale : multiple of nex0 used for subsequent runs (nex = nex0*nscale**p) 8 | ! nruns : number of total runs to make 9 | ! maxCFL : maximal CFL number to use throughout integration 10 | ! =============================================================== 11 | USE commonTestParameters 12 | USE nDGmod 13 | USE netCDF 14 | 15 | IMPLICIT NONE 16 | ! Inputs 17 | INTEGER, INTENT(IN) :: nex0,ney0,nscale,nruns,noutput 18 | REAL(KIND=8), INTENT(IN) :: maxCFL 19 | ! Outputs 20 | ! Local variables 21 | CHARACTER(len=60) :: cdfOut 22 | INTEGER, DIMENSION(10) :: tmp_method 23 | INTEGER :: nmethod,nmethod_final,imethod,ierr,i,j,p,n,m 24 | INTEGER :: nstep,nout 25 | DOUBLE PRECISION, DIMENSION(1:nRuns,1:meqn) :: e1,e2,ei,cons,tmpqMax,tmpqMin 26 | REAL(KIND=4), DIMENSION(1:nRuns) :: t0,tf 27 | LOGICAL :: oddstep 28 | DOUBLE PRECISION :: dxel,dyel,dxPlot,dyPlot,tmp_umax,tmp_vmax,calculatedMu,dt,time 29 | DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: quadNodes,quadWeights,elemX,elemY,& 30 | xPlot,yPlot,DGx,DGy,FOO,baryWeights 31 | DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: u0,v0,uEdge0,vEdge0,& 32 | avgXferOp,avgXferOpLU,basisPolyVal,basisPolyDeriv 33 | DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:) :: q,q0,u,v,uEdge,vEdge,reactiveCoeffs 34 | INTEGER, ALLOCATABLE, DIMENSION(:) :: IPIV 35 | 36 | ! ================================================================================= 37 | ! Subroutine Interfaces 38 | ! ================================================================================= 39 | 40 | INTERFACE 41 | SUBROUTINE init2d(q,u,v,uEdge,vEdge,xPlot,yPlot,DGx,DGy,quadNodes,dxel,dyel,& 42 | dxPlot,dyPlot,elemCenterX,elemCenterY,reactiveCoeffs) 43 | ! ============================================================================== 44 | ! Computes initial conditions for q,u,v fields 45 | ! INPUTS: meqn - number of fields to evaluate 46 | ! nx,ny - number of points to evaluate q,u,v at 47 | ! quadNodes - local locations to evaluate velocities at 48 | ! elemCenterX, elemCenterY - element center locations 49 | ! 50 | ! OUTPUTS: q(i,j,neq) - initial conditions evaluated for neqth field 51 | ! u(i,j),v(i,j) - velocities evaluated at quadrature locations 52 | ! uEdge,vEdge - velocities at edges of each element 53 | ! reactiveCoeffs - reaction coefficients at x(i),y(j) 54 | ! ============================================================================== 55 | USE commonTestParameters 56 | IMPLICIT NONE 57 | ! Inputs 58 | DOUBLE PRECISION, INTENT(IN) :: dxel, dyel,dxPlot,dyPlot 59 | DOUBLE PRECISION, DIMENSION(0:nQuad), INTENT(IN) :: quadNodes 60 | DOUBLE PRECISION, DIMENSION(1:nxOut), INTENT(IN) :: xPlot 61 | DOUBLE PRECISION, DIMENSION(1:nyOut), INTENT(IN) :: yPlot 62 | DOUBLE PRECISION, DIMENSION(1:nex), INTENT(IN) :: elemCenterX 63 | DOUBLE PRECISION, DIMENSION(1:ney), INTENT(IN) :: elemCenterY 64 | ! Outputs 65 | DOUBLE PRECISION, DIMENSION(1:nxOut,1:nyOut,1:meqn) :: q,reactiveCoeffs 66 | DOUBLE PRECISION, DIMENSION(1:nxOut,1:nyOut) :: u,v 67 | DOUBLE PRECISION, DIMENSION(1:nex,1:nyOut), INTENT(OUT) :: uEdge 68 | DOUBLE PRECISION, DIMENSION(1:nxOut,1:ney), INTENT(OUT) :: vEdge 69 | DOUBLE PRECISION, DIMENSION(1:nxOut), INTENT(OUT) :: DGx 70 | DOUBLE PRECISION, DIMENSION(1:nyOut), INTENT(OUT) :: DGy 71 | END SUBROUTINE init2d 72 | 73 | SUBROUTINE output2d(q,xOut,yOut,timeOut,muOut,cdfOut,ilvl,stat) 74 | ! ============================================================================ 75 | ! output2d - Creates netCDF output files and writes out different output fields 76 | ! INPUTS: q(nx,ny,meqn) 77 | ! xOut(nx),yOut(ny) 78 | ! timeOut,muOut 79 | ! OUTPUTS: -None- 80 | ! ============================================================================ 81 | USE commonTestParameters 82 | USE netCDF 83 | IMPLICIT NONE 84 | ! Inputs 85 | INTEGER, INTENT(IN) :: ilvl,stat 86 | CHARACTER(len=40), INTENT(IN) :: cdfOut 87 | DOUBLE PRECISION, INTENT(IN) :: muOut,timeOut 88 | DOUBLE PRECISION, DIMENSION(1:nxOut), INTENT(IN) :: xOut 89 | DOUBLE PRECISION, DIMENSION(1:nyOut), INTENT(IN) :: yOut 90 | DOUBLE PRECISION, DIMENSION(1:nxOut,1:nyOut,1:meqn), INTENT(IN) :: q 91 | ! Outputs 92 | END SUBROUTINE output2d 93 | 94 | SUBROUTINE updateVelocities(uOut,vOut,uEdge,vEdge,xOut,elemEdgeX,DGx,yOut,elemEdgeY,DGy,time,dt) 95 | ! ========================================================= 96 | ! Updates horizontal and vertical velocities 97 | ! at necessary grid points to time levels required by integrator 98 | ! ========================================================= 99 | USE commonTestParameters 100 | IMPLICIT NONE 101 | ! Inputs 102 | DOUBLE PRECISION, INTENT(IN) :: time,dt 103 | DOUBLE PRECISION, DIMENSION(1:nxOut), INTENT(IN) :: xOut,DGx 104 | DOUBLE PRECISION, DIMENSION(1:nyOut), INTENT(IN) :: yOut,DGy 105 | DOUBLE PRECISION, DIMENSION(1:nex), INTENT(IN) :: elemEdgeX 106 | DOUBLE PRECISION, DIMENSION(1:ney), INTENT(IN) :: elemEdgeY 107 | ! Outputs 108 | DOUBLE PRECISION, DIMENSION(1:3,1:nxOut,1:nyOut), INTENT(INOUT) :: uOut,vOut 109 | DOUBLE PRECISION, DIMENSION(1:3,1:nex,1:nyOut), INTENT(INOUT) :: uEdge 110 | DOUBLE PRECISION, DIMENSION(1:3,1:nxOut,1:ney), INTENT(INOUT) :: vEdge 111 | END SUBROUTINE updateVelocities 112 | 113 | SUBROUTINE strangSplit(q,u0,v0,uEdge0,vEdge0,quadNodes,quadWeights,time,& 114 | basisPolyVal,basisPolyDeriv,avgXferOp,avgXferOpLU,IPIV,& 115 | dt,dxel,dyel,reactiveCoeffs,oddstep) 116 | ! ===================================================================================================== 117 | ! strangSplitUpdate is responsible for selecting which slice of subcell volumes is sent to mDGsweep for update to time 118 | ! level tn+1 following a Strang splitting. 119 | ! For Strang splitting: 120 | ! - Each slice is updated 121 | ! - Odd steps: x-slices are updated first (horizontal advection) then y-slices are updated (vertical advection) 122 | ! - Even steps: y-slices are updated first then x-slices are updated (vertical advection) 123 | ! ===================================================================================================== 124 | USE commonTestParameters 125 | IMPLICIT NONE 126 | ! Inputs 127 | REAL(KIND=8), INTENT(IN) :: dt,dxel,dyel,time 128 | REAL(KIND=8), DIMENSION(1:nxOut,1:nyOut), INTENT(IN) :: u0,v0 129 | REAL(KIND=8), DIMENSION(1:nex,1:nyOut), INTENT(IN) :: uEdge0 130 | REAL(KIND=8), DIMENSION(1:nxOut,1:ney), INTENT(IN) :: vEdge0 131 | REAL(KIND=8), DIMENSION(0:nQuad), INTENT(IN) :: quadNodes,quadWeights 132 | REAL(KIND=8), DIMENSION(0:maxPolyDegree,0:nQuad), INTENT(IN) :: basisPolyVal,basisPolyDeriv,avgXferOp,avgXferOpLU 133 | DOUBLE PRECISION, DIMENSION(1:nxOut,1:nyOut,1:meqn), INTENT(IN) :: reactiveCoeffs 134 | INTEGER, DIMENSION(0:maxPolyDegree), INTENT(IN) :: IPIV 135 | LOGICAL, INTENT(IN) :: oddstep 136 | ! Outputs 137 | REAL(KIND=8), DIMENSION(1:nxOut,1:nyOut,1:meqn), INTENT(INOUT) :: q 138 | END SUBROUTINE strangSplit 139 | 140 | SUBROUTINE computeErrors(qOut,q0,quadWeights,e1,e2,ei,cons,qMax,qMin,tf,nRuns,nex0,ney0,nscale,stat) 141 | ! ============================================================================= 142 | ! Prints error estimates and other useful information to screen 143 | ! INPUTS: qOut - current estimate solution 144 | ! q0 - initial conditions 145 | ! quadWeights - quadrature weights (used in conservation estimation) 146 | ! tf(p) - cput time for pth run 147 | ! stat - status integer 148 | ! ovrshoot(p,m) - maximum overshoot in appx soln at plotting times 149 | ! undrshoot(p,m) - maximum undershoot in appx soln at plotting times 150 | ! OUTPUTS: e1(p,m) - L1 error estimate 151 | ! e2(p,m) - L2 error estimate 152 | ! ei(p,m) - Linf error estimate 153 | ! cons(p,m) - conservation estimate 154 | ! ============================================================================= 155 | USE commonTestParameters 156 | IMPLICIT NONE 157 | ! Inputs 158 | INTEGER, INTENT(IN) :: nRuns,stat,nscale,nex0,ney0 159 | DOUBLE PRECISION, DIMENSION(1:nxOut,1:nyOut,1:meqn), INTENT(IN) :: q0,qOut 160 | DOUBLE PRECISION, DIMENSION(1:nRuns,1:meqn), INTENT(IN) :: qMax,qMin 161 | DOUBLE PRECISION, DIMENSION(0:nQuad), INTENT(IN) :: quadWeights 162 | REAL(KIND=4), DIMENSION(1:nRuns),INTENT(IN) :: tf 163 | ! Outputs 164 | DOUBLE PRECISION, DIMENSION(1:nRuns,1:meqn),INTENT(INOUT) :: e1,e2,ei,cons 165 | END SUBROUTINE computeErrors 166 | 167 | END INTERFACE 168 | ! ================================================================================= 169 | ! END SUBROUTINE INTERFACES 170 | ! ================================================================================= 171 | 172 | if(nRuns.lt.1) STOP 'nRuns should be at least 1 in DRIVER()' 173 | PI = DACOS(-1D0) 174 | 175 | ! Set spatial domain 176 | xDomain(1) = 0D0 177 | xDomain(2) = 1D0 178 | yDomain = xDomain 179 | 180 | nmethod_final = 2 181 | tmp_method = 0 182 | tmp_method(1) = 1 ! Split nodal DG, no limiting 183 | tmp_method(2) = 2 ! Split nodal DG, TMAR limiting for positivity 184 | tmp_method(3) = 3 ! Split nodal DG, subcell rescaling for positivity 185 | tmp_method(4) = 4 ! Split nodal DG, strictest subcell rescaling for positivity 186 | 187 | DO nmethod = 1,nmethod_final 188 | SELECT CASE(testID) 189 | CASE(0) 190 | cdfOut = 'splt2d_consistency' 191 | CASE(1) 192 | cdfOut = 'splt2d_adv_sine' 193 | CASE(2) 194 | cdfOut = 'splt2d_reactive' 195 | CASE(5) 196 | cdfOut = 'splt2d_def_cosinebell' 197 | CASE(6) 198 | cdfOut = 'splt2d_smth_cosbell' 199 | CASE(7) 200 | cdfOut = 'splt2d_def_cyl' 201 | CASE(99) 202 | cdfOut = 'splt2d_non_adv' 203 | END SELECT !testID 204 | imethod = tmp_method(nmethod) 205 | 206 | write(*,*) '********************' 207 | SELECT CASE(imethod) 208 | CASE(1) 209 | write(*,*) 'DG, nodal, no limiting' 210 | doposlimit = .false. 211 | write(outdir,'(A,I1,A)') '_nodal/n',maxPolyDegree,'/' 212 | ! outdir = '_nodal/' 213 | CASE(2) 214 | write(*,*) 'DG, nodal, TMAR limiting' 215 | doposlimit = .true. 216 | limitingType = 1 217 | write(outdir,'(A,I1,A)') '_pdNodal/tmar/n',maxPolyDegree,'/' 218 | ! outdir = '_pdNodal/tmar/' 219 | CASE(3) 220 | write(*,*) 'DG, nodal, subcell rescaling' 221 | doposlimit = .true. 222 | limitingType = 2 223 | outdir = '_pdNodal/rescale/' 224 | CASE(4) 225 | WRITE(*,*) 'DG, nodal, equal subscale rescaling' 226 | doposlimit = .true. 227 | limitingType = 3 228 | outdir = '_pdNodal/eqscale/' 229 | 230 | END SELECT !imethod 231 | 232 | write(*,FMT='(A5,i1)') ' N = ',maxPolyDegree 233 | write(*,*) '********************' 234 | 235 | IF(DEBUG) THEN 236 | write(*,*) '================' 237 | write(*,*) 'WARNING:::: ADVECTION IS DISABLED!!' 238 | write(*,*) '================' 239 | ENDIF 240 | 241 | nQuad = maxPolyDegree 242 | 243 | ALLOCATE(quadNodes(0:nQuad),quadWeights(0:nQuad),basisPolyVal(0:maxPolyDegree,0:nQuad),& 244 | basisPolyDeriv(0:maxPolyDegree,0:nQuad),baryWeights(0:nQuad),STAT=ierr) 245 | 246 | CALL gllquad_nodes(nQuad,quadNodes) 247 | CALL gllquad_weights(nQuad,quadNodes,quadWeights) 248 | 249 | ! Fill array of Basis polynomials evaluated at quad nodes + derivative at quad nodes 250 | CALL fillBaryWeights(baryWeights,quadNodes,nQuad) ! Barycentric weights for basis polynomials 251 | DO i=0,maxPolyDegree 252 | DO j=0,nQuad 253 | basisPolyVal(i,j) = lagrange(quadNodes(j),i,nQuad,quadNodes,baryWeights) 254 | ENDDO !j 255 | ENDDO !i 256 | CALL Dmat(nQuad,quadNodes,basisPolyDeriv) 257 | 258 | DO p=1,nRuns 259 | write(*,*) 'Beginning run p = ',p 260 | CALL cpu_time(t0(p)) 261 | 262 | nex = nex0*nscale**(p-1) ! Number of x elements 263 | ney = ney0*nscale**(p-1) 264 | nxOut = nex*(nQuad+1) ! Number of local subcells for plotting final solution 265 | nyOut = ney*(nQuad+1) 266 | 267 | ALLOCATE(elemX(1:nex),elemY(1:ney),xPlot(1:nxOut),yPlot(1:nyOut),& 268 | DGx(1:nxOut),DGy(1:nyOut),q(1:nxOut,1:nyOut,1:meqn),q0(1:nxOut,1:nyOut,1:meqn),& 269 | reactiveCoeffs(1:nxOut,1:nyOut,1:meqn), u0(1:nxOut,1:nyOut),v0(1:nxOut,1:nyOut),& 270 | uEdge0(1:nex,1:nyOut),vEdge0(1:nxOut,1:ney),& 271 | u(1:3,1:nxOut,1:nyOut), v(1:3,1:nxOut,1:nyOut),uEdge(1:3,1:nex,1:nyOut),& 272 | vEdge(1:3,1:nxOut,1:ney),& 273 | STAT=ierr) 274 | 275 | ALLOCATE(avgXferOp(0:maxPolyDegree,0:maxPolyDegree),avgXferOpLU(0:maxPolyDegree,0:maxPolyDegree),& 276 | IPIV(0:maxPolyDegree),FOO(0:maxPolyDegree),STAT=ierr) 277 | 278 | ! Create plotting grids 279 | CALL makeGrid(dxel,dyel,elemX,elemY,dxPlot,dyPlot,quadNodes,xPlot,yPlot) 280 | 281 | ! ===================================================================================================== 282 | ! Initialize q, u, and v arrays. 283 | ! ===================================================================================================== 284 | CALL init2d(q0,u0,v0,uEdge0,vEdge0,xPlot,yPlot,DGx,DGy,quadNodes,dxel,dyel,& 285 | dxPlot,dyPlot,elemX,elemY,reactiveCoeffs) 286 | DO i=1,3 287 | u(i,:,:) = u0 288 | v(i,:,:) = v0 289 | uEdge(i,:,:) = uEdge0 290 | vEdge(i,:,:) = vEdge0 291 | ENDDO 292 | q = q0 293 | 294 | ! elemX and elemY are coordinates of element edges 295 | elemX = elemX+0.5D0*dxel 296 | elemY = elemY+0.5D0*dyel 297 | 298 | ! ===================================================================================================== 299 | ! Set up time step size 300 | ! ===================================================================================================== 301 | time = 0D0 302 | 303 | tmp_umax = MAX(MAXVAL(abs(u0)),1D0) 304 | tmp_vmax = MAX(MAXVAL(abs(v0)),1D0) 305 | 306 | IF(noutput .eq. -1) THEN 307 | nstep = CEILING( tfinal*MAX(tmp_umax/dxel,tmp_vmax/dyel)/maxcfl ) 308 | nout = nstep 309 | ELSE 310 | nstep = noutput*CEILING( tfinal*MAX(tmp_umax/dxel,tmp_vmax/dyel)/maxcfl/DBLE(noutput) ) 311 | nout = noutput 312 | ENDIF 313 | dt = tfinal/DBLE(nstep) 314 | calculatedMu = MAX(tmp_umax/dxel,tmp_vmax/dyel)*dt 315 | write(*,'(A,E12.4,A,I5)') 'Mu used=',calculatedMu,' nsteps used=',nstep 316 | 317 | IF(p==1) THEN ! Set up netCDF output file 318 | cdfOut = TRIM(outdir)//TRIM(cdfOut)//'.nc' 319 | write(*,*) '*****' 320 | write(*,*) 'Outputting to: ',cdfOut 321 | write(*,*) '*****' 322 | CALL output2d(q,xPlot,yPlot,tfinal,calculatedMu,cdfOut,nout,-1) 323 | ENDIF 324 | CALL output2d(q,xPlot,yPlot,tfinal,calculatedMu,cdfOut,p,0) 325 | 326 | ! ===================================================================================================== 327 | ! Time integration 328 | ! ===================================================================================================== 329 | DO m=1,meqn 330 | tmpqMax(p,m) = MAXVAL(q(:,:,m)) 331 | tmpqMin(p,m) = MINVAL(q(:,:,m)) 332 | ENDDO !m 333 | 334 | oddstep = .TRUE. 335 | write(*,*) 'Beginning time step...' 336 | 337 | DO n=1,nstep 338 | ! Call update 339 | IF(transient) THEN 340 | CALL updateVelocities(u,v,uEdge,vEdge,xPlot,elemX,DGx,yPlot,elemY,DGy,time,dt) 341 | ENDIF 342 | 343 | CALL strangSplit(q,u,v,uEdge,vEdge,quadNodes,quadWeights,time,& 344 | basisPolyVal,basisPolyDeriv,avgXferOp,avgXferOpLU,IPIV,& 345 | dt,dxel,dyel,reactiveCoeffs,oddstep) 346 | time = time + dt 347 | ! Check if this is output time 348 | IF((MOD(n,nstep/nout).eq.0).OR.(n.eq.nstep)) THEN ! Write output variables 349 | write(*,*) 'Outputting at time =',time 350 | CALL output2d(q,xPlot,yPlot,tfinal,calculatedMu,cdfOut,p,2) 351 | ENDIF 352 | DO m=1,meqn 353 | tmpqMin(p,m) = MIN(tmpqMin(p,m),MINVAL(q(:,:,m))) 354 | tmpqMax(p,m) = MAX(tmpqMax(p,m),MAXVAL(q(:,:,m))) 355 | ENDDO !m 356 | 357 | oddstep = .NOT. oddstep 358 | ENDDO !n 359 | 360 | CALL cpu_time(tf(p)) 361 | tf(p) = tf(p) - t0(p) 362 | CALL computeErrors(q,q0,quadWeights,e1,e2,ei,cons,tmpqMax,tmpqMin,tf,nRuns,nex0,ney0,nscale,p) 363 | 364 | IF(p == nRuns) THEN 365 | ! Close output files 366 | CALL output2d(q,xPlot,yPlot,tfinal,calculatedMu,cdfOut,nout,1) 367 | CALL computeErrors(q,q0,quadWeights,e1,e2,ei,cons,tmpqMax,tmpqMin,tf,nRuns,nex0,ney0,nscale,-1) 368 | ENDIF 369 | 370 | DEALLOCATE(elemX,elemY,xPlot,yPlot,DGx,DGy,avgXferOp,avgXferOpLU,IPIV,FOO,& 371 | q,q0,reactiveCoeffs,u0,v0,uEdge0,vEdge0,u,v,uEdge,vEdge,STAT=ierr) 372 | ENDDO !p 373 | 374 | DEALLOCATE(quadNodes,quadWeights,baryWeights,basisPolyVal,basisPolyDeriv,STAT=ierr) 375 | 376 | ENDDO !nmethod 377 | 378 | CONTAINS 379 | SUBROUTINE makeGrid(dxel,dyel,xCenter,yCenter,dxPlot,dyPlot,quadNodes,xPlot,yPlot) 380 | ! ============================================================================= 381 | ! Computes cell width and initializes cell centers and quadrature grid 382 | ! INPUTS: nex,ney - number of elements 383 | ! nQuad - number of quadrature nodes 384 | ! quadNodes(0:nQuad) - Gauss-Legendre quadrature nodes 385 | ! OUTPUTS: dxel,dyel - width of elements 386 | ! xCenter(j),yCenter(j) - location of jth element center 387 | ! ============================================================================= 388 | USE commonTestParameters, ONLY: xDomain,yDomain,nxOut,nyOut,nQuad 389 | IMPLICIT NONE 390 | ! Inputs 391 | DOUBLE PRECISION, DIMENSION(0:nQuad), INTENT(IN) :: quadNodes 392 | ! Outputs 393 | DOUBLE PRECISION, INTENT(OUT) :: dxel,dyel,dxPlot,dyPlot 394 | DOUBLE PRECISION, DIMENSION(1:nex), INTENT(OUT) :: xCenter 395 | DOUBLE PRECISION, DIMENSION(1:ney), INTENT(OUT) :: yCenter 396 | DOUBLE PRECISION, DIMENSION(1:nxOut), INTENT(OUT) :: xPlot 397 | DOUBLE PRECISION, DIMENSION(1:nyOut), INTENT(OUT) :: yPlot 398 | 399 | ! Local variables 400 | DOUBLE PRECISION :: domainWidth 401 | INTEGER :: k,j 402 | 403 | domainWidth = xDomain(2)-xDomain(1) 404 | dxel = domainWidth/DBLE(nex) 405 | dxPlot = domainWidth/DBLE(nxOut) 406 | 407 | domainWidth = yDomain(2)-yDomain(1) 408 | dyel = domainWidth/DBLE(ney) 409 | dyPlot = domainWidth/DBLE(nyOut) 410 | 411 | xCenter(1) = xDomain(1)+0.5D0*dxel 412 | DO j=2,nex 413 | xCenter(j) = xCenter(j-1)+dxel 414 | ENDDO!j 415 | 416 | ! xPlot(1) = xDomain(1)+0.5D0*dxPlot 417 | ! DO j=2,nxOut 418 | ! xPlot(j) = xPlot(j-1)+dxPlot 419 | ! ENDDO!j 420 | DO j=1,nex 421 | xPlot(1+(j-1)*(nQuad+1):j*(nQuad+1)) = xCenter(j)+0.5D0*dxel*quadNodes(:) 422 | ENDDO !j 423 | 424 | yCenter(1) = yDomain(1)+0.5D0*dyel 425 | DO j=2,ney 426 | yCenter(j) = yCenter(j-1)+dyel 427 | ENDDO!j 428 | 429 | DO j=1,ney 430 | yPlot(1+(j-1)*(nQuad+1):j*(nQuad+1)) = yCenter(j)+0.5D0*dyel*quadNodes(:) 431 | ENDDO !j 432 | 433 | ! yPlot(1) = xDomain(1)+0.5D0*dyPlot 434 | ! DO j=2,nyOut 435 | ! yPlot(j) = yPlot(j-1)+dyPlot 436 | ! ENDDO!j 437 | END SUBROUTINE makeGrid 438 | END SUBROUTINE DRIVER 439 | -------------------------------------------------------------------------------- /plotter2d.m: -------------------------------------------------------------------------------- 1 | % Plot Advection Tests using plot_2dadv.m 2 | % By: Devin Light 3 | % ------ 4 | 5 | clear all; 6 | close all; 7 | clc; 8 | %% 9 | cd('/Users/Devin/Desktop/R/NodalDG/2d_adv/advReaction'); 10 | 11 | tests = { 12 | 'def_cosinebell', ... % 1, LeVeque deformation test cosinebell 13 | 'def_cyl',... % 2, Deformation flow applied to slotted cylinder 14 | 'consistency',... %3 uniform field deformation flow 15 | 'reactive',... % 4 Reactive half plane flow 16 | 'sbr',... % 5 Solid body rotation 17 | 'smth_cosbell' % 6 Deformation of a smoother cosine bell 18 | }; 19 | res = {'1','2','3','4'}; 20 | methods = { 'nodal',... 21 | 'nodalPDtmar',... 22 | 'nodalPDr',... 23 | 'nodalPDs',... 24 | }; 25 | 26 | % Read in data 27 | cd('/Users/Devin/Desktop/R/NodalDG/2d_adv/advReaction'); 28 | 29 | ntest = 1; 30 | meqn = 1; 31 | whichRes = res(2); 32 | whichTest = tests{ntest}; 33 | 34 | subDir = 'n5/'; 35 | %subDir = ''; 36 | whichMethods = [1 2]; 37 | ncfilename = strcat('splt2d_' ,whichTest, '.nc'); 38 | 39 | reactiveTest = 0; 40 | reactionCoeff = 1.0; 41 | tfinal = 5.0; 42 | 43 | for imethod=1:length(whichMethods) 44 | nmethod = whichMethods(imethod); 45 | methName = methods{nmethod}; 46 | if(nmethod == 1) 47 | methname = 'Unlimited (nod)'; 48 | nc = ['_nodal/' subDir ncfilename]; 49 | out = plot_2dadv(methname,whichTest,nc,whichRes,meqn); 50 | out.figLabel = 'b'; 51 | out.pltStyle = 'k-'; 52 | elseif(nmethod == 2) 53 | methname = 'TMAR (nod)'; 54 | nc = ['_pdnodal/tmar/' subDir ncfilename]; 55 | out = plot_2dadv(methname,whichTest,nc,whichRes,meqn); 56 | out.figLabel = 'b'; 57 | out.pltStyle = 'r--'; 58 | elseif(nmethod == 3) 59 | methname = 'ZS'; 60 | nc = ['_pdnodal/rescale/' subDir ncfilename]; 61 | out = plot_2dadv(methname,whichTest,nc,whichRes,meqn); 62 | out.figLabel = 'c'; 63 | out.pltStyle = 'b-.'; 64 | elseif(nmethod == 4) 65 | methname = 'Nodal PD (strictest)'; 66 | nc = ['_pdnodal/eqscale/' subDir ncfilename]; 67 | out = plot_2dadv(methname,whichTest,nc,whichRes,meqn); 68 | out.figLabel = 'd'; 69 | out.pltStyle = 'g:'; 70 | end 71 | meth.(methName) = out; 72 | 73 | % Generate exact solution data 74 | data = squeeze(meth.(methName).q1(1,:,:)); 75 | q_ic = zeros([size(data) meqn]); 76 | for m=1:meqn 77 | qname = ['q' num2str(m)]; 78 | q_ic(:,:,m) = squeeze(meth.(methName).(qname)(1,:,:)); 79 | end 80 | 81 | if(reactiveTest) 82 | qEx = reactiveExact(reactionCoeff,q_ic,tfinal); 83 | meth.(methName).q_ex = qEx; 84 | else 85 | meth.(methName).q_ex = q_ic; 86 | end 87 | 88 | for m=1:meqn 89 | error = []; 90 | einf = []; 91 | 92 | qname = ['q' num2str(m)]; 93 | final = squeeze(out.(qname)(end,:,:)); 94 | 95 | exact = squeeze(meth.(methName).q_ex(:,:,m)); 96 | 97 | % Compute L2 and Linf error 98 | nError = sqrt(mean( (exact(:)-final(:)).^2 )); 99 | error = [error nError]; 100 | errName = ['q' num2str(m) '_err_l2']; 101 | meth.(methName).(errName) = error; 102 | 103 | nError = max(abs(exact(:)-final(:))); 104 | errName = ['q' num2str(m) '_err_inf']; 105 | einf = [einf nError]; 106 | meth.(methName).(errName) = einf; 107 | end 108 | %} 109 | end 110 | %% Make colored figures 111 | FS = 'FontSize'; 112 | label = 'abcdefghijklmnopqrstuvwxyz'; 113 | xwidth = 400; ywidth = 400; 114 | 115 | nFigs = length(whichMethods); 116 | 117 | whichTime = -1; 118 | printErrors = 1; 119 | printExtrema = 1; 120 | printLabel = 1; 121 | makeExactFigs = 0; 122 | 123 | numCol = 1; 124 | numRows = 1; 125 | 126 | outDir = ['_figs/_' whichTest '/']; 127 | saveFigure = 1; 128 | closeAfterPause = 1; 129 | 130 | 131 | for imethod=1:length(whichMethods) 132 | 133 | nmethod = whichMethods(imethod); 134 | methName = methods{nmethod}; 135 | currMeth = meth.(methName); 136 | 137 | disp(['*** Plotting: ' methName 'output:' outDir]); 138 | 139 | x = currMeth.x; 140 | y = currMeth.y; 141 | 142 | if(ntest == 1) 143 | contAxis = [-0.5 1.0];contStep = 0.1; 144 | clvls = contAxis(1):contStep:contAxis(2); 145 | xloc1 = 0.55; xloc2 = xloc1; 146 | yloc1 = 0.65; yloc2 = yloc1-0.3; 147 | end 148 | 149 | nt = length(currMeth.t); 150 | if(whichTime == -1) 151 | nlvls = nt; 152 | else 153 | nlvls = whichTime; 154 | end 155 | nCol = length(nlvls); nRow = 1; numPlot = nCol*nRow; 156 | 157 | for m=1:meqn 158 | if(m==1) 159 | xpos = 0; 160 | ypos = (imethod-1)*300; 161 | else 162 | xpos = 400; 163 | ypos = (imethod-1)*300; 164 | end 165 | fig = figure(); 166 | set(gcf, 'PaperUnits', 'points'); 167 | set(gcf,'PaperPositionMode','auto','PaperSize',[xwidth ywidth]); 168 | set(fig, 'Position', [xpos ypos xwidth ywidth]); 169 | 170 | qname = ['q' num2str(m)]; 171 | e2name = [qname '_err_l2']; 172 | einfname = [qname '_err_inf']; 173 | 174 | err2 = sprintf('%#.3g',currMeth.(e2name)); 175 | einf = sprintf('%#.3g',currMeth.(einfname)); 176 | 177 | if(makeExactFigs) 178 | final = squeeze(currMeth.q_ex(:,:,m)); 179 | else 180 | final = squeeze(currMeth.(qname)(nlvls,:,:)); 181 | end 182 | 183 | final = final+10^(-15); % Adjust values below machine precision 184 | % Plot data 185 | 186 | % Modify colormap 187 | nColors = round((contAxis(2)-contAxis(1))/contStep); 188 | negColorRange = sum(clvls<=0); 189 | cmap = colormap(jet(nColors-negColorRange)); 190 | LG = [0.0 0.0 0.0]; W = [1 1 1]; 191 | R = linspace(LG(1),W(1),negColorRange)'; G = linspace(LG(2),W(2),negColorRange)'; B = linspace(LG(3),W(3),negColorRange)'; 192 | T = [R G B]; cmap = [T' cmap']'; 193 | colormap(cmap); 194 | 195 | [C,h]=contourf(x,y,final,clvls,'LineStyle','none'); 196 | axis([0 1 0 1]); caxis(contAxis); 197 | 198 | xlabel('x',FS,18); ylabel('y',FS,18); 199 | set(gca,'XTick',0:.2:1,'YTick',0:.2:1,'XTickLabel',[0:.2:1],'YTickLabel',[0:.2:1]); 200 | 201 | if(printErrors == 1 && makeExactFigs == 0) 202 | text(xloc1,yloc1,['E_2= ' err2],FS,18 ); 203 | text(xloc1,yloc1-.1,['E_{\infty}= ' einf],FS,18 ); 204 | end 205 | if(printExtrema) 206 | text(xloc2,yloc2,sprintf('Max_ = %4.3f', max(final(:))),FS,18 ); 207 | text(xloc2,yloc2-0.1,sprintf('Min_ = %4.3f', min(final(:))),FS,18 ); 208 | end 209 | if(printLabel) 210 | if(makeExactFigs) 211 | hLu = text(0.05,0.95,[label(m) ') Exact --' qname],FS,18); 212 | else 213 | %hLu = text(0.05,0.95,[label(m) ') ' currMeth.method '--' qname],FS,18); 214 | hLu = text(0.05,0.95,[currMeth.figLabel ') ' currMeth.method '--' qname],FS,18); 215 | end 216 | end 217 | 218 | opos = get(gca,'OuterPosition'); 219 | pos = get(gca,'Position'); 220 | 221 | currLabel = label(m); 222 | if( (numCol*numRows-(currLabel-'a')) > 2) 223 | xtl = ''; 224 | set(gca,'XTickLabel',xtl,FS,8); 225 | xlabel(''); 226 | end 227 | if( mod(currLabel-'a',numCol) ~= 0) 228 | ytl = ''; yaxlab = ''; 229 | set(gca,'YTickLabel',ytl,FS,8); 230 | ylabel(''); 231 | end 232 | 233 | set(gca,FS,16,'Position',pos,'OuterPosition',opos); 234 | box on; 235 | 236 | pow = str2double(whichRes); 237 | nelem = length(squeeze(currMeth.q1(1,:,:)))/(currMeth.N+1); 238 | name = ['_' methName '/_color/' subDir whichTest '_N', num2str(currMeth.N), 'E', num2str(nelem), '_' qname]; 239 | if(makeExactFigs) 240 | name = [name '_EXACT']; 241 | end 242 | name = [outDir name '.pdf']; 243 | 244 | if(saveFigure == 1) 245 | print(fig,'-dpdf',name); 246 | end 247 | end 248 | 249 | % Print colorbar figure 250 | fig = figure(); axis off; 251 | set(gcf, 'PaperUnits', 'points'); 252 | set(gcf,'PaperPositionMode','auto','PaperSize',[2*xwidth ywidth]); 253 | set(fig, 'Position', [800 0 2*xwidth ywidth]) 254 | colormap(cmap); 255 | h = colorbar('location','southoutside',FS,18); caxis(contAxis); 256 | 257 | name = ['_' methName '/_color/' subDir whichTest '_N', num2str(currMeth.N), 'E', num2str(nelem),'_CB.pdf']; 258 | name = [outDir name]; 259 | if(saveFigure == 1) 260 | print(fig,'-dpdf',name); 261 | end 262 | 263 | end 264 | 265 | pause(3.0); 266 | if(closeAfterPause) 267 | close all 268 | end 269 | 270 | %% Make colored figures 271 | FS = 'FontSize'; 272 | label = 'abcdefghijklmnopqrstuvwxyz'; 273 | xwidth = 400; ywidth = 400; 274 | 275 | nFigs = length(whichMethods); 276 | 277 | whichTime = -1; 278 | meqn = 2; 279 | printErrors = 1; 280 | printExtrema = 1; 281 | printLabel = 1; 282 | makeExactFigs = 0; 283 | 284 | numCol = 1; 285 | numRows = 1; 286 | 287 | outDir = ['_figs/_' whichTest '/']; 288 | saveFigure = 1; 289 | closeAfterPause = 0; 290 | 291 | 292 | for imethod=1:length(whichMethods) 293 | 294 | nmethod = whichMethods(imethod); 295 | methName = methods{nmethod}; 296 | currMeth = meth.(methName); 297 | 298 | disp(['*** Plotting: ' methName ]); 299 | disp([' output:' outDir]); 300 | 301 | x = currMeth.x; 302 | y = currMeth.y; 303 | 304 | if(ntest == 1) 305 | contAxis = [-0.5 2.0];contStep = 0.1; 306 | clvls = contAxis(1):contStep:contAxis(2); 307 | xloc1 = 0.55; xloc2 = xloc1; 308 | yloc1 = 0.65; yloc2 = yloc1-0.3; 309 | end 310 | 311 | nt = length(currMeth.t); 312 | if(whichTime == -1) 313 | nlvls = nt; 314 | else 315 | nlvls = whichTime; 316 | end 317 | nCol = length(nlvls); nRow = 1; numPlot = nCol*nRow; 318 | 319 | for m=1:meqn 320 | fig = figure(); 321 | set(gcf, 'PaperUnits', 'points'); 322 | set(gcf,'PaperPositionMode','auto','PaperSize',[xwidth ywidth]); 323 | set(fig, 'Position', [0 0 xwidth ywidth]); 324 | 325 | qname = ['q' num2str(m)]; 326 | e2name = [qname '_err_l2']; 327 | einfname = [qname '_err_inf']; 328 | 329 | err2 = sprintf('%#.3g',currMeth.(e2name)); 330 | einf = sprintf('%#.3g',currMeth.(einfname)); 331 | 332 | if(makeExactFigs) 333 | final = squeeze(currMeth.q_ex(:,:,m)); 334 | else 335 | final = squeeze(currMeth.(qname)(nlvls,:,:)); 336 | end 337 | 338 | final = final+10^(-15); % Adjust values below machine precision 339 | % Plot data 340 | 341 | % Modify colormap 342 | nColors = round((contAxis(2)-contAxis(1))/contStep); 343 | negColorRange = sum(clvls<=0); 344 | %negColorRange = 0; 345 | cmap = colormap(jet(nColors-negColorRange)); 346 | LG = [0.0 0.0 0.0]; W = [1 1 1]; 347 | R = linspace(LG(1),W(1),negColorRange)'; G = linspace(LG(2),W(2),negColorRange)'; B = linspace(LG(3),W(3),negColorRange)'; 348 | %T = [R G B]; cmap(1:negColorRange,:) = T; 349 | T = [R G B]; cmap = [T' cmap']'; 350 | colormap(cmap); 351 | 352 | [C,h]=contourf(x,y,final,clvls,'LineStyle','none'); 353 | axis([0 1 0 1]); caxis(contAxis); 354 | 355 | xlabel('x',FS,18); ylabel('y',FS,18); 356 | set(gca,'XTick',0:.2:1,'YTick',0:.2:1,'XTickLabel',[0:.2:1],'YTickLabel',[0:.2:1]); 357 | 358 | if(printErrors == 1 && makeExactFigs==0) 359 | text(xloc1,yloc1,['E_2= ' err2],FS,18 ); 360 | text(xloc1,yloc1-.1,['E_{\infty}= ' einf],FS,18 ); 361 | end 362 | if(printExtrema) 363 | text(xloc2,yloc2,sprintf('Max_ = %4.3f', max(final(:))),FS,18 ); 364 | text(xloc2,yloc2-0.1,sprintf('Min_ = %4.3f', min(final(:))),FS,18 ); 365 | end 366 | if(printLabel) 367 | if(makeExactFigs) 368 | hLu = text(0.05,0.95,[label(m) ') Exact --' qname],FS,18); 369 | else 370 | hLu = text(0.05,0.95,[label(m) ') ' currMeth.method '--' qname],FS,18); 371 | end 372 | end 373 | 374 | opos = get(gca,'OuterPosition'); 375 | pos = get(gca,'Position'); 376 | 377 | currLabel = label(m); 378 | if( (numCol*numRows-(currLabel-'a')) > 2) 379 | xtl = ''; 380 | set(gca,'XTickLabel',xtl,FS,8); 381 | xlabel(''); 382 | end 383 | if( mod(currLabel-'a',numCol) ~= 0) 384 | ytl = ''; yaxlab = ''; 385 | set(gca,'YTickLabel',ytl,FS,8); 386 | ylabel(''); 387 | end 388 | 389 | set(gca,FS,16,'Position',pos,'OuterPosition',opos); 390 | box on; 391 | 392 | pow = str2double(whichRes); 393 | nelem = length(squeeze(currMeth.q1(1,:,:)))/(currMeth.N+1); 394 | name = [subDir '_' methName '/_color/' whichTest '_N', num2str(currMeth.N), 'E', num2str(nelem), '_' qname]; 395 | if(makeExactFigs) 396 | name = [name '_EXACT']; 397 | end 398 | name = [outDir name '.pdf']; 399 | 400 | if(saveFigure == 1) 401 | print(fig,'-dpdf',name); 402 | end 403 | end 404 | 405 | end 406 | 407 | % Print colorbar figure 408 | fig = figure(); axis off; 409 | set(gcf, 'PaperUnits', 'points'); 410 | set(gcf,'PaperPositionMode','auto','PaperSize',[2*xwidth ywidth]); 411 | set(fig, 'Position', [0 0 2*xwidth ywidth]) 412 | colormap(cmap); 413 | h = colorbar('location','southoutside',FS,18); caxis(contAxis); 414 | %set(h,'XTick',contAxis(1):0.2:contAxis(2),'XTickLabel',contAxis(1):0.2:contAxis(2)); 415 | 416 | name = [subDir '_' methName '/_color/' whichTest '_N', num2str(currMeth.N), 'E', num2str(nelem),'_CB.pdf']; 417 | name = [outDir name]; 418 | if(saveFigure == 1) 419 | print(fig,'-dpdf',name); 420 | end 421 | 422 | pause(5.0); 423 | if(closeAfterPause) 424 | close all 425 | end 426 | %% Make Comparison Figure for this resolution 427 | FS = 'FontSize'; 428 | cd('/Users/Devin/Desktop/R/NodalDG/2d_adv/advReaction/'); 429 | close all 430 | 431 | print_errors = 1; 432 | print_label = 1; 433 | plotICs = 1; 434 | numRows = 1; 435 | figsPerRow = 1; 436 | saveFigure = 1; 437 | 438 | xwidth = 400; 439 | ywidth = 400; 440 | outDir = ['_figs/_' whichTest]; 441 | 442 | for imethod=1:length(whichMethods) 443 | nmethod = whichMethods(imethod); 444 | if(ntest == 1) 445 | xloc1 = 0.1; xloc2 = 0.50; 446 | yloc1 = 0.65; yloc2 = 0.75; 447 | excontours = [.05 .75]; clvls = 0.1:0.1:1.0; 448 | elseif(ntest == 4) 449 | xloc1 = 0.1; xloc2 = 0.6; 450 | yloc1 = 0.1; yloc2 = 0.2; 451 | excontours = [.05 1.0]; clvls = 0.1:0.1:1.0; 452 | end 453 | 454 | methName = methods{nmethod}; 455 | currMeth = meth.(methName); 456 | disp(['Plotting: ' methName]); 457 | 458 | x = currMeth.x; 459 | y = currMeth.y; 460 | 461 | for m=1:meqn 462 | fig = figure(); 463 | set(gcf, 'PaperUnits', 'points'); 464 | set(gcf,'PaperPositionMode','auto','PaperSize',[xwidth ywidth]); 465 | set(fig, 'Position', [0 0 xwidth ywidth]) 466 | 467 | qname = ['q' num2str(m)]; 468 | e2name = [qname '_err_l2']; 469 | einfname = [qname '_err_inf']; 470 | 471 | ics = squeeze(currMeth.(qname)(1,:,:)); 472 | final = squeeze(currMeth.(qname)(end,:,:)); 473 | 474 | final(final < 0) = final(final<0)+10^(-15); 475 | 476 | err2 = sprintf('%#.3g',currMeth.(e2name)); 477 | einf = sprintf('%#.3g',currMeth.(einfname)); 478 | 479 | hold on 480 | [C,h] = contour(x,y,final,clvls); 481 | set (h, 'LineWidth', 1,'LineColor','k'); 482 | 483 | negclvls = -1*[1 1]*10^(-14); 484 | [C,h] = contour(x,y,final,negclvls,'LineWidth',2.0,'LineColor',[0.75 0.75 0.75]); 485 | %set(h,'LineWidth', 0.2,'LineColor',[0.95 0.95 0.95]); 486 | 487 | if(plotICs) 488 | [C,h] = contour(x,y,ics,excontours); 489 | set (h, 'LineWidth', 2,'LineColor','k'); 490 | axis square 491 | end 492 | hold off 493 | 494 | xlabel('x',FS,18); ylabel('y',FS,18); 495 | set(gca,'XTick',[0:.2:1],'YTick',[0:0.2:1]); 496 | 497 | if(print_errors == 1) 498 | text(xloc1,yloc1,['E_2= ' err2],FS,18 ); 499 | text(xloc1,yloc2,['E_{\infty}= ' einf],FS,18 ); 500 | text(xloc2,yloc1,sprintf('Max_ = %4.3f', max(final(:))),FS,18 ); 501 | text(xloc2,yloc2,sprintf('Min_ = %4.3f', min(final(:))),FS,18 ); 502 | end 503 | 504 | if(print_label) 505 | % if(ntest == 1 || nTe ) 506 | hLu = text(0.05,0.95,[currMeth.figLabel ') ' currMeth.method '--' qname],FS,18); 507 | axis([-0.005 1.005 -0.005 1.005]); 508 | % end 509 | end 510 | 511 | opos = get(gca,'OuterPosition'); 512 | pos = get(gca,'Position'); 513 | 514 | currLabel = currMeth.figLabel; 515 | if( (figsPerRow*numRows-(currLabel-'a')) > 2) 516 | xtl = ''; 517 | set(gca,'XTickLabel',xtl,FS,8); 518 | xlabel(''); 519 | end 520 | if( mod(currLabel-'a',figsPerRow) ~= 0) 521 | ytl = ''; yaxlab = ''; 522 | set(gca,'YTickLabel',ytl,FS,8); 523 | ylabel(''); 524 | end 525 | 526 | set(gca,FS,16,'Position',pos,'OuterPosition',opos); 527 | box on; 528 | 529 | pow = str2double(whichRes); 530 | nelem = length(ics)/(currMeth.N+1); 531 | name = [subDir methName '_2d',qname, '_', num2str(nelem),'e','.pdf']; 532 | name = [outDir name]; 533 | 534 | if(saveFigure == 1) 535 | print(fig,'-dpdf',name); 536 | end 537 | pause(0.5); 538 | end % m 539 | end 540 | 541 | %% Make slice figures 542 | 543 | xwidth = 400; 544 | ywidth = 400; 545 | label = 'abcdefghijklmnopqrstuvwxyz'; 546 | FS = 'FontSize'; LW = 'LineWidth'; 547 | 548 | ySlicePos = 0.25; 549 | meqn = 2; 550 | saveFigure = 1; 551 | outDir = '_figs/_'; 552 | 553 | 554 | for imethod=1:length(whichMethods) 555 | fig = figure(); 556 | set(gcf, 'PaperUnits', 'points'); 557 | set(gcf,'PaperPositionMode','auto','PaperSize',[xwidth ywidth]); 558 | set(fig, 'Position', [0 0 xwidth ywidth]); 559 | 560 | nmethod = whichMethods(imethod); 561 | methName = methods{nmethod}; 562 | currMeth = meth.(methName); 563 | 564 | disp(['Reading: ' methName]); 565 | 566 | ny = length(currMeth.y); 567 | yloc = round(ny*ySlicePos); 568 | 569 | x = currMeth.x; y = currMeth.y; 570 | for m=1:meqn 571 | qname = ['q' num2str(m)]; 572 | 573 | qinit = squeeze(currMeth.(qname)(1,:,yloc)); 574 | qf = squeeze(currMeth.(qname)(end,:,yloc)); 575 | 576 | fprintf('%s min=%6.4e \n',qname,min(qf(:))); 577 | fprintf('%s max=%6.4e \n',qname,max(qf(:))); 578 | disp('==='); 579 | 580 | subplot(meqn,1,m), plot(x,qinit,'g.',x,qf,currMeth.pltStyle,LW,2),axis([0 1 -0.5 1.4]); 581 | ylabel(['q(x,y*)'],FS,14); 582 | if(m==meqn) 583 | xlabel('x',FS,14); 584 | end 585 | hLu = text(0.05,1.25,[label(m) ') ' currMeth.method '--' qname],FS,18); 586 | 587 | end 588 | disp(''); 589 | box on; 590 | 591 | pow = str2double(whichRes); 592 | nelem = length(x)/(currMeth.N+1); 593 | name = [whichTest '/' subDir '_' methName '/' whichTest,'_N', num2str(currMeth.N), 'E', num2str(nelem),'.pdf']; 594 | name = [outDir name]; 595 | 596 | if(saveFigure == 1) 597 | print(fig,'-dpdf',name); 598 | end 599 | pause(0.5); 600 | 601 | end 602 | 603 | 604 | %% For reactive flows, plot change in 2*q1+q2 (should be constant) 605 | xwidth = 400; 606 | ywidth = 400; 607 | FS = 'FontSize'; LW = 'LineWidth'; 608 | figl2 = figure(1); 609 | figinf = figure(2); 610 | for imethod=1:length(whichMethods) 611 | nmethod = whichMethods(imethod); 612 | methName = methods{nmethod}; 613 | currMeth = meth.(methName); 614 | 615 | disp(['Reading: ' methName]); 616 | 617 | q1init=squeeze(currMeth.q1(1,:,:)); 618 | q2init=squeeze(currMeth.q2(1,:,:)); 619 | %qTinit=2*q1init+q2init; 620 | qTinit=q1init+q2init; 621 | 622 | fprintf('qT min=%6.4e \n',min(qTinit(:))); 623 | disp(''); 624 | fprintf('qT max=%6.4e \n' ,max(qTinit(:))); 625 | disp(''); 626 | 627 | nt = length(currMeth.t); 628 | el2errs = []; 629 | einferrs = []; 630 | 631 | normFac1 = sqrt(mean(qTinit(:).^2)); 632 | normFac2 = max(abs(qTinit(:))); 633 | for n=1:nt 634 | q1=squeeze(currMeth.q1(n,:,:)); 635 | q2=squeeze(currMeth.q2(n,:,:)); 636 | %qT=2*q1+q2; 637 | qT=q1+q2; 638 | 639 | el2 = sqrt(mean( (qT(:)-qTinit(:)).^2 ))/normFac1; 640 | einf = max(abs(qT(:)-qTinit(:)))/normFac2; 641 | 642 | el2errs = [el2errs el2]; 643 | einferrs = [einferrs einf]; 644 | end 645 | 646 | fig = figure(figl2); 647 | set(gcf, 'PaperUnits', 'points'); 648 | set(gcf,'PaperPositionMode','auto','PaperSize',[xwidth ywidth]); 649 | set(fig, 'Position', [0 0 xwidth ywidth]) 650 | hold on,plot(currMeth.t,el2errs,currMeth.pltStyle,LW,2); 651 | disp(''); 652 | 653 | fig = figure(figinf); 654 | set(gcf, 'PaperUnits', 'points'); 655 | set(gcf,'PaperPositionMode','auto','PaperSize',[xwidth ywidth]); 656 | set(fig, 'Position', [xwidth 0 xwidth ywidth]) 657 | hold on,plot(currMeth.t,einferrs,currMeth.pltStyle,LW,2); 658 | end 659 | fig = figure(figl2); 660 | set(gca,'YScale','log'); 661 | xlabel('time',FS,14); ylabel('L_2 Error',FS,14); 662 | hLu = text(0.25,3.5,['a) L_2 Normalized Errors'],FS,18); 663 | set(gca,FS,14); 664 | axis([0 5 10^(-6) 10]); box on; 665 | 666 | name = '_figs/term_N4E48_l2.pdf'; 667 | %print(fig,name,'-dpdf'); 668 | 669 | fig = figure(figinf); 670 | set(gca,'YScale','log'); 671 | xlabel('time',FS,14); ylabel('L_{\infty} Error',FS,14); 672 | hLu = text(0.25,3.5,['b) L_{\infty} Normalized Errors'],FS,18); 673 | set(gca,FS,14); 674 | axis([0 5 10^(-6) 10]); box on; 675 | 676 | name = '_figs/term_N4E48_einf.pdf'; 677 | %print(fig,name,'-dpdf'); 678 | 679 | %% Make IC plots 680 | FS = 'FontSize'; 681 | qT = 4*10^(-6); 682 | 683 | x = meth.nodal.x; y = meth.nodal.y; 684 | fig = figure(); 685 | set(gcf, 'PaperUnits', 'points'); 686 | set(gcf,'PaperPositionMode','auto','PaperSize',[xwidth ywidth]); 687 | set(fig, 'Position', [0 0 xwidth ywidth]) 688 | 689 | q1 = squeeze(meth.nodal.q1(1,:,:)); 690 | contourf(x,y,q1); 691 | colorbar; 692 | caxis([0 qT]); 693 | hLu = text(0.05,1.03,['a) Cl_2(x,y,0)'],FS,18); 694 | xlabel('x',FS,14); ylabel('y',FS,14); 695 | set(gca,FS,14); 696 | 697 | name = '_figs/cl2_ics.pdf'; 698 | print(fig,name,'-dpdf'); 699 | 700 | fig = figure(); 701 | set(gcf, 'PaperUnits', 'points'); 702 | set(gcf,'PaperPositionMode','auto','PaperSize',[xwidth ywidth]); 703 | set(fig, 'Position', [0 0 xwidth ywidth]) 704 | 705 | q2 = squeeze(meth.nodal.q2(1,:,:)); 706 | contourf(x,y,q2); 707 | hLu = text(0.05,1.05,['b) Cl(x,y,0)'],FS,18); 708 | colorbar; 709 | caxis([0 qT]); 710 | set(gca,FS,14); 711 | set(gca,'YTickLabel',''); xlabel('x',FS,14); 712 | 713 | name = '_figs/cl_ics.pdf'; 714 | print(fig,name,'-dpdf'); 715 | 716 | %% Coeff k1 717 | fig = figure(); 718 | set(gcf, 'PaperUnits', 'points'); 719 | set(gcf,'PaperPositionMode','auto','PaperSize',[xwidth ywidth]); 720 | set(fig, 'Position', [0 0 xwidth ywidth]) 721 | 722 | k1 = zeros(length(x),length(y)); 723 | xloc = x<0.5; 724 | for j=1:length(y) 725 | k1(j,xloc) = cos(2.0*pi*(x(xloc)-0.25)); 726 | end 727 | 728 | contourf(x,y,k1); 729 | colorbar; 730 | xlabel('x',FS,14);ylabel('y',FS,14);set(gca,FS,14); 731 | title('k1(x,y)',FS,14); 732 | name = '_figs/k1.pdf'; 733 | print(fig,name,'-dpdf'); 734 | 735 | %% 736 | qT = 4*10^(-6); 737 | for imethod = 1:length(whichMethods) 738 | nmethod = whichMethods(imethod); 739 | methName = methods{nmethod}; 740 | currMeth = meth.(methName); 741 | 742 | fig = figure(); 743 | set(gcf, 'PaperUnits', 'points'); 744 | set(gcf,'PaperPositionMode','auto','PaperSize',[xwidth ywidth]); 745 | set(fig, 'Position', [0 0 xwidth ywidth]) 746 | 747 | 748 | q1 = squeeze(currMeth.q1(end,:,:)); 749 | q2 = squeeze(currMeth.q2(end,:,:)); 750 | qTf = 2.*q1+q2; 751 | max(qTf(:)) 752 | min(qTf(:)) 753 | contourf(x,y,qTf); 754 | colorbar; caxis([0 5*10^(-6)]); 755 | hLu = text(0.05,1.03,[currMeth.figLabel ') Cl_T(x,y,5)'],FS,18); 756 | xlabel('x',FS,14); ylabel('y',FS,14); 757 | set(gca,FS,14); 758 | name = ['_figs/' methName '_N4E48_final.pdf']; 759 | print(fig,name,'-dpdf'); 760 | 761 | end 762 | 763 | %% 764 | q1ExactIC = squeeze(meth.nodal.q1(1,:,:)); 765 | r = 1.0; T = 5.0; 766 | qT = ones(size(q1ExactIC)); 767 | 768 | beta = r.*qT; 769 | alpha = (q1ExactIC+beta)./(q1ExactIC.*beta); 770 | 771 | q1Ex = beta./(beta.*alpha.*exp(beta.*T)-1); 772 | [C,h] = contour(x,y,q1Ex); 773 | set (h, 'LineWidth', 1,'LineColor','k'); 774 | 775 | q1F = squeeze(meth.nodal.q1(end,:,:)); 776 | err2 = sqrt(mean( (q1Ex(:)-q1F(:)).^2 )); 777 | 778 | %% 779 | q1_ic = squeeze(meth.nodal.q1(1,:,:)); 780 | q2_ic = squeeze(meth.nodal.q2(1,:,:)); 781 | qT_ic = q1_ic+q2_ic; 782 | 783 | [q1_ex,q2_ex] = reactiveExact(1.0,q1_ic,1.0,5.0); 784 | 785 | q1_nodal_apx = squeeze(meth.nodal.q1(end,:,:)); 786 | q2_nodal_apx = squeeze(meth.nodal.q2(end,:,:)); 787 | qT_nodal_apx = q1_nodal_apx+q2_nodal_apx; 788 | x = meth.nodal.x; y = meth.nodal.y; 789 | 790 | q1_nodalPD_apx = squeeze(meth.nodalPDtmar.q1(end,:,:)); 791 | q2_nodalPD_apx = squeeze(meth.nodalPDtmar.q2(end,:,:)); 792 | qT_nodalPD_apx = q1_nodalPD_apx+q2_nodalPD_apx; 793 | 794 | [C,h] = contour(x,y,q1_ex); 795 | set (h, 'LineWidth', 1,'LineColor','k'); 796 | 797 | figure(); 798 | [C,h] = contour(x,y,q1_apx); 799 | set (h, 'LineWidth', 1,'LineColor','g'); 800 | 801 | normFac = sqrt(mean(q1_ic(:).^2)); 802 | err2 = sqrt(mean( (q1_apx(:)-q1_ex(:)).^2 ) )/normFac; 803 | disp(err2) 804 | 805 | 806 | %% 807 | yloc = round(ny*ySlicePos); 808 | q1_init = squeeze(meth.nodal.q1(1,:,yloc)); 809 | q2_init = squeeze(meth.nodal.q2(1,:,yloc)); 810 | [q1f,q2f] = reactiveExact(1.0,q1_init,1.0,5.0); 811 | 812 | fig = figure(); 813 | set(gcf, 'PaperUnits', 'points'); 814 | set(gcf,'PaperPositionMode','auto','PaperSize',[xwidth ywidth]); 815 | set(fig, 'Position', [0 0 xwidth ywidth]); 816 | 817 | subplot(211), plot(x,q1_init,'g.',x,q1f,'m-',LW,2),axis([0 1 -0.5 1.4]); 818 | ylabel('q(x,y*)',FS,14); 819 | hLu = text(0.05,1.25,['a) Exact -- q1'],FS,18); 820 | subplot(212), plot(x,q2_init,'g.',x,q2f,'m-',LW,2),axis([0 1 -0.5 1.4]); 821 | ylabel('q(x,y*)',FS,14),xlabel('x',FS,14); 822 | hLu = text(0.05,1.25,['b) Exact -- q2'],FS,18); 823 | 824 | name = '_figs/_def_cosinebell/noadv/exact_N4E24.pdf'; 825 | print(fig,name,'-dpdf'); 826 | --------------------------------------------------------------------------------