SUBROUTINE InitWENO(dim_, meqn_, nvars_, nghost_, order_, optimized_, & use_carbfix_, method_, useViscous_, useLES_, useSource_, noTimeRefine_, & alpha_filter_) ! ---- Shared Variables USE method_parms use cles_interfaces USE Generic_Transport IMPLICIT NONE include 'cles.i' INTEGER, INTENT(IN) :: dim_, meqn_, nvars_, nghost_ INTEGER, INTENT(IN) :: order_, optimized_, use_carbfix_, method_ INTEGER, INTENT(IN) :: useViscous_, useLES_, useSource_, noTimeRefine_ DOUBLE PRECISION, INTENT(IN) :: alpha_filter_ INTEGER :: CLESLOG_TCD, CLESLOG_TCD_STENCIL PARAMETER (CLESLOG_TCD=3, CLESLOG_TCD_STENCIL=1) NAMELIST/stencilstuff/stencil,optimized call cleslog_log_enter('InitWENO') dim = dim_ ! ---- The number of components actually used ncomps = meqn_ ! ---- the number of equations nvars = nvars_ ! ---- (nvars -5) is the number of scalars nscal = nvars-5 order = order_ method = method_ optimized = optimized_ alpha_eta2 = max(min(1.0d0,alpha_filter_),0.0d0) alpha_eta1 = 1.0d0-alpha_eta2 if ( method .eq. CLES_METHOD_UPWIND ) then if ( order .eq. 2 .or. order .eq. 3 ) then stencil = 5 else if ( order .eq. 4 .or. order .eq. 5 ) then stencil = 7 else print *, 'Error: wrong order of accuracy for pure weno' print *, 'method was ', method print *, 'cles method upwind is ', cles_method_upwind stop endif ! do not use dcflag to determine upwinded fluxes, do it to all terms use_dcflag = CLES_FALSE else if ( method .eq. CLES_METHOD_HYBRID ) then if ( order .eq. 2 ) then if ( optimized .eq. 0 ) then stencil = 3 else if ( optimized .eq. 1 ) then stencil = 5 else print *, 'Error: out of range optimization value' stop endif else if ( order .eq. 4 ) then if ( optimized .eq. 0 ) then stencil = 5 else if ( optimized .eq. 1 ) then stencil = 7 else print *, 'Error: out of range optimization value' stop endif else if ( order .eq. 6 ) then stencil = 7 else print *, 'Error: order must be 2 or 4' stop endif ! always used dcflag to find out what to do use_dcflag = CLES_TRUE else print *, 'Error: method unknown' stop endif call set_use_dcflag() use_carbfix = use_carbfix_ useViscous = useViscous_ useLES = useLES_ useSource = useSource_ noTimeRefine = noTimeRefine_ upb = (stencil-3)/2 lob = (stencil-1)/2 IF (ncomps.le.nvars) THEN PRINT *, 'Number of components in vector of state too small!' STOP END IF if ( .not. (dim .eq. 3 .and. useLES .eq. CLES_TRUE) ) useLES = CLES_FALSE if ( useLES .eq. CLES_TRUE ) then useViscous = CLES_TRUE endif ! ncomps = nvars + 1 (temp) + 1 (dcflag) +1 (sgske) if (ncomps.lt.nvars+2+useLES) then print *, 'number of compents in vector of state too small' stop end if ! ---- Initialize transport properties if ( useViscous .eq. CLES_TRUE ) call SetupTransport() ! setup the compressible version of the sgs solver if ( useLES .eq. CLES_TRUE ) call SetUpLES(1) ! ---- set the number of ghostcells in the fortran program nghost = nghost_ ! ---- The nominal order/width of the canidate ENO stencils if(stencil.lt.5) then ! here stencil should be 3 point ! using a simple flux split with up-winding ! enoOrder =1 will allow for using a single ghostcell ! (for non viscous problems) enoOrder = 1 else ! here the stencil is 7 ! uses the weno 7 formulation enoOrder = (stencil-1)/2 end if ! ---- make sure this is consistant with our scheme CALL TestGhostSize ! ---- Intiailize Ceofficents for WENO and CenterDiff CALL SetInterpConstants if ( cleslog_active(CLESLOG_TCD, CLESLOG_TCD_STENCIL) & .eq. CLES_TRUE ) then call cles_test_tcdstencil() call cleslog_log_flush() endif call cleslog_log_exit('InitWENO') END SUBROUTINE InitWENO SUBROUTINE FinishWENO USE method_parms USE Generic_Transport IMPLICIT NONE include 'cles.i' call cleslog_log_enter('FinishWENO') if ( useLES .eq. CLES_TRUE ) call CleanUpLES() call cleslog_log_exit('FinishWENO') END SUBROUTINE FinishWENO subroutine set_use_dcflag() USE method_parms implicit none include 'cles.i' if ( method .eq. CLES_METHOD_UPWIND ) then use_dcflag = CLES_FALSE else if ( method .eq. CLES_METHOD_HYBRID ) then use_dcflag = CLES_TRUE endif return end subroutine set_use_dcflag