diff --git a/cime_config/namelist_definition_cam.xml b/cime_config/namelist_definition_cam.xml index fce70728..e2f2a090 100644 --- a/cime_config/namelist_definition_cam.xml +++ b/cime_config/namelist_definition_cam.xml @@ -189,7 +189,27 @@ UNSET_PATH - + + real + initial_conditions + cam_initfiles_nl + + Specify whether and how to perform + dry surface pressure scaling. If less than or equal to 0.0, + do not perform scaling. If greater than 0.0, perform scaling to scale_dry_air_mass + value (in Pa) as the average dry surface pressure target. + Default: set by build-namelist. + + + 0.0D0 + 101080.0D0 + + 98288.0D0 + 98288.0D0 + 98288.0D0 + 98288.0D0 + + diff --git a/src/control/cam_initfiles.F90 b/src/control/cam_initfiles.F90 index bea73de7..32c06b52 100644 --- a/src/control/cam_initfiles.F90 +++ b/src/control/cam_initfiles.F90 @@ -44,6 +44,8 @@ module cam_initfiles ! cam_branch_file: Filepath of primary restart file for a branch run character(len=cl) :: cam_branch_file = ' ' + real(r8), public, protected :: scale_dry_air_mass = 0.0_r8 ! Toggle and target avg air mass + ! rest_pfile: The restart pointer file contains name of most recently ! written primary restart file. ! The contents of this file are updated by cam_write_restart @@ -89,7 +91,7 @@ subroutine cam_initfiles_readnl(nlfile) character(len=*), parameter :: subname = 'cam_initfiles_readnl' namelist /cam_initfiles_nl/ ncdata, bnd_topo, pertlim, cam_branch_file, & - unset_path_str + unset_path_str, scale_dry_air_mass !------------------------------------------------------------------------ if (masterproc) then @@ -121,7 +123,11 @@ subroutine cam_initfiles_readnl(nlfile) mstrid, mpicom, ierr) if (ierr /= 0) then call endrun(subname//": ERROR: mpi_bcast: cam_branch_file") - end if + end if + call mpi_bcast(scale_dry_air_mass, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) then + call endrun(subname//": ERROR: mpi_bcast: scale_dry_air_mass") + endif call mpi_bcast(unset_path_str, len(unset_path_str), mpi_character, & mstrid, mpicom, ierr) if (ierr /= 0) then @@ -198,7 +204,13 @@ subroutine cam_initfiles_readnl(nlfile) write(iulog,*) ' Maximum abs value of scale factor used to ', & 'perturb initial conditions, pertlim= ', pertlim - + if (scale_dry_air_mass > 0) then + write(iulog,*) & + ' Initial condition dry mass will be scaled to: ',scale_dry_air_mass,' Pa' + else + write(iulog,*) & + ' Initial condition dry mass will not be scaled.' + end if end if end subroutine cam_initfiles_readnl diff --git a/src/dynamics/se/advect_tend.F90 b/src/dynamics/se/advect_tend.F90 index 62d5b65c..8b5a4966 100644 --- a/src/dynamics/se/advect_tend.F90 +++ b/src/dynamics/se/advect_tend.F90 @@ -29,7 +29,7 @@ subroutine compute_adv_tends_xyz(elem,fvm,nets,nete,qn0,n0) use cam_abortutils, only: check_allocate ! SE dycore: - use dimensions_mod, only: nc,np,nlev,ntrac + use dimensions_mod, only: nc,np,nlev,ntrac,use_cslam use element_mod, only: element_t use fvm_control_volume_mod, only: fvm_struct @@ -45,7 +45,7 @@ subroutine compute_adv_tends_xyz(elem,fvm,nets,nete,qn0,n0) character(len=*), parameter :: subname = 'compute_adv_tends_xyz' - if (ntrac>0) then + if (use_cslam) then nx=nc else nx=np @@ -65,7 +65,7 @@ subroutine compute_adv_tends_xyz(elem,fvm,nets,nete,qn0,n0) adv_tendxyz(:,:,:,:,:) = 0._r8 endif - if (ntrac>0) then + if (use_cslam) then do ie=nets,nete do ic = 1, num_advected adv_tendxyz(:,:,:,ic,ie) = fvm(ie)%c(1:nc,1:nc,:,ic) - adv_tendxyz(:,:,:,ic,ie) @@ -105,5 +105,174 @@ subroutine compute_adv_tends_xyz(elem,fvm,nets,nete,qn0,n0) deallocate(ftmp) #endif end subroutine compute_adv_tends_xyz +#ifdef scm_code + !---------------------------------------------------------------------- + ! computes camiop specific tendencies + ! and writes these to the camiop file + ! called twice each time step: + ! - first call sets the initial mixing ratios/state + ! - second call computes and outputs the tendencies + !---------------------------------------------------------------------- + subroutine compute_write_iop_fields(elem,fvm,nets,nete,qn0,n0) + use cam_abortutils, only: endrun + use cam_history, only: outfld, hist_fld_active + use time_manager, only: get_step_size + use constituents, only: pcnst,cnst_name + use dimensions_mod, only: nc,np,nlev,use_cslam,npsq + use element_mod, only: element_t + use fvm_control_volume_mod, only: fvm_struct + implicit none + + type (element_t), intent(inout) :: elem(:) + type(fvm_struct), intent(inout) :: fvm(:) + integer, intent(in) :: nets,nete,qn0,n0 + real(r8) :: dt + real(r8), allocatable :: q_new(:,:,:) + real(r8), allocatable :: q_adv(:,:,:) + real(r8), allocatable :: t_adv(:,:) + real(r8), allocatable :: out_q(:,:) + real(r8), allocatable :: out_t(:,:) + real(r8), allocatable :: out_u(:,:) + real(r8), allocatable :: out_v(:,:) + real(r8), allocatable :: out_ps(:) + + integer :: i,j,ic,nx,ie,nxsq,p + integer :: ierr + logical :: init + character(len=*), parameter :: sub = 'compute_write_iop_fields:' + !---------------------------------------------------------------------------- + + if (use_cslam) then + nx=nc + else + nx=np + endif + nxsq=nx*nx + init = .false. + dt = get_step_size() + + if ( .not. allocated( iop_qtendxyz ) ) then + init = .true. + + allocate( iop_qtendxyz(nx,nx,nlev,pcnst,nets:nete),stat=ierr ) + if (ierr/=0) call endrun( sub//': not able to allocate iop_qtendxyz' ) + iop_qtendxyz = 0._r8 + allocate( derivedfq(nx,nx,nlev,pcnst,nets:nete),stat=ierr ) + if (ierr/=0) call endrun( sub//': not able to allocate derivedfq' ) + derivedfq = 0._r8 + allocate( iop_qtendxyz_init(nx,nx,nlev,pcnst,nets:nete),stat=ierr ) + if (ierr/=0) call endrun( sub//': not able to allocate iop_qtendxyz' ) + iop_qtendxyz_init = 0._r8 + allocate( iop_ttendxyz(nx,nx,nlev,nets:nete),stat=ierr ) + if (ierr/=0) call endrun( sub//': not able to allocate iop_ttendxyz' ) + iop_ttendxyz = 0._r8 + allocate( iop_ttendxyz_init(nx,nx,nlev,nets:nete),stat=ierr ) + if (ierr/=0) call endrun( sub//': not able to allocate iop_ttendxyz_init' ) + iop_ttendxyz_init = 0._r8 + endif + + ! save initial/calc tendencies on second call to this routine. + if (use_cslam) then + do ie=nets,nete + do ic=1,pcnst + iop_qtendxyz(:,:,:,ic,ie) = fvm(ie)%c(1:nc,1:nc,:,ic) - iop_qtendxyz(:,:,:,ic,ie) + end do + end do + else + do ie=nets,nete + do ic=1,pcnst + iop_qtendxyz(:,:,:,ic,ie) = elem(ie)%state%Qdp(:,:,:,ic,qn0)/elem(ie)%state%dp3d(:,:,:,n0) - iop_qtendxyz(:,:,:,ic,ie) + enddo + end do + end if + do ie=nets,nete + iop_ttendxyz(:,:,:,ie) = elem(ie)%state%T(:,:,:,n0) - iop_ttendxyz(:,:,:,ie) + end do + + if (init) then + do ie=nets,nete + iop_ttendxyz_init(:,:,:,ie) = iop_ttendxyz(:,:,:,ie) + iop_qtendxyz_init(:,:,:,:,ie) = iop_qtendxyz(:,:,:,:,ie) + derivedfq(:,:,:,:,ie)=elem(ie)%derived%FQ(:,:,:,:)/dt + end do + end if + + if ( .not. init ) then + allocate( q_adv(nxsq,nlev,pcnst),stat=ierr ) + if (ierr/=0) call endrun( sub//': not able to allocate q_adv' ) + q_adv = 0._r8 + allocate( t_adv(npsq,nlev),stat=ierr ) + if (ierr/=0) call endrun( sub//': not able to allocate t_adv' ) + t_adv = 0._r8 + allocate( q_new(nx,nx,nlev),stat=ierr ) + if (ierr/=0) call endrun( sub//': not able to allocate q_new' ) + q_new = 0._r8 + allocate( out_q(npsq,nlev),stat=ierr ) + if (ierr/=0) call endrun( sub//': not able to allocate out_q' ) + out_q = 0._r8 + allocate( out_t(npsq,nlev),stat=ierr ) + if (ierr/=0) call endrun( sub//': not able to allocate out_t' ) + out_t = 0._r8 + allocate( out_u(npsq,nlev),stat=ierr ) + if (ierr/=0) call endrun( sub//': not able to allocate out_u' ) + out_u = 0._r8 + allocate( out_v(npsq,nlev),stat=ierr ) + if (ierr/=0) call endrun( sub//': not able to allocate out_v' ) + out_v = 0._r8 + allocate( out_ps(npsq),stat=ierr ) + if (ierr/=0) call endrun( sub//': not able to allocate out_ps' ) + out_ps = 0._r8 + do ie=nets,nete + do j=1,nx + do i=1,nx + t_adv(i+(j-1)*np,:) = iop_ttendxyz(i,j,:,ie)/dt - elem(ie)%derived%FT(i,j,:) + out_u(i+(j-1)*np,:) = elem(ie)%state%v(i,j,1,:,n0) + out_v(i+(j-1)*np,:) = elem(ie)%state%v(i,j,2,:,n0) + out_ps(i+(j-1)*np) = elem(ie)%state%psdry(i,j) + + ! to retain bfb, replace state q and t with roundoff version calculated using the ordering and tendencies of the + ! scam prognostic equation + elem(ie)%state%T(i,j,:,n0) = iop_ttendxyz_init(i,j,:,ie) + dt*(elem(ie)%derived%FT(i,j,:) + t_adv(i+(j-1)*np,:)) + out_t(i+(j-1)*np,:) = elem(ie)%state%T(i,j,:,n0) + do p=1,pcnst + q_adv(i+(j-1)*nx,:,p) = iop_qtendxyz(i,j,:,p,ie)/dt - derivedfq(i,j,:,p,ie) + q_new(i,j,:) = iop_qtendxyz_init(i,j,:,p,ie) + dt*(derivedfq(i,j,:,p,ie) + q_adv(i+(j-1)*nx,:,p)) + if (use_cslam) then + fvm(ie)%c(i,j,:,p)=q_new(i,j,:) + else + elem(ie)%state%Qdp(i,j,:,p,qn0)=q_new(i,j,:)*elem(ie)%state%dp3d(i,j,:,n0) + end if + enddo + out_q(i+(j-1)*nx,:) = elem(ie)%state%Qdp(i,j,:,1,qn0)/elem(ie)%state%dp3d(i,j,:,n0) + end do + end do + call outfld('Ps',out_ps,npsq,ie) + call outfld('t',out_t,npsq,ie) + call outfld('q',out_q,nxsq,ie) + call outfld('u',out_u,npsq,ie) + call outfld('v',out_v,npsq,ie) + call outfld('divT3d',t_adv,npsq,ie) + do p=1,pcnst + call outfld(trim(cnst_name(p))//'_dten',q_adv(:,:,p),nxsq,ie) + enddo + end do + + deallocate(iop_ttendxyz) + deallocate(iop_ttendxyz_init) + deallocate(iop_qtendxyz) + deallocate(iop_qtendxyz_init) + deallocate(derivedfq) + deallocate(out_t) + deallocate(out_q) + deallocate(out_u) + deallocate(out_v) + deallocate(out_ps) + deallocate(t_adv) + deallocate(q_adv) + deallocate(q_new) + + endif + end subroutine compute_write_iop_fields +#endif end module advect_tend diff --git a/src/dynamics/se/dp_coupling.F90 b/src/dynamics/se/dp_coupling.F90 index 572f663f..75f2e612 100644 --- a/src/dynamics/se/dp_coupling.F90 +++ b/src/dynamics/se/dp_coupling.F90 @@ -61,7 +61,7 @@ subroutine d_p_coupling(cam_runtime_opts, phys_state, phys_tend, dyn_out) !SE dycore: use fvm_mapping, only: dyn2phys_vector, dyn2phys_all_vars - use time_mod, only: timelevel_qdp + use se_dyn_time_mod, only: timelevel_qdp use control_mod, only: qsplit ! arguments @@ -329,7 +329,7 @@ subroutine p_d_coupling(cam_runtime_opts, phys_state, phys_tend, dyn_in, tl_f, t use bndry_mod, only: bndry_exchange use edge_mod, only: edgeVpack, edgeVunpack use fvm_mapping, only: phys2dyn_forcings_fvm - + use dimensions_mod, only: use_cslam ! arguments type(runtime_options), intent(in) :: cam_runtime_opts ! Runtime settings object type(physics_state), intent(inout) :: phys_state @@ -521,9 +521,15 @@ subroutine p_d_coupling(cam_runtime_opts, phys_state, phys_tend, dyn_in, tl_f, t call edgeVpack(edgebuf, dyn_in%elem(ie)%derived%FM(:,:,:,:), 2*nlev, kptr, ie) kptr = kptr + 2*nlev call edgeVpack(edgebuf, dyn_in%elem(ie)%derived%FT(:,:,:), nlev, kptr, ie) - kptr = kptr + nlev - call edgeVpack(edgebuf, dyn_in%elem(ie)%derived%FQ(:,:,:,:), nlev*qsize, kptr, ie) - end do + if (.not. use_cslam) then + ! + ! if using CSLAM qdp is being overwritten with CSLAM values in the dynamics + ! so no need to do boundary exchange of tracer tendency on GLL grid here + ! + kptr = kptr + nlev + call edgeVpack(edgebuf, dyn_in%elem(ie)%derived%FQ(:,:,:,:), nlev*qsize, kptr, ie) + end if + end do if (iam < par%nprocs) then call bndry_exchange(par, edgebuf, location='p_d_coupling') @@ -534,8 +540,10 @@ subroutine p_d_coupling(cam_runtime_opts, phys_state, phys_tend, dyn_in, tl_f, t call edgeVunpack(edgebuf, dyn_in%elem(ie)%derived%FM(:,:,:,:), 2*nlev, kptr, ie) kptr = kptr + 2*nlev call edgeVunpack(edgebuf, dyn_in%elem(ie)%derived%FT(:,:,:), nlev, kptr, ie) - kptr = kptr + nlev - call edgeVunpack(edgebuf, dyn_in%elem(ie)%derived%FQ(:,:,:,:), nlev*qsize, kptr, ie) + if (.not. use_cslam) then + kptr = kptr + nlev + call edgeVunpack(edgebuf, dyn_in%elem(ie)%derived%FQ(:,:,:,:), nlev*qsize, kptr, ie) + end if if (fv_nphys > 0) then do k = 1, nlev dyn_in%elem(ie)%derived%FM(:,:,1,k) = & @@ -743,6 +751,7 @@ subroutine derived_phys_dry(cam_runtime_opts, phys_state, phys_tend) ! Ensure N2 = 1 - (O2 + O + H) mmr is greater than 0 ! Check for unusually large H2 values and set to lower value. !------------------------------------------------------------ + !xxx this code is NOT in cam_development? if (cam_runtime_opts%waccmx_option() == 'ionosphere' .or. & cam_runtime_opts%waccmx_option() == 'neutral') then @@ -853,44 +862,4 @@ subroutine derived_phys_dry(cam_runtime_opts, phys_state, phys_tend) errflg, errmsg) end subroutine derived_phys_dry - -!========================================================================================= - -subroutine thermodynamic_consistency(phys_state, const_data_ptr, phys_tend, ncols, pver) - ! - ! Adjust the physics temperature tendency for thermal energy consistency with the - ! dynamics. - ! Note: mixing ratios are assumed to be dry. - ! - use physconst, only: cpair - use air_composition, only: get_cp - - ! SE dycore: - use dimensions_mod, only: lcp_moist - use control_mod, only: phys_dyn_cp - - type(physics_state), intent(in) :: phys_state - real(kind_phys), pointer :: const_data_ptr(:,:,:) - type(physics_tend ), intent(inout) :: phys_tend - integer, intent(in) :: ncols, pver - - real(kind_phys) :: inv_cp(ncols,pver) - !---------------------------------------------------------------------------- - - if (lcp_moist.and.phys_dyn_cp==1) then - ! - ! scale temperature tendency so that thermal energy increment from physics - ! matches SE (not taking into account dme adjust) - ! - ! note that if lcp_moist=.false. then there is thermal energy increment - ! consistency (not taking into account dme adjust) - ! - call get_cp(const_data_ptr(1:ncols,1:pver,1:num_advected),.true.,inv_cp) - - phys_tend%dTdt_total(1:ncols,1:pver) = phys_tend%dTdt_total(1:ncols,1:pver)*cpair*inv_cp - end if -end subroutine thermodynamic_consistency - -!========================================================================================= - end module dp_coupling diff --git a/src/dynamics/se/dycore/control_mod.F90 b/src/dynamics/se/dycore/control_mod.F90 index fb7046d9..245e5d95 100644 --- a/src/dynamics/se/dycore/control_mod.F90 +++ b/src/dynamics/se/dycore/control_mod.F90 @@ -16,6 +16,7 @@ module control_mod integer, public :: rk_stage_user = 0 ! number of RK stages to use integer, public :: ftype = 2 ! Forcing Type integer, public :: ftype_conserve = 1 !conserve momentum (dp*u) + integer, public :: dribble_in_rsplit_loop = 0 integer, public :: statediag_numtrac = 3 integer, public :: qsplit = 1 ! ratio of dynamics tsteps to tracer tsteps @@ -23,9 +24,6 @@ module control_mod ! every rsplit tracer timesteps logical, public :: variable_nsplit=.false. - integer, public :: phys_dyn_cp = 0 !=0; no thermal energy scaling of T increment - !=1; scale increment for cp consistency between dynamics and physics - logical, public :: refined_mesh integer, public :: vert_remap_q_alg = 10 @@ -63,10 +61,25 @@ module control_mod ! (only used for variable viscosity, recommend 1.9 in namelist) real (kind=r8), public :: nu = 7.0D5 ! viscosity (momentum equ) real (kind=r8), public :: nu_div = -1 ! viscsoity (momentum equ, div component) - real (kind=r8), public :: nu_s = -1 ! default = nu T equ. viscosity + real (kind=r8), public :: nu_t = -1 ! default = nu T equ. viscosity xxx rename nu_t real (kind=r8), public :: nu_q = -1 ! default = nu tracer viscosity real (kind=r8), public :: nu_p = 0.0D5 ! default = 0 ps equ. viscosity real (kind=r8), public :: nu_top = 0.0D5 ! top-of-the-model viscosity + + ! + ! Del4 sponge layer diffusion + ! + ! Divergence damping hyperviscosity coefficient nu_div [m^4/s] for u,v is increased to + ! nu_div*sponge_del4_nu_div_fac following a hyperbolic tangent function + ! centered around pressure at vertical index sponge_del4_lev + ! + ! Similar for sponge_del4_nu_fac + ! + real(r8), public :: sponge_del4_nu_fac + real(r8), public :: sponge_del4_nu_div_fac + integer , public :: sponge_del4_lev + + integer, public :: hypervis_subcycle=1 ! number of subcycles for hyper viscsosity timestep integer, public :: hypervis_subcycle_sponge=1 ! number of subcycles for hyper viscsosity timestep in sponge integer, public :: hypervis_subcycle_q=1 ! number of subcycles for hyper viscsosity timestep on TRACERS @@ -105,18 +118,13 @@ module control_mod integer, public, parameter :: seast = 6 integer, public, parameter :: nwest = 7 integer, public, parameter :: neast = 8 - - ! - ! parameters for sponge layer Rayleigh damping - ! - real(r8), public :: raytau0 - real(r8), public :: raykrange - integer, public :: rayk0 ! ! molecular diffusion ! real(r8), public :: molecular_diff = -1.0_r8 integer, public :: vert_remap_uvTq_alg, vert_remap_tracer_alg - + + + integer, public :: pgf_formulation = -1 !PGF formulation - see prim_advance_mod.F90 end module control_mod diff --git a/src/dynamics/se/dycore/dimensions_mod.F90 b/src/dynamics/se/dycore/dimensions_mod.F90 index 14856a4b..58a85093 100644 --- a/src/dynamics/se/dycore/dimensions_mod.F90 +++ b/src/dynamics/se/dycore/dimensions_mod.F90 @@ -1,5 +1,6 @@ module dimensions_mod use shr_kind_mod, only: r8=>shr_kind_r8 + use air_composition, only: thermodynamic_active_species_num implicit none private @@ -19,26 +20,16 @@ module dimensions_mod ! character(len=16), allocatable, public :: cnst_name_gll(:) ! constituent names for SE tracers character(len=128), allocatable, public :: cnst_longname_gll(:) ! long name of SE tracers - ! - !moist cp in energy conversion term - ! - ! .false.: force dycore to use cpd (cp dry) instead of moist cp - ! .true. : use moist cp in dycore - ! - logical , public :: lcp_moist = .true. integer, parameter, public :: np = NP integer, parameter, public :: nc = 3 !cslam resolution integer , public :: fv_nphys !physics-grid resolution - the "MAX" is so that the code compiles with NC=0 integer, public, protected :: qsize_d !SE tracer dimension size + logical, public :: use_cslam = .false. !logical for CSLAM integer, public, protected :: ntrac = 0 !FVM tracer dimension size integer, public :: qsize = 0 !qsize is set in dyn_comp ! - ! hyperviscosity is applied on approximate pressure levels - ! Similar to CAM-EUL; see CAM5 scietific documentation (Note TN-486), equation (3.09), page 58. - ! - logical, public :: hypervis_dynamic_ref_state = .false. ! fvm dimensions: logical, public :: lprint!for debugging integer, parameter, public :: ngpc=3 !number of Gausspoints for the fvm integral approximation !phl change from 4 @@ -62,19 +53,15 @@ module dimensions_mod integer, allocatable, public :: kord_tr(:), kord_tr_cslam(:) real(r8), allocatable, public :: nu_scale_top(:) ! scaling of del2 viscosity in sponge layer (initialized in dyn_comp) - real(r8), allocatable, public :: nu_lev(:) - real(r8), allocatable, public :: otau(:) - - integer, public :: ksponge_end ! sponge is active k=1,ksponge_end - real (r8), allocatable, public :: nu_div_lev(:) ! scaling of viscosity in sponge layer + real(r8), allocatable, public :: nu_lev(:) ! level dependent del4 (u,v) damping + real(r8), allocatable, public :: nu_t_lev(:) ! level depedendet del4 T damping + integer, public :: ksponge_end ! sponge is active k=1,ksponge_end + real(r8), allocatable, public :: nu_div_lev(:) ! scaling of viscosity in sponge layer real(r8), allocatable, public :: kmvis_ref(:) !reference profiles for molecular diffusion real(r8), allocatable, public :: kmcnd_ref(:) !reference profiles for molecular diffusion real(r8), allocatable, public :: rho_ref(:) !reference profiles for rho real(r8), allocatable, public :: km_sponge_factor(:) !scaling for molecular diffusion (when used as sponge) - real(r8), allocatable, public :: kmvisi_ref(:) !reference profiles for molecular diffusion - real(r8), allocatable, public :: kmcndi_ref(:) !reference profiles for molecular diffusion - real(r8), allocatable, public :: rhoi_ref(:) !reference profiles for rho integer, public :: nhc_phys integer, public :: nhe_phys @@ -129,13 +116,15 @@ subroutine dimensions_mod_init() ! Set tracer dimension variables: if (fv_nphys > 0) then - ! Use CSLAM for tracer advection - qsize_d = 10 ! SE tracers (currently SE supports 10 condensate loading tracers) + ! Use CSLAM for tracer advection + qsize_d = thermodynamic_active_species_num ntrac = num_advected + use_cslam = .true. else ! Use GLL for tracer advection qsize_d = num_advected ntrac = 0 ! No fvm tracers if CSLAM is off + use_cslam = .false. end if ! Set grid dimension variables: @@ -157,8 +146,8 @@ subroutine dimensions_mod_init() call check_allocate(iret, subname, 'nu_lev(nlev)', & file=__FILE__, line=__LINE__) - allocate(otau(nlev), stat=iret) - call check_allocate(iret, subname, 'otau(nlev)', & + allocate(nu_t_lev(nlev), stat=iret) + call check_allocate(iret, subname, 'nu_t_lev(nlev)', & file=__FILE__, line=__LINE__) allocate(nu_div_lev(nlev), stat=iret) @@ -181,18 +170,6 @@ subroutine dimensions_mod_init() call check_allocate(iret, subname, 'km_sponge_factor(nlev)', & file=__FILE__, line=__LINE__) - allocate(kmvisi_ref(nlevp), stat=iret) - call check_allocate(iret, subname, 'kmvisi_ref(nlevp)', & - file=__FILE__, line=__LINE__) - - allocate(kmcndi_ref(nlevp), stat=iret) - call check_allocate(iret, subname, 'kmcndi_ref(nlevp)', & - file=__FILE__, line=__LINE__) - - allocate(rhoi_ref(nlevp), stat=iret) - call check_allocate(iret, subname, 'rhoi_ref(nlevp)', & - file=__FILE__, line=__LINE__) - end subroutine dimensions_mod_init !============================================================================== diff --git a/src/dynamics/se/dycore/element_mod.F90 b/src/dynamics/se/dycore/element_mod.F90 index 2fa3b91a..c1401794 100644 --- a/src/dynamics/se/dycore/element_mod.F90 +++ b/src/dynamics/se/dycore/element_mod.F90 @@ -45,10 +45,6 @@ module element_mod real(kind=r8), allocatable :: phi(:,:,:) ! geopotential real(kind=r8), allocatable :: omega(:,:,:) ! vertical velocity - ! semi-implicit diagnostics: computed in explict-component, reused in Helmholtz-component. - real(kind=r8), allocatable :: zeta(:,:,:) ! relative vorticity - real(kind=r8), allocatable :: div(:,:,:,:) ! divergence - ! tracer advection fields used for consistency and limiters real(kind=r8), allocatable :: dp(:,:,:) ! for dp_tracers at physics timestep real(kind=r8), allocatable :: divdp(:,:,:) ! divergence of dp @@ -60,24 +56,10 @@ module element_mod real(kind=r8), allocatable :: FM(:,:,:,:) ! momentum forcing real(kind=r8), allocatable :: FDP(:,:,:) ! save full updated dp right after physics real(kind=r8), allocatable :: FT(:,:,:) ! temperature forcing - real(kind=r8), allocatable :: etadot_prescribed(:,:,:) ! prescribed vertical tendency - real(kind=r8), allocatable :: u_met(:,:,:) ! zonal component of prescribed meteorology winds - real(kind=r8), allocatable :: dudt_met(:,:,:) ! rate of change of zonal component of prescribed meteorology winds - real(kind=r8), allocatable :: v_met(:,:,:) ! meridional component of prescribed meteorology winds - real(kind=r8), allocatable :: dvdt_met(:,:,:) ! rate of change of meridional component of prescribed meteorology winds - real(kind=r8), allocatable :: T_met(:,:,:) ! prescribed meteorology temperature - real(kind=r8), allocatable :: dTdt_met(:,:,:) ! rate of change of prescribed meteorology temperature - real(kind=r8), allocatable :: nudge_factor(:,:,:) ! nudging factor (prescribed) - real(kind=r8), allocatable :: Utnd(:,:) ! accumulated U tendency due to nudging towards prescribed met - real(kind=r8), allocatable :: Vtnd(:,:) ! accumulated V tendency due to nudging towards prescribed met - real(kind=r8), allocatable :: Ttnd(:,:) ! accumulated T tendency due to nudging towards prescribed met - - real(kind=r8), allocatable :: pecnd(:,:,:) ! pressure perturbation from condensate - - real(kind=r8) :: ps_met(np,np) ! surface pressure of prescribed meteorology - real(kind=r8) :: dpsdt_met(np,np) ! rate of change of surface pressure of prescribed meteorology - + ! reference profiles + real(kind=r8), allocatable :: T_ref(:,:,:) ! reference temperature + real(kind=r8), allocatable :: dp_ref(:,:,:) ! reference pressure level thickness end type derived_state_t !___________________________________________________________________ @@ -455,7 +437,7 @@ subroutine allocate_element_dims(elem) allocate(elem(i)%state%Qdp(np,np,nlev,qsize_d,2), stat=iret) call check_allocate(iret, subname, 'elem%state%Qdp(np,np,nlev,qsize_d,2)', & file=__FILE__, line=__LINE__) - + !-------------------------- !Allocate "derived" variables: @@ -486,16 +468,6 @@ subroutine allocate_element_dims(elem) call check_allocate(iret, subname, 'elem%derived%omega(np,np,nlev)', & file=__FILE__, line=__LINE__) - ! relative vorticity - allocate(elem(i)%derived%zeta(np,np,nlev), stat=iret) - call check_allocate(iret, subname, 'elem%derived%zeta(np,np,nlev)', & - file=__FILE__, line=__LINE__) - - ! divergence - allocate(elem(i)%derived%div(np,np,nlev,timelevels), stat=iret) - call check_allocate(iret, subname, 'elem%derived%div(np,np,nlev,timelevels)', & - file=__FILE__, line=__LINE__) - ! for dp_tracers at physics timestep allocate(elem(i)%derived%dp(np,np,nlev), stat=iret) call check_allocate(iret, subname, 'elem%derived%dp(np,np,nlev)', & @@ -536,64 +508,14 @@ subroutine allocate_element_dims(elem) call check_allocate(iret, subname, 'elem%derived%FT(np,np,nlev)', & file=__FILE__, line=__LINE__) - ! prescribed vertical tendency - allocate(elem(i)%derived%etadot_prescribed(np,np,nlevp), stat=iret) - call check_allocate(iret, subname, 'elem%derived%etadot_prescribed(np,np,nlevp)', & - file=__FILE__, line=__LINE__) - - ! zonal component of prescribed meteorology winds - allocate(elem(i)%derived%u_met(np,np,nlev), stat=iret) - call check_allocate(iret, subname, 'elem%derived%u_met(np,np,nlev)', & - file=__FILE__, line=__LINE__) - - ! rate of change of zonal component of prescribed meteorology winds - allocate(elem(i)%derived%dudt_met(np,np,nlev), stat=iret) - call check_allocate(iret, subname, 'elem%derived%dudt_met(np,np,nlev)', & - file=__FILE__, line=__LINE__) - - ! meridional component of prescribed meteorology winds - allocate(elem(i)%derived%v_met(np,np,nlev), stat=iret) - call check_allocate(iret, subname, 'elem%derived%v_met(np,np,nlev)', & - file=__FILE__, line=__LINE__) - - ! rate of change of meridional component of prescribed meteorology winds - allocate(elem(i)%derived%dvdt_met(np,np,nlev), stat=iret) - call check_allocate(iret, subname, 'elem%derived%dvdt_met(np,np,nlev)', & - file=__FILE__, line=__LINE__) - - ! prescribed meteorology temperature - allocate(elem(i)%derived%T_met(np,np,nlev), stat=iret) - call check_allocate(iret, subname, 'elem%derived%T_met(np,np,nlev)', & - file=__FILE__, line=__LINE__) - - ! rate of change of prescribed meteorology temperature - allocate(elem(i)%derived%dTdt_met(np,np,nlev), stat=iret) - call check_allocate(iret, subname, 'elem%derived%dTdt_met(np,np,nlev)', & - file=__FILE__, line=__LINE__) - - ! nudging factor (prescribed) - allocate(elem(i)%derived%nudge_factor(np,np,nlev), stat=iret) - call check_allocate(iret, subname, 'elem%derived%nudge_factor(np,np,nlev)', & - file=__FILE__, line=__LINE__) - - ! accumulated U tendency due to nudging towards prescribed met - allocate(elem(i)%derived%Utnd(npsq,nlev), stat=iret) - call check_allocate(iret, subname, 'elem%derived%Utnd(npsq,nlev)', & - file=__FILE__, line=__LINE__) - - ! accumulated V tendency due to nudging towards prescribed met - allocate(elem(i)%derived%Vtnd(npsq,nlev), stat=iret) - call check_allocate(iret, subname, 'elem%derived%Vtnd(npsq,nlev)', & - file=__FILE__, line=__LINE__) - - ! accumulated T tendency due to nudging towards prescribed met - allocate(elem(i)%derived%Ttnd(npsq,nlev), stat=iret) - call check_allocate(iret, subname, 'elem%derived%Ttnd(npsq,nlev)', & - file=__FILE__, line=__LINE__) + ! reference temperature profile for hyperviscosity + allocate(elem(i)%derived%T_ref(np,np,nlev), stat=iret) + call check_allocate(iret, subname, 'elem%derived%T_ref(np,np,nlev)', & + file=__FILE__, line=__LINE__) - ! pressure perturbation from condensate - allocate(elem(i)%derived%pecnd(np,np,nlev), stat=iret) - call check_allocate(iret, subname, 'elem%derived%pecnd(np,np,nlev)', & + ! reference pressure level thickness profile for hyperviscosity + allocate(elem(i)%derived%dp_ref(np,np,nlev), stat=iret) + call check_allocate(iret, subname, 'elem%derived%dp_ref(np,np,nlev)', & file=__FILE__, line=__LINE__) !---------------------------- diff --git a/src/dynamics/se/dycore/fvm_consistent_se_cslam.F90 b/src/dynamics/se/dycore/fvm_consistent_se_cslam.F90 index 20391710..221fd197 100644 --- a/src/dynamics/se/dycore/fvm_consistent_se_cslam.F90 +++ b/src/dynamics/se/dycore/fvm_consistent_se_cslam.F90 @@ -6,7 +6,7 @@ module fvm_consistent_se_cslam use cam_abortutils, only: endrun use cam_logfile, only: iulog - use time_mod, only: timelevel_t + use se_dyn_time_mod, only: timelevel_t use element_mod, only: element_t use fvm_control_volume_mod, only: fvm_struct use hybrid_mod, only: hybrid_t, config_thread_region, get_loop_ranges, threadOwnsVertLevel @@ -45,7 +45,7 @@ subroutine run_consistent_se_cslam(elem,fvm,hybrid,dt_fvm,tl,nets,nete,hvcoord,& use thread_mod , only: vert_num_threads, omp_set_nested implicit none type (element_t) , intent(inout) :: elem(:) - type (fvm_struct) , intent(inout) :: fvm(:) + type (fvm_struct), target , intent(inout) :: fvm(:) type (hybrid_t) , intent(in) :: hybrid ! distributed parallel structure (shared) type (TimeLevel_t) , intent(in) :: tl ! time level struct type (hvcoord_t) , intent(in) :: hvcoord @@ -72,7 +72,9 @@ subroutine run_consistent_se_cslam(elem,fvm,hybrid,dt_fvm,tl,nets,nete,hvcoord,& integer :: region_num_threads logical :: inJetCall logical :: ActiveJetThread - + + real(r8), pointer :: fcube(:,:,:,:) + real(r8), pointer :: spherecentroid(:,:,:) llimiter = .true. @@ -153,22 +155,26 @@ subroutine run_consistent_se_cslam(elem,fvm,hybrid,dt_fvm,tl,nets,nete,hvcoord,& !call t_stopf('fvm:orthogonal_swept_areas') do ie=nets,nete + ! Intel compiler version 2023.0.0 on derecho had significant slowdown on subroutine interface without + ! these pointers. + fcube => fvm(ie)%c(:,:,:,:) + spherecentroid => fvm(ie)%spherecentroid(:,1-nhe:nc+nhe,1-nhe:nc+nhe) do k=kmin,kmax - !call t_startf('fvm:tracers_reconstruct') - call reconstruction(fvm(ie)%c(:,:,:,:),nlev,k,& + !call t_startf('FVM:tracers_reconstruct') + call reconstruction(fcube,nlev,k,& ctracer(:,:,:,:),irecons_tracer,llimiter,ntrac,& nc,nhe,nhr,nhc,nht,ns,nhr+(nhe-1),& fvm(ie)%jx_min,fvm(ie)%jx_max,fvm(ie)%jy_min,fvm(ie)%jy_max,& fvm(ie)%cubeboundary,fvm(ie)%halo_interp_weight,fvm(ie)%ibase,& - fvm(ie)%spherecentroid(:,1-nhe:nc+nhe,1-nhe:nc+nhe),& + spherecentroid,& fvm(ie)%recons_metrics,fvm(ie)%recons_metrics_integral,& fvm(ie)%rot_matrix,fvm(ie)%centroid_stretch,& fvm(ie)%vertex_recons_weights,fvm(ie)%vtx_cart,& irecons_tracer_lev(k)) - !call t_stopf('fvm:tracers_reconstruct') - !call t_startf('fvm:swept_flux') - call swept_flux(elem(ie),fvm(ie),k,ctracer,irecons_tracer_lev(k),gsweights,gspts) - !call t_stopf('fvm:swept_flux') + !call t_stopf('FVM:tracers_reconstruct') + !call t_startf('fvm:swept_flux') + call swept_flux(elem(ie),fvm(ie),k,ctracer,irecons_tracer_lev(k),gsweights,gspts) + !call t_stopf('fvm:swept_flux') end do end do ! diff --git a/src/dynamics/se/dycore/fvm_mapping.F90 b/src/dynamics/se/dycore/fvm_mapping.F90 index 7a4fb2bb..581440d8 100644 --- a/src/dynamics/se/dycore/fvm_mapping.F90 +++ b/src/dynamics/se/dycore/fvm_mapping.F90 @@ -25,7 +25,7 @@ module fvm_mapping private public :: phys2dyn_forcings_fvm, dyn2phys, dyn2phys_vector, dyn2phys_all_vars,dyn2fvm_mass_vars - public :: phys2dyn,fvm2dyn,dyn2fvm + public :: phys2dyn,fvm2dyn,dyn2fvm,cslam2gll save integer :: save_max_overlap real(kind=r8), allocatable, dimension(:,:,:,:,:) :: save_air_mass_overlap @@ -35,6 +35,12 @@ module fvm_mapping real(kind=r8), allocatable, dimension(:,:,:,:) :: save_overlap_area integer , allocatable, dimension(:,:,:,:,:) :: save_overlap_idx integer , allocatable, dimension(:,:,:,:) :: save_num_overlap + + interface fvm2dyn + module procedure fvm2dynt1 + module procedure fvm2dyntn + end interface fvm2dyn + contains ! ! map all mass variables from gll to fvm @@ -53,8 +59,7 @@ subroutine phys2dyn_forcings_fvm(elem, fvm, hybrid,nets,nete,no_cslam, tl_f, tl_ integer :: ie,i,j,k,m_cnst,nq integer :: iret - real (kind=r8), dimension(:,:,:,:,:) , allocatable :: fld_phys, fld_gll, fld_fvm - real (kind=r8), allocatable, dimension(:,:,:,:,:) :: qgll + real (kind=r8), dimension(:,:,:,:,:) , allocatable :: fld_phys, fld_gll real (kind=r8) :: element_ave ! ! for tensor product Lagrange interpolation @@ -64,17 +69,6 @@ subroutine phys2dyn_forcings_fvm(elem, fvm, hybrid,nets,nete,no_cslam, tl_f, tl_ character(len=*), parameter :: subname = 'phys2dyn_forcings_fvm (SE)' - allocate(qgll(np,np,nlev,thermodynamic_active_species_num,nets:nete), stat=iret) - call check_allocate(iret, subname, & - 'qgll(np,np,nlev,thermodynamic_active_species_num,nets:nete)', & - file=__FILE__, line=__LINE__) - - do ie=nets,nete - do nq=1,thermodynamic_active_species_num - qgll(:,:,:,nq,ie) = elem(ie)%state%Qdp(:,:,:,nq,tl_qdp)/elem(ie)%state%dp3d(:,:,:,tl_f) - end do - end do - if (no_cslam) then call endrun("phys2dyn_forcings_fvm: no cslam case: NOT SUPPORTED") else if (nc.ne.fv_nphys) then @@ -96,7 +90,7 @@ subroutine phys2dyn_forcings_fvm(elem, fvm, hybrid,nets,nete,no_cslam, tl_f, tl_ call check_allocate(iret, subname, 'fld_gll(np,np,nlev,3,nets:nete)', & file=__FILE__, line=__LINE__) - allocate(llimiter(nflds), stat=iret) + allocate(llimiter(3), stat=iret) call check_allocate(iret, subname, 'llimiter(nflds)', & file=__FILE__, line=__LINE__) @@ -123,7 +117,9 @@ subroutine phys2dyn_forcings_fvm(elem, fvm, hybrid,nets,nete,no_cslam, tl_f, tl_ ! ! do mapping of fu,fv,ft ! - call phys2dyn(hybrid,elem,fld_phys(:,:,:,1:3,:),fld_gll(:,:,:,1:3,:),nets,nete,nlev,3,fvm,llimiter(1:3),2,.true.) + call phys2dyn(hybrid,elem,fld_phys(:,:,:,1:3,:),fld_gll,nets,nete,nlev,3,fvm,llimiter, & + istart_vector=2,halo_filled=.true.) + do ie=nets,nete elem(ie)%derived%fT(:,:,:) = fld_gll(:,:,:,1,ie) elem(ie)%derived%fM(:,:,1,:) = fld_gll(:,:,:,2,ie) @@ -144,44 +140,7 @@ subroutine phys2dyn_forcings_fvm(elem, fvm, hybrid,nets,nete,no_cslam, tl_f, tl_ end do end do call t_stopf('p2d-pg2:phys2fvm') - - ! - ! overwrite SE Q with cslam Q - ! - nflds = thermodynamic_active_species_num - allocate(fld_gll(np,np,nlev,nflds,nets:nete), stat=iret) - call check_allocate(iret, subname, 'fld_gll(np,np,nlev,nflds,nets:nete)', & - file=__FILE__, line=__LINE__) - - allocate(fld_fvm(1-nhc:nc+nhc,1-nhc:nc+nhc,nlev,nflds,nets:nete), stat=iret) - call check_allocate(iret, subname, 'fld_fvm(1-nhc:nc+nhc,1-nhc:nc+nhc,nlev,nflds,nets:nete)', & - file=__FILE__, line=__LINE__) - - do ie=nets,nete - ! - ! compute cslam updated Q value - do m_cnst=1,thermodynamic_active_species_num - fld_fvm(1:nc,1:nc,:,m_cnst,ie) = fvm(ie)%c(1:nc,1:nc,:,thermodynamic_active_species_idx(m_cnst))+& - fvm(ie)%fc(1:nc,1:nc,:,thermodynamic_active_species_idx(m_cnst))/fvm(ie)%dp_fvm(1:nc,1:nc,:) - enddo - end do - call t_startf('p2d-pg2:fvm2dyn') - llimiter(1:nflds) = .false. - call fvm2dyn(fld_fvm,fld_gll(:,:,:,1:nflds,:),hybrid,nets,nete,nlev,nflds,fvm,llimiter(1:nflds)) - call t_stopf('p2d-pg2:fvm2dyn') - ! - ! fld_gll now holds q cslam value on gll grid - ! - ! convert fld_gll to increment (q_new-q_old) - ! - do ie=nets,nete - do m_cnst=1,thermodynamic_active_species_num - elem(ie)%derived%fq(:,:,:,m_cnst) =& - fld_gll(:,:,:,m_cnst,ie)-qgll(:,:,:,m_cnst,ie) - end do - end do - deallocate(fld_fvm) - !deallocate arrays allocated in dyn2phys_all_vars + !deallocate arrays allocated in dyn2phys_all_vars deallocate(save_air_mass_overlap,save_q_phys,save_q_overlap,& save_overlap_area,save_num_overlap,save_overlap_idx,save_dp_phys) else @@ -194,7 +153,7 @@ subroutine phys2dyn_forcings_fvm(elem, fvm, hybrid,nets,nete,no_cslam, tl_f, tl_ !***************************************************************************************** ! ! nflds is ft, fu, fv, + thermo species - nflds = 3+thermodynamic_active_species_num + nflds = 3 allocate(fld_phys(1-nhc_phys:fv_nphys+nhc_phys,1-nhc_phys:fv_nphys+nhc_phys,nlev,nflds,nets:nete), stat=iret) call check_allocate(iret, subname, & 'fld_phys(1-nhc_phys:fv_nphys+nhc_phys,1-nhc_phys:fv_nphys+nhc_phys,nlev,nflds,nets:nete)', & @@ -217,18 +176,8 @@ subroutine phys2dyn_forcings_fvm(elem, fvm, hybrid,nets,nete,no_cslam, tl_f, tl_ fld_phys(1:fv_nphys,1:fv_nphys,:,1,ie) = fvm(ie)%ft(1:fv_nphys,1:fv_nphys,:) fld_phys(1:fv_nphys,1:fv_nphys,:,2,ie) = fvm(ie)%fm(1:fv_nphys,1:fv_nphys,1,:) fld_phys(1:fv_nphys,1:fv_nphys,:,3,ie) = fvm(ie)%fm(1:fv_nphys,1:fv_nphys,2,:) - ! - ! compute cslam mixing ratio with physics update - ! - do m_cnst=1,thermodynamic_active_species_num - do k=1,nlev - fld_phys(1:fv_nphys,1:fv_nphys,k,m_cnst+3,ie) = & - fvm(ie)%c(1:fv_nphys,1:fv_nphys,k,thermodynamic_active_species_idx(m_cnst))+& - fvm(ie)%fc_phys(1:fv_nphys,1:fv_nphys,k,thermodynamic_active_species_idx(m_cnst)) - end do - end do - end do - ! + end do + ! ! do mapping ! call phys2dyn(hybrid,elem,fld_phys,fld_gll,nets,nete,nlev,nflds,fvm,llimiter,2) @@ -238,22 +187,16 @@ subroutine phys2dyn_forcings_fvm(elem, fvm, hybrid,nets,nete,no_cslam, tl_f, tl_ elem(ie)%derived%fM(:,:,2,:) = fld_gll(:,:,:,3,ie) end do do ie=nets,nete - do m_cnst=1,thermodynamic_active_species_num - ! - ! convert fq so that it will effectively overwrite SE q with CSLAM q - ! - elem(ie)%derived%fq(:,:,:,m_cnst) = fld_gll(:,:,:,m_cnst+3,ie)-& - qgll(:,:,:,m_cnst,ie) - end do do m_cnst = 1,ntrac fvm(ie)%fc(1:nc,1:nc,:,m_cnst) = fvm(ie)%fc_phys(1:nc,1:nc,:,m_cnst)*fvm(ie)%dp_fvm(1:nc,1:nc,:) end do end do end if - deallocate(fld_phys,llimiter,fld_gll,qgll) + deallocate(fld_phys,llimiter) end subroutine phys2dyn_forcings_fvm - subroutine fvm2dyn(fld_fvm,fld_gll,hybrid,nets,nete,numlev,num_flds,fvm,llimiter) + ! for multiple fields + subroutine fvm2dyntn(fld_fvm,fld_gll,hybrid,nets,nete,numlev,num_flds,fvm,llimiter,halo_filled) use dimensions_mod, only: np, nhc, nc use hybrid_mod , only: hybrid_t use bndry_mod , only: ghost_exchange @@ -266,7 +209,10 @@ subroutine fvm2dyn(fld_fvm,fld_gll,hybrid,nets,nete,numlev,num_flds,fvm,llimiter type (hybrid_t) , intent(in) :: hybrid type(fvm_struct) , intent(in) :: fvm(nets:nete) logical , intent(in) :: llimiter(num_flds) + logical, optional , intent(in) :: halo_filled !optional if boundary exchange for fld_fvm has already been called + integer :: ie, iwidth + logical :: fill_halo ! !********************************************* ! @@ -274,13 +220,20 @@ subroutine fvm2dyn(fld_fvm,fld_gll,hybrid,nets,nete,numlev,num_flds,fvm,llimiter ! !********************************************* ! - do ie=nets,nete - call ghostpack(ghostBufQnhc_s, fld_fvm(:,:,:,:,ie),numlev*num_flds,0,ie) - end do - call ghost_exchange(hybrid,ghostbufQnhc_s,location='fvm2dyn') - do ie=nets,nete - call ghostunpack(ghostbufQnhc_s, fld_fvm(:,:,:,:,ie),numlev*num_flds,0,ie) - end do + fill_halo = .true. + if (present(halo_filled)) then + fill_halo = .not. halo_filled + end if + + if (fill_halo) then + do ie=nets,nete + call ghostpack(ghostBufQnhc_s, fld_fvm(:,:,:,:,ie),numlev*num_flds,0,ie) + end do + call ghost_exchange(hybrid,ghostbufQnhc_s,location='fvm2dyntn') + do ie=nets,nete + call ghostunpack(ghostbufQnhc_s, fld_fvm(:,:,:,:,ie),numlev*num_flds,0,ie) + end do + end if ! ! mapping ! @@ -290,8 +243,56 @@ subroutine fvm2dyn(fld_fvm,fld_gll,hybrid,nets,nete,numlev,num_flds,fvm,llimiter call tensor_lagrange_interp(fvm(ie)%cubeboundary,np,nc,nhc,numlev,num_flds,fld_fvm(:,:,:,:,ie),& fld_gll(:,:,:,:,ie),llimiter,iwidth,fvm(ie)%norm_elem_coord) end do - end subroutine fvm2dyn + end subroutine fvm2dyntn + + ! for single field + subroutine fvm2dynt1(fld_fvm,fld_gll,hybrid,nets,nete,numlev,fvm,llimiter,halo_filled) + use dimensions_mod, only: np, nhc, nc + use hybrid_mod , only: hybrid_t + use bndry_mod , only: ghost_exchange + use edge_mod , only: ghostpack,ghostunpack + use fvm_mod , only: ghostBufQnhc_t1 + ! + integer , intent(in) :: nets,nete,numlev + real (kind=r8), intent(inout) :: fld_fvm(1-nhc:nc+nhc,1-nhc:nc+nhc,numlev,1,nets:nete) + real (kind=r8), intent(out) :: fld_gll(np,np,numlev,1,nets:nete) + type (hybrid_t) , intent(in) :: hybrid + type(fvm_struct) , intent(in) :: fvm(nets:nete) + logical , intent(in) :: llimiter(1) + logical, optional , intent(in) :: halo_filled!optional if boundary exchange for fld_fvm has already been called + + integer :: ie, iwidth + logical :: fill_halo + ! + !********************************************* + ! + ! halo exchange + ! + !********************************************* + ! + fill_halo = .true. + if (present(halo_filled)) then + fill_halo = .not. halo_filled + end if + if (fill_halo) then + do ie=nets,nete + call ghostpack(ghostBufQnhc_t1, fld_fvm(:,:,:,1,ie),numlev,0,ie) + end do + call ghost_exchange(hybrid,ghostbufQnhc_t1,location='fvm2dynt1') + do ie=nets,nete + call ghostunpack(ghostbufQnhc_t1, fld_fvm(:,:,:,1,ie),numlev,0,ie) + end do + end if + ! + ! mapping + ! + iwidth=2 + do ie=nets,nete + call tensor_lagrange_interp(fvm(ie)%cubeboundary,np,nc,nhc,numlev,1,fld_fvm(:,:,:,:,ie),& + fld_gll(:,:,:,:,ie),llimiter,iwidth,fvm(ie)%norm_elem_coord) + end do + end subroutine fvm2dynt1 subroutine fill_halo_phys(fld_phys,hybrid,nets,nete,num_lev,num_flds) use dimensions_mod, only: nhc_phys, fv_nphys @@ -330,7 +331,7 @@ end subroutine fill_halo_phys ! must call fill_halo_phys before calling this subroutine ! subroutine phys2dyn(hybrid,elem,fld_phys,fld_gll,nets,nete,num_lev,num_flds,fvm,llimiter,istart_vector,halo_filled) - use dimensions_mod, only: np, nhc_phys, fv_nphys + use dimensions_mod, only: np, nhc_phys, fv_nphys use hybrid_mod, only : hybrid_t type (hybrid_t), intent(in) :: hybrid ! distributed parallel structure (shared) integer , intent(in) :: nets,nete,num_flds,num_lev @@ -512,7 +513,7 @@ subroutine dyn2phys_all_vars(nets,nete,elem,fvm,& do ie=nets,nete tmp = 1.0_r8 inv_area = 1.0_r8/dyn2phys(tmp,elem(ie)%metdet(:,:)) - phis_phys(:,ie) = RESHAPE(fvm(ie)%phis_physgrid,SHAPE(phis_phys(:,ie))) + phis_phys(:,ie) = RESHAPE(dyn2phys(elem(ie)%state%phis(:,:),elem(ie)%metdet(:,:),inv_area),SHAPE(phis_phys(:,ie))) ps_phys(:,ie) = ptop if (nc.ne.fv_nphys) then tmp = 1.0_r8 @@ -542,7 +543,7 @@ subroutine dyn2phys_all_vars(nets,nete,elem,fvm,& ! no mapping needed - just copy fields into physics structure ! dp3d_phys(:,k,ie) = RESHAPE(fvm(ie)%dp_fvm(1:nc,1:nc,k),SHAPE(dp3d_phys(:,k,ie))) - ps_phys(:,ie) = ps_phys(:,ie)+RESHAPE(fvm(ie)%dp_fvm(1:nc,1:nc,k),SHAPE(ps_phys(:,ie))) + ps_phys(:,ie) = ps_phys(:,ie)+RESHAPE(fvm(ie)%dp_fvm(1:nc,1:nc,k),SHAPE(ps_phys(:,ie))) do m_cnst=1,num_trac q_phys(:,k,m_cnst,ie) = RESHAPE(fvm(ie)%c(1:nc,1:nc,k,m_cnst),SHAPE(q_phys(:,k,m_cnst,ie))) end do @@ -1074,11 +1075,11 @@ subroutine phys2fvm(ie,k,fvm,fq_phys,fqdp_fvm,num_trac) mass_forcing_phys = 0.0_r8 do h=1,num jdx = save_overlap_idx(1,h,jx,jy,ie); jdy = save_overlap_idx(2,h,jx,jy,ie) - q_prev = save_q_overlap(h,jx,jy,k,m_cnst,ie) + q_prev = save_q_overlap(h,jx,jy,k,m_cnst,ie) #ifndef skip_high_order_fq_map save_q_overlap(h,jx,jy,k,m_cnst,ie) = save_q_overlap(h,jx,jy,k,m_cnst,ie)+fq_phys_overlap(h,jx,jy) save_q_overlap(h,jx,jy,k,m_cnst,ie) = MIN(save_q_overlap(h,jx,jy,k,m_cnst,ie),phys_cdp_max(jx,jy)) - save_q_overlap(h,jx,jy,k,m_cnst,ie) = MAX(save_q_overlap(h,jx,jy,k,m_cnst,ie),phys_cdp_min(jx,jy)) + save_q_overlap(h,jx,jy,k,m_cnst,ie) = MAX(save_q_overlap(h,jx,jy,k,m_cnst,ie),phys_cdp_min(jx,jy)) mass_forcing = (save_q_overlap(h,jx,jy,k,m_cnst,ie)-q_prev)*save_air_mass_overlap(h,jx,jy,k,ie) mass_forcing_phys = mass_forcing_phys + mass_forcing fqdp_fvm(jdx,jdy,m_cnst) = fqdp_fvm(jdx,jdy,m_cnst)+mass_forcing @@ -1236,7 +1237,7 @@ subroutine get_fq_overlap(ie,k,fvm,fq_phys,max_overlap,fq_phys_overlap,num_trac) do m_cnst=1,num_trac fq_phys_overlap(idx,jx,jy,m_cnst) = & (fvm%dp_fvm(jdx,jdy,k)*SUM(weights_all_phys2fvm_local(h,:)*recons_q(:,jx,jy,m_cnst))+& - fq_phys(jx,jy,m_cnst)*dp_tmp)/save_air_mass_overlap(idx,jx,jy,k,ie) + fq_phys(jx,jy,m_cnst)*dp_tmp)/save_air_mass_overlap(idx,jx,jy,k,ie) end do end do end subroutine get_fq_overlap @@ -1335,13 +1336,13 @@ subroutine get_q_overlap_save(ie,k,fvm,q_fvm,num_trac,q_phys) num_overlap(:,:) = 0 q_phys = 0.0_r8 do h=1,jall_fvm2phys(ie) - jx = weights_lgr_index_all_fvm2phys(h,1,ie); jy = weights_lgr_index_all_fvm2phys(h,2,ie) + jx = weights_lgr_index_all_fvm2phys(h,1,ie); jy = weights_lgr_index_all_fvm2phys(h,2,ie) jdx = weights_eul_index_all_fvm2phys(h,1,ie); jdy = weights_eul_index_all_fvm2phys(h,2,ie) num_overlap(jx,jy) = num_overlap(jx,jy)+1 idx = num_overlap(jx,jy) - dp_fvm_tmp = fvm%dp_fvm(jdx,jdy,k) + dp_fvm_tmp = fvm%dp_fvm(jdx,jdy,k) dp_tmp = save_air_mass_overlap(idx,jx,jy,k,ie)-dp_fvm_tmp*weights_all_fvm2phys(h,1,ie) #ifdef PCoM dp_tmp = save_air_mass_overlap(idx,jx,jy,k,ie) @@ -1364,6 +1365,82 @@ subroutine get_q_overlap_save(ie,k,fvm,q_fvm,num_trac,q_phys) save_q_phys(:,:,k,m_cnst,ie) = q_phys(:,:,m_cnst) end do end subroutine get_q_overlap_save - + ! + ! Routine to overwrite thermodynamic active tracers on the GLL grid with CSLAM values + ! by Lagrange interpolation from 3x3 CSLAM grid to GLL grid. + ! + subroutine cslam2gll(elem, fvm, hybrid,nets,nete, tl_f, tl_qdp) + use dimensions_mod, only: nc,nlev,np,nhc + use hybrid_mod, only: hybrid_t + use air_composition, only: thermodynamic_active_species_num, thermodynamic_active_species_idx + use fvm_mod, only: ghostBuf_cslam2gll + use bndry_mod, only: ghost_exchange + use edge_mod, only: ghostpack,ghostunpack + use cam_logfile, only: iulog + type (element_t), intent(inout):: elem(:) + type(fvm_struct), intent(inout):: fvm(:) + + type (hybrid_t), intent(in) :: hybrid ! distributed parallel structure (shared) + integer, intent(in) :: nets, nete, tl_f, tl_qdp + + integer :: ie,i,j,k,m_cnst,nq,iret + real (kind=r8), dimension(:,:,:,:,:) , allocatable :: fld_fvm, fld_gll + character(len=*), parameter :: subname = 'cslam2gll' + ! + ! for tensor product Lagrange interpolation + ! + integer :: nflds + logical, allocatable :: llimiter(:) + call t_startf('cslam2gll') + nflds = thermodynamic_active_species_num + + !Allocate variables + !------------------ + allocate(fld_fvm(1-nhc:nc+nhc,1-nhc:nc+nhc,nlev,nflds,nets:nete), stat=iret) + call check_allocate(iret, subname, 'fld_fvm(1-nhc:nc+nhc,1-nhc:nc+nhc,nlev,nflds,nets:nete)', & + file=__FILE__, line=__LINE__) + + allocate(fld_gll(np,np,nlev,thermodynamic_active_species_num,nets:nete),stat=iret) + call check_allocate(iret, subname, 'fld_gll(np,np,nlev,thermodynamic_active_species_num,nets:nete)', & + file=__FILE__, line=__LINE__) + + allocate(llimiter(nflds), stat=iret) + call check_allocate(iret, subname, 'llimiter(nflds)', & + file=__FILE__, line=__LINE__) + !------------------ + + llimiter(1:nflds) = .false. + do ie=nets,nete + do m_cnst=1,thermodynamic_active_species_num + do k=1,nlev + fld_fvm(1:nc,1:nc,k,m_cnst,ie) = & + fvm(ie)%c(1:nc,1:nc,k,thermodynamic_active_species_idx(m_cnst)) + end do + end do + end do + call t_startf('fvm:fill_halo_cslam2gll') + do ie=nets,nete + call ghostpack(ghostBuf_cslam2gll, fld_fvm(:,:,:,:,ie),nlev*nflds,0,ie) + end do + + call ghost_exchange(hybrid,ghostBuf_cslam2gll,location='cslam2gll') + do ie=nets,nete + call ghostunpack(ghostBuf_cslam2gll, fld_fvm(:,:,:,:,ie),nlev*nflds,0,ie) + end do + call t_stopf('fvm:fill_halo_cslam2gll') + ! + ! do mapping + ! + call fvm2dyn(fld_fvm,fld_gll,hybrid,nets,nete,nlev,nflds,fvm,llimiter,halo_filled=.true.) + + do ie=nets,nete + do m_cnst=1,thermodynamic_active_species_num + elem(ie)%state%qdp(:,:,:,m_cnst,tl_qdp) = fld_gll(:,:,:,m_cnst,ie)*& + elem(ie)%state%dp3d(:,:,:,tl_f) + end do + end do + deallocate(fld_fvm, fld_gll, llimiter) + call t_stopf('cslam2gll') + end subroutine cslam2gll end module fvm_mapping diff --git a/src/dynamics/se/dycore/fvm_mod.F90 b/src/dynamics/se/dycore/fvm_mod.F90 index 925e5e89..77c88010 100644 --- a/src/dynamics/se/dycore/fvm_mod.F90 +++ b/src/dynamics/se/dycore/fvm_mod.F90 @@ -26,6 +26,7 @@ module fvm_mod type (EdgeBuffer_t) :: edgeveloc type (EdgeBuffer_t), public :: ghostBufQnhc_s + type (EdgeBuffer_t), public :: ghostBufQnhc_t1 type (EdgeBuffer_t), public :: ghostBufQnhc_vh type (EdgeBuffer_t), public :: ghostBufQnhc_h type (EdgeBuffer_t), public :: ghostBufQ1_h @@ -35,6 +36,7 @@ module fvm_mod type (EdgeBuffer_t), public :: ghostBufQnhcJet_h type (EdgeBuffer_t), public :: ghostBufFluxJet_h type (EdgeBuffer_t), public :: ghostBufPG_s + type (EdgeBuffer_t), public :: ghostBuf_cslam2gll interface fill_halo_fvm module procedure fill_halo_fvm_noprealloc @@ -65,7 +67,7 @@ subroutine fill_halo_fvm_noprealloc(elem,fvm,hybrid,nets,nete,ndepth,kmin,kmax,k ! ! - if(kmin .ne. 1 .or. kmax .ne. nlev) then + if(kmin .ne. 1 .or. kmax .ne. nlev) then print *,'WARNING: fill_halo_fvm_noprealloc does not support the passing of non-contigous arrays' print *,'WARNING: incorrect answers are likely' endif @@ -118,7 +120,7 @@ subroutine fill_halo_fvm_prealloc(cellghostbuf,elem,fvm,hybrid,nets,nete,ndepth, integer,intent(in) :: ndepth ! depth of halo integer,intent(in) :: kmin,kmax ! min and max vertical level integer,intent(in) :: ksize ! the total number of vertical - logical, optional :: active ! indicates if te current thread is active + logical, optional :: active ! indicates if te current thread is active integer :: ie,i1,i2,kblk,q,kptr ! ! @@ -134,7 +136,7 @@ subroutine fill_halo_fvm_prealloc(cellghostbuf,elem,fvm,hybrid,nets,nete,ndepth, i2=nc+ndepth kblk = kmax-kmin+1 if(FVM_TIMERS) call t_startf('FVM:pack') - if(lactive) then + if(lactive) then do ie=nets,nete kptr = kmin-1 call ghostpack(cellghostbuf, fvm(ie)%dp_fvm(i1:i2,i1:i2,kmin:kmax),kblk, kptr,ie) @@ -150,7 +152,7 @@ subroutine fill_halo_fvm_prealloc(cellghostbuf,elem,fvm,hybrid,nets,nete,ndepth, if(FVM_TIMERS) call t_stopf('FVM:Communication') !-----------------------------------------------------------------------------------! if(FVM_TIMERS) call t_startf('FVM:Unpack') - if(lactive) then + if(lactive) then do ie=nets,nete kptr = kmin-1 call ghostunpack(cellghostbuf, fvm(ie)%dp_fvm(i1:i2,i1:i2,kmin:kmax),kblk, kptr,ie) @@ -302,28 +304,24 @@ subroutine fvm_init1(par,elem) use control_mod, only: rsplit use dimensions_mod, only: qsize, qsize_d use dimensions_mod, only: fvm_supercycling, fvm_supercycling_jet - use dimensions_mod, only: nc,nhe, nhc, nlev,ntrac, ntrac,ns, nhr + use dimensions_mod, only: nc,nhe, nhc, nlev,ntrac, ntrac,ns, nhr, use_cslam use dimensions_mod, only: large_Courant_incr use dimensions_mod, only: kmin_jet,kmax_jet type (parallel_t) :: par type (element_t),intent(inout) :: elem(:) ! - if (ntrac>0) then + if (use_cslam) then if (par%masterproc) then write(iulog,*) " " write(iulog,*) "|-----------------------------------------|" write(iulog,*) "| FVM tracer transport scheme information |" write(iulog,*) "|-----------------------------------------|" write(iulog,*) " " - end if - if (ntrac>0) then - if (par%masterproc) then - write(iulog,*) "Running consistent SE-CSLAM, Lauritzen et al. (2017, MWR)." - write(iulog,*) "CSLAM = Conservative Semi-LAgrangian Multi-tracer scheme" - write(iulog,*) "Lauritzen et al., (2010), J. Comput. Phys." - write(iulog,*) " " - end if + write(iulog,*) "Running consistent SE-CSLAM, Lauritzen et al. (2017, MWR)." + write(iulog,*) "CSLAM = Conservative Semi-LAgrangian Multi-tracer scheme" + write(iulog,*) "Lauritzen et al., (2010), J. Comput. Phys." + write(iulog,*) " " end if ! ! PARAMETER ERROR CHECKING @@ -423,8 +421,8 @@ subroutine fvm_init1(par,elem) endif call endrun("stopping") end if - end if - + endif + if (nc==4.and.ns.ne.4) then if (par%masterproc) then write(iulog,*) "Recommended setting for nc=4 is ns=4 (cubic interpolation in halo)" @@ -497,6 +495,7 @@ subroutine fvm_init2(elem,fvm,hybrid,nets,nete) ! changes the values for reverse call initghostbuffer(hybrid%par,ghostBufQnhc_s,elem,nlev*(ntrac+1),nhc,nc,nthreads=1) + call initghostbuffer(hybrid%par,ghostBufQnhc_t1,elem,nlev, nhc,nc,nthreads=1) call initghostbuffer(hybrid%par,ghostBufQnhc_h,elem,nlev*(ntrac+1),nhc,nc,nthreads=horz_num_threads) call initghostbuffer(hybrid%par,ghostBufQnhc_vh,elem,nlev*(ntrac+1),nhc,nc,nthreads=vert_num_threads*horz_num_threads) klev = kmax_jet-kmin_jet+1 @@ -504,13 +503,14 @@ subroutine fvm_init2(elem,fvm,hybrid,nets,nete) call initghostbuffer(hybrid%par,ghostBufQ1_vh,elem,klev*(ntrac+1),1,nc,nthreads=vert_num_threads*horz_num_threads) ! call initghostbuffer(hybrid%par,ghostBufFlux_h,elem,4*nlev,nhe,nc,nthreads=horz_num_threads) call initghostbuffer(hybrid%par,ghostBufFlux_vh,elem,4*nlev,nhe,nc,nthreads=vert_num_threads*horz_num_threads) + call initghostbuffer(hybrid%par,ghostBuf_cslam2gll,elem,nlev*thermodynamic_active_species_num,nhc,nc,nthreads=1) ! ! preallocate buffers for physics-dynamics coupling ! if (fv_nphys.ne.nc) then call initghostbuffer(hybrid%par,ghostBufPG_s,elem,nlev*(4+ntrac),nhc_phys,fv_nphys,nthreads=1) else - call initghostbuffer(hybrid%par,ghostBufPG_s,elem,nlev*(3+thermodynamic_active_species_num),nhc_phys,fv_nphys,nthreads=1) + call initghostbuffer(hybrid%par,ghostBufPG_s,elem,nlev*3,nhc_phys,fv_nphys,nthreads=1) end if if (fvm_supercycling.ne.fvm_supercycling_jet) then @@ -527,7 +527,7 @@ end subroutine fvm_init2 subroutine fvm_init3(elem,fvm,hybrid,nets,nete,irecons) use control_mod , only: neast, nwest, seast, swest use fvm_analytic_mod, only: compute_reconstruct_matrix - use dimensions_mod , only: fv_nphys + use dimensions_mod , only: fv_nphys, use_cslam use dimensions_mod, only: nlev, nc, nhe, nlev, ntrac, nhc use coordinate_systems_mod, only: cartesian2D_t,cartesian3D_t use coordinate_systems_mod, only: cubedsphere2cart, cart2cubedsphere @@ -546,7 +546,7 @@ subroutine fvm_init3(elem,fvm,hybrid,nets,nete,irecons) type (cartesian2D_t) :: gnom type(cartesian3D_t) :: tmpcart3d - if (ntrac>0.and.nc.ne.fv_nphys) then + if (use_cslam.and.nc.ne.fv_nphys) then ! ! fill the fvm halo for mapping in d_p_coupling if ! physics grid resolution is different than fvm resolution diff --git a/src/dynamics/se/dycore/fvm_reconstruction_mod.F90 b/src/dynamics/se/dycore/fvm_reconstruction_mod.F90 index b7310ad4..b4708dfd 100644 --- a/src/dynamics/se/dycore/fvm_reconstruction_mod.F90 +++ b/src/dynamics/se/dycore/fvm_reconstruction_mod.F90 @@ -105,7 +105,6 @@ subroutine reconstruction(fcube,nlev_in,k_in,recons,irecons,llimiter,ntrac_in,& if(FVM_TIMERS) call t_startf('FVM:reconstruction:part#1') if (nhe>0) then do itr=1,ntrac_in - ! f=-9e9_r8 call extend_panel_interpolate(nc,nhc,nhr,nht,ns,nh,& fcube(:,:,k_in,itr),cubeboundary,halo_interp_weight,ibase,f(:,:,1),f(:,:,2:3)) call get_gradients(f(:,:,:),jx,jy,irecons,recons(:,:,:,itr),& @@ -113,8 +112,6 @@ subroutine reconstruction(fcube,nlev_in,k_in,recons,irecons,llimiter,ntrac_in,& end do else do itr=1,ntrac_in - ! f=-9e9_r8!to avoid floating point exception for uninitialized variables - ! !in non-existent cells (corners of cube) call extend_panel_interpolate(nc,nhc,nhr,nht,ns,nh,& fcube(:,:,k_in,itr),cubeboundary,halo_interp_weight,ibase,f(:,:,1)) call get_gradients(f(:,:,:),jx,jy,irecons,recons(:,:,:,itr),& diff --git a/src/dynamics/se/dycore/global_norms_mod.F90 b/src/dynamics/se/dycore/global_norms_mod.F90 index 21d46b9b..a77ce33b 100644 --- a/src/dynamics/se/dycore/global_norms_mod.F90 +++ b/src/dynamics/se/dycore/global_norms_mod.F90 @@ -157,7 +157,7 @@ function global_integral(elem, h,hybrid,npts,nets,nete) result(I_sphere) real (kind=r8) :: da real (kind=r8) :: J_tmp(nets:nete) ! -! This algorythm is independent of thread count and task count. +! This algorithm is independent of thread count and task count. ! This is a requirement of consistancy checking in cam. ! J_tmp = 0.0_r8 @@ -203,25 +203,25 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& ! worse viscosity CFL (given by dtnu) is not violated by reducing ! viscosity coefficient in regions where CFL is violated ! - use hybrid_mod, only: hybrid_t, PrintHybrid + use hybrid_mod, only: hybrid_t use element_mod, only: element_t - use dimensions_mod, only: np,ne,nelem,nelemd,nc,nhe,qsize,ntrac,nlev,large_Courant_incr - use dimensions_mod, only: nu_scale_top,nu_div_lev,nu_lev + use dimensions_mod, only: np,ne,nelem,nc,nhe,use_cslam,nlev,large_Courant_incr + use dimensions_mod, only: nu_scale_top,nu_div_lev,nu_lev,nu_t_lev use quadrature_mod, only: gausslobatto, quadrature_t use reduction_mod, only: ParallelMin,ParallelMax use dynconst, only: ra, rearth, cpair - use control_mod, only: nu, nu_div, nu_q, nu_p, nu_s, nu_top, fine_ne, rk_stage_user, max_hypervis_courant + use control_mod, only: nu, nu_div, nu_q, nu_p, nu_t, nu_top, fine_ne, max_hypervis_courant use control_mod, only: tstep_type, hypervis_power, hypervis_scaling + use control_mod, only: sponge_del4_nu_div_fac, sponge_del4_nu_fac, sponge_del4_lev use cam_abortutils, only: endrun use parallel_mod, only: global_shared_buf, global_shared_sum use edge_mod, only: initedgebuffer, FreeEdgeBuffer, edgeVpack, edgeVunpack use bndry_mod, only: bndry_exchange - use time_mod, only: tstep use mesh_mod, only: MeshUseMeshFile use dimensions_mod, only: ksponge_end, kmvis_ref, kmcnd_ref,rho_ref - + use std_atm_profile,only: std_atm_height type(element_t) , intent(inout) :: elem(:) integer , intent(in) :: nets,nete type (hybrid_t) , intent(in) :: hybrid @@ -237,14 +237,14 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& real (kind=r8) :: max_min_dx,min_min_dx,min_max_dx,max_unif_dx ! used for normalizing scalar HV real (kind=r8) :: max_normDinv, min_normDinv ! used for CFL real (kind=r8) :: min_area, max_area,max_ratio !min/max element area - real (kind=r8) :: avg_area, avg_min_dx + real (kind=r8) :: avg_area, avg_min_dx,tot_area,tot_area_rad real (kind=r8) :: min_hypervis, max_hypervis, avg_hypervis, stable_hv real (kind=r8) :: normDinv_hypervis real (kind=r8) :: x, y, noreast, nw, se, sw real (kind=r8), dimension(np,np,nets:nete) :: zeta real (kind=r8) :: lambda_max, lambda_vis, min_gw, lambda,umax, ugw - real (kind=r8) :: press,scale1,scale2,scale3, max_laplace - integer :: ie,corner, i, j, rowind, colind, k + real (kind=r8) :: scale1,scale2,max_laplace,z(nlev) + integer :: ie, i, j, rowind, colind, k type (quadrature_t) :: gp character(LEN=256) :: rk_str @@ -252,10 +252,11 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& real (kind=r8) :: dt_max_adv, dt_max_gw, dt_max_tracer_se, dt_max_tracer_fvm real (kind=r8) :: dt_max_hypervis, dt_max_hypervis_tracer, dt_max_laplacian_top - real(kind=r8) :: I_sphere + real(kind=r8) :: I_sphere, nu_max, nu_div_max real(kind=r8) :: h(np,np,nets:nete) - + logical :: top_000_032km, top_032_042km, top_042_090km, top_090_140km, top_140_600km ! model top location ranges + logical :: nu_set,div_set,lev_set ! Eigenvalues calculated by folks at UMich (Paul U & Jared W) select case (np) @@ -336,6 +337,7 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& enddo call wrap_repro_sum(nvars=2, comm=hybrid%par%comm) avg_area = global_shared_sum(1)/real(nelem, r8) + tot_area_rad = global_shared_sum(1) avg_min_dx = global_shared_sum(2)/real(nelem, r8) min_area = ParallelMin(min_area,hybrid) @@ -347,15 +349,18 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& min_max_dx = ParallelMin(min_max_dx,hybrid) max_ratio = ParallelMax(max_ratio,hybrid) ! Physical units for area - min_area = min_area*rearth*rearth/1000000._r8 + min_area = min_area*rearth*rearth/1000000._r8!m2 (rearth is in units of km) max_area = max_area*rearth*rearth/1000000._r8 avg_area = avg_area*rearth*rearth/1000000._r8 + tot_area = tot_area_rad*rearth*rearth/1000000._r8 if (hybrid%masterthread) then write(iulog,* )"" write(iulog,* )"Running Global Integral Diagnostic..." write(iulog,*)"Area of unit sphere is",I_sphere write(iulog,*)"Should be 1.0 to round off..." write(iulog,'(a,f9.3)') 'Element area: max/min',(max_area/min_area) + write(iulog,'(a,E23.15)') 'Total Grid area: ',(tot_area) + write(iulog,'(a,E23.15)') 'Total Grid area rad^2: ',(tot_area_rad) if (.not.MeshUseMeshFile) then write(iulog,'(a,f6.3,f8.2)') "Average equatorial node spacing (deg, km) = ", & real(90, r8)/real(ne*(np-1), r8), pi*rearth/(2000.0_r8*real(ne*(np-1), r8)) @@ -539,41 +544,146 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& end do end do enddo !rowind - enddo !colind + enddo !colind endif deallocate(gp%points) deallocate(gp%weights) call automatically_set_viscosity_coefficients(hybrid,ne,max_min_dx,min_min_dx,nu_p ,1.0_r8 ,'_p ') - call automatically_set_viscosity_coefficients(hybrid,ne,max_min_dx,min_min_dx,nu ,0.5_r8,' ') - if (ptop>100.0_r8) then + call automatically_set_viscosity_coefficients(hybrid,ne,max_min_dx,min_min_dx,nu ,1.0_r8,' ') + call automatically_set_viscosity_coefficients(hybrid,ne,max_min_dx,min_min_dx,nu_div,2.5_r8 ,'_div') + + if (nu_q<0) nu_q = nu_p ! necessary for consistency + if (nu_t<0) nu_t = nu_p ! temperature damping is always equal to nu_p + + nu_div_lev(:) = nu_div + nu_lev(:) = nu + nu_t_lev(:) = nu_p + + ! + ! sponge layer strength needed for stability depends on model top location + ! + top_000_032km = .false. + top_032_042km = .false. + top_042_090km = .false. + top_090_140km = .false. + top_140_600km = .false. + nu_set = sponge_del4_nu_fac < 0 + div_set = sponge_del4_nu_div_fac < 0 + lev_set = sponge_del4_lev < 0 + if (ptop>1000.0_r8) then + ! + ! low top; usually idealized test cases + ! + top_000_032km = .true. + if (hybrid%masterthread) write(iulog,* )"Model top damping configuration: top_000_032km" + else if (ptop>100.0_r8) then + ! + ! CAM6 top (~225 Pa) or CAM7 low top + ! + top_032_042km = .true. + if (hybrid%masterthread) write(iulog,* )"Model top damping configuration: top_032_042km" + else if (ptop>1e-1_r8) then + ! + ! CAM7 top (~4.35e-1 Pa) ! - ! CAM setting + top_042_090km = .true. + if (hybrid%masterthread) write(iulog,* )"Model top damping configuration: top_042_090km" + else if (ptop>1E-4_r8) then ! - call automatically_set_viscosity_coefficients(hybrid,ne,max_min_dx,min_min_dx,nu_div,2.5_r8 ,'_div') - nu_div_lev(:) = nu_div - nu_lev(:) = nu + ! WACCM top (~4.5e-4 Pa) + ! + top_090_140km = .true. + if (hybrid%masterthread) write(iulog,* )"Model top damping configuration: top_090_140km" else ! - ! WACCM setting + ! WACCM-x - geospace (~4e-7 Pa) ! - call automatically_set_viscosity_coefficients(hybrid,ne,max_min_dx,min_min_dx,nu_div,2.5_r8 ,'_div') - if (hybrid%masterthread) write(iulog,*) ": sponge layer viscosity scaling factor" + top_140_600km = .true. + if (hybrid%masterthread) write(iulog,* )"Model top damping configuration: top_140_600km" + end if + ! + ! Logging text for sponge layer configuration + ! + if (hybrid%masterthread .and. (nu_set .or. div_set .or. lev_set)) then + write(iulog,* )"" + write(iulog,* )"Sponge layer del4 coefficient defaults based on model top location:" + end if + ! + ! if user or namelist is not specifying sponge del4 settings here are best guesses (empirically determined) + ! + if (top_042_090km) then + if (sponge_del4_lev <0) sponge_del4_lev = 4 + if (sponge_del4_nu_fac <0) sponge_del4_nu_fac = 3.375_r8 !max value without having to increase subcycling of div4 + if (sponge_del4_nu_div_fac<0) sponge_del4_nu_div_fac = 3.375_r8 !max value without having to increase subcycling of div4 + else if (top_090_140km.or.top_140_600km) then ! defaults for waccm(x) + if (sponge_del4_lev <0) sponge_del4_lev = 20 + if (sponge_del4_nu_fac <0) sponge_del4_nu_fac = 5.0_r8 + if (sponge_del4_nu_div_fac<0) sponge_del4_nu_div_fac = 10.0_r8 + else + if (sponge_del4_lev <0) sponge_del4_lev = 1 + if (sponge_del4_nu_fac <0) sponge_del4_nu_fac = 1.0_r8 + if (sponge_del4_nu_div_fac<0) sponge_del4_nu_div_fac = 1.0_r8 + end if + + ! set max wind speed for diagnostics + umax = 120.0_r8 + if (top_042_090km) then + umax = 240._r8 + else if (top_090_140km) then + umax = 300._r8 + else if (top_140_600km) then + umax = 800._r8 + end if + ! + ! Log sponge layer configuration + ! + if (hybrid%masterthread) then + if (nu_set) then + write(iulog, '(a,e9.2)') ' sponge_del4_nu_fac = ',sponge_del4_nu_fac + end if + + if (div_set) then + write(iulog, '(a,e9.2)') ' sponge_del4_nu_div_fac = ',sponge_del4_nu_div_fac + end if + + if (lev_set) then + write(iulog, '(a,i0)') ' sponge_del4_lev = ',sponge_del4_lev + end if + write(iulog,* )"" + end if + + nu_max = sponge_del4_nu_fac*nu_p + nu_div_max = sponge_del4_nu_div_fac*nu_p + do k=1,nlev + ! Vertical profile from FV dycore (see Lauritzen et al. 2012 DOI:10.1177/1094342011410088) + scale1 = 0.5_r8*(1.0_r8+tanh(2.0_r8*log(pmid(sponge_del4_lev)/pmid(k)))) + if (sponge_del4_nu_div_fac /= 1.0_r8) then + nu_div_lev(k) = (1.0_r8-scale1)*nu_div+scale1*nu_div_max + end if + if (sponge_del4_nu_fac /= 1.0_r8) then + nu_lev(k) = (1.0_r8-scale1)*nu +scale1*nu_max + nu_t_lev(k) = (1.0_r8-scale1)*nu_p +scale1*nu_max + end if + end do + + if (hybrid%masterthread)then + write(iulog,*) "z computed from barometric formula (using US std atmosphere)" + call std_atm_height(pmid(:),z(:)) + write(iulog,*) "k,pmid_ref,z,nu_lev,nu_t_lev,nu_div_lev" do k=1,nlev - press = pmid(k) - - scale1 = 0.5_r8*(1.0_r8+tanh(2.0_r8*log(100.0_r8/press))) - nu_div_lev(k) = (1.0_r8-scale1)*nu_div+scale1*2.0_r8*nu_div - nu_div_lev(k) = nu_div - nu_lev(k) = (1.0_r8-scale1)*nu +scale1*nu_p - nu_lev(k) = nu - if (hybrid%masterthread) write(iulog,*) "nu_lev=",k,nu_lev(k) - if (hybrid%masterthread) write(iulog,*) "nu_div_lev=",k,nu_div_lev(k) + write(iulog,'(i3,5e11.4)') k,pmid(k),z(k),nu_lev(k),nu_t_lev(k),nu_div_lev(k) end do - end if + if (nu_top>0) then + write(iulog,*) ": ksponge_end = ",ksponge_end + write(iulog,*) ": sponge layer Laplacian damping" + write(iulog,*) "k, p, z, nu_scale_top, nu (actual Laplacian damping coefficient)" - if (nu_q<0) nu_q = nu_p ! necessary for consistency - if (nu_s<0) nu_s = nu_p ! temperature damping is always equal to nu_p + do k=1,ksponge_end + write(iulog,'(i3,4e11.4)') k,pmid(k),z(k),nu_scale_top(k),nu_scale_top(k)*nu_top + end do + end if + end if !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! @@ -600,40 +710,31 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& write(iulog,'(a,f12.8,a)') 'Model top is ',ptop,'Pa' write(iulog,'(a)') ' ' write(iulog,'(a)') 'Timestepping methods used in dynamical core:' - write(iulog,'(a)') + write(iulog,'(a)') write(iulog,*) rk_str write(iulog,'(a)') ' * Spectral-element advection uses SSP preservation RK3' write(iulog,'(a)') ' * Viscosity operators use forward Euler' - if (ntrac>0) then - write(iulog,'(a)') ' * CSLAM uses two time-levels backward trajectory method' - end if end if S_laplacian = 2.0_r8 !using forward Euler for sponge diffusion S_hypervis = 2.0_r8 !using forward Euler for hyperviscosity S_rk_tracer = 2.0_r8 - ! - ! estimate max winds - ! - if (ptop>100.0_r8) then - umax = 120.0_r8 - else - umax = 400.0_r8 - end if + ugw = 342.0_r8 !max gravity wave speed dt_max_adv = S_rk/(umax*max_normDinv*lambda_max*ra) dt_max_gw = S_rk/(ugw*max_normDinv*lambda_max*ra) dt_max_tracer_se = S_rk_tracer*min_gw/(umax*max_normDinv*ra) - if (ntrac>0) then + if (use_cslam) then if (large_Courant_incr) then - dt_max_tracer_fvm = real(nhe, r8)*(4.0_r8*pi*real(Rearth, r8)/real(4.0_r8*ne*nc, r8))/umax + dt_max_tracer_fvm = dble(nhe)*(4.0_r8*pi*Rearth/dble(4.0_r8*ne*nc))/umax else - dt_max_tracer_fvm = real(nhe, r8)*(2.0_r8*pi*real(Rearth, r8)/real(4.0_r8*ne*nc, r8))/umax + dt_max_tracer_fvm = dble(nhe)*(2.0_r8*pi*Rearth/dble(4.0_r8*ne*nc))/umax end if else dt_max_tracer_fvm = -1.0_r8 end if - dt_max_hypervis = s_hypervis/(MAX(MAXVAL(nu_div_lev(:)),MAXVAL(nu_lev(:)))*normDinv_hypervis) + nu_max = MAX(MAXVAL(nu_div_lev(:)),MAXVAL(nu_lev(:)),MAXVAL(nu_t_lev(:))) + dt_max_hypervis = s_hypervis/(nu_max*normDinv_hypervis) dt_max_hypervis_tracer = s_hypervis/(nu_q*normDinv_hypervis) max_laplace = MAX(MAXVAL(nu_scale_top(:))*nu_top,MAXVAL(kmvis_ref(:)/rho_ref(:))) @@ -653,14 +754,15 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& write(iulog,'(a,f10.2,a,f10.2,a)') '* dt_dyn_vis (hyperviscosity) ; u,v,T,dM) < ',dt_max_hypervis,& 's ',dt_dyn_visco_actual,'s' if (dt_dyn_visco_actual>dt_max_hypervis) write(iulog,*) 'WARNING: dt_dyn_vis theoretically unstable' - write(iulog,'(a,f10.2,a,f10.2,a)') '* dt_tracer_se (time-stepping tracers ; q ) < ',dt_max_tracer_se,'s ',& + if (.not.use_cslam) then + write(iulog,'(a,f10.2,a,f10.2,a)') '* dt_tracer_se (time-stepping tracers ; q ) < ',dt_max_tracer_se,'s ',& dt_tracer_se_actual,'s' - if (dt_tracer_se_actual>dt_max_tracer_se) write(iulog,*) 'WARNING: dt_tracer_se theoretically unstable' - write(iulog,'(a,f10.2,a,f10.2,a)') '* dt_tracer_vis (hyperviscosity tracers; q ) < ',dt_max_hypervis_tracer,'s',& - dt_tracer_visco_actual,'s' - if (dt_tracer_visco_actual>dt_max_hypervis_tracer) write(iulog,*) 'WARNING: dt_tracer_hypervis theoretically unstable' - - if (ntrac>0) then + if (dt_tracer_se_actual>dt_max_tracer_se) write(iulog,*) 'WARNING: dt_tracer_se theoretically unstable' + write(iulog,'(a,f10.2,a,f10.2,a)') '* dt_tracer_vis (hyperviscosity tracers; q ) < ',dt_max_hypervis_tracer,'s',& + dt_tracer_visco_actual,'s' + if (dt_tracer_visco_actual>dt_max_hypervis_tracer) write(iulog,*) 'WARNING: dt_tracer_hypervis theoretically unstable' + end if + if (use_cslam) then write(iulog,'(a,f10.2,a,f10.2,a)') '* dt_tracer_fvm (time-stepping tracers ; q ) < ',dt_max_tracer_fvm,& 's ',dt_tracer_fvm_actual if (dt_tracer_fvm_actual>dt_max_tracer_fvm) write(iulog,*) 'WARNING: dt_tracer_fvm theortically unstable' @@ -673,8 +775,14 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& write(iulog,'(a,f10.2,a,f10.2,a)') '* dt (del2 sponge ; u,v,T,dM) < ',& dt_max_laplacian_top,'s',dt_dyn_del2_actual,'s' - if (dt_dyn_del2_actual>dt_max_laplacian_top) & - write(iulog,*) 'WARNING: theoretically unstable in sponge; increase se_hypervis_subcycle_sponge' + if (dt_dyn_del2_actual>dt_max_laplacian_top) then + if (k==1) then + write(iulog,*) 'WARNING: theoretically unstable in sponge; increase se_hypervis_subcycle_sponge',& + ' (this WARNING can sometimes be ignored in level 1)' + else + write(iulog,*) 'WARNING: theoretically unstable in sponge; increase se_hypervis_subcycle_sponge' + endif + end if end do write(iulog,*) ' ' if (hypervis_power /= 0) then @@ -1104,7 +1212,9 @@ subroutine automatically_set_viscosity_coefficients(hybrid,ne,max_min_dx,min_min if (nu < 0) then if (ne <= 0) then - if (hypervis_scaling/=0) then + if (hypervis_power/=0) then + call endrun('ERROR: Automatic scaling of scalar viscosity not implemented') + else if (hypervis_scaling/=0) then nu_min = factor*nu_fac*(max_min_dx*1000.0_r8)**uniform_res_hypervis_scaling nu_max = factor*nu_fac*(min_min_dx*1000.0_r8)**uniform_res_hypervis_scaling nu = factor*nu_min @@ -1113,11 +1223,9 @@ subroutine automatically_set_viscosity_coefficients(hybrid,ne,max_min_dx,min_min write(iulog,'(a,2e9.2,a,2f9.2)') "Value at min/max grid spacing: ",nu_min,nu_max,& " Max/min grid spacing (km) = ",max_min_dx,min_min_dx end if - nu = nu_min*(2.0_r8*rearth/(3.0_r8*max_min_dx*1000.0_r8))**hypervis_scaling/(rearth**4._r8) + nu = nu_min*(2.0_r8*rearth/(3.0_r8*max_min_dx*1000.0_r8))**hypervis_scaling/(rearth**4) if (hybrid%masterthread) & write(iulog,'(a,a,a,e9.3)') "Nu_tensor",TRIM(str)," = ",nu - else if (hypervis_power/=0) then - call endrun('ERROR: Automatic scaling of scalar viscosity not implemented') end if else nu = factor*nu_fac*((30.0_r8/ne)*110000.0_r8)**uniform_res_hypervis_scaling diff --git a/src/dynamics/se/dycore/hybrid_mod.F90 b/src/dynamics/se/dycore/hybrid_mod.F90 index f167435a..46c5a76f 100644 --- a/src/dynamics/se/dycore/hybrid_mod.F90 +++ b/src/dynamics/se/dycore/hybrid_mod.F90 @@ -7,7 +7,7 @@ module hybrid_mod use parallel_mod , only : parallel_t, copy_par use thread_mod , only : omp_set_num_threads, omp_get_thread_num use thread_mod , only : horz_num_threads, vert_num_threads, tracer_num_threads -use dimensions_mod, only : nlev, qsize, ntrac +use dimensions_mod, only : nlev, qsize, ntrac, use_cslam implicit none private @@ -268,7 +268,7 @@ subroutine init_loop_ranges(nelemd) work_pool_trac(ith+1,2) = end_index end do - if(ntrac>0 .and. ntrac0) then + if ((cubed_sphere_map /= 0) .AND. use_cslam) then if (par%masterproc) then write(iulog, *) subname, 'fvm transport and require equi-angle gnomonic cube sphere mapping.' write(iulog, *) ' Set cubed_sphere_map = 0 or comment it out all together. ' diff --git a/src/dynamics/se/dycore/prim_advance_mod.F90 b/src/dynamics/se/dycore/prim_advance_mod.F90 index cf88d7f9..5389ed04 100644 --- a/src/dynamics/se/dycore/prim_advance_mod.F90 +++ b/src/dynamics/se/dycore/prim_advance_mod.F90 @@ -10,7 +10,7 @@ module prim_advance_mod private save - public :: prim_advance_exp, prim_advance_init, applyCAMforcing, calc_tot_energy_dynamics, compute_omega + public :: prim_advance_exp, prim_advance_init, applyCAMforcing, tot_energy_dyn, compute_omega type (EdgeBuffer_t) :: edge3,edgeOmega,edgeSponge real (kind=r8), allocatable :: ur_weights(:) @@ -31,7 +31,9 @@ subroutine prim_advance_init(par, elem) character(len=*), parameter :: subname = 'prim_advance_init (SE)' call initEdgeBuffer(par,edge3 ,elem,4*nlev ,bndry_type=HME_BNDRY_P2P, nthreads=horz_num_threads) - call initEdgeBuffer(par,edgeSponge,elem,4*ksponge_end,bndry_type=HME_BNDRY_P2P, nthreads=horz_num_threads) + if (ksponge_end>0) then + call initEdgeBuffer(par,edgeSponge,elem,4*ksponge_end,bndry_type=HME_BNDRY_P2P, nthreads=horz_num_threads) + end if call initEdgeBuffer(par,edgeOmega ,elem,nlev ,bndry_type=HME_BNDRY_P2P, nthreads=horz_num_threads) if(.not. allocated(ur_weights)) then @@ -67,15 +69,13 @@ subroutine prim_advance_exp(elem, fvm, deriv, hvcoord, hybrid,dt, tl, nets, net use element_mod, only: element_t use hybvcoord_mod, only: hvcoord_t use hybrid_mod, only: hybrid_t - use time_mod, only: TimeLevel_t, timelevel_qdp, tevolve - use dimensions_mod, only: lcp_moist + use se_dyn_time_mod, only: TimeLevel_t, timelevel_qdp, tevolve use fvm_control_volume_mod, only: fvm_struct - use control_mod, only: raytau0 implicit none type (element_t), intent(inout), target :: elem(:) - type(fvm_struct) , intent(in) :: fvm(:) + type(fvm_struct) , intent(inout) :: fvm(:) type (derivative_t) , intent(in) :: deriv type (hvcoord_t) :: hvcoord type (hybrid_t) , intent(in) :: hybrid @@ -86,14 +86,12 @@ subroutine prim_advance_exp(elem, fvm, deriv, hvcoord, hybrid,dt, tl, nets, net ! Local real (kind=r8) :: dt_vis, eta_ave_w - real (kind=r8) :: dp(np,np) integer :: ie,nm1,n0,np1,k,qn0,m_cnst, nq + real (kind=r8) :: inv_cp_full(np,np,nlev,nets:nete) real (kind=r8) :: qwater(np,np,nlev,thermodynamic_active_species_num,nets:nete) integer :: qidx(thermodynamic_active_species_num) real (kind=r8) :: kappa(np,np,nlev,nets:nete) - real (kind=r8) :: inv_cp_full(np,np,nlev,nets:nete) - call t_startf('prim_advance_exp') nm1 = tl%nm1 n0 = tl%n0 @@ -120,9 +118,6 @@ subroutine prim_advance_exp(elem, fvm, deriv, hvcoord, hybrid,dt, tl, nets, net ! (K&G 2nd order method has CFL=4. tiny CFL improvement not worth 2nd order) ! - if (dry_air_species_num > 0) & - call endrun('ERROR: SE dycore not ready for species dependent thermodynamics - ABORT') - call omp_set_nested(.true.) ! default weights for computing mean dynamics fluxes @@ -140,30 +135,23 @@ subroutine prim_advance_exp(elem, fvm, deriv, hvcoord, hybrid,dt, tl, nets, net ! ! make sure Q is updated ! - qwater(:,:,:,nq,ie) = elem(ie)%state%Qdp(:,:,:,m_cnst,qn0)/elem(ie)%state%dp3d(:,:,:,n0) + qwater(:,:,:,nq,ie) = elem(ie)%state%Qdp(:,:,:,m_cnst,qn0)/elem(ie)%state%dp3d(:,:,:,n0) end do end do ! ! compute Cp and kappa=Rdry/cpdry here and not in RK-stages since Q stays constant => Cp and kappa also stays constant ! - if (lcp_moist) then - do ie=nets,nete - call get_cp(qwater(:,:,:,:,ie), & - .true.,inv_cp_full(:,:,:,ie),active_species_idx_dycore=qidx) - end do - else - do ie=nets,nete - inv_cp_full(:,:,:,ie) = 1.0_r8/cpair - end do - end if do ie=nets,nete - call get_kappa_dry(qwater(:,:,:,:,ie),qidx,kappa(:,:,:,ie)) + call get_cp(qwater(:,:,:,:,ie),.true.,& + inv_cp_full(:,:,:,ie), active_species_idx_dycore=qidx) + end do + do ie=nets,nete + call get_kappa_dry(qwater(:,:,:,:,ie), qidx, kappa(:,:,:,ie)) end do dt_vis = dt - if (raytau0>0) call rayleigh_friction(elem,n0,nets,nete,dt) if (tstep_type==1) then ! RK2-SSP 3 stage. matches tracer scheme. optimal SSP CFL, but ! not optimal for regular CFL @@ -318,7 +306,7 @@ end subroutine prim_advance_exp subroutine applyCAMforcing(elem,fvm,np1,np1_qdp,dt_dribble,dt_phys,nets,nete,nsubstep) - use dimensions_mod, only: np, nc, nlev, qsize, ntrac + use dimensions_mod, only: np, nc, nlev, qsize, ntrac, use_cslam use element_mod, only: element_t use control_mod, only: ftype, ftype_conserve use fvm_control_volume_mod, only: fvm_struct @@ -341,7 +329,8 @@ subroutine applyCAMforcing(elem,fvm,np1,np1_qdp,dt_dribble,dt_phys,nets,nete,nsu character(len=*), parameter :: subname = 'applyCAMforcing (SE)' - if (ntrac>0) then + call t_startf('applyCAMforc') + if (use_cslam) then allocate(ftmp_fvm(nc,nc,nlev,ntrac,nets:nete), stat=iret) call check_allocate(iret, subname, 'ftmp_fvm(nc,nc,nlev,ntrac,nets:nete)', & file=__FILE__, line=__LINE__) @@ -377,7 +366,7 @@ subroutine applyCAMforcing(elem,fvm,np1,np1_qdp,dt_dribble,dt_phys,nets,nete,nsu ! do state-update for tracers and "dribbling" forcing for u,v,T ! dt_local = dt_dribble - if (ntrac>0) then + if (use_cslam) then dt_local_tracer = dt_dribble dt_local_tracer_fvm = dt_phys if (nsubstep.ne.1) then @@ -397,7 +386,7 @@ subroutine applyCAMforcing(elem,fvm,np1,np1_qdp,dt_dribble,dt_phys,nets,nete,nsu ! ! tracers ! - if (qsize>0.and.dt_local_tracer>0) then + if (.not.use_cslam.and.dt_local_tracer>0) then #if (defined COLUMN_OPENMP) !$omp parallel do num_threads(tracer_num_threads) private(q,k,i,j,v1) #endif @@ -426,7 +415,7 @@ subroutine applyCAMforcing(elem,fvm,np1,np1_qdp,dt_dribble,dt_phys,nets,nete,nsu else ftmp(:,:,:,:,ie) = 0.0_r8 end if - if (ntrac>0.and.dt_local_tracer_fvm>0) then + if (use_cslam.and.dt_local_tracer_fvm>0) then ! ! Repeat for the fvm tracers: fc holds tendency (fc_new-fc_old)/dt_physics ! @@ -450,13 +439,12 @@ subroutine applyCAMforcing(elem,fvm,np1,np1_qdp,dt_dribble,dt_phys,nets,nete,nsu end do end do else - if (ntrac>0) ftmp_fvm(:,:,:,:,ie) = 0.0_r8 + if (use_cslam) ftmp_fvm(:,:,:,:,ie) = 0.0_r8 end if - - if (ftype_conserve==1) then - call get_dp(elem(ie)%state%Qdp(:,:,:,1:qsize,np1_qdp),MASS_MIXING_RATIO, & - thermodynamic_active_species_idx_dycore,elem(ie)%state%dp3d(:,:,:,np1),pdel) + if (ftype_conserve==1.and..not.use_cslam) then + call get_dp(elem(ie)%state%Qdp(:,:,:,1:qsize,np1_qdp), MASS_MIXING_RATIO, & + thermodynamic_active_species_idx_dycore, elem(ie)%state%dp3d(:,:,:,np1), pdel) do k=1,nlev do j=1,np do i = 1,np @@ -481,34 +469,33 @@ subroutine applyCAMforcing(elem,fvm,np1,np1_qdp,dt_dribble,dt_phys,nets,nete,nsu dt_local*elem(ie)%derived%FM(:,:,:,:) end if end do - if (ntrac>0) then + if (use_cslam) then call output_qdp_var_dynamics(ftmp_fvm(:,:,:,:,:),nc,ntrac,nets,nete,'PDC') else call output_qdp_var_dynamics(ftmp(:,:,:,:,:),np,qsize,nets,nete,'PDC') end if - if (ftype==1.and.nsubstep==1) call calc_tot_energy_dynamics(elem,fvm,nets,nete,np1,np1_qdp,'p2d') - if (ntrac>0) deallocate(ftmp_fvm) + if (ftype==1.and.nsubstep==1) call tot_energy_dyn(elem,fvm,nets,nete,np1,np1_qdp,'p2d') + if (use_cslam) deallocate(ftmp_fvm) + call t_stopf('applyCAMforc') end subroutine applyCAMforcing - subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2,eta_ave_w,inv_cp_full,hvcoord) ! ! take one timestep of: ! u(:,:,:,np) = u(:,:,:,np) + dt2*nu*laplacian**order ( u ) - ! T(:,:,:,np) = T(:,:,:,np) + dt2*nu_s*laplacian**order ( T ) + ! T(:,:,:,np) = T(:,:,:,np) + dt2*nu_t*laplacian**order ( T ) ! ! ! For correct scaling, dt2 should be the same 'dt2' used in the leapfrog advace ! ! - use dynconst, only: gravit, cappa, cpair, tref, lapse_rate - use dyn_thermo, only: get_dp_ref - use dimensions_mod, only: np, nlev, nc, ntrac, npsq, qsize - use dimensions_mod, only: hypervis_dynamic_ref_state,ksponge_end + use physconst, only: cappa, cpair + use cam_thermo, only: get_molecular_diff_coef, get_rho_dry + use dimensions_mod, only: np, nlev, nc, use_cslam, npsq, qsize, ksponge_end use dimensions_mod, only: nu_scale_top,nu_lev,kmvis_ref,kmcnd_ref,rho_ref,km_sponge_factor - use dimensions_mod, only: kmvisi_ref,kmcndi_ref,rhoi_ref - use control_mod, only: nu, nu_s, hypervis_subcycle,hypervis_subcycle_sponge, nu_p, nu_top - use control_mod, only: molecular_diff + use dimensions_mod, only: nu_t_lev + use control_mod, only: nu, nu_t, hypervis_subcycle,hypervis_subcycle_sponge, nu_p, nu_top + use control_mod, only: molecular_diff,sponge_del4_lev use hybrid_mod, only: hybrid_t!, get_loop_ranges use element_mod, only: element_t use derivative_mod, only: derivative_t, laplace_sphere_wk, vlaplace_sphere_wk, vlaplace_sphere_wk_mol @@ -519,14 +506,13 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, use viscosity_mod, only: biharmonic_wk_dp3d use hybvcoord_mod, only: hvcoord_t use fvm_control_volume_mod, only: fvm_struct - use air_composition, only: thermodynamic_active_species_idx_dycore - use dyn_thermo, only: get_molecular_diff_coef,get_rho_dry -!Un-comment once history output has been resolved in CAMDEN -JN: + use air_composition, only: thermodynamic_active_species_idx_dycore +!Un-comment once constituents and history outputs are enabled -JN: ! use cam_history, only: outfld, hist_fld_active type (hybrid_t) , intent(in) :: hybrid type (element_t) , intent(inout), target :: elem(:) - type(fvm_struct) , intent(in) :: fvm(:) + type(fvm_struct) , intent(inout) :: fvm(:) type (EdgeBuffer_t), intent(inout):: edge3 type (derivative_t), intent(in ) :: deriv integer , intent(in) :: nets,nete, nt, qn0 @@ -539,8 +525,6 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, integer :: kbeg, kend, kblk real (kind=r8), dimension(np,np,2,nlev,nets:nete) :: vtens real (kind=r8), dimension(np,np,nlev,nets:nete) :: ttens, dptens - real (kind=r8), dimension(np,np,nlev,nets:nete) :: dp3d_ref, T_ref - real (kind=r8), dimension(np,np,nets:nete) :: ps_ref real (kind=r8), dimension(0:np+1,0:np+1,nlev) :: corners real (kind=r8), dimension(2,2,2) :: cflux real (kind=r8) :: temp (np,np,nlev) @@ -549,60 +533,19 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, type (EdgeDescriptor_t) :: desc real (kind=r8), dimension(np,np) :: lap_t,lap_dp - real (kind=r8), dimension(np,np) :: tmp, tmp2 real (kind=r8), dimension(np,np,ksponge_end,nets:nete):: kmvis,kmcnd,rho_dry - real (kind=r8), dimension(np,np,ksponge_end+1):: kmvisi,kmcndi - real (kind=r8), dimension(np,np,ksponge_end+1):: pint,rhoi_dry - real (kind=r8), dimension(np,np,ksponge_end ):: pmid real (kind=r8), dimension(np,np,nlev) :: tmp_kmvis,tmp_kmcnd real (kind=r8), dimension(np,np,2) :: lap_v - real (kind=r8) :: v1,v2,v1new,v2new,dt,heating,T0,T1 + real (kind=r8) :: v1,v2,v1new,v2new,dt,heating real (kind=r8) :: laplace_fluxes(nc,nc,4) real (kind=r8) :: rhypervis_subcycle real (kind=r8) :: nu_ratio1, ptop, inv_rho - real (kind=r8), dimension(ksponge_end) :: dtemp,du,dv real (kind=r8) :: nu_temp, nu_dp, nu_velo - if (nu_s == 0 .and. nu == 0 .and. nu_p==0 ) return; + if (nu_t == 0 .and. nu == 0 .and. nu_p==0 ) return; ptop = hvcoord%hyai(1)*hvcoord%ps0 - if (hypervis_dynamic_ref_state) then - ! - ! use dynamic reference pressure (P. Callaghan) - ! - call calc_dp3d_reference(elem,edge3,hybrid,nets,nete,nt,hvcoord,dp3d_ref) - do ie=nets,nete - ps_ref(:,:,ie) = ptop + sum(elem(ie)%state%dp3d(:,:,:,nt),3) - end do - else - ! - ! use static reference pressure (hydrostatic balance incl. effect of topography) - ! - do ie=nets,nete - call get_dp_ref(hvcoord%hyai, hvcoord%hybi, hvcoord%ps0,& - elem(ie)%state%phis(:,:),dp3d_ref(:,:,:,ie),ps_ref(:,:,ie)) - end do - endif - ! - ! reference temperature profile (Simmons and Jiabin, 1991, QJRMS, Section 2a) - ! - ! Tref = T0+T1*Exner - ! T1 = .0065*Tref*Cp/g ! = ~191 - ! T0 = Tref-T1 ! = ~97 - ! - T1 = lapse_rate*Tref*cpair/gravit - T0 = Tref-T1 - do ie=nets,nete - do k=1,nlev - dp3d_ref(:,:,k,ie) = ((hvcoord%hyai(k+1)-hvcoord%hyai(k))*hvcoord%ps0 + & - (hvcoord%hybi(k+1)-hvcoord%hybi(k))*ps_ref(:,:,ie)) - tmp = hvcoord%hyam(k)*hvcoord%ps0+hvcoord%hybm(k)*ps_ref(:,:,ie) - tmp2 = (tmp/hvcoord%ps0)**cappa - T_ref(:,:,k,ie) = (T0+T1*tmp2) - end do - end do - kbeg=1; kend=nlev kblk = kend - kbeg + 1 @@ -614,11 +557,10 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! do ic=1,hypervis_subcycle - call calc_tot_energy_dynamics(elem,fvm,nets,nete,nt,qn0,'dBH') + call tot_energy_dyn(elem,fvm,nets,nete,nt,qn0,'dBH') rhypervis_subcycle=1.0_r8/real(hypervis_subcycle,kind=r8) - call biharmonic_wk_dp3d(elem,dptens,dpflux,ttens,vtens,deriv,edge3,hybrid,nt,nets,nete,kbeg,kend,& - dp3d_ref,T_ref) + call biharmonic_wk_dp3d(elem,dptens,dpflux,ttens,vtens,deriv,edge3,hybrid,nt,nets,nete,kbeg,kend) do ie=nets,nete ! compute mean flux @@ -629,7 +571,7 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, do j=1,np do i=1,np elem(ie)%derived%dpdiss_ave(i,j,k)=elem(ie)%derived%dpdiss_ave(i,j,k)+& - rhypervis_subcycle*eta_ave_w*elem(ie)%state%dp3d(i,j,k,nt) + rhypervis_subcycle*eta_ave_w*(elem(ie)%state%dp3d(i,j,k,nt)-elem(ie)%derived%dp_ref(i,j,k)) elem(ie)%derived%dpdiss_biharmonic(i,j,k)=elem(ie)%derived%dpdiss_biharmonic(i,j,k)+& rhypervis_subcycle*eta_ave_w*dptens(i,j,k,ie) enddo @@ -646,14 +588,14 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, !DIR_VECTOR_ALIGNED do j=1,np do i=1,np - ttens(i,j,k,ie) = -nu_s*ttens(i,j,k,ie) + ttens(i,j,k,ie) = -nu_t_lev(k)*ttens(i,j,k,ie) dptens(i,j,k,ie) = -nu_p*dptens(i,j,k,ie) vtens(i,j,1,k,ie) = -nu_lev(k)*vtens(i,j,1,k,ie) vtens(i,j,2,k,ie) = -nu_lev(k)*vtens(i,j,2,k,ie) enddo enddo - if (ntrac>0) then + if (use_cslam) then !OMP_COLLAPSE_SIMD !DIR_VECTOR_ALIGNED do j=1,nc @@ -705,7 +647,7 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, kptr = kbeg - 1 + 2*nlev call edgeVunpack(edge3,vtens(:,:,2,kbeg:kend,ie),kblk,kptr,ie) - if (ntrac>0) then + if (use_cslam) then do k=kbeg,kend temp(:,:,k) = elem(ie)%state%dp3d(:,:,k,nt) / elem(ie)%spheremp ! STATE before DSS corners(0:np+1,0:np+1,k) = 0.0_r8 @@ -715,7 +657,7 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, kptr = kbeg - 1 + 3*nlev call edgeVunpack(edge3,elem(ie)%state%dp3d(:,:,kbeg:kend,nt),kblk,kptr,ie) - if (ntrac>0) then + if (use_cslam) then desc = elem(ie)%desc kptr = kbeg - 1 + 3*nlev @@ -775,10 +717,13 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, enddo end do - call calc_tot_energy_dynamics(elem,fvm,nets,nete,nt,qn0,'dCH') + call tot_energy_dyn(elem,fvm,nets,nete,nt,qn0,'dCH') do ie=nets,nete !$omp parallel do num_threads(vert_num_threads), private(k,i,j,v1,v2,heating) - do k=kbeg,kend + do k=sponge_del4_lev+2,nlev + ! + ! only do "frictional heating" away from sponge + ! !OMP_COLLAPSE_SIMD !DIR_VECTOR_ALIGNED do j=1,np @@ -795,7 +740,7 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, enddo enddo enddo - call calc_tot_energy_dynamics(elem,fvm,nets,nete,nt,qn0,'dAH') + call tot_energy_dyn(elem,fvm,nets,nete,nt,qn0,'dAH') end do ! @@ -805,83 +750,26 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, ! !*************************************************************** ! - ! - ! vertical diffusion - ! - call t_startf('vertical_molec_diff') - if (molecular_diff>1) then - do ie=nets,nete - call get_rho_dry(elem(ie)%state%Qdp(:,:,:,1:qsize,qn0), & - elem(ie)%state%T(:,:,:,nt),ptop,elem(ie)%state%dp3d(:,:,:,nt),& - .true.,rhoi_dry=rhoi_dry(:,:,:), & - active_species_idx_dycore=thermodynamic_active_species_idx_dycore) - ! - ! constant coefficients - ! - do k=1,ksponge_end+1 - kmvisi(:,:,k) = kmvisi_ref(k)*rhoi_dry(:,:,k) - kmcndi(:,:,k) = kmcndi_ref(k)*rhoi_dry(:,:,k) - end do - ! - ! do vertical diffusion - ! - do j=1,np - do i=1,np - call solve_diffusion(dt2,np,nlev,i,j,ksponge_end,pmid,pint,kmcndi(:,:,:)/cpair,elem(ie)%state%T(:,:,:,nt),& - 0,dtemp) - call solve_diffusion(dt2,np,nlev,i,j,ksponge_end,pmid,pint,kmvisi(:,:,:),elem(ie)%state%v(:,:,1,:,nt),1,du) - call solve_diffusion(dt2,np,nlev,i,j,ksponge_end,pmid,pint,kmvisi(:,:,:),elem(ie)%state%v(:,:,2,:,nt),1,dv) - do k=1,ksponge_end - v1 = elem(ie)%state%v(i,j,1,k,nt) - v2 = elem(ie)%state%v(i,j,2,k,nt) - v1new = v1 + du(k) - v2new = v2 + dv(k) - ! - ! frictional heating - ! - heating = 0.5_r8*((v1new*v1new+v2new*v2new) - (v1*v1+v2*v2)) - elem(ie)%state%T(i,j,k,nt)=elem(ie)%state%T(i,j,k,nt) & - -heating*inv_cp_full(i,j,k,ie)+dtemp(k) - elem(ie)%state%v(i,j,1,k,nt)=v1new - elem(ie)%state%v(i,j,2,k,nt)=v2new - end do - end do - end do - end do - end if - call t_stopf('vertical_molec_diff') call t_startf('sponge_diff') ! ! compute coefficients for horizontal diffusion ! - if (molecular_diff>0) then + if (molecular_diff==1) then do ie=nets,nete call get_rho_dry(elem(ie)%state%Qdp(:,:,:,1:qsize,qn0), & - elem(ie)%state%T(:,:,:,nt),ptop,elem(ie)%state%dp3d(:,:,:,nt),& - .true.,rho_dry=rho_dry(:,:,:,ie), & + elem(ie)%state%T(:,:,:,nt), ptop, elem(ie)%state%dp3d(:,:,:,nt),& + .true., rho_dry=rho_dry(:,:,:,ie), & active_species_idx_dycore=thermodynamic_active_species_idx_dycore) end do - if (molecular_diff==1) then - do ie=nets,nete - ! - ! compute molecular diffusion and thermal conductivity coefficients at mid-levels - ! - call get_molecular_diff_coef(elem(ie)%state%T(:,:,:,nt),.false.,km_sponge_factor(1:ksponge_end),kmvis(:,:,:,ie),kmcnd(:,:,:,ie),qsize,& - elem(ie)%state%Qdp(:,:,:,1:qsize,qn0),fact=1.0_r8/elem(ie)%state%dp3d(:,:,1:ksponge_end,nt),& - active_species_idx_dycore=thermodynamic_active_species_idx_dycore) - end do - else + do ie=nets,nete ! - ! constant coefficients + ! compute molecular diffusion and thermal conductivity coefficients at mid-levels ! - do ie=nets,nete - do k=1,ksponge_end - kmvis (:,:,k,ie) = kmvis_ref(k) - kmcnd (:,:,k,ie) = kmcnd_ref(k) - end do - end do - end if + call get_molecular_diff_coef(elem(ie)%state%T(:,:,:,nt), .false., km_sponge_factor(1:ksponge_end), kmvis(:,:,:,ie),& + kmcnd(:,:,:,ie), elem(ie)%state%Qdp(:,:,:,1:qsize,qn0), fact=1.0_r8/elem(ie)%state%dp3d(:,:,1:ksponge_end,nt),& + active_species_idx_dycore=thermodynamic_active_species_idx_dycore) + end do ! ! diagnostics ! @@ -914,7 +802,7 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, call outfld('nu_kmcnd_dp',RESHAPE(tmp_kmcnd(:,:,:), (/npsq,nlev/)), npsq, ie) end do end if -#endif + ! ! scale by reference value ! @@ -924,12 +812,13 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, kmvis(:,:,k,ie) = kmvis(:,:,k,ie)/kmvis_ref(k) end do end do +#endif end if ! ! Horizontal Laplacian diffusion ! dt=dt2/hypervis_subcycle_sponge - call calc_tot_energy_dynamics(elem,fvm,nets,nete,nt,qn0,'dBS') + call tot_energy_dyn(elem,fvm,nets,nete,nt,qn0,'dBS') kblk = ksponge_end do ic=1,hypervis_subcycle_sponge rhypervis_subcycle=1.0_r8/real(hypervis_subcycle_sponge,kind=r8) @@ -986,7 +875,7 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, end do end if - if (ntrac>0.and.nu_dp>0) then + if (use_cslam.and.nu_dp>0) then ! ! mass flux for CSLAM due to sponge layer diffusion on dp ! @@ -1034,7 +923,7 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, kptr = 2*ksponge_end call edgeVunpack(edgeSponge,vtens(:,:,2,1:ksponge_end,ie),kblk,kptr,ie) - if (ntrac>0.and.nu_dp>0.0_r8) then + if (use_cslam.and.nu_dp>0.0_r8) then do k=1,ksponge_end temp(:,:,k) = elem(ie)%state%dp3d(:,:,k,nt) / elem(ie)%spheremp ! STATE before DSS corners(0:np+1,0:np+1,k) = 0.0_r8 @@ -1044,7 +933,7 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, kptr = 3*ksponge_end call edgeVunpack(edgeSponge,elem(ie)%state%dp3d(:,:,1:ksponge_end,nt),kblk,kptr,ie) - if (ntrac>0.and.nu_dp>0.0_r8) then + if (use_cslam.and.nu_dp>0.0_r8) then desc = elem(ie)%desc kptr = 3*ksponge_end @@ -1084,42 +973,42 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, vtens(i,j,2,k,ie)=dt*vtens(i,j,2,k,ie)*elem(ie)%rspheremp(i,j) ttens(i,j,k,ie)=dt*ttens(i,j,k,ie)*elem(ie)%rspheremp(i,j) elem(ie)%state%dp3d(i,j,k,nt)=elem(ie)%state%dp3d(i,j,k,nt)*elem(ie)%rspheremp(i,j) + ! update v first (gives better results than updating v after heating) + elem(ie)%state%v(i,j,:,k,nt)=elem(ie)%state%v(i,j,:,k,nt) + vtens(i,j,:,k,ie) + elem(ie)%state%T(i,j, k,nt)=elem(ie)%state%T(i,j, k,nt) + ttens(i,j, k,ie) enddo enddo enddo - !$omp parallel do num_threads(vert_num_threads) private(k,i,j,v1,v2,v1new,v2new) - do k=1,ksponge_end - !OMP_COLLAPSE_SIMD - !DIR_VECTOR_ALIGNED - do j=1,np - do i=1,np - ! update v first (gives better results than updating v after heating) - elem(ie)%state%v(i,j,:,k,nt)=elem(ie)%state%v(i,j,:,k,nt) + & - vtens(i,j,:,k,ie) - elem(ie)%state%T(i,j,k,nt)=elem(ie)%state%T(i,j,k,nt) & - +ttens(i,j,k,ie) - - v1new=elem(ie)%state%v(i,j,1,k,nt) - v2new=elem(ie)%state%v(i,j,2,k,nt) - v1 =elem(ie)%state%v(i,j,1,k,nt)- vtens(i,j,1,k,ie) - v2 =elem(ie)%state%v(i,j,2,k,nt)- vtens(i,j,2,k,ie) - ! - ! frictional heating - ! - heating = 0.5_r8*(v1new*v1new+v2new*v2new-(v1*v1+v2*v2)) - elem(ie)%state%T(i,j,k,nt)=elem(ie)%state%T(i,j,k,nt) & - -heating*inv_cp_full(i,j,k,ie) + if (molecular_diff.ne.1) then + ! + ! no frictional heating for artificial sponge + ! + !$omp parallel do num_threads(vert_num_threads) private(k,i,j,v1,v2,v1new,v2new) + do k=1,ksponge_end + !OMP_COLLAPSE_SIMD + !DIR_VECTOR_ALIGNED + do j=1,np + do i=1,np + v1new=elem(ie)%state%v(i,j,1,k,nt) + v2new=elem(ie)%state%v(i,j,2,k,nt) + v1 =elem(ie)%state%v(i,j,1,k,nt)- vtens(i,j,1,k,ie) + v2 =elem(ie)%state%v(i,j,2,k,nt)- vtens(i,j,2,k,ie) + ! + ! frictional heating + ! + heating = 0.5_r8*(v1new*v1new+v2new*v2new-(v1*v1+v2*v2)) + elem(ie)%state%T(i,j,k,nt)=elem(ie)%state%T(i,j,k,nt) & + -heating*inv_cp_full(i,j,k,ie) + enddo enddo enddo - enddo + end if end do end do call t_stopf('sponge_diff') - call calc_tot_energy_dynamics(elem,fvm,nets,nete,nt,qn0,'dAS') + call tot_energy_dyn(elem,fvm,nets,nete,nt,qn0,'dAS') end subroutine advance_hypervis_dp - - subroutine compute_and_apply_rhs(np1,nm1,n0,dt2,elem,hvcoord,hybrid,& deriv,nets,nete,eta_ave_w,inv_cp_full,qwater,qidx,kappa) ! =================================== @@ -1141,15 +1030,8 @@ subroutine compute_and_apply_rhs(np1,nm1,n0,dt2,elem,hvcoord,hybrid,& ! allows us to fuse these two loops for more cache reuse ! ! =================================== - use air_composition, only: thermodynamic_active_species_num - use air_composition, only: thermodynamic_active_species_idx_dycore - use air_composition, only: dry_air_species_num - use dyn_thermo, only: get_gz_given_dp_Tv_Rdry - use dyn_thermo, only: get_virtual_temp, get_cp_dry - use dyn_thermo, only: get_R_dry - - !SE dycore: - use dimensions_mod, only: np, nc, nlev, ntrac, ksponge_end + use dimensions_mod, only: np, nc, nlev, use_cslam + use control_mod, only: pgf_formulation use hybrid_mod, only: hybrid_t use element_mod, only: element_t use derivative_mod, only: derivative_t, divergence_sphere, gradient_sphere, vorticity_sphere @@ -1158,7 +1040,10 @@ subroutine compute_and_apply_rhs(np1,nm1,n0,dt2,elem,hvcoord,hybrid,& use edgetype_mod, only: edgedescriptor_t use bndry_mod, only: bndry_exchange use hybvcoord_mod, only: hvcoord_t - use time_mod, only: tevolve + use cam_thermo, only: get_gz, get_virtual_temp + use air_composition, only: thermodynamic_active_species_num, dry_air_species_num + use air_composition, only: get_cp_dry, get_R_dry + use physconst, only: tref,cpair,rga,lapse_rate implicit none integer, intent(in) :: np1,nm1,n0,nets,nete @@ -1189,11 +1074,9 @@ subroutine compute_and_apply_rhs(np1,nm1,n0,dt2,elem,hvcoord,hybrid,& real (kind=r8), dimension(np,np) :: vgrad_T ! v.grad(T) real (kind=r8), dimension(np,np) :: Ephi ! kinetic energy + PHI term real (kind=r8), dimension(np,np,2,nlev) :: grad_p_full - real (kind=r8), dimension(np,np,2,nlev) :: grad_p_m_pmet! gradient(p - p_met) real (kind=r8), dimension(np,np,nlev) :: vort ! vorticity - real (kind=r8), dimension(np,np,nlev) :: p_dry ! pressure dry real (kind=r8), dimension(np,np,nlev) :: dp_dry ! delta pressure dry - real (kind=r8), dimension(np,np,nlev) :: R_dry + real (kind=r8), dimension(np,np,nlev) :: R_dry, cp_dry! real (kind=r8), dimension(np,np,nlev) :: p_full ! pressure real (kind=r8), dimension(np,np,nlev) :: dp_full real (kind=r8), dimension(np,np) :: exner @@ -1203,17 +1086,17 @@ subroutine compute_and_apply_rhs(np1,nm1,n0,dt2,elem,hvcoord,hybrid,& real (kind=r8) :: vtens1(np,np,nlev),vtens2(np,np,nlev),ttens(np,np,nlev) real (kind=r8) :: stashdp3d (np,np,nlev),tempdp3d(np,np), tempflux(nc,nc,4) real (kind=r8) :: ckk, term, T_v(np,np,nlev) - real (kind=r8), dimension(np,np,2) :: grad_exner + real (kind=r8), dimension(np,np,2) :: pgf_term + real (kind=r8), dimension(np,np,2) :: grad_exner,grad_logexner + real (kind=r8) :: T0,T1 real (kind=r8), dimension(np,np) :: theta_v - real (kind=r8), dimension(np,np,nlev) :: cp_dry - type (EdgeDescriptor_t):: desc real (kind=r8) :: sum_water(np,np,nlev), density_inv(np,np) real (kind=r8) :: E,v1,v2,glnps1,glnps2 integer :: i,j,k,kptr,ie - real (kind=r8) :: u_m_umet, v_m_vmet, t_m_tmet, ptop + real (kind=r8) :: ptop !JMD call t_barrierf('sync_compute_and_apply_rhs', hybrid%par%comm) call t_adj_detailf(+1) @@ -1223,17 +1106,16 @@ subroutine compute_and_apply_rhs(np1,nm1,n0,dt2,elem,hvcoord,hybrid,& ! ! compute virtual temperature and sum_water ! - call get_virtual_temp(qwater(:,:,:,:,ie),& - t_v(:,:,:),temp=elem(ie)%state%T(:,:,:,n0),sum_q =sum_water(:,:,:),& - active_species_idx_dycore=qidx) - call get_R_dry(qwater(:,:,:,:,ie),qidx,R_dry) - call get_cp_dry(qwater(:,:,:,:,ie),qidx,cp_dry) + call get_virtual_temp(qwater(:,:,:,:,ie), t_v(:,:,:),temp=elem(ie)%state%T(:,:,:,n0),& + sum_q =sum_water(:,:,:), active_species_idx_dycore=qidx) + call get_R_dry(qwater(:,:,:,:,ie), qidx, R_dry) + call get_cp_dry(qwater(:,:,:,:,ie), qidx, cp_dry) do k=1,nlev dp_dry(:,:,k) = elem(ie)%state%dp3d(:,:,k,n0) dp_full(:,:,k) = sum_water(:,:,k)*dp_dry(:,:,k) end do - call get_gz_given_dp_Tv_Rdry(dp_full,T_v,R_dry,elem(ie)%state%phis,ptop,phi,pmid=p_full) + call get_gz(dp_full, T_v, R_dry, elem(ie)%state%phis, ptop, phi, pmid=p_full) do k=1,nlev ! vertically lagrangian code: we advect dp3d instead of ps ! we also need grad(p) at all levels (not just grad(ps)) @@ -1349,32 +1231,52 @@ subroutine compute_and_apply_rhs(np1,nm1,n0,dt2,elem,hvcoord,hybrid,& ! vtemp = gradient_sphere(Ephi(:,:),deriv,elem(ie)%Dinv) call gradient_sphere(Ephi(:,:),deriv,elem(ie)%Dinv,vtemp) density_inv(:,:) = R_dry(:,:,k)*T_v(:,:,k)/p_full(:,:,k) - - if (dry_air_species_num==0) then - exner(:,:)=(p_full(:,:,k)/hvcoord%ps0)**kappa(:,:,k,ie) - theta_v(:,:)=T_v(:,:,k)/exner(:,:) - call gradient_sphere(exner(:,:),deriv,elem(ie)%Dinv,grad_exner) - - grad_exner(:,:,1) = real(cp_dry(:,:,k), r8)*theta_v(:,:)*grad_exner(:,:,1) - grad_exner(:,:,2) = real(cp_dry(:,:,k), r8)*theta_v(:,:)*grad_exner(:,:,2) + if (pgf_formulation==1.or.(pgf_formulation==3.and.hvcoord%hybm(k)>0._r8)) then + if (dry_air_species_num==0) then + exner(:,:)=(p_full(:,:,k)/hvcoord%ps0)**kappa(:,:,k,ie) + theta_v(:,:)=T_v(:,:,k)/exner(:,:) + call gradient_sphere(exner(:,:),deriv,elem(ie)%Dinv,grad_exner) + pgf_term(:,:,1) = cp_dry(:,:,k)*theta_v(:,:)*grad_exner(:,:,1) + pgf_term(:,:,2) = cp_dry(:,:,k)*theta_v(:,:)*grad_exner(:,:,2) + else + exner(:,:)=(p_full(:,:,k)/hvcoord%ps0)**kappa(:,:,k,ie) + theta_v(:,:)=T_v(:,:,k)/exner(:,:) + call gradient_sphere(exner(:,:),deriv,elem(ie)%Dinv,grad_exner) + call gradient_sphere(kappa(:,:,k,ie),deriv,elem(ie)%Dinv,grad_kappa_term) + suml = exner(:,:)*LOG(p_full(:,:,k)/hvcoord%ps0) + grad_kappa_term(:,:,1)=-suml*grad_kappa_term(:,:,1) + grad_kappa_term(:,:,2)=-suml*grad_kappa_term(:,:,2) + pgf_term(:,:,1) = cp_dry(:,:,k)*theta_v(:,:)*(grad_exner(:,:,1)+grad_kappa_term(:,:,1)) + pgf_term(:,:,2) = cp_dry(:,:,k)*theta_v(:,:)*(grad_exner(:,:,2)+grad_kappa_term(:,:,2)) + end if + ! balanced ref profile correction: + ! reference temperature profile (Simmons and Jiabin, 1991, QJRMS, Section 2a) + ! + ! Tref = T0+T1*Exner + ! T1 = .0065*Tref*Cp/g ! = ~191 + ! T0 = Tref-T1 ! = ~97 + ! + T1 = lapse_rate*Tref*cpair*rga + T0 = Tref-T1 + if (hvcoord%hybm(k)>0) then + !only apply away from constant pressure levels + call gradient_sphere(log(exner(:,:)),deriv,elem(ie)%Dinv,grad_logexner) + pgf_term(:,:,1)=pgf_term(:,:,1) + & + cpair*T0*(grad_logexner(:,:,1)-grad_exner(:,:,1)/exner(:,:)) + pgf_term(:,:,2)=pgf_term(:,:,2) + & + cpair*T0*(grad_logexner(:,:,2)-grad_exner(:,:,2)/exner(:,:)) + end if + elseif (pgf_formulation==2.or.pgf_formulation==3) then + pgf_term(:,:,1) = density_inv(:,:)*grad_p_full(:,:,1,k) + pgf_term(:,:,2) = density_inv(:,:)*grad_p_full(:,:,2,k) else - exner(:,:)=(p_full(:,:,k)/hvcoord%ps0)**kappa(:,:,k,ie) - theta_v(:,:)=T_v(:,:,k)/exner(:,:) - call gradient_sphere(exner(:,:),deriv,elem(ie)%Dinv,grad_exner) - - call gradient_sphere(kappa(:,:,k,ie),deriv,elem(ie)%Dinv,grad_kappa_term) - suml = exner(:,:)*LOG(p_full(:,:,k)/hvcoord%ps0) - grad_kappa_term(:,:,1)=-suml*grad_kappa_term(:,:,1) - grad_kappa_term(:,:,2)=-suml*grad_kappa_term(:,:,2) - - grad_exner(:,:,1) = real(cp_dry(:,:,k), r8)*theta_v(:,:)*(grad_exner(:,:,1)+grad_kappa_term(:,:,1)) - grad_exner(:,:,2) = real(cp_dry(:,:,k), r8)*theta_v(:,:)*(grad_exner(:,:,2)+grad_kappa_term(:,:,2)) + call endrun('ERROR: bad choice of pgf_formulation (must be 1, 2, or 3)') end if do j=1,np do i=1,np - glnps1 = grad_exner(i,j,1) - glnps2 = grad_exner(i,j,2) + glnps1 = pgf_term(i,j,1) + glnps2 = pgf_term(i,j,2) v1 = elem(ie)%state%v(i,j,1,k,n0) v2 = elem(ie)%state%v(i,j,2,k,n0) @@ -1415,7 +1317,7 @@ subroutine compute_and_apply_rhs(np1,nm1,n0,dt2,elem,hvcoord,hybrid,& enddo - if (ntrac>0.and.eta_ave_w.ne.0._r8) then + if (use_cslam.and.eta_ave_w.ne.0._r8) then !OMP_COLLAPSE_SIMD !DIR_VECTOR_ALIGNED do j=1,np @@ -1458,7 +1360,7 @@ subroutine compute_and_apply_rhs(np1,nm1,n0,dt2,elem,hvcoord,hybrid,& kptr=nlev call edgeVunpack(edge3, elem(ie)%state%v(:,:,:,:,np1), 2*nlev, kptr, ie) - if (ntrac>0.and.eta_ave_w.ne.0._r8) then + if (use_cslam.and.eta_ave_w.ne.0._r8) then do k=1,nlev stashdp3d(:,:,k) = elem(ie)%state%dp3d(:,:,k,np1)/elem(ie)%spheremp(:,:) end do @@ -1469,7 +1371,7 @@ subroutine compute_and_apply_rhs(np1,nm1,n0,dt2,elem,hvcoord,hybrid,& kptr=kptr+2*nlev call edgeVunpack(edge3, elem(ie)%state%dp3d(:,:,:,np1),nlev,kptr,ie) - if (ntrac>0.and.eta_ave_w.ne.0._r8) then + if (use_cslam.and.eta_ave_w.ne.0._r8) then desc = elem(ie)%desc call edgeDGVunpack(edge3, corners, nlev, kptr, ie) @@ -1522,7 +1424,6 @@ subroutine compute_and_apply_rhs(np1,nm1,n0,dt2,elem,hvcoord,hybrid,& call t_adj_detailf(-1) end subroutine compute_and_apply_rhs - ! ! corner fluxes for CSLAM ! @@ -1588,39 +1489,52 @@ subroutine distribute_flux_at_corners(cflux, corners, getmapP) endif end subroutine distribute_flux_at_corners - subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suffix) - use dynconst, only: gravit, cpair, rearth, omega - use dyn_thermo, only: get_dp, get_cp - use cam_thermo, only: MASS_MIXING_RATIO - use air_composition, only: thermodynamic_active_species_idx_dycore - use hycoef, only: hyai, ps0 - use string_utils, only: strlist_get_ind + subroutine tot_energy_dyn(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suffix) + use dimensions_mod, only: npsq,nlev,np,nc,use_cslam,qsize + use physconst, only: rga, rearth, omega + use element_mod, only: element_t !Un-comment once constituents and history outputs are enabled -JN: -! use cam_history, only: outfld, hist_fld_active +! use cam_history, only: outfld +! use cam_history_support, only: max_fieldname_len ! use constituents, only: cnst_get_ind - - !SE dycore: - use element_mod, only: element_t - use dimensions_mod, only: npsq,nlev,np,lcp_moist,nc,ntrac,qsize + use string_utils, only: strlist_get_ind + use hycoef, only: hyai, ps0 use fvm_control_volume_mod, only: fvm_struct + use cam_thermo, only: get_dp, MASS_MIXING_RATIO +! ,wvidx,wlidx,wiidx,seidx,keidx,moidx,mridx,ttidx,teidx, & +! poidx,thermo_budget_num_vars,thermo_budget_vars + use cam_thermo, only: get_hydrostatic_energy + use air_composition, only: thermodynamic_active_species_idx_dycore, get_cp + use air_composition, only: thermodynamic_active_species_num, thermodynamic_active_species_idx_dycore + use air_composition, only: thermodynamic_active_species_liq_num,thermodynamic_active_species_liq_idx + use air_composition, only: thermodynamic_active_species_ice_num,thermodynamic_active_species_ice_idx use dimensions_mod, only: cnst_name_gll + use dyn_tests_utils, only: vcoord=>vc_dry_pressure +! use cam_budget, only: thermo_budget_history !------------------------------Arguments-------------------------------- - type (element_t) , intent(in) :: elem(:) - type(fvm_struct) , intent(in) :: fvm(:) + type (element_t) , intent(inout) :: elem(:) + type(fvm_struct) , intent(inout) :: fvm(:) integer , intent(in) :: tl, tl_qdp,nets,nete character*(*) , intent(in) :: outfld_name_suffix ! suffix for "outfld" names !---------------------------Local storage------------------------------- - real(kind=r8) :: se(npsq) ! Dry Static energy (J/m2) - real(kind=r8) :: ke(npsq) ! kinetic energy (J/m2) + real(kind=r8) :: se(np,np) ! Enthalpy energy (J/m2) + real(kind=r8) :: ke(np,np) ! kinetic energy (J/m2) + real(kind=r8) :: po(np,np) ! PHIS term in energy equation (J/m2) + real(kind=r8) :: wv(np,np) ! water vapor + real(kind=r8) :: liq(np,np) ! liquid + real(kind=r8) :: ice(np,np) ! ice + real(kind=r8) :: q(np,nlev,qsize) + integer :: qidx(thermodynamic_active_species_num) real(kind=r8) :: cdp_fvm(nc,nc,nlev) - real(kind=r8) :: se_tmp - real(kind=r8) :: ke_tmp - real(kind=r8) :: ps(np,np) + real(kind=r8) :: cdp(np,np,nlev) + real(kind=r8) :: ptop(np,np) real(kind=r8) :: pdel(np,np,nlev) + real(kind=r8) :: cp(np,np,nlev) + ! ! global axial angular momentum (AAM) can be separated into one part (mr) associatedwith the relative motion ! of the atmosphere with respect to the planets surface (also known as wind AAM) and another part (mo) @@ -1631,28 +1545,19 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf real(kind=r8) :: mo(npsq) ! mass AAM real(kind=r8) :: mr_cnst, mo_cnst, cos_lat, mr_tmp, mo_tmp - real(kind=r8) :: cp(np,np,nlev) - - integer :: ie,i,j,k + integer :: ie,i,j,k,m_cnst,nq,idx integer :: ixwv,ixcldice, ixcldliq, ixtt ! CLDICE, CLDLIQ and test tracer indices - character(len=16) :: name_out1,name_out2,name_out3,name_out4,name_out5,name_out6 - - !----------------------------------------------------------------------- - !Un-comment once history outputs are enabled -JN: #if 0 + character(len=max_fieldname_len) :: name_out(thermo_budget_num_vars) - name_out1 = 'SE_' //trim(outfld_name_suffix) - name_out2 = 'KE_' //trim(outfld_name_suffix) - name_out3 = 'WV_' //trim(outfld_name_suffix) - name_out4 = 'WL_' //trim(outfld_name_suffix) - name_out5 = 'WI_' //trim(outfld_name_suffix) - name_out6 = 'TT_' //trim(outfld_name_suffix) - - if ( hist_fld_active(name_out1).or.hist_fld_active(name_out2).or.hist_fld_active(name_out3).or.& - hist_fld_active(name_out4).or.hist_fld_active(name_out5).or.hist_fld_active(name_out6)) then + !----------------------------------------------------------------------- + if (thermo_budget_history) then + do i=1,thermo_budget_num_vars + name_out(i)=trim(thermo_budget_vars(i))//'_'//trim(outfld_name_suffix) + end do - if (ntrac>0) then + if (use_cslam) then ixwv = 1 call cnst_get_ind('CLDLIQ' , ixcldliq, abort=.false.) call cnst_get_ind('CLDICE' , ixcldice, abort=.false.) @@ -1668,83 +1573,105 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf ! ! Compute frozen static energy in 3 parts: KE, SE, and energy associated with vapor and liquid ! + do nq=1,thermodynamic_active_species_num + qidx(nq) = nq + end do do ie=nets,nete - se = 0.0_r8 - ke = 0.0_r8 - call get_dp(elem(ie)%state%Qdp(:,:,:,1:qsize,tl_qdp),MASS_MIXING_RATIO,thermodynamic_active_species_idx_dycore,& - elem(ie)%state%dp3d(:,:,:,tl),pdel,ps=ps,ptop=hyai(1)*ps0) call get_cp(elem(ie)%state%Qdp(:,:,:,1:qsize,tl_qdp),& - .false.,cp,factor=1.0_r8/elem(ie)%state%dp3d(:,:,:,tl),& + .false., cp, factor=1.0_r8/elem(ie)%state%dp3d(:,:,:,tl),& active_species_idx_dycore=thermodynamic_active_species_idx_dycore) - - ! TODO: need to port cam6_3_109 changes to total energy using get_hydrostatic_energy - ! https://github.com/ESCOMP/CAM/pull/761/files#diff-946bde17289e2f42e43e64413610aa11d102deda8b5199ddaa5b71e67e5d517a - - do k = 1, nlev - do j=1,np - do i = 1, np - ! - ! kinetic energy - ! - ke_tmp = 0.5_r8*(elem(ie)%state%v(i,j,1,k,tl)**2+ elem(ie)%state%v(i,j,2,k,tl)**2)*pdel(i,j,k)/gravit - if (lcp_moist) then - se_tmp = cp(i,j,k)*elem(ie)%state%T(i,j,k,tl)*pdel(i,j,k)/gravit - else - ! - ! using CAM physics definition of internal energy - ! - se_tmp = cpair*elem(ie)%state%T(i,j,k,tl)*pdel(i,j,k)/gravit - end if - se (i+(j-1)*np) = se (i+(j-1)*np) + se_tmp - ke (i+(j-1)*np) = ke (i+(j-1)*np) + ke_tmp - end do - end do - end do + ptop = hyai(1)*ps0 do j=1,np - do i = 1, np - se(i+(j-1)*np) = se(i+(j-1)*np) + elem(ie)%state%phis(i,j)*ps(i,j)/gravit + !get mixing ratio of thermodynamic active species only + !(other tracers not used in get_hydrostatic_energy) + do nq=1,thermodynamic_active_species_num + m_cnst = thermodynamic_active_species_idx_dycore(nq) + q(:,:,m_cnst) = elem(ie)%state%Qdp(:,j,:,m_cnst,tl_qdp)/& + elem(ie)%state%dp3d(:,j,:,tl) end do + call get_hydrostatic_energy(q, & + .false., elem(ie)%state%dp3d(:,j,:,tl), cp(:,j,:), elem(ie)%state%v(:,j,1,:,tl), & + elem(ie)%state%v(:,j,2,:,tl), elem(ie)%state%T(:,j,:,tl), vcoord, ptop=ptop(:,j),& + phis=elem(ie)%state%phis(:,j), dycore_idx=.true., & + se=se(:,j), po=po(:,j), ke=ke(:,j), wv=wv(:,j), liq=liq(:,j), ice=ice(:,j)) end do ! ! Output energy diagnostics on GLL grid ! - call outfld(name_out1 ,se ,npsq,ie) - call outfld(name_out2 ,ke ,npsq,ie) + call outfld(name_out(poidx) ,po ,npsq,ie) + call outfld(name_out(seidx) ,se ,npsq,ie) + call outfld(name_out(keidx) ,ke ,npsq,ie) + call outfld(name_out(teidx) ,ke+se+po ,npsq,ie) ! ! mass variables are output on CSLAM grid if using CSLAM else GLL grid ! - if (ntrac>0) then - if (ixwv>0) then - cdp_fvm = fvm(ie)%c(1:nc,1:nc,:,ixwv)*fvm(ie)%dp_fvm(1:nc,1:nc,:) - call util_function(cdp_fvm,nc,nlev,name_out3,ie) - end if - if (ixcldliq>0) then - cdp_fvm = fvm(ie)%c(1:nc,1:nc,:,ixcldliq)*fvm(ie)%dp_fvm(1:nc,1:nc,:) - call util_function(cdp_fvm,nc,nlev,name_out4,ie) - end if - if (ixcldice>0) then - cdp_fvm = fvm(ie)%c(1:nc,1:nc,:,ixcldice)*fvm(ie)%dp_fvm(1:nc,1:nc,:) - call util_function(cdp_fvm,nc,nlev,name_out5,ie) - end if - if (ixtt>0) then - cdp_fvm = fvm(ie)%c(1:nc,1:nc,:,ixtt)*fvm(ie)%dp_fvm(1:nc,1:nc,:) - call util_function(cdp_fvm,nc,nlev,name_out6,ie) - end if + if (use_cslam) then + if (ixwv>0) then + cdp_fvm = fvm(ie)%c(1:nc,1:nc,:,ixwv)*fvm(ie)%dp_fvm(1:nc,1:nc,:) + call util_function(cdp_fvm,nc,nlev,name_out(wvidx),ie) + end if + ! + ! sum over liquid water + ! + if (thermodynamic_active_species_liq_num>0) then + cdp_fvm = 0.0_r8 + do nq = 1,thermodynamic_active_species_liq_num + cdp_fvm = cdp_fvm + fvm(ie)%c(1:nc,1:nc,:,thermodynamic_active_species_liq_idx(nq))& + *fvm(ie)%dp_fvm(1:nc,1:nc,:) + end do + call util_function(cdp_fvm,nc,nlev,name_out(wlidx),ie) + end if + ! + ! sum over ice water + ! + if (thermodynamic_active_species_ice_num>0) then + cdp_fvm = 0.0_r8 + do nq = 1,thermodynamic_active_species_ice_num + cdp_fvm = cdp_fvm + fvm(ie)%c(1:nc,1:nc,:,thermodynamic_active_species_ice_idx(nq))& + *fvm(ie)%dp_fvm(1:nc,1:nc,:) + end do + call util_function(cdp_fvm,nc,nlev,name_out(wiidx),ie) + end if + if (ixtt>0) then + cdp_fvm = fvm(ie)%c(1:nc,1:nc,:,ixtt)*fvm(ie)%dp_fvm(1:nc,1:nc,:) + call util_function(cdp_fvm,nc,nlev,name_out(ttidx),ie) + end if else - call util_function(elem(ie)%state%qdp(:,:,:,1 ,tl_qdp),np,nlev,name_out3,ie) - if (ixcldliq>0) call util_function(elem(ie)%state%qdp(:,:,:,ixcldliq,tl_qdp),np,nlev,name_out4,ie) - if (ixcldice>0) call util_function(elem(ie)%state%qdp(:,:,:,ixcldice,tl_qdp),np,nlev,name_out5,ie) - if (ixtt>0 ) call util_function(elem(ie)%state%qdp(:,:,:,ixtt ,tl_qdp),np,nlev,name_out6,ie) + cdp = elem(ie)%state%qdp(:,:,:,1,tl_qdp) + call util_function(cdp,np,nlev,name_out(wvidx),ie) + ! + ! sum over liquid water + ! + if (thermodynamic_active_species_liq_num>0) then + cdp = 0.0_r8 + do idx = 1,thermodynamic_active_species_liq_num + cdp = cdp + elem(ie)%state%qdp(:,:,:,thermodynamic_active_species_liq_idx(idx),tl_qdp) + end do + call util_function(cdp,np,nlev,name_out(wlidx),ie) + end if + ! + ! sum over ice water + ! + if (thermodynamic_active_species_ice_num>0) then + cdp = 0.0_r8 + do idx = 1,thermodynamic_active_species_ice_num + cdp = cdp + elem(ie)%state%qdp(:,:,:,thermodynamic_active_species_ice_idx(idx),tl_qdp) + end do + call util_function(cdp,np,nlev,name_out(wiidx),ie) + end if + if (ixtt>0) then + cdp = elem(ie)%state%qdp(:,:,:,ixtt ,tl_qdp) + call util_function(cdp,np,nlev,name_out(ttidx),ie) + end if end if - end do - end if - ! - ! Axial angular momentum diagnostics - ! - ! Code follows - ! - ! Lauritzen et al., (2014): Held-Suarez simulations with the Community Atmosphere Model + end do + ! + ! Axial angular momentum diagnostics + ! + ! Code follows + ! + ! Lauritzen et al., (2014): Held-Suarez simulations with the Community Atmosphere Model ! Spectral Element (CAM-SE) dynamical core: A global axial angularmomentum analysis using Eulerian ! and floating Lagrangian vertical coordinates. J. Adv. Model. Earth Syst. 6,129-140, ! doi:10.1002/2013MS000268 @@ -1752,19 +1679,16 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf ! MR is equation (6) without \Delta A and sum over areas (areas are in units of radians**2) ! MO is equation (7) without \Delta A and sum over areas (areas are in units of radians**2) ! - name_out1 = 'MR_' //trim(outfld_name_suffix) - name_out2 = 'MO_' //trim(outfld_name_suffix) - if ( hist_fld_active(name_out1).or.hist_fld_active(name_out2)) then call strlist_get_ind(cnst_name_gll, 'CLDLIQ', ixcldliq, abort=.false.) call strlist_get_ind(cnst_name_gll, 'CLDICE', ixcldice, abort=.false.) - mr_cnst = rearth**3/gravit - mo_cnst = omega*rearth**4/gravit + mr_cnst = rga*rearth**3 + mo_cnst = rga*omega*rearth**4 do ie=nets,nete mr = 0.0_r8 mo = 0.0_r8 - call get_dp(elem(ie)%state%Qdp(:,:,:,1:qsize,tl_qdp),MASS_MIXING_RATIO,thermodynamic_active_species_idx_dycore,& - elem(ie)%state%dp3d(:,:,:,tl),pdel,ps=ps,ptop=hyai(1)*ps0) + call get_dp(elem(ie)%state%Qdp(:,:,:,1:qsize,tl_qdp), MASS_MIXING_RATIO, thermodynamic_active_species_idx_dycore,& + elem(ie)%state%dp3d(:,:,:,tl), pdel) do k = 1, nlev do j=1,np do i = 1, np @@ -1777,14 +1701,12 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf end do end do end do - call outfld(name_out1 ,mr ,npsq,ie) - call outfld(name_out2 ,mo ,npsq,ie) + call outfld(name_out(mridx) ,mr ,npsq,ie) + call outfld(name_out(moidx) ,mo ,npsq,ie) end do - end if - + endif ! if thermo budget history #endif - - end subroutine calc_tot_energy_dynamics + end subroutine tot_energy_dyn subroutine output_qdp_var_dynamics(qdp,nx,num_trac,nets,nete,outfld_name) use dimensions_mod, only: nlev,ntrac @@ -1833,7 +1755,7 @@ end subroutine output_qdp_var_dynamics ! column integrate mass-variable and outfld ! subroutine util_function(f_in,nx,nz,name_out,ie) - use dynconst, only: gravit + use physconst, only: rga !Un-comment once history outputs are enabled -JN: ! use cam_history, only: outfld, hist_fld_active integer, intent(in) :: nx,nz,ie @@ -1841,12 +1763,10 @@ subroutine util_function(f_in,nx,nz,name_out,ie) character(len=16), intent(in) :: name_out real(kind=r8) :: f_out(nx*nx) integer :: i,j,k - real(kind=r8) :: inv_g !Un-comment once history outputs are enabled -JN: #if 0 if (hist_fld_active(name_out)) then f_out = 0.0_r8 - inv_g = 1.0_r8/gravit do k = 1, nz do j = 1, nx do i = 1, nx @@ -1854,21 +1774,21 @@ subroutine util_function(f_in,nx,nz,name_out,ie) end do end do end do - f_out = f_out*inv_g + f_out = f_out*rga call outfld(name_out,f_out,nx*nx,ie) end if #endif end subroutine util_function subroutine compute_omega(hybrid,n0,qn0,elem,deriv,nets,nete,dt,hvcoord) - use control_mod, only : nu_p, hypervis_subcycle - use dimensions_mod, only : np, nlev, qsize - use hybrid_mod, only : hybrid_t - use element_mod, only : element_t - use derivative_mod, only : divergence_sphere, derivative_t,gradient_sphere - use hybvcoord_mod, only : hvcoord_t - use edge_mod, only : edgevpack, edgevunpack - use bndry_mod, only : bndry_exchange + use control_mod, only: nu_p, hypervis_subcycle + use dimensions_mod, only: np, nlev, qsize + use hybrid_mod, only: hybrid_t + use element_mod, only: element_t + use derivative_mod, only: divergence_sphere, derivative_t,gradient_sphere + use hybvcoord_mod, only: hvcoord_t + use edge_mod, only: edgevpack, edgevunpack + use bndry_mod, only: bndry_exchange use viscosity_mod, only: biharmonic_wk_omega use air_composition,only: thermodynamic_active_species_num use air_composition,only: thermodynamic_active_species_idx_dycore @@ -1887,13 +1807,13 @@ subroutine compute_omega(hybrid,n0,qn0,elem,deriv,nets,nete,dt,hvcoord) real (kind=r8) :: dp_full(np,np,nlev) real (kind=r8) :: p_full(np,np,nlev),grad_p_full(np,np,2),vgrad_p_full(np,np,nlev) real (kind=r8) :: divdp_full(np,np,nlev),vdp_full(np,np,2) - real(kind=r8) :: Otens(np,np ,nlev,nets:nete), dt_hyper, sum_water(np,np,nlev) + real(kind=r8) :: Otens(np,np ,nlev,nets:nete), dt_hyper logical, parameter :: del4omega = .true. do ie=nets,nete - call get_dp(elem(ie)%state%Qdp(:,:,:,1:qsize,qn0),MASS_MIXING_RATIO,& - thermodynamic_active_species_idx_dycore,elem(ie)%state%dp3d(:,:,:,n0),dp_full) + call get_dp(elem(ie)%state%Qdp(:,:,:,1:qsize,qn0), MASS_MIXING_RATIO,& + thermodynamic_active_species_idx_dycore, elem(ie)%state%dp3d(:,:,:,n0), dp_full) do k=1,nlev if (k==1) then p_full(:,:,k) = hvcoord%hyai(k)*hvcoord%ps0 + dp_full(:,:,k)/2 @@ -1975,366 +1895,4 @@ subroutine compute_omega(hybrid,n0,qn0,elem,deriv,nets,nete,dt,hvcoord) !call FreeEdgeBuffer(edgeOmega) end subroutine compute_omega - - subroutine calc_dp3d_reference(elem,edge3,hybrid,nets,nete,nt,hvcoord,dp3d_ref) - ! - ! calc_dp3d_reference: When the del^4 horizontal damping is applied to dp3d - ! the values are implicitly affected by natural variations - ! due to surface topography. - ! - ! To account for these physicaly correct variations, use - ! the current state values to compute appropriate - ! reference values for the current (lagrangian) ETA-surfaces. - ! Damping should then be applied to values relative to - ! this reference. - !======================================================================= - use hybvcoord_mod , only: hvcoord_t - use dynconst, only: rair, cappa - use element_mod, only: element_t - use dimensions_mod, only: np,nlev - use hybrid_mod, only: hybrid_t - use edge_mod, only: edgevpack, edgevunpack - use bndry_mod, only: bndry_exchange - ! - ! Passed variables - !------------------- - type(element_t ),target,intent(inout):: elem(:) - type(EdgeBuffer_t) ,intent(inout):: edge3 - type(hybrid_t ) ,intent(in ):: hybrid - integer ,intent(in ):: nets,nete - integer ,intent(in ):: nt - type(hvcoord_t ) ,intent(in ):: hvcoord - real(kind=r8) ,intent(out ):: dp3d_ref(np,np,nlev,nets:nete) - ! - ! Local Values - !-------------- - real(kind=r8):: Phis_avg(np,np, nets:nete) - real(kind=r8):: Phi_avg (np,np,nlev,nets:nete) - real(kind=r8):: RT_avg (np,np,nlev,nets:nete) - real(kind=r8):: P_val (np,np,nlev) - real(kind=r8):: Ps_val (np,np) - real(kind=r8):: Phi_val (np,np,nlev) - real(kind=r8):: Phi_ival(np,np) - real(kind=r8):: I_Phi (np,np,nlev+1) - real(kind=r8):: Alpha (np,np,nlev ) - real(kind=r8):: I_P (np,np,nlev+1) - real(kind=r8):: DP_avg (np,np,nlev) - real(kind=r8):: P_avg (np,np,nlev) - real(kind=r8):: Ps_avg (np,np) - real(kind=r8):: Ps_ref (np,np) - real(kind=r8):: RT_lapse(np,np) - real(kind=r8):: dlt_Ps (np,np) - real(kind=r8):: dPhi (np,np,nlev) - real(kind=r8):: dPhis (np,np) - real(kind=r8):: E_Awgt,E_phis,E_phi(nlev),E_T(nlev),Lapse0,Expon0 - integer :: ie,ii,jj,kk,kptr - - ! Loop over elements - !-------------------- - do ie=nets,nete - - ! Calculate Pressure values from dp3dp - !-------------------------------------- - P_val(:,:,1) = hvcoord%hyai(1)*hvcoord%ps0 + elem(ie)%state%dp3d(:,:,1,nt)*0.5_r8 - do kk=2,nlev - P_val(:,:,kk) = P_val(:,:,kk-1) & - + elem(ie)%state%dp3d(:,:,kk-1,nt)*0.5_r8 & - + elem(ie)%state%dp3d(:,:,kk ,nt)*0.5_r8 - end do - Ps_val(:,:) = P_val(:,:,nlev) + elem(ie)%state%dp3d(:,:,nlev,nt)*0.5_r8 - - ! Calculate (dry) geopotential values - !-------------------------------------- - dPhi (:,:,:) = 0.5_r8*(rair*elem(ie)%state%T (:,:,:,nt) & - *elem(ie)%state%dp3d(:,:,:,nt) & - /P_val(:,:,:) ) - Phi_val (:,:,nlev) = elem(ie)%state%phis(:,:) + dPhi(:,:,nlev) - Phi_ival(:,:) = elem(ie)%state%phis(:,:) + dPhi(:,:,nlev)*2._r8 - do kk=(nlev-1),1,-1 - Phi_val (:,:,kk) = Phi_ival(:,:) + dPhi(:,:,kk) - Phi_ival(:,:) = Phi_val (:,:,kk) + dPhi(:,:,kk) - end do - - ! Calculate Element averages - !---------------------------- - E_Awgt = 0.0_r8 - E_phis = 0.0_r8 - E_phi(:) = 0._r8 - E_T (:) = 0._r8 - do jj=1,np - do ii=1,np - E_Awgt = E_Awgt + elem(ie)%spheremp(ii,jj) - E_phis = E_phis + elem(ie)%spheremp(ii,jj)*elem(ie)%state%phis(ii,jj) - E_phi (:) = E_phi (:) + elem(ie)%spheremp(ii,jj)*Phi_val(ii,jj,:) - E_T (:) = E_T (:) + elem(ie)%spheremp(ii,jj)*elem(ie)%state%T(ii,jj,:,nt) - end do - end do - - Phis_avg(:,:,ie) = E_phis/E_Awgt - do kk=1,nlev - Phi_avg(:,:,kk,ie) = E_phi(kk) /E_Awgt - RT_avg (:,:,kk,ie) = E_T (kk)*rair/E_Awgt - end do - end do ! ie=nets,nete - - ! Boundary Exchange of average values - !------------------------------------- - do ie=nets,nete - Phis_avg(:,:,ie) = elem(ie)%spheremp(:,:)*Phis_avg(:,:,ie) - do kk=1,nlev - Phi_avg(:,:,kk,ie) = elem(ie)%spheremp(:,:)*Phi_avg(:,:,kk,ie) - RT_avg (:,:,kk,ie) = elem(ie)%spheremp(:,:)*RT_avg (:,:,kk,ie) - end do - kptr = 0 - call edgeVpack(edge3,Phi_avg(:,:,:,ie),nlev,kptr,ie) - kptr = nlev - call edgeVpack(edge3,RT_avg (:,:,:,ie),nlev,kptr,ie) - kptr = 2*nlev - call edgeVpack(edge3,Phis_avg (:,:,ie),1 ,kptr,ie) - end do ! ie=nets,nete - - call bndry_exchange(hybrid,edge3,location='calc_dp3d_reference') - - do ie=nets,nete - kptr = 0 - call edgeVunpack(edge3,Phi_avg(:,:,:,ie),nlev,kptr,ie) - kptr = nlev - call edgeVunpack(edge3,RT_avg (:,:,:,ie),nlev,kptr,ie) - kptr = 2*nlev - call edgeVunpack(edge3,Phis_avg (:,:,ie),1 ,kptr,ie) - Phis_avg(:,:,ie) = elem(ie)%rspheremp(:,:)*Phis_avg(:,:,ie) - do kk=1,nlev - Phi_avg(:,:,kk,ie) = elem(ie)%rspheremp(:,:)*Phi_avg(:,:,kk,ie) - RT_avg (:,:,kk,ie) = elem(ie)%rspheremp(:,:)*RT_avg (:,:,kk,ie) - end do - end do ! ie=nets,nete - - ! Loop over elements - !-------------------- - do ie=nets,nete - - ! Fill elements with uniformly varying average values - !----------------------------------------------------- - call fill_element(Phis_avg(1,1,ie)) - do kk=1,nlev - call fill_element(Phi_avg(1,1,kk,ie)) - call fill_element(RT_avg (1,1,kk,ie)) - end do - - ! Integrate upward to compute Alpha == (dp3d/P) - !---------------------------------------------- - I_Phi(:,:,nlev+1) = Phis_avg(:,:,ie) - do kk=nlev,1,-1 - I_Phi(:,:,kk) = 2._r8* Phi_avg(:,:,kk,ie) - I_Phi(:,:,kk+1) - Alpha(:,:,kk) = 2._r8*(Phi_avg(:,:,kk,ie) - I_Phi(:,:,kk+1))/RT_avg(:,:,kk,ie) - end do - - ! Integrate downward to compute corresponding average pressure values - !--------------------------------------------------------------------- - I_P(:,:,1) = hvcoord%hyai(1)*hvcoord%ps0 - do kk=1,nlev - DP_avg(:,:,kk ) = I_P(:,:,kk)*(2._r8 * Alpha(:,:,kk))/(2._r8 - Alpha(:,:,kk)) - P_avg (:,:,kk ) = I_P(:,:,kk)*(2._r8 )/(2._r8 - Alpha(:,:,kk)) - I_P (:,:,kk+1) = I_P(:,:,kk)*(2._r8 + Alpha(:,:,kk))/(2._r8 - Alpha(:,:,kk)) - end do - Ps_avg(:,:) = I_P(:,:,nlev+1) - - ! Determine an appropriate d/d lapse rate near the surface - ! OPTIONALLY: Use dry adiabatic lapse rate or environmental lapse rate. - !----------------------------------------------------------------------- - if(.FALSE.) then - ! DRY ADIABATIC laspe rate - !------------------------------ - RT_lapse(:,:) = -1._r8*cappa - else - ! ENVIRONMENTAL (empirical) laspe rate - !-------------------------------------- - RT_lapse(:,:) = (RT_avg (:,:,nlev-1,ie)-RT_avg (:,:,nlev,ie)) & - /(Phi_avg(:,:,nlev-1,ie)-Phi_avg(:,:,nlev,ie)) - endif - - ! Calcualte reference surface pressure - !-------------------------------------- - dPhis(:,:) = elem(ie)%state%phis(:,:)-Phis_avg(:,:,ie) - do jj=1,np - do ii=1,np - if (abs(RT_lapse(ii,jj)) .gt. 1.e-3_r8) then - Lapse0 = RT_lapse(ii,jj)/RT_avg(ii,jj,nlev,ie) - Expon0 = (-1._r8/RT_lapse(ii,jj)) - Ps_ref(ii,jj) = Ps_avg(ii,jj)*((1._r8 + Lapse0*dPhis(ii,jj))**Expon0) - else - Ps_ref(ii,jj) = Ps_avg(ii,jj)*exp(-dPhis(ii,jj)/RT_avg(ii,jj,nlev,ie)) - endif - end do - end do - - ! Calculate reference dp3d values - !--------------------------------- - dlt_Ps(:,:) = Ps_ref(:,:) - Ps_avg(:,:) - do kk=1,nlev - dp3d_ref(:,:,kk,ie) = DP_avg(:,:,kk) + (hvcoord%hybi(kk+1) & - -hvcoord%hybi(kk ))*dlt_Ps(:,:) - end do - - end do ! ie=nets,nete - - ! End Routine - !------------ - return - end subroutine calc_dp3d_reference - !============================================================================= - - - !============================================================================= - subroutine fill_element(Eval) - ! - ! fill_element_bilin: Fill in element gridpoints using local bi-linear - ! interpolation of nearby average values. - ! - ! NOTE: This routine is hard coded for NP=4, if a - ! different value of NP is used... bad things - ! will happen. - !======================================================================= - use dimensions_mod,only: np - ! - ! Passed variables - !------------------- - real(kind=r8),intent(inout):: Eval(np,np) - ! - ! Local Values - !-------------- - real(kind=r8):: X0 - real(kind=r8):: S1,S2,S3,S4 - real(kind=r8):: C1,C2,C3,C4 - real(kind=r8):: E1,E2,E3,E4,E0 - - X0 = sqrt(1._r8/5._r8) - - ! Set the "known" values Eval - !---------------------------- - S1 = (Eval(1 ,2 )+Eval(1 ,3 ))/2._r8 - S2 = (Eval(2 ,np)+Eval(3 ,np))/2._r8 - S3 = (Eval(np,2 )+Eval(np,3 ))/2._r8 - S4 = (Eval(2 ,1 )+Eval(3 ,1 ))/2._r8 - C1 = Eval(1 ,1 ) - C2 = Eval(1 ,np) - C3 = Eval(np,np) - C4 = Eval(np,1 ) - - ! E0 OPTION: Element Center value: - !--------------------------------- - IF(.FALSE.) THEN - ! Use ELEMENT AVERAGE value contained in (2,2) - !---------------------------------------------- - E0 = Eval(2,2) - ELSE - ! Use AVG OF SIDE VALUES after boundary exchange of E0 (smooting option) - !----------------------------------------------------------------------- - E0 = (S1 + S2 + S3 + S4)/4._r8 - ENDIF - - ! Calc interior values along center axes - !---------------------------------------- - E1 = E0 + X0*(S1-E0) - E2 = E0 + X0*(S2-E0) - E3 = E0 + X0*(S3-E0) - E4 = E0 + X0*(S4-E0) - - ! Calculate Side Gridpoint Values for Eval - !------------------------------------------ - Eval(1 ,2 ) = S1 + X0*(C1-S1) - Eval(1 ,3 ) = S1 + X0*(C2-S1) - Eval(2 ,np) = S2 + X0*(C2-S2) - Eval(3 ,np) = S2 + X0*(C3-S2) - Eval(np,2 ) = S3 + X0*(C4-S3) - Eval(np,3 ) = S3 + X0*(C3-S3) - Eval(2 ,1 ) = S4 + X0*(C1-S4) - Eval(3 ,1 ) = S4 + X0*(C4-S4) - - ! Calculate interior values - !--------------------------- - Eval(2 ,2 ) = E1 + X0*(Eval(2 ,1 )-E1) - Eval(2 ,3 ) = E1 + X0*(Eval(2 ,np)-E1) - Eval(3 ,2 ) = E3 + X0*(Eval(3 ,1 )-E3) - Eval(3 ,3 ) = E3 + X0*(Eval(3 ,np)-E3) - - ! End Routine - !------------ - return - end subroutine fill_element - - subroutine rayleigh_friction(elem,nt,nets,nete,dt) - use dimensions_mod, only: nlev, otau - use hybrid_mod, only: hybrid_t!, get_loop_ranges - use element_mod, only: element_t - - type (element_t) , intent(inout), target :: elem(:) - integer , intent(in) :: nets,nete, nt - real(r8) :: dt - - real(r8) :: c1, c2 - integer :: k,ie - - do ie=nets,nete - do k=1,nlev - c2 = 1._r8 / (1._r8 + otau(k)*dt) - c1 = -otau(k) * c2 * dt - elem(ie)%state%v(:,:,:,k,nt) = elem(ie)%state%v(:,:,:,k,nt)+c1 * elem(ie)%state%v(:,:,:,k,nt) -! ptend%s(:ncol,k) = c3 * (state%u(:ncol,k)**2 + state%v(:ncol,k)**2) - enddo - end do - end subroutine rayleigh_friction - - - - subroutine solve_diffusion(dt,nx,nlev,i,j,nlay,pmid,pint,km,fld,boundary_condition,dfld) - use dynconst, only: gravit - real(kind=r8), intent(in) :: dt - integer , intent(in) :: nlay, nlev,nx, i, j - real(kind=r8), intent(in) :: pmid(nx,nx,nlay),pint(nx,nx,nlay+1),km(nx,nx,nlay+1) - real(kind=r8), intent(in) :: fld(nx,nx,nlev) - real(kind=r8), intent(out) :: dfld(nlay) - integer :: boundary_condition - ! - real(kind=r8), dimension(nlay) :: current_guess,next_iterate - real(kind=r8) :: alp, alm, value_level0 - integer :: k,iter, niterations=4 - - ! Make the guess for the next time step equal to the initial value - current_guess(:)= fld(i,j,1:nlay) - do iter = 1, niterations - ! two formulations of the upper boundary condition - !next_iterate(1) = (initial_value(1) + alp * current_guess(i+1) + alm * current_guess(1)) /(1. + alp + alm) ! top BC, u'=0 - if (boundary_condition==0) then - next_iterate(1) = fld(i,j,1) ! u doesn't get prognosed by diffusion at top - else if (boundary_condition==1) then - value_level0 = 0.75_r8*fld(i,j,1) ! value above sponge - k=1 - alp = dt*(km(i,j,k+1)*gravit*gravit/(pmid(i,j,k)-pmid(i,j,k+1)))/(pint(i,j,k)-pint(i,j,k+1)) - alm = dt*(km(i,j,k )*gravit*gravit/(0.5_r8*(pmid(i,j,1)-pmid(i,j,2))))/(pint(i,j,k)-pint(i,j,k+1)) - next_iterate(k) = (fld(i,j,k) + alp * current_guess(k+1) + alm * value_level0)/(1._r8 + alp + alm) - else - ! - ! set fld'=0 at model top - ! - k=1 - alp = dt*(km(i,j,k+1)*gravit*gravit/(pmid(i,j,k)-pmid(i,j,k+1)))/(pint(i,j,k)-pint(i,j,k+1)) - alm = dt*(km(i,j,k )*gravit*gravit/(0.5_r8*(pmid(i,j,1)-pmid(i,j,2))))/(pint(i,j,k)-pint(i,j,k+1)) - next_iterate(k) = (fld(i,j,1) + alp * current_guess(2) + alm * current_guess(1))/(1._r8 + alp + alm) - end if - do k = 2, nlay-1 - alp = dt*(km(i,j,k+1)*gravit*gravit/(pmid(i,j,k )-pmid(i,j,k+1)))/(pint(i,j,k)-pint(i,j,k+1)) - alm = dt*(km(i,j,k )*gravit*gravit/(pmid(i,j,k-1)-pmid(i,j,k )))/(pint(i,j,k)-pint(i,j,k+1)) - next_iterate(k) = (fld(i,j,k) + alp * current_guess(k+1) + alm * current_guess(k-1))/(1._r8 + alp + alm) - end do - next_iterate(nlay) = (fld(i,j,nlay) + alp * fld(i,j,nlay) + alm * current_guess(nlay-1))/(1._r8 + alp + alm) ! bottom BC - - ! before the next iterate, make the current guess equal to the values of the last iteration - current_guess(:) = next_iterate(:) - end do - dfld(:) = next_iterate(:) - fld(i,j,1:nlay) - - end subroutine solve_diffusion - - end module prim_advance_mod diff --git a/src/dynamics/se/dycore/prim_advection_mod.F90 b/src/dynamics/se/dycore/prim_advection_mod.F90 index f1ea126e..e0add527 100644 --- a/src/dynamics/se/dycore/prim_advection_mod.F90 +++ b/src/dynamics/se/dycore/prim_advection_mod.F90 @@ -22,7 +22,7 @@ module prim_advection_mod use element_mod, only: element_t use fvm_control_volume_mod, only: fvm_struct use hybvcoord_mod, only: hvcoord_t - use time_mod, only: TimeLevel_t, TimeLevel_Qdp + use se_dyn_time_mod, only: TimeLevel_t, TimeLevel_Qdp use control_mod, only: nu_q, nu_p, limiter_option, hypervis_subcycle_q, rsplit use edge_mod, only: edgevpack, edgevunpack, initedgebuffer, initedgesbuffer @@ -44,7 +44,7 @@ module prim_advection_mod public :: prim_advec_tracers_fvm public :: vertical_remap - type (EdgeBuffer_t) :: edgeAdv, edgeAdvp1, edgeAdvQminmax, edgeAdv1, edgeveloc + type (EdgeBuffer_t) :: edgeAdv, edgeAdvp1, edgeAdvQminmax, edgeveloc integer,parameter :: DSSeta = 1 integer,parameter :: DSSomega = 2 @@ -62,7 +62,7 @@ module prim_advection_mod subroutine Prim_Advec_Init1(par, elem) - use dimensions_mod, only: nlev, qsize, nelemd,ntrac + use dimensions_mod, only: nlev, qsize, nelemd,ntrac,use_cslam use parallel_mod, only: parallel_t, boundaryCommMethod use cam_abortutils, only: check_allocate type(parallel_t) :: par @@ -82,7 +82,7 @@ subroutine Prim_Advec_Init1(par, elem) ! ! Set the number of threads used in the subroutine Prim_Advec_tracers_remap() ! - if (ntrac>0) then + if (use_cslam) then advec_remap_num_threads = 1 else advec_remap_num_threads = tracer_num_threads @@ -91,17 +91,17 @@ subroutine Prim_Advec_Init1(par, elem) ! allocate largest one first ! Currently this is never freed. If it was, only this first one should ! be freed, as only it knows the true size of the buffer. - call initEdgeBuffer(par,edgeAdvp1,elem,qsize*nlev + nlev,bndry_type=boundaryCommMethod,& - nthreads=horz_num_threads*advec_remap_num_threads) - call initEdgeBuffer(par,edgeAdv,elem,qsize*nlev,bndry_type=boundaryCommMethod, & - nthreads=horz_num_threads*advec_remap_num_threads) - ! This is a different type of buffer pointer allocation - ! used for determine the minimum and maximum value from - ! neighboring elements - call initEdgeSBuffer(par,edgeAdvQminmax,elem,qsize*nlev*2,bndry_type=boundaryCommMethod, & - nthreads=horz_num_threads*advec_remap_num_threads) - - call initEdgeBuffer(par,edgeAdv1,elem,nlev,bndry_type=boundaryCommMethod) + if (.not.use_cslam) then + call initEdgeBuffer(par,edgeAdvp1,elem,qsize*nlev + nlev,bndry_type=boundaryCommMethod,& + nthreads=horz_num_threads*advec_remap_num_threads) + call initEdgeBuffer(par,edgeAdv,elem,qsize*nlev,bndry_type=boundaryCommMethod, & + nthreads=horz_num_threads*advec_remap_num_threads) + ! This is a different type of buffer pointer allocation + ! used for determine the minimum and maximum value from + ! neighboring elements + call initEdgeSBuffer(par,edgeAdvQminmax,elem,qsize*nlev*2,bndry_type=boundaryCommMethod, & + nthreads=horz_num_threads*advec_remap_num_threads) + end if call initEdgeBuffer(par,edgeveloc,elem,2*nlev,bndry_type=boundaryCommMethod) @@ -231,9 +231,9 @@ end subroutine euler_step_driver !----------------------------------------------------------------------------- !----------------------------------------------------------------------------- subroutine Prim_Advec_Tracers_remap_rk2( elem , deriv , hvcoord , hybrid , dt , tl , nets , nete ) - use derivative_mod, only : divergence_sphere - use control_mod , only : qsplit - use hybrid_mod , only : get_loop_ranges!, PrintHybrid + use derivative_mod, only: divergence_sphere + use control_mod , only: qsplit + use hybrid_mod , only: get_loop_ranges!, PrintHybrid ! use thread_mod , only : omp_set_num_threads, omp_get_thread_num type (element_t) , intent(inout) :: elem(:) @@ -321,7 +321,7 @@ subroutine qdp_time_avg( elem , rkstage , n0_qdp , np1_qdp , hybrid , nets , net use hybrid_mod, only : hybrid_t, get_loop_ranges implicit none type(element_t) , intent(inout) :: elem(:) - integer , intent(in ) :: rkstage , n0_qdp , np1_qdp , nets , nete + integer , intent(in ) :: rkstage , n0_qdp , np1_qdp , nets , nete type(hybrid_t) :: hybrid integer :: i,j,ie,q,k integer :: kbeg,kend,qbeg,qend @@ -948,22 +948,23 @@ subroutine vertical_remap(hybrid,elem,fvm,hvcoord,np1,np1_qdp,nets,nete) ! ! map tracers ! map velocity components - ! map temperature (either by mapping thermal energy or virtual temperature over log(p) + ! map temperature (either by mapping enthalpy or virtual temperature + ! over log(p) ! (controlled by vert_remap_uvTq_alg > -20 or <= -20) ! - use hybvcoord_mod , only: hvcoord_t - use vertremap_mod , only: remap1 - use hybrid_mod , only: hybrid_t, config_thread_region,get_loop_ranges, PrintHybrid + use hybvcoord_mod, only: hvcoord_t + use vertremap_mod, only: remap1 + use hybrid_mod, only: hybrid_t, config_thread_region,get_loop_ranges, PrintHybrid use fvm_control_volume_mod, only: fvm_struct - use dimensions_mod , only: ntrac - use dimensions_mod , only: lcp_moist, kord_tr,kord_tr_cslam - use cam_logfile , only: iulog - use dynconst , only: pi - use dyn_thermo , only: get_enthalpy, get_dp, get_virtual_temp - use cam_thermo , only: MASS_MIXING_RATIO - use air_composition , only: thermodynamic_active_species_idx_dycore - use thread_mod , only: omp_set_nested - use control_mod , only: vert_remap_uvTq_alg + use dimensions_mod, only: use_cslam, ntrac + use dimensions_mod, only: kord_tr,kord_tr_cslam + use cam_logfile, only: iulog + use dynconst, only: pi + use air_composition, only: thermodynamic_active_species_idx_dycore + use dyn_thermo, only: get_enthalpy, get_virtual_temp, get_dp + use cam_thermo, only: MASS_MIXING_RATIO + use thread_mod, only: omp_set_nested + use control_mod, only: vert_remap_uvTq_alg type (hybrid_t), intent(in) :: hybrid ! distributed parallel structure (shared) type(fvm_struct), intent(inout) :: fvm(:) @@ -974,7 +975,7 @@ subroutine vertical_remap(hybrid,elem,fvm,hvcoord,np1,np1_qdp,nets,nete) type (hvcoord_t) :: hvcoord integer :: ie,i,j,k,np1,nets,nete,np1_qdp,q, m_cnst real (kind=r8), dimension(np,np,nlev) :: dp_moist,dp_star_moist, dp_dry,dp_star_dry - real (kind=r8), dimension(np,np,nlev) :: internal_energy_star + real (kind=r8), dimension(np,np,nlev) :: enthalpy_star real (kind=r8), dimension(np,np,nlev,2):: ttmp real(r8), parameter :: rad2deg = 180.0_r8/pi integer :: region_num_threads,qbeg,qend,kord_uvT(1) @@ -989,23 +990,20 @@ subroutine vertical_remap(hybrid,elem,fvm,hvcoord,np1,np1_qdp,nets,nete) ! prepare for mapping of temperature ! if (vert_remap_uvTq_alg>-20) then - if (lcp_moist) then - ! - ! compute internal energy on Lagrangian levels - ! (do it here since qdp is overwritten by remap1) - ! - call get_enthalpy(elem(ie)%state%qdp(:,:,:,1:qsize,np1_qdp), & - elem(ie)%state%t(:,:,:,np1),elem(ie)%state%dp3d(:,:,:,np1),internal_energy_star, & - active_species_idx_dycore=thermodynamic_active_species_idx_dycore) - end if + ! + ! compute enthalpy on Lagrangian levels + ! (do it here since qdp is overwritten by remap1) + ! + call get_enthalpy(elem(ie)%state%qdp(:,:,:,1:qsize,np1_qdp), & + elem(ie)%state%t(:,:,:,np1), elem(ie)%state%dp3d(:,:,:,np1), enthalpy_star, & + active_species_idx_dycore=thermodynamic_active_species_idx_dycore) else ! ! map Tv over log(p) following FV and FV3 ! - call get_virtual_temp(elem(ie)%state%qdp(:,:,:,1:qsize,np1_qdp), & - internal_energy_star,dp_dry=elem(ie)%state%dp3d(:,:,:,np1), & - active_species_idx_dycore=thermodynamic_active_species_idx_dycore) - internal_energy_star = internal_energy_star*elem(ie)%state%t(:,:,:,np1) + call get_virtual_temp(elem(ie)%state%qdp(:,:,:,1:qsize,np1_qdp), enthalpy_star, & + dp_dry=elem(ie)%state%dp3d(:,:,:,np1), active_species_idx_dycore=thermodynamic_active_species_idx_dycore) + enthalpy_star = enthalpy_star*elem(ie)%state%t(:,:,:,np1) end if ! ! update final psdry @@ -1013,17 +1011,18 @@ subroutine vertical_remap(hybrid,elem,fvm,hvcoord,np1,np1_qdp,nets,nete) elem(ie)%state%psdry(:,:) = ptop + & sum(elem(ie)%state%dp3d(:,:,:,np1),3) ! - ! compute dry vertical coordinate (Lagrangian and reference levels) + ! compute dry vertical coordinate (Lagrangian and reference + ! levels) ! do k=1,nlev dp_star_dry(:,:,k) = elem(ie)%state%dp3d(:,:,k,np1) - dp_dry(:,:,k) = ( hvcoord%hyai(k+1) - hvcoord%hyai(k) )*hvcoord%ps0 + & - ( hvcoord%hybi(k+1) - hvcoord%hybi(k) )*elem(ie)%state%psdry(:,:) + dp_dry(:,:,k) = ( hvcoord%hyai(k+1) - hvcoord%hyai(k))*hvcoord%ps0 + & + ( hvcoord%hybi(k+1) - hvcoord%hybi(k))*elem(ie)%state%psdry(:,:) elem(ie)%state%dp3d(:,:,k,np1) = dp_dry(:,:,k) enddo ! call get_dp(elem(ie)%state%Qdp(:,:,:,1:qsize,np1_qdp),MASS_MIXING_RATIO,& - thermodynamic_active_species_idx_dycore,dp_star_dry,dp_star_moist(:,:,:)) + thermodynamic_active_species_idx_dycore, dp_star_dry,dp_star_moist(:,:,:)) ! ! Check if Lagrangian leves have crossed ! @@ -1037,7 +1036,7 @@ subroutine vertical_remap(hybrid,elem,fvm,hvcoord,np1,np1_qdp,nets,nete) elem(ie)%spherep(i,j)%lon*rad2deg,elem(ie)%spherep(i,j)%lat*rad2deg write(iulog,*) " " do k=1,nlev - write(iulog,'(A21,I5,A1,f12.8,3f8.2)') "k,dp_star_moist,u,v,T: ",k," ",dp_star_moist(i,j,k)/100.0_r8,& + write(iulog,'(A21,I5,A1,f16.12,3f10.2)')"k,dp_star_moist,u,v,T: ",k," ",dp_star_moist(i,j,k)/100.0_r8,& elem(ie)%state%v(i,j,1,k,np1),elem(ie)%state%v(i,j,2,k,np1),elem(ie)%state%T(i,j,k,np1) end do end if @@ -1051,42 +1050,35 @@ subroutine vertical_remap(hybrid,elem,fvm,hvcoord,np1,np1_qdp,nets,nete) ! compute moist reference pressure level thickness ! call get_dp(elem(ie)%state%Qdp(:,:,:,1:qsize,np1_qdp),MASS_MIXING_RATIO,& - thermodynamic_active_species_idx_dycore,dp_dry,dp_moist(:,:,:)) + thermodynamic_active_species_idx_dycore, dp_dry,dp_moist(:,:,:)) ! ! Remapping of temperature ! if (vert_remap_uvTq_alg>-20) then ! - ! remap internal energy and back out temperature + ! remap enthalpy energy and back out temperature ! - if (lcp_moist) then - call remap1(internal_energy_star,np,1,1,1,dp_star_dry,dp_dry,ptop,1,.true.,kord_uvT) - ! - ! compute sum c^(l)_p*m^(l)*dp on arrival (Eulerian) grid - ! - ttmp(:,:,:,1) = 1.0_r8 - call get_enthalpy(elem(ie)%state%qdp(:,:,:,1:qsize,np1_qdp), & - ttmp(:,:,:,1),dp_dry,ttmp(:,:,:,2), & - active_species_idx_dycore=thermodynamic_active_species_idx_dycore) - elem(ie)%state%t(:,:,:,np1)=internal_energy_star/ttmp(:,:,:,2) - else - internal_energy_star(:,:,:)=elem(ie)%state%t(:,:,:,np1)*dp_star_moist - call remap1(internal_energy_star,np,1,1,1,dp_star_moist,dp_moist,ptop,1,.true.,kord_uvT) - elem(ie)%state%t(:,:,:,np1)=internal_energy_star/dp_moist - end if + call remap1(enthalpy_star,np,1,1,1,dp_star_dry,dp_dry,ptop,1,.true.,kord_uvT) + ! + ! compute sum c^(l)_p*m^(l)*dp on arrival (Eulerian) grid + ! + ttmp(:,:,:,1) = 1.0_r8 + call get_enthalpy(elem(ie)%state%qdp(:,:,:,1:qsize,np1_qdp), & + ttmp(:,:,:,1), dp_dry,ttmp(:,:,:,2), & + active_species_idx_dycore=thermodynamic_active_species_idx_dycore) + elem(ie)%state%t(:,:,:,np1)=enthalpy_star/ttmp(:,:,:,2) else ! ! map Tv over log(p); following FV and FV3 ! - call remap1(internal_energy_star,np,1,1,1,dp_star_moist,dp_moist,ptop,1,.false.,kord_uvT) - call get_virtual_temp(elem(ie)%state%qdp(:,:,:,1:qsize,np1_qdp), & - ttmp(:,:,:,1),dp_dry=dp_dry, & - active_species_idx_dycore=thermodynamic_active_species_idx_dycore) + call remap1(enthalpy_star,np,1,1,1,dp_star_moist,dp_moist,ptop,1,.false.,kord_uvT) + call get_virtual_temp(elem(ie)%state%qdp(:,:,:,1:qsize,np1_qdp), ttmp(:,:,:,1), & + dp_dry=dp_dry,active_species_idx_dycore=thermodynamic_active_species_idx_dycore) ! ! convert new Tv to T ! - elem(ie)%state%t(:,:,:,np1)=internal_energy_star/ttmp(:,:,:,1) + elem(ie)%state%t(:,:,:,np1)=enthalpy_star/ttmp(:,:,:,1) end if ! ! remap velocity components @@ -1095,7 +1087,7 @@ subroutine vertical_remap(hybrid,elem,fvm,hvcoord,np1,np1_qdp,nets,nete) call remap1(elem(ie)%state%v(:,:,2,:,np1),np,1,1,1,dp_star_moist,dp_moist,ptop,-1,.false.,kord_uvT) enddo - if (ntrac>0) then + if (use_cslam) then ! ! vertical remapping of CSLAM tracers ! @@ -1112,14 +1104,15 @@ subroutine vertical_remap(hybrid,elem,fvm,hvcoord,np1,np1_qdp,nets,nete) end do end do end do - if(ntrac>tracer_num_threads) then + if(ntrac>tracer_num_threads) then call omp_set_nested(.true.) - !$OMP PARALLEL NUM_THREADS(tracer_num_threads), DEFAULT(SHARED), PRIVATE(hybridnew2,qbeg,qend) + !$OMP PARALLEL NUM_THREADS(tracer_num_threads), + !DEFAULT(SHARED), PRIVATE(hybridnew2,qbeg,qend) hybridnew2 = config_thread_region(hybrid,'ctracer') call get_loop_ranges(hybridnew2, qbeg=qbeg, qend=qend) call remap1(fvm(ie)%c(1:nc,1:nc,:,1:ntrac),nc,qbeg,qend,ntrac,dpc_star, & fvm(ie)%dp_fvm(1:nc,1:nc,:),ptop,0,.false.,kord_tr_cslam) - !$OMP END PARALLEL + !$OMP END PARALLEL call omp_set_nested(.false.) else call remap1(fvm(ie)%c(1:nc,1:nc,:,1:ntrac),nc,1,ntrac,ntrac,dpc_star, & diff --git a/src/dynamics/se/dycore/prim_driver_mod.F90 b/src/dynamics/se/dycore/prim_driver_mod.F90 index fdee231f..bd9680af 100644 --- a/src/dynamics/se/dycore/prim_driver_mod.F90 +++ b/src/dynamics/se/dycore/prim_driver_mod.F90 @@ -26,10 +26,10 @@ module prim_driver_mod subroutine prim_init2(elem, fvm, hybrid, nets, nete, tl, hvcoord) use dimensions_mod, only: irecons_tracer, fvm_supercycling - use dimensions_mod, only: fv_nphys, ntrac, nc + use dimensions_mod, only: fv_nphys, nc use parallel_mod, only: syncmp - use time_mod, only: timelevel_t, tstep, phys_tscale, nsplit, TimeLevel_Qdp - use time_mod, only: nsplit_baseline,rsplit_baseline + use se_dyn_time_mod, only: timelevel_t, tstep, phys_tscale, nsplit, TimeLevel_Qdp + use se_dyn_time_mod, only: nsplit_baseline,rsplit_baseline use prim_state_mod, only: prim_printstate use control_mod, only: runtype, topology, rsplit, qsplit, rk_stage_user, & nu, nu_q, nu_div, hypervis_subcycle, hypervis_subcycle_q, & @@ -40,6 +40,9 @@ subroutine prim_init2(elem, fvm, hybrid, nets, nete, tl, hvcoord) use hybvcoord_mod, only: hvcoord_t use prim_advection_mod, only: prim_advec_init2,deriv use prim_advance_mod, only: compute_omega + use physconst, only: rga, cappa, cpair, tref, lapse_rate + use dyn_thermo, only: get_dp_ref + use physconst, only: pstd type (element_t), intent(inout) :: elem(:) type (fvm_struct), intent(inout) :: fvm(:) @@ -56,13 +59,16 @@ subroutine prim_init2(elem, fvm, hybrid, nets, nete, tl, hvcoord) ! Local variables ! ================================== + ! variables used to calculate CFL ! variables used to calculate CFL real (kind=r8) :: dtnu ! timestep*viscosity parameter - real (kind=r8) :: dt_dyn_vis ! viscosity timestep used in dynamics - real (kind=r8) :: dt_dyn_del2_sponge, dt_remap + real (kind=r8) :: dt_dyn_del2_sponge real (kind=r8) :: dt_tracer_vis ! viscosity timestep used in tracers + real (kind=r8) :: dt_dyn_vis ! viscosity timestep + real (kind=r8) :: dt_remap ! remapping timestep - real (kind=r8) :: dp + real (kind=r8) :: dp,dp0,T1,T0,pmid_ref(np,np) + real (kind=r8) :: ps_ref(np,np,nets:nete) integer :: i,j,k,ie,t,q integer :: n0,n0_qdp @@ -120,7 +126,7 @@ subroutine prim_init2(elem, fvm, hybrid, nets, nete, tl, hvcoord) ! so only now does HOMME learn the timstep. print them out: call print_cfl(elem,hybrid,nets,nete,dtnu,& !p top and p mid levels - hvcoord%hyai(1)*hvcoord%ps0,(hvcoord%hyam(:)+hvcoord%hybm(:))*hvcoord%ps0,& + hvcoord%hyai(1)*hvcoord%ps0,hvcoord%hyam(:)*hvcoord%ps0+hvcoord%hybm(:)*pstd,& !dt_remap,dt_tracer_fvm,dt_tracer_se tstep*qsplit*rsplit,tstep*qsplit*fvm_supercycling,tstep*qsplit,& !dt_dyn,dt_dyn_visco,dt_tracer_visco, dt_phys @@ -138,6 +144,39 @@ subroutine prim_init2(elem, fvm, hybrid, nets, nete, tl, hvcoord) n0=tl%n0 call TimeLevel_Qdp( tl, qsplit, n0_qdp) call compute_omega(hybrid,n0,n0_qdp,elem,deriv,nets,nete,dt_remap,hvcoord) + ! + ! pre-compute pressure-level thickness reference profile + ! + do ie=nets,nete + call get_dp_ref(hvcoord%hyai, hvcoord%hybi, hvcoord%ps0, elem(ie)%state%phis(:,:), & + elem(ie)%derived%dp_ref(:,:,:), ps_ref(:,:,ie)) + end do + ! + ! pre-compute reference temperature profile (Simmons and Jiabin, 1991, QJRMS, Section 2a + ! doi: https://doi.org/10.1002/qj.49711749703c) + ! + ! Tref = T0+T1*Exner + ! T1 = .0065*Tref*Cp/g ! = ~191 + ! T0 = Tref-T1 ! = ~97 + ! + T1 = lapse_rate*Tref*cpair*rga + T0 = Tref-T1 + do ie=nets,nete + do k=1,nlev + pmid_ref =hvcoord%hyam(k)*hvcoord%ps0 + hvcoord%hybm(k)*ps_ref(:,:,ie) + dp0 = ( hvcoord%hyai(k+1) - hvcoord%hyai(k) )*hvcoord%ps0 + & + ( hvcoord%hybi(k+1) - hvcoord%hybi(k) )*hvcoord%ps0 + if (hvcoord%hybm(k)>0) then + elem(ie)%derived%T_ref(:,:,k) = T0+T1*(pmid_ref/hvcoord%ps0)**cappa + ! + ! pel@ucar.edu: resolved noise issue over Antartica + ! + elem(ie)%derived%dp_ref(:,:,k) = elem(ie)%derived%dp_ref(:,:,k)-dp0 + else + elem(ie)%derived%T_ref(:,:,k) = 0.0_r8 + end if + end do + end do if (hybrid%masterthread) write(iulog,*) "initial state:" call prim_printstate(elem, tl, hybrid,nets,nete, fvm) @@ -146,8 +185,7 @@ end subroutine prim_init2 !=======================================================================================================! - - subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubstep, omega_cn) + subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubstep, single_column, omega_cn) ! ! advance all variables (u,v,T,ps,Q,C) from time t to t + dt_q ! @@ -181,17 +219,17 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst ! ! use hybvcoord_mod, only : hvcoord_t - use time_mod, only: TimeLevel_t, timelevel_update, timelevel_qdp, nsplit - use control_mod, only: statefreq,qsplit, rsplit, variable_nsplit + use se_dyn_time_mod, only: TimeLevel_t, timelevel_update, timelevel_qdp, nsplit + use control_mod, only: statefreq,qsplit, rsplit, variable_nsplit, dribble_in_rsplit_loop use prim_advance_mod, only: applycamforcing - use prim_advance_mod, only: calc_tot_energy_dynamics,compute_omega + use prim_advance_mod, only: tot_energy_dyn,compute_omega use prim_state_mod, only: prim_printstate, adjust_nsplit use prim_advection_mod, only: vertical_remap, deriv use thread_mod, only: omp_get_thread_num use perf_mod , only: t_startf, t_stopf use fvm_mod , only: fill_halo_fvm, ghostBufQnhc_h - use dimensions_mod, only: ntrac,fv_nphys, ksponge_end - + use dimensions_mod, only: use_cslam,fv_nphys + use fvm_mapping, only: cslam2gll type (element_t) , intent(inout) :: elem(:) type(fvm_struct), intent(inout) :: fvm(:) type (hybrid_t), intent(in) :: hybrid ! distributed parallel structure (shared) @@ -201,6 +239,7 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst real(kind=r8), intent(in) :: dt ! "timestep dependent" timestep type (TimeLevel_t), intent(inout):: tl integer, intent(in) :: nsubstep ! nsubstep = 1 .. nsplit + logical, intent(in) :: single_column real (kind=r8) , intent(inout):: omega_cn(2,nets:nete) !min and max of vertical Courant number real(kind=r8) :: dt_q, dt_remap, dt_phys @@ -208,7 +247,6 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst real (kind=r8) :: dp_np1(np,np) real (kind=r8) :: dp_start(np,np,nlev+1,nets:nete),dp_end(np,np,nlev,nets:nete) logical :: compute_diagnostics - ! =================================== ! Main timestepping loop ! =================================== @@ -245,12 +283,39 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst call TimeLevel_Qdp( tl, qsplit, n0_qdp) - call calc_tot_energy_dynamics(elem,fvm,nets,nete,tl%n0,n0_qdp,'dAF') - call ApplyCAMForcing(elem,fvm,tl%n0,n0_qdp,dt_remap,dt_phys,nets,nete,nsubstep) - call calc_tot_energy_dynamics(elem,fvm,nets,nete,tl%n0,n0_qdp,'dBD') + if (dribble_in_rsplit_loop==0) then + call tot_energy_dyn(elem,fvm,nets,nete,tl%n0,n0_qdp,'dAF') + call ApplyCAMForcing(elem,fvm,tl%n0,n0_qdp,dt_remap,dt_phys,nets,nete,nsubstep) + call tot_energy_dyn(elem,fvm,nets,nete,tl%n0,n0_qdp,'dBD') + end if do r=1,rsplit if (r.ne.1) call TimeLevel_update(tl,"leapfrog") - call prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,r) + ! + ! if nsplit==1 and physics time-step is long then there will be noise in the + ! pressure field; hence "dripple" in tendencies + ! + if (dribble_in_rsplit_loop==1) then + call tot_energy_dyn(elem,fvm,nets,nete,tl%n0,n0_qdp,'dAF') + call ApplyCAMForcing(elem,fvm,tl%n0,n0_qdp,dt,dt_phys,nets,nete,MAX(nsubstep,r)) + call tot_energy_dyn(elem,fvm,nets,nete,tl%n0,n0_qdp,'dBD') + end if + ! + ! right after physics overwrite Qdp with CSLAM values + ! + if (use_cslam.and.nsubstep==1.and.r==1) then + call tot_energy_dyn(elem,fvm,nets,nete,tl%n0,n0_qdp,'dAF') + call cslam2gll(elem, fvm, hybrid,nets,nete, tl%n0, n0_qdp) + call tot_energy_dyn(elem,fvm,nets,nete,tl%n0,n0_qdp,'dBD') + end if + call tot_energy_dyn(elem,fvm,nets,nete,tl%n0,n0_qdp,'dBL') + if (single_column) then + ! Single Column Case + ! Loop over rsplit vertically lagrangian timesteps + call prim_step_scm(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,r) + else + call prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,r,nsubstep==nsplit,dt_remap) + end if + call tot_energy_dyn(elem,fvm,nets,nete,tl%np1,n0_qdp,'dAL') enddo @@ -263,7 +328,7 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst ! always for tracers !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - call calc_tot_energy_dynamics(elem,fvm,nets,nete,tl%np1,np1_qdp,'dAD') + call tot_energy_dyn(elem,fvm,nets,nete,tl%np1,np1_qdp,'dAD') if (variable_nsplit.or.compute_diagnostics) then ! @@ -280,9 +345,9 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! time step is complete. !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - call calc_tot_energy_dynamics(elem,fvm,nets,nete,tl%np1,np1_qdp,'dAR') + call tot_energy_dyn(elem,fvm,nets,nete,tl%np1,np1_qdp,'dAR') - if (nsubstep==nsplit) then + if (nsubstep==nsplit.and. .not. single_column) then call compute_omega(hybrid,tl%np1,np1_qdp,elem,deriv,nets,nete,dt_remap,hvcoord) end if @@ -326,7 +391,6 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst end do end do end do - if (nsubstep==nsplit.and.variable_nsplit) then call t_startf('adjust_nsplit') call adjust_nsplit(elem, tl, hybrid,nets,nete, fvm, omega_cn) @@ -341,7 +405,7 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst call prim_printstate(elem, tl, hybrid,nets,nete, fvm, omega_cn) end if - if (ntrac>0.and.nsubstep==nsplit.and.nc.ne.fv_nphys) then + if (use_cslam.and.nsubstep==nsplit.and.nc.ne.fv_nphys) then ! ! fill the fvm halo for mapping in d_p_coupling if ! physics grid resolution is different than fvm resolution @@ -351,8 +415,7 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst end subroutine prim_run_subcycle - - subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep) + subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep, last_step,dt_remap) ! ! Take qsplit dynamics steps and one tracer step ! for vertically lagrangian option, this subroutine does only the horizontal step @@ -370,18 +433,19 @@ subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep) ! tl%n0 time t + dt_q ! use hybvcoord_mod, only: hvcoord_t - use time_mod, only: TimeLevel_t, timelevel_update + use se_dyn_time_mod, only: TimeLevel_t, timelevel_update use control_mod, only: statefreq, qsplit, nu_p use thread_mod, only: omp_get_thread_num use prim_advance_mod, only: prim_advance_exp use prim_advection_mod, only: prim_advec_tracers_remap, prim_advec_tracers_fvm, deriv use derivative_mod, only: subcell_integration use hybrid_mod, only: set_region_num_threads, config_thread_region, get_loop_ranges - use dimensions_mod, only: ntrac,fvm_supercycling,fvm_supercycling_jet + use dimensions_mod, only: use_cslam,fvm_supercycling,fvm_supercycling_jet use dimensions_mod, only: kmin_jet, kmax_jet use fvm_mod, only: ghostBufQnhc_vh,ghostBufQ1_vh, ghostBufFlux_vh use fvm_mod, only: ghostBufQ1_h,ghostBufQnhcJet_h, ghostBufFluxJet_h - + use se_dyn_time_mod, only: timelevel_qdp + use fvm_mapping, only: cslam2gll #ifdef waccm_debug use cam_history, only: outfld #endif @@ -396,6 +460,8 @@ subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep) real(kind=r8), intent(in) :: dt ! "timestep dependent" timestep type (TimeLevel_t), intent(inout) :: tl integer, intent(in) :: rstep ! vertical remap subcycling step + logical, intent(in) :: last_step! last step before d_p_coupling + real(kind=r8), intent(in) :: dt_remap type (hybrid_t):: hybridnew,hybridnew2 real(kind=r8) :: st, st1, dp, dt_q @@ -403,6 +469,7 @@ subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep) integer :: ithr integer :: region_num_threads integer :: kbeg,kend + integer :: n0_qdp, np1_qdp real (kind=r8) :: tempdp3d(np,np), x real (kind=r8) :: tempmass(nc,nc) @@ -456,7 +523,7 @@ subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep) ! defer final timelevel update until after Q update. enddo #ifdef HOMME_TEST_SUB_ELEMENT_MASS_FLUX - if (ntrac>0.and.rstep==1) then + if (use_cslam.and.rstep==1) then do ie=nets,nete do k=1,nlev tempdp3d = elem(ie)%state%dp3d(:,:,k,tl%np1) - & @@ -480,7 +547,6 @@ subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep) end do end if #endif - ! current dynamics state variables: ! derived%dp = dp at start of timestep ! derived%vn0 = mean horiz. flux: U*dp @@ -500,32 +566,19 @@ subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep) ! special case in CAM: if CSLAM tracers are turned on , qsize=1 but this tracer should ! not be advected. This will be cleaned up when the physgrid is merged into CAM trunk ! Currently advecting all species - if (qsize > 0) then - + if (.not.use_cslam) then call t_startf('prim_advec_tracers_remap') - if(ntrac>0) then - ! Deactivate threading in the tracer dimension if this is a CSLAM run - region_num_threads = 1 - else - region_num_threads=tracer_num_threads - endif + region_num_threads=tracer_num_threads call omp_set_nested(.true.) !$OMP PARALLEL NUM_THREADS(region_num_threads), DEFAULT(SHARED), PRIVATE(hybridnew) - if(ntrac>0) then - ! Deactivate threading in the tracer dimension if this is a CSLAM run - hybridnew = config_thread_region(hybrid,'serial') - else - hybridnew = config_thread_region(hybrid,'tracer') - endif + hybridnew = config_thread_region(hybrid,'tracer') call Prim_Advec_Tracers_remap(elem, deriv,hvcoord,hybridnew,dt_q,tl,nets,nete) !$OMP END PARALLEL call omp_set_nested(.false.) call t_stopf('prim_advec_tracers_remap') - end if - ! - ! only run fvm transport every fvm_supercycling rstep - ! - if (ntrac>0) then + else + ! + ! only run fvm transport every fvm_supercycling rstep ! ! FVM transport ! @@ -557,7 +610,9 @@ subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep) fvm(ie)%psc(i,j) = sum(fvm(ie)%dp_fvm(i,j,:)) + hvcoord%hyai(1)*hvcoord%ps0 end do end do - end do + end do + call TimeLevel_Qdp( tl, qsplit, n0_qdp, np1_qdp) + if (.not.last_step) call cslam2gll(elem, fvm, hybrid,nets,nete, tl%np1, np1_qdp) else if ((mod(rstep,fvm_supercycling_jet) == 0)) then ! ! shorter fvm time-step in jet region @@ -572,11 +627,84 @@ subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep) (/nc*nc,nlev/)), nc*nc, ie) end do #endif - endif + endif end subroutine prim_step + subroutine prim_step_scm(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep) + ! + ! prim_step version for single column model (SCM) + ! Here we simply want to compute the floating level tendency + ! based on the prescribed large scale vertical velocity + ! Take qsplit dynamics steps and one tracer step + ! for vertically lagrangian option, this subroutine does only + ! the horizontal step + ! + ! input: + ! tl%nm1 not used + ! tl%n0 data at time t + ! tl%np1 new values at t+dt_q + ! + ! then we update timelevel pointers: + ! tl%nm1 = tl%n0 + ! tl%n0 = tl%np1 + ! so that: + ! tl%nm1 tracers: t dynamics: t+(qsplit-1)*dt + ! tl%n0 time t + dt_q + ! + use hybvcoord_mod, only: hvcoord_t + use se_dyn_time_mod, only: TimeLevel_t, timelevel_update + use control_mod, only: statefreq, qsplit, nu_p + use prim_advection_mod, only: deriv + use hybrid_mod, only: config_thread_region, get_loop_ranges + type (element_t) , intent(inout) :: elem(:) + type(fvm_struct), intent(inout) :: fvm(:) + type (hybrid_t), intent(in) :: hybrid ! distributed parallel structure (shared) + type (hvcoord_t), intent(in) :: hvcoord ! hybrid vertical coordinate struct + integer, intent(in) :: nets ! starting thread element number (private) + integer, intent(in) :: nete ! ending thread element number (private) + real(kind=r8), intent(in) :: dt ! "timestep dependent" timestep + type (TimeLevel_t), intent(inout) :: tl + integer, intent(in) :: rstep ! vertical remap subcycling step + + integer :: ie,n + ! =============== + ! initialize mean flux accumulation variables and save some variables at n0 + ! for use by advection + ! =============== + do ie=nets,nete + elem(ie)%derived%vn0=0 ! mean horizontal mass flux + if (nu_p>0) then + elem(ie)%derived%dpdiss_ave=0 + elem(ie)%derived%dpdiss_biharmonic=0 + endif + elem(ie)%derived%dp(:,:,:)=elem(ie)%state%dp3d(:,:,:,tl%n0) + enddo + + ! =============== + ! Dynamical Step + ! =============== +#ifdef scam + call t_startf('set_prescribed_scm') + + call set_prescribed_scm(elem, fvm, deriv, hvcoord, & + hybrid, dt, tl, nets, nete) + + call t_stopf('set_prescribed_scm') + + do n=2,qsplit + call TimeLevel_update(tl,"leapfrog") + + call t_startf('set_prescribed_scm') + + call set_prescribed_scm(elem, fvm, deriv, hvcoord, & + hybrid, dt, tl, nets, nete) + + call t_stopf('set_prescribed_scm') + enddo +#endif + end subroutine prim_step_scm !=======================================================================================================! diff --git a/src/dynamics/se/dycore/prim_init.F90 b/src/dynamics/se/dycore/prim_init.F90 index b0e8e425..b884ca80 100644 --- a/src/dynamics/se/dycore/prim_init.F90 +++ b/src/dynamics/se/dycore/prim_init.F90 @@ -30,7 +30,7 @@ subroutine prim_init1(elem, fvm, par, Tl) use element_mod, only: element_t, allocate_element_dims, allocate_element_desc use fvm_mod, only: fvm_init1 use mesh_mod, only: MeshUseMeshFile - use time_mod, only: timelevel_init, timelevel_t + use se_dyn_time_mod, only: timelevel_init, timelevel_t use mass_matrix_mod, only: mass_matrix use derivative_mod, only: allocate_subcell_integration_matrix_cslam use derivative_mod, only: allocate_subcell_integration_matrix_physgrid @@ -332,25 +332,9 @@ subroutine prim_init1(elem, fvm, par, Tl) elem(ie)%derived%FQ=0.0_r8 elem(ie)%derived%FT=0.0_r8 elem(ie)%derived%FDP=0.0_r8 - elem(ie)%derived%pecnd=0.0_r8 elem(ie)%derived%Omega=0 elem(ie)%state%dp3d=0 - - elem(ie)%derived%etadot_prescribed = nan - elem(ie)%derived%u_met = nan - elem(ie)%derived%v_met = nan - elem(ie)%derived%dudt_met = nan - elem(ie)%derived%dvdt_met = nan - elem(ie)%derived%T_met = nan - elem(ie)%derived%dTdt_met = nan - elem(ie)%derived%ps_met = nan - elem(ie)%derived%dpsdt_met = nan - elem(ie)%derived%nudge_factor = nan - - elem(ie)%derived%Utnd=0._r8 - elem(ie)%derived%Vtnd=0._r8 - elem(ie)%derived%Ttnd=0._r8 end do ! ========================================================== diff --git a/src/dynamics/se/dycore/prim_state_mod.F90 b/src/dynamics/se/dycore/prim_state_mod.F90 index 6395c169..84f9aee2 100644 --- a/src/dynamics/se/dycore/prim_state_mod.F90 +++ b/src/dynamics/se/dycore/prim_state_mod.F90 @@ -4,7 +4,7 @@ module prim_state_mod use dimensions_mod, only: nlev, np, nc, qsize_d, ntrac use parallel_mod, only: ordered use hybrid_mod, only: hybrid_t - use time_mod, only: timelevel_t, TimeLevel_Qdp, time_at + use se_dyn_time_mod, only: timelevel_t, TimeLevel_Qdp, time_at use control_mod, only: qsplit, statediag_numtrac use global_norms_mod, only: global_integrals_general use element_mod, only: element_t @@ -19,14 +19,14 @@ module prim_state_mod CONTAINS subroutine prim_printstate(elem, tl,hybrid,nets,nete, fvm, omega_cn) - use dimensions_mod, only: ntrac + use dimensions_mod, only: use_cslam !Un-comment once constitutents are enabled -JN: ! use constituents, only: cnst_name use string_utils, only: to_str !Remove once constituents are enabled -JN use air_composition, only: thermodynamic_active_species_idx_dycore, dry_air_species_num use air_composition, only: thermodynamic_active_species_num,thermodynamic_active_species_idx use cam_control_mod, only: initial_run - use time_mod, only: tstep + use se_dyn_time_mod, only: tstep use control_mod, only: rsplit, qsplit use perf_mod, only: t_startf, t_stopf use cam_abortutils, only: check_allocate @@ -115,7 +115,7 @@ subroutine prim_printstate(elem, tl,hybrid,nets,nete, fvm, omega_cn) n0=tl%n0 call TimeLevel_Qdp( tl, qsplit, n0_qdp) ! moist surface pressure - if (ntrac>0) then + if (use_cslam) then do ie=nets,nete moist_ps_fvm(:,:,ie)=SUM(fvm(ie)%dp_fvm(1:nc,1:nc,:),DIM=3) do q=dry_air_species_num+1,thermodynamic_active_species_num @@ -141,7 +141,7 @@ subroutine prim_printstate(elem, tl,hybrid,nets,nete, fvm, omega_cn) do ie=nets,nete da_gll(:,:,ie) = elem(ie)%mp(:,:)*elem(ie)%metdet(:,:) enddo - if (ntrac>0) then + if (use_cslam) then do ie=nets,nete da_fvm(:,:,ie) = fvm(ie)%area_sphere(:,:) enddo @@ -158,7 +158,7 @@ subroutine prim_printstate(elem, tl,hybrid,nets,nete, fvm, omega_cn) varname(3) = 'T ' varname(4) = 'OMEGA ' varname(5) = 'OMEGA CN ' - if (ntrac>0) then + if (use_cslam) then varname(6) = 'PSDRY(fvm)' varname(7) = 'PS(fvm) ' varname(8) = 'PSDRY(gll)' @@ -188,7 +188,7 @@ subroutine prim_printstate(elem, tl,hybrid,nets,nete, fvm, omega_cn) min_local(ie,5) = 0.0_r8 max_local(ie,5) = 0.0_r8 end if - if (ntrac>0) then + if (use_cslam) then min_local(ie,6) = MINVAL(SUM(fvm(ie)%dp_fvm(1:nc,1:nc,:),DIM=3)) max_local(ie,6) = MAXVAL(SUM(fvm(ie)%dp_fvm(1:nc,1:nc,:),DIM=3)) min_local(ie,7) = MINVAL(moist_ps_fvm(:,:,ie)) @@ -227,7 +227,7 @@ subroutine prim_printstate(elem, tl,hybrid,nets,nete, fvm, omega_cn) max_local(ie,nm2+1) = MAXVAL(elem(ie)%derived%FT(:,:,:)) min_local(ie,nm2+2) = MINVAL(elem(ie)%derived%FM(:,:,:,:)) max_local(ie,nm2+2) = MAXVAL(elem(ie)%derived%FM(:,:,:,:)) - if (ntrac>0) then + if (use_cslam) then do q=1,statediag_numtrac !Un-comment once constitutents are enabled -JN: !varname(nm2+2+q) = TRIM('F'//TRIM(cnst_name(q))) @@ -265,7 +265,7 @@ subroutine prim_printstate(elem, tl,hybrid,nets,nete, fvm, omega_cn) ! tracers ! mass = -1.0_r8 - if (ntrac>0) then + if (use_cslam) then do ie=nets,nete do q=1,statediag_numtrac tmp_fvm(:,:,q,ie) = SUM(fvm(ie)%c(1:nc,1:nc,:,q)*fvm(ie)%dp_fvm(1:nc,1:nc,:),DIM=3) @@ -307,7 +307,7 @@ subroutine prim_printstate(elem, tl,hybrid,nets,nete, fvm, omega_cn) if (tl%nstep==0.or..not. initial_run) then mass_chg(:) = 0.0_R8 elem(nets)%derived%mass(nm+1:nm+statediag_numtrac) = mass(nm+1:nm+statediag_numtrac) - if (ntrac>0) then + if (use_cslam) then elem(nets)%derived%mass(6:9) = mass(6:9) else elem(nets)%derived%mass(6:7) = mass(6:7) @@ -409,10 +409,10 @@ end subroutine prim_printstate_cslam_gamma subroutine adjust_nsplit(elem, tl,hybrid,nets,nete, fvm, omega_cn) use dimensions_mod, only: ksponge_end use dimensions_mod, only: fvm_supercycling, fvm_supercycling_jet - use time_mod, only: tstep + use se_dyn_time_mod, only: tstep use control_mod, only: rsplit, qsplit use perf_mod, only: t_startf, t_stopf - use time_mod, only: nsplit, nsplit_baseline,rsplit_baseline + use se_dyn_time_mod, only: nsplit, nsplit_baseline,rsplit_baseline use control_mod, only: qsplit, rsplit use time_manager, only: get_step_size use cam_abortutils, only: endrun diff --git a/src/dynamics/se/dycore/time_mod.F90 b/src/dynamics/se/dycore/se_dyn_time_mod.F90 similarity index 96% rename from src/dynamics/se/dycore/time_mod.F90 rename to src/dynamics/se/dycore/se_dyn_time_mod.F90 index fdd68af0..716c34ad 100644 --- a/src/dynamics/se/dycore/time_mod.F90 +++ b/src/dynamics/se/dycore/se_dyn_time_mod.F90 @@ -1,4 +1,4 @@ -module time_mod +module se_dyn_time_mod !------------------ use shr_kind_mod, only: r8=>shr_kind_r8 !------------------ @@ -80,13 +80,14 @@ end subroutine TimeLevel_init_specific !locations for nm1 and n0 for Qdp - because !it only has 2 levels for storage subroutine TimeLevel_Qdp(tl, qsplit, n0, np1) + use dimensions_mod, only: use_cslam type (TimeLevel_t) :: tl integer, intent(in) :: qsplit integer, intent(inout) :: n0 integer, intent(inout), optional :: np1 integer :: i_temp - +!xxxx change when not double advecting i_temp = tl%nstep/qsplit if (mod(i_temp,2) ==0) then @@ -132,4 +133,4 @@ subroutine TimeLevel_update(tl,uptype) !$OMP BARRIER end subroutine TimeLevel_update -end module time_mod +end module se_dyn_time_mod diff --git a/src/dynamics/se/dycore/viscosity_mod.F90 b/src/dynamics/se/dycore/viscosity_mod.F90 index b29e48a1..42bca4bd 100644 --- a/src/dynamics/se/dycore/viscosity_mod.F90 +++ b/src/dynamics/se/dycore/viscosity_mod.F90 @@ -1,15 +1,15 @@ module viscosity_mod ! ! This module should be renamed "global_deriv_mod.F90" -! -! It is a collection of derivative operators that must be applied to the field -! over the sphere (as opposed to derivative operators that can be applied element +! +! It is a collection of derivative operators that must be applied to the field +! over the sphere (as opposed to derivative operators that can be applied element ! by element) ! ! use shr_kind_mod, only: r8=>shr_kind_r8 use thread_mod, only: max_num_threads, omp_get_num_threads - use dimensions_mod, only: np, nc, nlev,qsize,nelemd + use dimensions_mod, only: np, nc, nlev,nlevp, qsize,nelemd use hybrid_mod, only: hybrid_t, get_loop_ranges, config_thread_region use parallel_mod, only: parallel_t use element_mod, only: element_t @@ -50,11 +50,9 @@ module viscosity_mod CONTAINS -subroutine biharmonic_wk_dp3d(elem,dptens,dpflux,ttens,vtens,deriv,edge3,hybrid,nt,nets,nete,kbeg,kend,& - dp3d_ref,T_ref) +subroutine biharmonic_wk_dp3d(elem,dptens,dpflux,ttens,vtens,deriv,edge3,hybrid,nt,nets,nete,kbeg,kend) use derivative_mod, only : subcell_Laplace_fluxes - use dimensions_mod, only : ntrac, nu_div_lev,nu_lev - + use dimensions_mod, only : use_cslam, nu_div_lev,nu_lev !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! compute weak biharmonic operator ! input: h,v (stored in elem()%, in lat-lon coordinates @@ -68,101 +66,95 @@ subroutine biharmonic_wk_dp3d(elem,dptens,dpflux,ttens,vtens,deriv,edge3,hybrid, real (kind=r8), intent(out), dimension(nc,nc,4,nlev,nets:nete) :: dpflux real (kind=r8), dimension(np,np,2,nlev,nets:nete) :: vtens real (kind=r8), dimension(np,np,nlev,nets:nete) :: ttens,dptens - real (kind=r8), dimension(np,np,nlev,nets:nete), optional :: dp3d_ref,T_ref type (EdgeBuffer_t) , intent(inout) :: edge3 type (derivative_t) , intent(in) :: deriv - ! local integer :: i,j,k,kptr,ie,kblk ! real (kind=r8), dimension(:,:), pointer :: rspheremv real (kind=r8), dimension(np,np) :: tmp real (kind=r8), dimension(np,np) :: tmp2 real (kind=r8), dimension(np,np,2) :: v + + real (kind=r8), dimension(np,np,nlev) :: lap_p_wk + real (kind=r8), dimension(np,np,nlevp) :: T_i + + real (kind=r8) :: nu_ratio1, nu_ratio2 logical var_coef1 - + kblk = kend - kbeg + 1 - - if (ntrac>0) dpflux = 0 - !if tensor hyperviscosity with tensor V is used, then biharmonic operator is (\grad\cdot V\grad) (\grad \cdot \grad) + + if (use_cslam) dpflux = 0 + !if tensor hyperviscosity with tensor V is used, then biharmonic operator is (\grad\cdot V\grad) (\grad \cdot \grad) !so tensor is only used on second call to laplace_sphere_wk var_coef1 = .true. if(hypervis_scaling > 0) var_coef1 = .false. - - - do ie=nets,nete + do ie=nets,nete !$omp parallel do num_threads(vert_num_threads) private(k,tmp) do k=kbeg,kend - nu_ratio1=1 - nu_ratio2=1 - if (nu_div_lev(k)/=nu_lev(k)) then - if(hypervis_scaling /= 0) then - ! we have a problem with the tensor in that we cant seperate - ! div and curl components. So we do, with tensor V: - ! nu * (del V del ) * ( nu_ratio * grad(div) - curl(curl)) - nu_ratio1=nu_div_lev(k)/nu_lev(k) - nu_ratio2=1 - else - nu_ratio1=sqrt(nu_div_lev(k)/nu_lev(k)) - nu_ratio2=sqrt(nu_div_lev(k)/nu_lev(k)) - endif - endif - - if (present(T_ref)) then - tmp=elem(ie)%state%T(:,:,k,nt)-T_ref(:,:,k,ie) - else - tmp=elem(ie)%state%T(:,:,k,nt) - end if + nu_ratio1=1 + nu_ratio2=1 + if (nu_div_lev(k)/=nu_lev(k)) then + if(hypervis_scaling /= 0) then + ! we have a problem with the tensor in that we cant seperate + ! div and curl components. So we do, with tensor V: + ! nu * (del V del ) * ( nu_ratio * grad(div) - curl(curl)) + nu_ratio1=nu_div_lev(k)/nu_lev(k) + nu_ratio2=1 + else + nu_ratio1=sqrt(nu_div_lev(k)/nu_lev(k)) + nu_ratio2=sqrt(nu_div_lev(k)/nu_lev(k)) + endif + endif + + tmp=elem(ie)%state%T(:,:,k,nt)-elem(ie)%derived%T_ref(:,:,k) call laplace_sphere_wk(tmp,deriv,elem(ie),ttens(:,:,k,ie),var_coef=var_coef1) - if (present(dp3d_ref)) then - tmp=elem(ie)%state%dp3d(:,:,k,nt)-dp3d_ref(:,:,k,ie) - else - tmp=elem(ie)%state%dp3d(:,:,k,nt) - end if + + tmp=elem(ie)%state%dp3d(:,:,k,nt)-elem(ie)%derived%dp_ref(:,:,k) call laplace_sphere_wk(tmp,deriv,elem(ie),dptens(:,:,k,ie),var_coef=var_coef1) call vlaplace_sphere_wk(elem(ie)%state%v(:,:,:,k,nt),deriv,elem(ie),.true.,vtens(:,:,:,k,ie), & var_coef=var_coef1,nu_ratio=nu_ratio1) enddo - + kptr = kbeg - 1 call edgeVpack(edge3,ttens(:,:,kbeg:kend,ie),kblk,kptr,ie) - - kptr = kbeg - 1 + nlev + + kptr = kbeg - 1 + nlev call edgeVpack(edge3,vtens(:,:,1,kbeg:kend,ie),kblk,kptr,ie) - - kptr = kbeg - 1 + 2*nlev + + kptr = kbeg - 1 + 2*nlev call edgeVpack(edge3,vtens(:,:,2,kbeg:kend,ie),kblk,kptr,ie) - - kptr = kbeg - 1 + 3*nlev + + kptr = kbeg - 1 + 3*nlev call edgeVpack(edge3,dptens(:,:,kbeg:kend,ie),kblk,kptr,ie) enddo - + call bndry_exchange(hybrid,edge3,location='biharmonic_wk_dp3d') - + do ie=nets,nete !CLEAN rspheremv => elem(ie)%rspheremp(:,:) - + kptr = kbeg - 1 call edgeVunpack(edge3,ttens(:,:,kbeg:kend,ie),kblk,kptr,ie) - - kptr = kbeg - 1 + nlev + + kptr = kbeg - 1 + nlev call edgeVunpack(edge3,vtens(:,:,1,kbeg:kend,ie),kblk,kptr,ie) - - kptr = kbeg - 1 + 2*nlev + + kptr = kbeg - 1 + 2*nlev call edgeVunpack(edge3,vtens(:,:,2,kbeg:kend,ie),kblk,kptr,ie) - - kptr = kbeg - 1 + 3*nlev + + kptr = kbeg - 1 + 3*nlev call edgeVunpack(edge3,dptens(:,:,kbeg:kend,ie),kblk,kptr,ie) - - if (ntrac>0) then + + if (use_cslam) then do k=1,nlev -!CLEAN tmp(:,:)= rspheremv(:,:)*dptens(:,:,k,ie) - tmp(:,:)= elem(ie)%rspheremp(:,:)*dptens(:,:,k,ie) - call subcell_Laplace_fluxes(tmp, deriv, elem(ie), np, nc,dpflux(:,:,:,k,ie)) +!CLEAN tmp(:,:)= rspheremv(:,:)*dptens(:,:,k,ie) + tmp(:,:)= elem(ie)%rspheremp(:,:)*dptens(:,:,k,ie) + call subcell_Laplace_fluxes(tmp, deriv, elem(ie), np, nc,dpflux(:,:,:,k,ie)) enddo endif - + ! apply inverse mass matrix, then apply laplace again !$omp parallel do num_threads(vert_num_threads) private(k,v,tmp,tmp2) do k=kbeg,kend @@ -179,7 +171,7 @@ subroutine biharmonic_wk_dp3d(elem,dptens,dpflux,ttens,vtens,deriv,edge3,hybrid, v(:,:,2)=elem(ie)%rspheremp(:,:)*vtens(:,:,2,k,ie) call vlaplace_sphere_wk(v(:,:,:),deriv,elem(ie),.true.,vtens(:,:,:,k,ie), & var_coef=.true.,nu_ratio=nu_ratio2) - + enddo enddo !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -194,7 +186,7 @@ subroutine biharmonic_wk_omega(elem,ptens,deriv,edge3,hybrid,nets,nete,kbeg,kend real (kind=r8), dimension(np,np,nlev,nets:nete) :: ptens type (EdgeBuffer_t) , intent(inout) :: edge3 type (derivative_t) , intent(in) :: deriv - + ! local integer :: i,j,k,kptr,ie,kblk real (kind=r8), dimension(:,:), pointer :: rspheremv @@ -203,37 +195,37 @@ subroutine biharmonic_wk_omega(elem,ptens,deriv,edge3,hybrid,nets,nete,kbeg,kend real (kind=r8), dimension(np,np,2) :: v real (kind=r8) :: nu_ratio1, nu_ratio2 logical var_coef1 - + kblk = kend - kbeg + 1 - - !if tensor hyperviscosity with tensor V is used, then biharmonic operator is (\grad\cdot V\grad) (\grad \cdot \grad) + + !if tensor hyperviscosity with tensor V is used, then biharmonic operator is (\grad\cdot V\grad) (\grad \cdot \grad) !so tensor is only used on second call to laplace_sphere_wk var_coef1 = .true. if(hypervis_scaling > 0) var_coef1 = .false. - + nu_ratio1=1 nu_ratio2=1 - + do ie=nets,nete - + !$omp parallel do num_threads(vert_num_threads) private(k,tmp) do k=kbeg,kend - tmp=elem(ie)%derived%omega(:,:,k) + tmp=elem(ie)%derived%omega(:,:,k) call laplace_sphere_wk(tmp,deriv,elem(ie),ptens(:,:,k,ie),var_coef=var_coef1) enddo - + kptr = kbeg - 1 call edgeVpack(edge3,ptens(:,:,kbeg:kend,ie),kblk,kptr,ie) enddo - + call bndry_exchange(hybrid,edge3,location='biharmonic_wk_omega') - + do ie=nets,nete rspheremv => elem(ie)%rspheremp(:,:) - + kptr = kbeg - 1 call edgeVunpack(edge3,ptens(:,:,kbeg:kend,ie),kblk,kptr,ie) - + ! apply inverse mass matrix, then apply laplace again !$omp parallel do num_threads(vert_num_threads) private(k,tmp) do k=kbeg,kend @@ -261,14 +253,14 @@ subroutine biharmonic_wk_scalar(elem,qtens,deriv,edgeq,hybrid,nets,nete) ! local integer :: k,kptr,i,j,ie,ic,q -integer :: kbeg,kend,qbeg,qend +integer :: kbeg,kend,qbeg,qend real (kind=r8), dimension(np,np) :: lap_p logical var_coef1 integer :: kblk,qblk ! The per thead size of the vertical and tracers call get_loop_ranges(hybrid,kbeg=kbeg,kend=kend,qbeg=qbeg,qend=qend) - !if tensor hyperviscosity with tensor V is used, then biharmonic operator is (\grad\cdot V\grad) (\grad \cdot \grad) + !if tensor hyperviscosity with tensor V is used, then biharmonic operator is (\grad\cdot V\grad) (\grad \cdot \grad) !so tensor is only used on second call to laplace_sphere_wk var_coef1 = .true. if(hypervis_scaling > 0) var_coef1 = .false. @@ -278,7 +270,7 @@ subroutine biharmonic_wk_scalar(elem,qtens,deriv,edgeq,hybrid,nets,nete) qblk = qend - qbeg + 1 ! calculate size of the block of tracers do ie=nets,nete - do q=qbeg,qend + do q=qbeg,qend do k=kbeg,kend lap_p(:,:)=qtens(:,:,k,q,ie) call laplace_sphere_wk(lap_p,deriv,elem(ie),qtens(:,:,k,q,ie),var_coef=var_coef1) @@ -290,11 +282,11 @@ subroutine biharmonic_wk_scalar(elem,qtens,deriv,edgeq,hybrid,nets,nete) call bndry_exchange(hybrid,edgeq,location='biharmonic_wk_scalar') - + do ie=nets,nete ! apply inverse mass matrix, then apply laplace again - do q=qbeg,qend + do q=qbeg,qend kptr = nlev*(q-1) + kbeg - 1 call edgeVunpack(edgeq, qtens(:,:,kbeg:kend,q,ie),kblk,kptr,ie) do k=kbeg,kend @@ -310,7 +302,7 @@ end subroutine biharmonic_wk_scalar subroutine make_C0(zeta,elem,hybrid,nets,nete) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! apply DSS (aka assembly procedure) to zeta. +! apply DSS (aka assembly procedure) to zeta. !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! type (hybrid_t) , intent(in) :: hybrid @@ -346,7 +338,7 @@ subroutine make_C0(zeta,elem,hybrid,nets,nete) enddo enddo -call FreeEdgeBuffer(edge1) +call FreeEdgeBuffer(edge1) end subroutine @@ -414,7 +406,7 @@ subroutine make_C0_vector(v,elem,hybrid,nets,nete) enddo enddo -call FreeEdgeBuffer(edge2) +call FreeEdgeBuffer(edge2) #endif end subroutine @@ -425,11 +417,11 @@ subroutine make_C0_vector(v,elem,hybrid,nets,nete) subroutine compute_zeta_C0_contra(zeta,elem,hybrid,nets,nete,nt) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! compute C0 vorticity. That is, solve: +! compute C0 vorticity. That is, solve: ! < PHI, zeta > = ! ! input: v (stored in elem()%, in contra-variant coordinates) -! output: zeta(:,:,:,:) +! output: zeta(:,:,:,:) ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -464,11 +456,11 @@ subroutine compute_zeta_C0_contra(zeta,elem,hybrid,nets,nete,nt) subroutine compute_div_C0_contra(zeta,elem,hybrid,nets,nete,nt) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! compute C0 divergence. That is, solve: +! compute C0 divergence. That is, solve: ! < PHI, zeta > = ! ! input: v (stored in elem()%, in contra-variant coordinates) -! output: zeta(:,:,:,:) +! output: zeta(:,:,:,:) ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -501,11 +493,11 @@ subroutine compute_div_C0_contra(zeta,elem,hybrid,nets,nete,nt) subroutine compute_zeta_C0_par(zeta,elem,par,nt) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! compute C0 vorticity. That is, solve: +! compute C0 vorticity. That is, solve: ! < PHI, zeta > = ! ! input: v (stored in elem()%, in lat-lon coordinates) -! output: zeta(:,:,:,:) +! output: zeta(:,:,:,:) ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! type (parallel_t) :: par @@ -528,11 +520,11 @@ subroutine compute_zeta_C0_par(zeta,elem,par,nt) subroutine compute_div_C0_par(zeta,elem,par,nt) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! compute C0 divergence. That is, solve: +! compute C0 divergence. That is, solve: ! < PHI, zeta > = ! ! input: v (stored in elem()%, in lat-lon coordinates) -! output: zeta(:,:,:,:) +! output: zeta(:,:,:,:) ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -557,11 +549,11 @@ subroutine compute_div_C0_par(zeta,elem,par,nt) subroutine compute_zeta_C0_hybrid(zeta,elem,hybrid,nets,nete,nt) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! compute C0 vorticity. That is, solve: +! compute C0 vorticity. That is, solve: ! < PHI, zeta > = ! ! input: v (stored in elem()%, in lat-lon coordinates) -! output: zeta(:,:,:,:) +! output: zeta(:,:,:,:) ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -592,11 +584,11 @@ subroutine compute_zeta_C0_hybrid(zeta,elem,hybrid,nets,nete,nt) subroutine compute_div_C0_hybrid(zeta,elem,hybrid,nets,nete,nt) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! compute C0 divergence. That is, solve: +! compute C0 divergence. That is, solve: ! < PHI, zeta > = ! ! input: v (stored in elem()%, in lat-lon coordinates) -! output: zeta(:,:,:,:) +! output: zeta(:,:,:,:) ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -632,22 +624,22 @@ subroutine compute_div_C0_hybrid(zeta,elem,hybrid,nets,nete,nt) subroutine neighbor_minmax(hybrid,edgeMinMax,nets,nete,min_neigh,max_neigh) - + type (hybrid_t) , intent(in) :: hybrid type (EdgeBuffer_t) , intent(inout) :: edgeMinMax integer :: nets,nete real (kind=r8) :: min_neigh(nlev,qsize,nets:nete) real (kind=r8) :: max_neigh(nlev,qsize,nets:nete) integer :: kblk, qblk - ! local + ! local integer:: ie, q, k, kptr integer:: kbeg, kend, qbeg, qend call get_loop_ranges(hybrid,kbeg=kbeg,kend=kend,qbeg=qbeg,qend=qend) - + kblk = kend - kbeg + 1 ! calculate size of the block of vertical levels qblk = qend - qbeg + 1 ! calculate size of the block of tracers - + do ie=nets,nete do q = qbeg, qend kptr = nlev*(q - 1) + kbeg - 1 @@ -656,7 +648,7 @@ subroutine neighbor_minmax(hybrid,edgeMinMax,nets,nete,min_neigh,max_neigh) call edgeSpack(edgeMinMax,max_neigh(kbeg:kend,q,ie),kblk,kptr,ie) enddo enddo - + call bndry_exchange(hybrid,edgeMinMax,location='neighbor_minmax') do ie=nets,nete @@ -672,7 +664,7 @@ subroutine neighbor_minmax(hybrid,edgeMinMax,nets,nete,min_neigh,max_neigh) enddo end subroutine neighbor_minmax - + subroutine neighbor_minmax_start(hybrid,edgeMinMax,nets,nete,min_neigh,max_neigh) @@ -684,7 +676,7 @@ subroutine neighbor_minmax_start(hybrid,edgeMinMax,nets,nete,min_neigh,max_neigh integer :: kblk, qblk integer :: kbeg, kend, qbeg, qend - ! local + ! local integer :: ie,q, k,kptr call get_loop_ranges(hybrid,kbeg=kbeg,kend=kend,qbeg=qbeg,qend=qend) diff --git a/src/dynamics/se/dyn_comp.F90 b/src/dynamics/se/dyn_comp.F90 index 4f70ae2c..98daf9e7 100644 --- a/src/dynamics/se/dyn_comp.F90 +++ b/src/dynamics/se/dyn_comp.F90 @@ -40,10 +40,10 @@ module dyn_comp use parallel_mod, only: par use hybrid_mod, only: hybrid_t use dimensions_mod, only: nelemd, nlev, np, npsq, ntrac, nc, fv_nphys, & - qsize + qsize, use_cslam use element_mod, only: element_t, elem_state_t use fvm_control_volume_mod, only: fvm_struct -use time_mod, only: nsplit +use se_dyn_time_mod, only: nsplit use edge_mod, only: initEdgeBuffer, edgeVpack, edgeVunpack, FreeEdgeBuffer use edgetype_mod, only: EdgeBuffer_t use bndry_mod, only: bndry_exchange @@ -111,13 +111,13 @@ subroutine dyn_readnl(NLFileName) use control_mod, only: vert_remap_uvTq_alg, vert_remap_tracer_alg use control_mod, only: tstep_type, rk_stage_user use control_mod, only: ftype, limiter_option, partmethod - use control_mod, only: topology, phys_dyn_cp, variable_nsplit + use control_mod, only: topology, variable_nsplit use control_mod, only: fine_ne, hypervis_power, hypervis_scaling use control_mod, only: max_hypervis_courant, statediag_numtrac,refined_mesh - use control_mod, only: raytau0, raykrange, rayk0, molecular_diff + use control_mod, only: molecular_diff, pgf_formulation, dribble_in_rsplit_loop + use control_mod, only: sponge_del4_nu_div_fac, sponge_del4_nu_fac, sponge_del4_lev use dimensions_mod, only: ne, npart - use dimensions_mod, only: lcp_moist - use dimensions_mod, only: hypervis_dynamic_ref_state,large_Courant_incr + use dimensions_mod, only: large_Courant_incr use dimensions_mod, only: fvm_supercycling, fvm_supercycling_jet use dimensions_mod, only: kmin_jet, kmax_jet use params_mod, only: SFCURVE @@ -130,7 +130,6 @@ subroutine dyn_readnl(NLFileName) ! Local variables integer :: unitn, ierr,k - real(r8) :: uniform_res_hypervis_scaling,nu_fac ! SE Namelist variables integer :: se_fine_ne @@ -152,6 +151,9 @@ subroutine dyn_readnl(NLFileName) real(r8) :: se_nu_div real(r8) :: se_nu_p real(r8) :: se_nu_top + real(r8) :: se_sponge_del4_nu_fac + real(r8) :: se_sponge_del4_nu_div_fac + integer :: se_sponge_del4_lev integer :: se_qsplit logical :: se_refined_mesh integer :: se_rsplit @@ -163,19 +165,15 @@ subroutine dyn_readnl(NLFileName) integer :: se_horz_num_threads integer :: se_vert_num_threads integer :: se_tracer_num_threads - logical :: se_hypervis_dynamic_ref_state - logical :: se_lcp_moist logical :: se_write_restart_unstruct logical :: se_large_Courant_incr integer :: se_fvm_supercycling integer :: se_fvm_supercycling_jet integer :: se_kmin_jet integer :: se_kmax_jet - integer :: se_phys_dyn_cp - real(r8) :: se_raytau0 - real(r8) :: se_raykrange - integer :: se_rayk0 real(r8) :: se_molecular_diff + integer :: se_pgf_formulation + real(r8) :: se_dribble_in_rsplit_loop namelist /dyn_se_nl/ & se_fine_ne, & ! For refined meshes @@ -197,6 +195,9 @@ subroutine dyn_readnl(NLFileName) se_nu_div, & se_nu_p, & se_nu_top, & + se_sponge_del4_nu_fac, & + se_sponge_del4_nu_div_fac, & + se_sponge_del4_lev, & se_qsplit, & se_refined_mesh, & se_rsplit, & @@ -211,19 +212,15 @@ subroutine dyn_readnl(NLFileName) se_horz_num_threads, & se_vert_num_threads, & se_tracer_num_threads, & - se_hypervis_dynamic_ref_state,& - se_lcp_moist, & se_write_restart_unstruct, & se_large_Courant_incr, & se_fvm_supercycling, & se_fvm_supercycling_jet, & se_kmin_jet, & se_kmax_jet, & - se_phys_dyn_cp, & - se_raytau0, & - se_raykrange, & - se_rayk0, & - se_molecular_diff + se_molecular_diff, & + se_pgf_formulation, & + se_dribble_in_rsplit_loop !-------------------------------------------------------------------------- @@ -269,6 +266,9 @@ subroutine dyn_readnl(NLFileName) call MPI_bcast(se_nu_div, 1, mpi_real8, masterprocid, mpicom, ierr) call MPI_bcast(se_nu_p, 1, mpi_real8, masterprocid, mpicom, ierr) call MPI_bcast(se_nu_top, 1, mpi_real8, masterprocid, mpicom, ierr) + call MPI_bcast(se_sponge_del4_nu_fac, 1, mpi_real8, masterprocid, mpicom, ierr) + call MPI_bcast(se_sponge_del4_nu_div_fac, 1, mpi_real8, masterprocid, mpicom, ierr) + call MPI_bcast(se_sponge_del4_lev, 1, mpi_integer, masterprocid, mpicom, ierr) call MPI_bcast(se_qsplit, 1, mpi_integer, masterprocid, mpicom, ierr) call MPI_bcast(se_refined_mesh, 1, mpi_logical, masterprocid, mpicom, ierr) call MPI_bcast(se_rsplit, 1, mpi_integer, masterprocid, mpicom, ierr) @@ -284,20 +284,15 @@ subroutine dyn_readnl(NLFileName) call MPI_bcast(se_horz_num_threads, 1, MPI_integer, masterprocid, mpicom,ierr) call MPI_bcast(se_vert_num_threads, 1, MPI_integer, masterprocid, mpicom,ierr) call MPI_bcast(se_tracer_num_threads, 1, MPI_integer, masterprocid, mpicom,ierr) - call MPI_bcast(se_hypervis_dynamic_ref_state, 1, mpi_logical, masterprocid, mpicom, ierr) - call MPI_bcast(se_lcp_moist, 1, mpi_logical, masterprocid, mpicom, ierr) call MPI_bcast(se_write_restart_unstruct, 1, mpi_logical, masterprocid, mpicom, ierr) call MPI_bcast(se_large_Courant_incr, 1, mpi_logical, masterprocid, mpicom, ierr) call MPI_bcast(se_fvm_supercycling, 1, mpi_integer, masterprocid, mpicom, ierr) call MPI_bcast(se_fvm_supercycling_jet, 1, mpi_integer, masterprocid, mpicom, ierr) call MPI_bcast(se_kmin_jet, 1, mpi_integer, masterprocid, mpicom, ierr) call MPI_bcast(se_kmax_jet, 1, mpi_integer, masterprocid, mpicom, ierr) - call MPI_bcast(se_phys_dyn_cp, 1, mpi_integer, masterprocid, mpicom, ierr) - call MPI_bcast(se_rayk0 , 1, mpi_integer, masterprocid, mpicom, ierr) - call MPI_bcast(se_raykrange, 1, mpi_real8, masterprocid, mpicom, ierr) - call MPI_bcast(se_raytau0, 1, mpi_real8, masterprocid, mpicom, ierr) call MPI_bcast(se_molecular_diff, 1, mpi_real8, masterprocid, mpicom, ierr) - + call MPI_bcast(se_pgf_formulation, 1, mpi_integer, masterprocid, mpicom, ierr) + call MPI_bcast(se_dribble_in_rsplit_loop, 1, mpi_integer, masterprocid, mpicom, ierr) ! If se_npes is set to negative one, then make it match host model: if (se_npes == -1) then se_npes = npes @@ -334,6 +329,9 @@ subroutine dyn_readnl(NLFileName) fine_ne = se_fine_ne ftype = se_ftype statediag_numtrac = MIN(se_statediag_numtrac,num_advected) + sponge_del4_nu_fac = se_sponge_del4_nu_fac + sponge_del4_nu_div_fac = se_sponge_del4_nu_div_fac + sponge_del4_lev = se_sponge_del4_lev hypervis_power = se_hypervis_power hypervis_scaling = se_hypervis_scaling hypervis_subcycle = se_hypervis_subcycle @@ -360,20 +358,15 @@ subroutine dyn_readnl(NLFileName) vert_remap_uvTq_alg = set_vert_remap(se_vert_remap_T, se_vert_remap_uvTq_alg) vert_remap_tracer_alg = set_vert_remap(se_vert_remap_T, se_vert_remap_tracer_alg) fv_nphys = se_fv_nphys - hypervis_dynamic_ref_state = se_hypervis_dynamic_ref_state - lcp_moist = se_lcp_moist large_Courant_incr = se_large_Courant_incr fvm_supercycling = se_fvm_supercycling fvm_supercycling_jet = se_fvm_supercycling_jet kmin_jet = se_kmin_jet kmax_jet = se_kmax_jet variable_nsplit = .false. - phys_dyn_cp = se_phys_dyn_cp - raytau0 = se_raytau0 - raykrange = se_raykrange - rayk0 = se_rayk0 molecular_diff = se_molecular_diff - + pgf_formulation = se_pgf_formulation + dribble_in_rsplit_loop = se_dribble_in_rsplit_loop if (rsplit < 1) then call endrun('dyn_readnl: rsplit must be > 0') end if @@ -430,7 +423,6 @@ subroutine dyn_readnl(NLFileName) end if write(iulog, '(a,i0)') 'dyn_readnl: se_npes = ',se_npes write(iulog, '(a,i0)') 'dyn_readnl: se_nsplit = ',se_nsplit - write(iulog, '(a,i0)') 'dyn_readnl: se_phys_dyn_cp = ',se_phys_dyn_cp ! ! se_nu<0 then coefficients are set automatically in module global_norms_mod ! @@ -443,15 +435,20 @@ subroutine dyn_readnl(NLFileName) write(iulog, '(a)') 'Note that nu_q must be the same as nu_p for mass / tracer inconsistency' end if write(iulog, '(a,e9.2)') 'dyn_readnl: se_nu_top = ',se_nu_top + write(iulog, *) 'dyn_readnl: se_sponge_del4_nu_fac = ',se_sponge_del4_nu_fac + if (se_sponge_del4_nu_fac < 0) write(iulog, '(a)') ' (automatically set based on model top location)' + write(iulog, *) 'dyn_readnl: se_sponge_del4_nu_div_fac = ',se_sponge_del4_nu_div_fac + if (se_sponge_del4_nu_div_fac < 0) write(iulog, '(a)') ' (automatically set based on model top location)' + write(iulog, *) 'dyn_readnl: se_sponge_del4_lev = ',se_sponge_del4_lev + if (se_sponge_del4_lev < 0) write(iulog, '(a)') ' (automatically set based on model top location)' write(iulog, '(a,i0)') 'dyn_readnl: se_qsplit = ',se_qsplit write(iulog, '(a,i0)') 'dyn_readnl: se_rsplit = ',se_rsplit write(iulog, '(a,i0)') 'dyn_readnl: se_statefreq = ',se_statefreq + write(iulog, '(a,i0)') 'dyn_readnl: se_pgf_formulation = ',pgf_formulation write(iulog, '(a,i0)') 'dyn_readnl: se_tstep_type = ',se_tstep_type write(iulog, '(a,a)') 'dyn_readnl: se_vert_remap_T = ',trim(se_vert_remap_T) write(iulog, '(a,a)') 'dyn_readnl: se_vert_remap_uvTq_alg = ',trim(se_vert_remap_uvTq_alg) write(iulog, '(a,a)') 'dyn_readnl: se_vert_remap_tracer_alg = ',trim(se_vert_remap_tracer_alg) - write(iulog, '(a,l4)') 'dyn_readnl: se_hypervis_dynamic_ref_state = ',hypervis_dynamic_ref_state - write(iulog, '(a,l4)') 'dyn_readnl: lcp_moist = ',lcp_moist write(iulog, '(a,i0)') 'dyn_readnl: se_fvm_supercycling = ',fvm_supercycling write(iulog, '(a,i0)') 'dyn_readnl: se_fvm_supercycling_jet = ',fvm_supercycling_jet write(iulog, '(a,i0)') 'dyn_readnl: se_kmin_jet = ',kmin_jet @@ -470,7 +467,7 @@ subroutine dyn_readnl(NLFileName) end if end if - if (fv_nphys > 0) then + if (use_cslam) then write(iulog, '(a)') 'dyn_readnl: physics will run on FVM points; advection by CSLAM' write(iulog,'(a,i0)') 'dyn_readnl: se_fv_nphys = ', fv_nphys else @@ -488,10 +485,6 @@ subroutine dyn_readnl(NLFileName) se_write_gll_corners write(iulog,'(a,l1)') 'dyn_readnl: write restart data on unstructured grid = ', & se_write_restart_unstruct - - write(iulog, '(a,e9.2)') 'dyn_readnl: se_raytau0 = ', raytau0 - write(iulog, '(a,e9.2)') 'dyn_readnl: se_raykrange = ', raykrange - write(iulog, '(a,i0)' ) 'dyn_readnl: se_rayk0 = ', rayk0 write(iulog, '(a,e9.2)') 'dyn_readnl: se_molecular_diff = ', molecular_diff end if @@ -562,7 +555,7 @@ subroutine dyn_init(cam_runtime_opts, dyn_in, dyn_out) use cam_pio_utils, only: clean_iodesc_list use air_composition, only: thermodynamic_active_species_num, thermodynamic_active_species_idx use air_composition, only: thermodynamic_active_species_idx_dycore - use dynconst, only: cpair + use dynconst, only: cpair, pstd use dyn_thermo, only: get_molecular_diff_coef_reference !use cam_history, only: addfld, add_default, horiz_only, register_vector_field use gravity_waves_sources, only: gws_init @@ -574,16 +567,16 @@ subroutine dyn_init(cam_runtime_opts, dyn_in, dyn_out) use prim_advance_mod, only: prim_advance_init use thread_mod, only: horz_num_threads use hybrid_mod, only: get_loop_ranges, config_thread_region - use dimensions_mod, only: nu_scale_top, nu_lev, nu_div_lev + use dimensions_mod, only: nu_scale_top use dimensions_mod, only: ksponge_end, kmvis_ref, kmcnd_ref,rho_ref,km_sponge_factor - use dimensions_mod, only: kmvisi_ref, kmcndi_ref,rhoi_ref use dimensions_mod, only: cnst_name_gll, cnst_longname_gll - use dimensions_mod, only: irecons_tracer_lev, irecons_tracer, otau, kord_tr, kord_tr_cslam + use dimensions_mod, only: irecons_tracer_lev, irecons_tracer, kord_tr, kord_tr_cslam use prim_driver_mod, only: prim_init2 - use time_mod, only: time_at - use control_mod, only: runtype, raytau0, raykrange, rayk0, molecular_diff, nu_top + use se_dyn_time_mod, only: time_at + use control_mod, only: runtype, nu_top, molecular_diff use test_fvm_mapping, only: test_mapping_addfld use control_mod, only: vert_remap_uvTq_alg, vert_remap_tracer_alg + use std_atm_profile, only: std_atm_height ! Dummy arguments: type(runtime_options), intent(in) :: cam_runtime_opts @@ -591,9 +584,9 @@ subroutine dyn_init(cam_runtime_opts, dyn_in, dyn_out) type(dyn_export_t), intent(out) :: dyn_out ! Local variables - integer :: ithr, nets, nete, ie, k, kmol_end + integer :: nets, nete, ie, k, kmol_end, mfound real(r8), parameter :: Tinit = 300.0_r8 - real(r8) :: press, ptop, tref + real(r8) :: press(1), ptop, tref,z(1) type(hybrid_t) :: hybrid @@ -602,11 +595,14 @@ subroutine dyn_init(cam_runtime_opts, dyn_in, dyn_out) integer :: iret ! variables for initializing energy and axial angular momentum diagnostics - character (len = 3), dimension(12) :: stage = (/"dED","dAF","dBD","dAD","dAR","dBF","dBH","dCH","dAH",'dBS','dAS','p2d'/) - character (len = 70),dimension(12) :: stage_txt = (/& + integer, parameter :: num_stages = 14 + character (len = 4), dimension(num_stages) :: stage = (/"dED","dAF","dBD","dBL","dAL","dAD","dAR","dBF","dBH","dCH","dAH","dBS","dAS","p2d"/) + character (len = 70),dimension(num_stages) :: stage_txt = (/& " end of previous dynamics ",& !dED " from previous remapping or state passed to dynamics",& !dAF - state in beginning of nsplit loop " state after applying CAM forcing ",& !dBD - state after applyCAMforcing + " before floating dynamics ",& !dBL + " after floating dynamics ",& !dAL " before vertical remapping ",& !dAD - state before vertical remapping " after vertical remapping ",& !dAR - state at end of nsplit loop " state passed to parameterizations ",& !dBF @@ -617,22 +613,6 @@ subroutine dyn_init(cam_runtime_opts, dyn_in, dyn_out) " state after sponge layer diffusion ",& !dAS - state after sponge del2 " phys2dyn mapping errors (requires ftype-1) " & !p2d - for assessing phys2dyn mapping errors /) - character (len = 2) , dimension(8) :: vars = (/"WV" ,"WL" ,"WI" ,"SE" ,"KE" ,"MR" ,"MO" ,"TT" /) - !if ntrac>0 then tracers should be output on fvm grid but not energy (SE+KE) and AAM diags - logical , dimension(8) :: massv = (/.true.,.true.,.true.,.false.,.false.,.false.,.false.,.false./) - character (len = 70) , dimension(8) :: vars_descriptor = (/& - "Total column water vapor ",& - "Total column cloud water ",& - "Total column cloud ice ",& - "Total column dry static energy ",& - "Total column kinetic energy ",& - "Total column wind axial angular momentum",& - "Total column mass axial angular momentum",& - "Total column test tracer "/) - character (len = 14), dimension(8) :: & - vars_unit = (/& - "kg/m2 ","kg/m2 ","kg/m2 ","J/m2 ",& - "J/m2 ","kg*m2/s*rad2 ","kg*m2/s*rad2 ","kg/m2 "/) integer :: istage, ivars character (len=108) :: str1, str2, str3 @@ -642,7 +622,6 @@ subroutine dyn_init(cam_runtime_opts, dyn_in, dyn_out) character(len=*), parameter :: subname = 'dyn_init' - real(r8) :: tau0, krange, otau0, scale real(r8) :: km_sponge_factor_local(nlev+1) !---------------------------------------------------------------------------- ! Set dynamical core energy formula for use in cam_thermo. @@ -668,7 +647,7 @@ subroutine dyn_init(cam_runtime_opts, dyn_in, dyn_out) file=__FILE__, line=__LINE__) kord_tr(:) = vert_remap_tracer_alg - if (ntrac>0) then + if (use_cslam) then allocate(kord_tr_cslam(ntrac), stat=iret) call check_allocate(iret, subname, 'kord_tr_cslam(ntrac)', & file=__FILE__, line=__LINE__) @@ -688,7 +667,7 @@ subroutine dyn_init(cam_runtime_opts, dyn_in, dyn_out) ! CSLAM tracers are always indexed as in physics ! of no CSLAM then SE tracers are always indexed as in physics ! - if (ntrac>0) then + if (use_cslam) then ! ! note that in this case qsize = thermodynamic_active_species_num ! @@ -711,7 +690,36 @@ subroutine dyn_init(cam_runtime_opts, dyn_in, dyn_out) end if end do - +#ifdef energy_budget_code + do m=1,thermodynamic_active_species_liq_num + if (use_cslam) then + do mfound=1,qsize + if (TRIM(cnst_name(thermodynamic_active_species_liq_idx(m)))==TRIM(cnst_name_gll(mfound))) then + thermodynamic_active_species_liq_idx_dycore(m) = mfound + end if + end do + else + thermodynamic_active_species_liq_idx_dycore(m) = thermodynamic_active_species_liq_idx(m) + end if + if (masterproc) then + write(iulog,*) subname//": m,thermodynamic_active_species_idx_liq_dycore: ",m,thermodynamic_active_species_liq_idx_dycore(m) + end if + end do + do m=1,thermodynamic_active_species_ice_num + if (use_cslam) then + do mfound=1,qsize + if (TRIM(cnst_name(thermodynamic_active_species_ice_idx(m)))==TRIM(cnst_name_gll(mfound))) then + thermodynamic_active_species_ice_idx_dycore(m) = mfound + end if + end do + else + thermodynamic_active_species_ice_idx_dycore(m) = thermodynamic_active_species_ice_idx(m) + end if + if (masterproc) then + write(iulog,*) subname//": m,thermodynamic_active_species_idx_ice_dycore: ",m,thermodynamic_active_species_ice_idx_dycore(m) + end if + end do +#endif ! ! Initialize the import/export objects ! @@ -732,28 +740,15 @@ subroutine dyn_init(cam_runtime_opts, dyn_in, dyn_out) if (initial_run) then call read_inidat(dyn_in) - call clean_iodesc_list() - end if - ! - ! initialize Rayleigh friction - ! - krange = raykrange - if (raykrange .eq. 0._r8) krange = (rayk0 - 1) / 2._r8 - tau0 = (86400._r8) * raytau0 ! convert to seconds - otau0 = 0._r8 - if (tau0 .ne. 0._r8) otau0 = 1._r8/tau0 - do k = 1, nlev - otau(k) = otau0 * (1.0_r8 + tanh((rayk0 - k) / krange)) / (2._r8) - enddo - if (masterproc) then - if (tau0 > 0._r8) then - write (iulog,*) 'SE dycore Rayleigh friction - krange = ', krange - write (iulog,*) 'SE dycore Rayleigh friction - otau0 = ', 1.0_r8/tau0 - write (iulog,*) 'SE dycore Rayleigh friction decay rate profile (only applied to (u,v))' - do k = 1, nlev - write (iulog,*) ' k = ', k, ' otau = ', otau(k) - enddo +#ifdef scam + if (use_iop .and. masterproc) then + call setiopupdate_init() + call readiopdata( hvcoord%hyam, hvcoord%hybm, hvcoord%hyai, hvcoord%hybi, hvcoord%ps0 ) + call scm_setinitial(dyn_in%elem) end if + call clean_iodesc +#endif + call clean_iodesc_list() end if ! ! initialize diffusion in dycore @@ -767,9 +762,6 @@ subroutine dyn_init(cam_runtime_opts, dyn_in, dyn_out) tref = 1000._r8 !mean value at model top for solar max km_sponge_factor = molecular_diff km_sponge_factor_local = molecular_diff - call get_molecular_diff_coef_reference(tref,& - (hvcoord%hyai(:)+hvcoord%hybi(:))*hvcoord%ps0, km_sponge_factor_local,& - kmvisi_ref,kmcndi_ref,rhoi_ref) ! ! get rho, kmvis and kmcnd at mid-levels ! @@ -777,14 +769,17 @@ subroutine dyn_init(cam_runtime_opts, dyn_in, dyn_out) (hvcoord%hyam(:)+hvcoord%hybm(:))*hvcoord%ps0,km_sponge_factor,& kmvis_ref,kmcnd_ref,rho_ref) + if (masterproc) then + write(iulog,*) "Molecular viscosity and thermal conductivity reference profile" + write(iulog,*) "k, p, z, km_sponge_factor, kmvis_ref/rho_ref, kmcnd_ref/(cp*rho_ref):" + end if do k=1,nlev ! only apply molecular viscosity where viscosity is > 1000 m/s^2 if (MIN(kmvis_ref(k)/rho_ref(k),kmcnd_ref(k)/(cpair*rho_ref(k)))>1000.0_r8) then if (masterproc) then - write(iulog,'(a,i3,2e11.4)') "k, p, km_sponge_factor :",k, & - (hvcoord%hyam(k)+hvcoord%hybm(k))*hvcoord%ps0,km_sponge_factor(k) - write(iulog,'(a,2e11.4)') "kmvis_ref/rho_ref, kmcnd_ref/(cp*rho_ref): ", & - kmvis_ref(k)/rho_ref(k),kmcnd_ref(k)/(cpair*rho_ref(k)) + press = hvcoord%hyam(k)*hvcoord%ps0+hvcoord%hybm(k)*pstd + call std_atm_height(press,z) + write(iulog,'(i3,5e11.4)') k,press, z,km_sponge_factor(k),kmvis_ref(k)/rho_ref(k),kmcnd_ref(k)/(cpair*rho_ref(k)) end if kmol_end = k else @@ -806,26 +801,61 @@ subroutine dyn_init(cam_runtime_opts, dyn_in, dyn_out) ! nu_scale_top(:) = 0.0_r8 if (nu_top>0) then - if (masterproc) write(iulog,*) subname//": sponge layer viscosity scaling factor" - do k=1,nlev - press = (hvcoord%hyam(k)+hvcoord%hybm(k))*hvcoord%ps0 - ptop = hvcoord%hyai(1)*hvcoord%ps0 - nu_scale_top(k) = 8.0_r8*(1.0_r8+tanh(1.0_r8*log(ptop/press))) ! tau will be maximum 8 at model top - if (nu_scale_top(k).ge.0.15_r8) then - ksponge_end = k - else - nu_scale_top(k) = 0.0_r8 - end if - end do + ptop = hvcoord%hyai(1)*hvcoord%ps0 + if (ptop>300.0_r8) then + ! + ! for low tops the tanh formulae below makes the sponge excessively deep + ! + nu_scale_top(1) = 4.0_r8 + nu_scale_top(2) = 2.0_r8 + nu_scale_top(3) = 1.0_r8 + ksponge_end = 3 + else if (ptop>100.0_r8) then + ! + ! CAM6 top (~225 Pa) or CAM7 low top + ! + ! For backwards compatibility numbers below match tanh profile + ! used in FV + ! + nu_scale_top(1) = 4.4_r8 + nu_scale_top(2) = 1.3_r8 + nu_scale_top(3) = 3.9_r8 + ksponge_end = 3 + else if (ptop>1e-1_r8) then + ! + ! CAM7 FMT + ! + nu_scale_top(1) = 3.0_r8 + nu_scale_top(2) = 1.0_r8 + nu_scale_top(3) = 0.1_r8 + nu_scale_top(4) = 0.05_r8 + ksponge_end = 4 + else if (ptop>1e-4_r8) then + ! + ! WACCM and WACCM-x + ! + nu_scale_top(1) = 5.0_r8 + nu_scale_top(2) = 5.0_r8 + nu_scale_top(3) = 5.0_r8 + nu_scale_top(4) = 2.0_r8 + nu_scale_top(5) = 1.0_r8 + nu_scale_top(6) = 0.1_r8 + ksponge_end = 6 + end if else - ksponge_end = 0 + ksponge_end = 0 end if ksponge_end = MAX(MAX(ksponge_end,1),kmol_end) if (masterproc) then write(iulog,*) subname//": ksponge_end = ",ksponge_end + write(iulog,*) subname//": sponge layer Laplacian damping" + write(iulog,*) "k, p, z, nu_scale_top, nu (actual Laplacian damping coefficient)" if (nu_top>0) then - do k=1,ksponge_end - write(iulog,'(a,i3,1e11.4)') subname//": nu_scale_top ",k,nu_scale_top(k) + do k=1,ksponge_end+1 + press = (hvcoord%hyam(k)+hvcoord%hybm(k))*hvcoord%ps0 + call std_atm_height(press,z) + write(iulog,'(i3,4e11.4)') k,press,z,& + nu_scale_top(k),nu_scale_top(k)*nu_top end do end if end if @@ -856,7 +886,7 @@ subroutine dyn_init(cam_runtime_opts, dyn_in, dyn_out) call addfld ('FT', (/ 'lev' /), 'A', 'K/s', 'Temperature forcing term on GLL grid',gridname='GLL') ! Tracer forcing on fvm (CSLAM) grid and internal CSLAM pressure fields - if (ntrac>0) then + if (use_cslam) then do m = 1, ntrac call addfld (trim(const_name(m))//'_fvm', (/ 'lev' /), 'I', 'kg/kg', & trim(const_longname(m)), gridname='FVM') @@ -878,7 +908,7 @@ subroutine dyn_init(cam_runtime_opts, dyn_in, dyn_out) ! Energy diagnostics and axial angular momentum diagnostics call addfld ('ABS_dPSdt', horiz_only, 'A', 'Pa/s', 'Absolute surface pressure tendency',gridname='GLL') - if (ntrac>0) then + if (use_cslam) then #ifdef waccm_debug call addfld ('CSLAM_gamma', (/ 'lev' /), 'A', '', 'Courant number from CSLAM', gridname='FVM') #endif @@ -910,7 +940,7 @@ subroutine dyn_init(cam_runtime_opts, dyn_in, dyn_out) ! ! add dynamical core tracer tendency output ! - if (ntrac>0) then + if (use_cslam) then do m = 1, num_advected call addfld(tottnam(m),(/ 'lev' /),'A','kg/kg/s',trim(const_name(m))//' horz + vert', & gridname='FVM') @@ -945,7 +975,63 @@ subroutine dyn_init(cam_runtime_opts, dyn_in, dyn_out) !Remove/replace after CAMDEN history output is enabled -JN: #endif - +#ifdef cam_thermo_history + if (thermo_budget_history) then + ! Register stages for budgets + do istage = 1, num_stages + call cam_budget_em_snapshot(TRIM(ADJUSTL(stage(istage))), 'dyn', & + longname=TRIM(ADJUSTL(stage_txt(istage)))) + end do + ! + ! Register tendency (difference) budgets + ! + call cam_budget_em_register('dEdt_floating_dyn' ,'dAL','dBL','dyn','dif', & + longname="dE/dt floating dynamics (dAL-dBL)" ) + call cam_budget_em_register('dEdt_vert_remap' ,'dAR','dAD','dyn','dif', & + longname="dE/dt vertical remapping (dAR-dAD)" ) + call cam_budget_em_register('dEdt_phys_tot_in_dyn','dBD','dAF','dyn','dif', & + longname="dE/dt physics tendency in dynamics (dBD-dAF)" ) + call cam_budget_em_register('dEdt_del4' ,'dCH','dBH','dyn','dif', & + longname="dE/dt del4 (dCH-dBH)" ) + call cam_budget_em_register('dEdt_del4_fric_heat','dAH','dCH','dyn','dif', & + longname="dE/dt del4 frictional heating (dAH-dCH)" ) + call cam_budget_em_register('dEdt_del4_tot' ,'dAH','dBH','dyn','dif', & + longname="dE/dt del4 + del4 frictional heating (dAH-dBH)" ) + call cam_budget_em_register('dEdt_del2_sponge' ,'dAS','dBS','dyn','dif', & + longname="dE/dt del2 sponge (dAS-dBS)" ) + ! + ! Register derived budgets + ! + call cam_budget_em_register('dEdt_dycore' ,'dEdt_floating_dyn','dEdt_vert_remap' ,'dyn','sum', & + longname="dE/dt adiabatic dynamics" ) + call cam_budget_em_register('dEdt_del2_del4_tot' ,'dEdt_del4_tot' ,'dEdt_del2_sponge' ,'dyn','sum', & + longname="dE/dt explicit diffusion total" ) + call cam_budget_em_register('dEdt_residual' ,'dEdt_floating_dyn','dEdt_del2_del4_tot','dyn','dif',& + longname="dE/dt residual (dEdt_floating_dyn-dEdt_del2_del4_tot)" ) + end if + ! + ! add dynamical core tracer tendency output + ! + if (use_cslam) then + do m = 1, pcnst + call addfld(tottnam(m),(/ 'lev' /),'A','kg/kg/s',trim(cnst_name(m))//' horz + vert', & + gridname='FVM') + end do + else + do m = 1, pcnst + call addfld(tottnam(m),(/ 'lev' /),'A','kg/kg/s',trim(cnst_name(m))//' horz + vert', & + gridname='GLL') + end do + end if + call phys_getopts(history_budget_out=history_budget, history_budget_histfile_num_out=budget_hfile_num) + if ( history_budget ) then + call cnst_get_ind('CLDLIQ', ixcldliq) + call cnst_get_ind('CLDICE', ixcldice) + call add_default(tottnam( 1), budget_hfile_num, ' ') + call add_default(tottnam(ixcldliq), budget_hfile_num, ' ') + call add_default(tottnam(ixcldice), budget_hfile_num, ' ') + end if +#endif end subroutine dyn_init !========================================================================================= @@ -955,14 +1041,16 @@ subroutine dyn_run(dyn_state) use air_composition, only: thermodynamic_active_species_idx_dycore !Se dycore: - use prim_advance_mod, only: calc_tot_energy_dynamics use prim_driver_mod, only: prim_run_subcycle use dimensions_mod, only: cnst_name_gll - use time_mod, only: tstep, nsplit, timelevel_qdp + use se_dyn_time_mod, only: tstep, nsplit, timelevel_qdp, tevolve use hybrid_mod, only: config_thread_region, get_loop_ranges use control_mod, only: qsplit, rsplit, ftype_conserve use thread_mod, only: horz_num_threads - use time_mod, only: tevolve +#ifdef scam + use scamMod, only: single_column, use_3dfrc + use se_single_column_mod, only: apply_SC_forcing,ie_scm +#endif type(dyn_export_t), intent(inout) :: dyn_state @@ -982,6 +1070,7 @@ subroutine dyn_run(dyn_state) real(r8), allocatable, dimension(:,:,:) :: ps_before real(r8), allocatable, dimension(:,:,:) :: abs_ps_tend real (kind=r8) :: omega_cn(2,nelemd) !min and max of vertical Courant number + integer :: nets_in,nete_in character(len=*), parameter :: subname = 'dyn_run' @@ -1053,20 +1142,21 @@ subroutine dyn_run(dyn_state) #endif ! convert elem(ie)%derived%fq to mass tendency - do ie = nets, nete - do m = 1, qsize + if (.not.use_cslam) then + do ie = nets, nete + do m = 1, qsize do k = 1, nlev - do j = 1, np - do i = 1, np - dyn_state%elem(ie)%derived%FQ(i,j,k,m) = dyn_state%elem(ie)%derived%FQ(i,j,k,m)* & - rec2dt*dyn_state%elem(ie)%state%dp3d(i,j,k,tl_f) - end do - end do + do j = 1, np + do i = 1, np + dyn_state%elem(ie)%derived%FQ(i,j,k,m) = dyn_state%elem(ie)%derived%FQ(i,j,k,m)* & + rec2dt*dyn_state%elem(ie)%state%dp3d(i,j,k,tl_f) + end do + end do end do - end do - end do - - if (ftype_conserve>0) then + end do + end do + end if + if (ftype_conserve>0.and..not.use_cslam) then do ie = nets, nete do k=1,nlev do j=1,np @@ -1082,26 +1172,23 @@ subroutine dyn_run(dyn_state) end do end do end if - - if (ntrac > 0) then - do ie = nets, nete - do m = 1, ntrac - do k = 1, nlev - do j = 1, nc - do i = 1, nc - dyn_state%fvm(ie)%fc(i,j,k,m) = dyn_state%fvm(ie)%fc(i,j,k,m)* & - rec2dt!*dyn_state%fvm(ie)%dp_fvm(i,j,k) - end do - end do - end do + if (use_cslam) then + do ie = nets, nete + do m = 1, ntrac + do k = 1, nlev + do j = 1, nc + do i = 1, nc + dyn_state%fvm(ie)%fc(i,j,k,m) = dyn_state%fvm(ie)%fc(i,j,k,m)* & + rec2dt!*dyn_state%fvm(ie)%dp_fvm(i,j,k) + end do + end do end do - end do + end do + end do end if - if (ldiag) then abs_ps_tend(:,:,nets:nete) = 0.0_r8 endif - do n = 1, nsplit_local if (ldiag) then @@ -1109,11 +1196,21 @@ subroutine dyn_run(dyn_state) ps_before(:,:,ie) = dyn_state%elem(ie)%state%psdry(:,:) end do end if - +#ifdef scam + if (single_column) then + nets_in=ie_scm + nete_in=ie_scm + else + nets_in=nets + nete_in=nete + end if ! forward-in-time RK, with subcycling - call prim_run_subcycle(dyn_state%elem, dyn_state%fvm, hybrid, nets, nete, & + call prim_run_subcycle(dyn_state%elem, dyn_state%fvm, hybrid, nets_in, nete_in, & tstep, TimeLevel, hvcoord, n, omega_cn) - +#else + call prim_run_subcycle(dyn_state%elem, dyn_state%fvm, hybrid, nets, nete, & + tstep, TimeLevel, hvcoord, n, .false., omega_cn) +#endif if (ldiag) then do ie = nets, nete abs_ps_tend(:,:,ie) = abs_ps_tend(:,:,ie) + & @@ -1123,7 +1220,6 @@ subroutine dyn_run(dyn_state) end if end do - !Uncomment once "outfld" is enabled in CAMDEN-JN: #if 0 if (ldiag) then @@ -1134,7 +1230,6 @@ subroutine dyn_run(dyn_state) end if #endif - call calc_tot_energy_dynamics(dyn_state%elem,dyn_state%fvm, nets, nete, TimeLevel%n0, n0_qdp,'dBF') !$OMP END PARALLEL !Uncomment once "outfld" is enabled in CAMDEN-JN: @@ -1142,10 +1237,14 @@ subroutine dyn_run(dyn_state) if (ldiag) then deallocate(ps_before,abs_ps_tend) endif +#ifdef SCAM + if (single_column) then + call apply_SC_forcing(dyn_state%elem,hvcoord,TimeLevel,3,.false.) + end if +#endif ! output vars on CSLAM fvm grid call write_dyn_vars(dyn_state) #endif - end subroutine dyn_run !=============================================================================== @@ -1171,7 +1270,7 @@ subroutine read_inidat(dyn_in) use fvm_mapping, only: dyn2fvm_mass_vars use control_mod, only: runtype,initial_global_ave_dry_ps use prim_driver_mod, only: prim_set_dry_mass - + use cam_initfiles, only: scale_dry_air_mass ! Arguments type (dyn_import_t), target, intent(inout) :: dyn_in ! dynamics import @@ -1736,28 +1835,22 @@ subroutine read_inidat(dyn_in) end do end if - ! scale PS to achieve prescribed dry mass following FV dycore (dryairm.F90) -#ifndef planet_mars + ! If scale_dry_air_mass > 0.0 then scale dry air mass to scale_dry_air_mass global average dry pressure if (runtype == 0) then - initial_global_ave_dry_ps = 98288.0_r8 - if (.not. associated(fh_topo)) then - initial_global_ave_dry_ps = 101325._r8 - 245._r8 - end if - if (simple_phys) then - initial_global_ave_dry_ps = 0 !do not scale psdry - end if - if (iam < par%nprocs) then - call prim_set_dry_mass(elem, hvcoord, initial_global_ave_dry_ps, qtmp) - end if - endif -#endif + if (scale_dry_air_mass > 0.0_r8) then + if (iam < par%nprocs) then + call prim_set_dry_mass(elem, hvcoord, scale_dry_air_mass, qtmp) + end if + end if + end if + ! store Q values: ! ! if CSLAM is NOT active then state%Qdp for all constituents ! if CSLAM active then we only advect water vapor and condensate ! loading tracers in state%qdp - if (ntrac > 0) then + if (use_cslam) then do ie = 1, nelemd do nq = 1, thermodynamic_active_species_num m_cnst = thermodynamic_active_species_idx(nq) @@ -1788,7 +1881,7 @@ subroutine read_inidat(dyn_in) ! interpolate fvm tracers and fvm pressure variables - if (ntrac > 0) then + if (use_cslam) then if (par%masterproc) then write(iulog,*) 'Initializing dp_fvm from spectral element dp' end if @@ -1911,6 +2004,7 @@ subroutine set_phis(dyn_in) integer :: ierr, pio_errtype character(len=max_fieldname_len) :: fieldname + character(len=max_fieldname_len) :: fieldname_gll character(len=max_hcoordname_len):: grid_name integer :: dims(2) integer :: dyn_cols @@ -1947,7 +2041,7 @@ subroutine set_phis(dyn_in) phis_tmp = 0.0_r8 - if (fv_nphys > 0) then + if (use_cslam) then allocate(phis_phys_tmp(fv_nphys**2,nelemd), stat=ierr) call check_allocate(ierr, subname, 'phis_phys_tmp(fv_nphys**2,nelemd)', & file=__FILE__, line=__LINE__) @@ -1978,12 +2072,19 @@ subroutine set_phis(dyn_in) ! Set name of grid object which will be used to read data from file ! into internal data structure via PIO. - if (fv_nphys == 0) then - grid_name = 'GLL' - else - grid_name = 'physgrid_d' +#ifdef scam + if (single_column) then + grid_name = 'SCM' + else +#endif + if (fv_nphys == 0) then + grid_name = 'GLL' + else + grid_name = 'physgrid_d' + end if +#ifdef scam end if - +#endif ! Get number of global columns from the grid object and check that ! it matches the file data. call cam_grid_dimensions(grid_name, dims) @@ -1995,7 +2096,11 @@ subroutine set_phis(dyn_in) call endrun(subname//': dimension ncol not found in bnd_topo file') end if ierr = pio_inq_dimlen(fh_topo, ncol_did, ncol_size) +#ifdef scam + if (ncol_size /= dyn_cols .and. .not. single_column) then +#else if (ncol_size /= dyn_cols) then +#endif if (masterproc) then write(iulog,*) subname//': ncol_size=', ncol_size, ' : dyn_cols=', dyn_cols end if @@ -2003,18 +2108,43 @@ subroutine set_phis(dyn_in) end if fieldname = 'PHIS' - if (dyn_field_exists(fh_topo, trim(fieldname))) then - if (fv_nphys == 0) then - call read_dyn_var(fieldname, fh_topo, 'ncol', phis_tmp) + fieldname_gll = 'PHIS_gll' + if (use_cslam.and.dyn_field_exists(fh_topo, trim(fieldname_gll),required=.false.)) then + ! + ! If physgrid it is recommended to read in PHIS on the GLL grid and then + ! map to the physgrid in d_p_coupling + ! + ! This requires a topo file with PHIS_gll on it ... + ! + if (masterproc) then + write(iulog, *) "Reading in PHIS on GLL grid (mapped to physgrid in d_p_coupling)" + end if + call read_dyn_var(fieldname_gll, fh_topo, 'ncol_gll', phis_tmp) + else if (dyn_field_exists(fh_topo, trim(fieldname))) then + if (.not.use_cslam) then + if (masterproc) then + write(iulog, *) "Reading in PHIS" + end if + call read_dyn_var(fieldname, fh_topo, 'ncol', phis_tmp) else - call read_phys_field_2d(fieldname, fh_topo, 'ncol', phis_phys_tmp) - call map_phis_from_physgrid_to_gll(dyn_in%fvm, elem, phis_phys_tmp, & - phis_tmp, pmask) + ! + ! For backwards compatibility we allow reading in PHIS on the physgrid + ! which is then mapped to the GLL grid and back to the physgrid in d_p_coupling + ! (the latter is to avoid noise in derived quantities such as PSL) + ! + if (masterproc) then + write(iulog, *) "Reading in PHIS on physgrid" + write(iulog, *) "Recommended to read in PHIS on GLL grid" + end if + call read_phys_field_2d(fieldname, fh_topo, 'ncol', phis_phys_tmp) + call map_phis_from_physgrid_to_gll(dyn_in%fvm, elem, phis_phys_tmp, & + phis_tmp, pmask) + deallocate(phis_phys_tmp) end if else call endrun(subname//': Could not find PHIS field on input datafile') end if - + ! Put the error handling back the way it was call pio_seterrorhandling(fh_topo, pio_errtype) @@ -2049,57 +2179,8 @@ subroutine set_phis(dyn_in) call analytic_ic_set_ic(vcoord, latvals, lonvals, glob_ind, & PHIS_OUT=phis_tmp, mask=pmask(:)) deallocate(glob_ind) + end if - if (fv_nphys > 0) then - - ! initialize PHIS on physgrid - allocate(latvals_phys(fv_nphys*fv_nphys*nelemd), stat=ierr) - call check_allocate(ierr, subname, 'latvals_phys(fv_nphys*fv_nphys*nelemd)', & - file=__FILE__, line=__LINE__) - - allocate(lonvals_phys(fv_nphys*fv_nphys*nelemd), stat=ierr) - call check_allocate(ierr, subname, 'lonvals_phys(fv_nphys*fv_nphys*nelemd)', & - file=__FILE__, line=__LINE__) - - indx = 1 - do ie = 1, nelemd - do j = 1, fv_nphys - do i = 1, fv_nphys - latvals_phys(indx) = dyn_in%fvm(ie)%center_cart_physgrid(i,j)%lat - lonvals_phys(indx) = dyn_in%fvm(ie)%center_cart_physgrid(i,j)%lon - indx = indx + 1 - end do - end do - end do - - allocate(pmask_phys(fv_nphys*fv_nphys*nelemd), stat=ierr) - call check_allocate(ierr, subname, 'pmask_phys(fv_nphys*fv_nphys*nelemd)', & - file=__FILE__, line=__LINE__) - - pmask_phys(:) = .true. - allocate(glob_ind(fv_nphys*fv_nphys*nelemd), stat=ierr) - call check_allocate(ierr, subname, 'glob_ind(fv_nphys*fv_nphys*nelemd)', & - file=__FILE__, line=__LINE__) - - j = 1 - do ie = 1, nelemd - do i = 1, fv_nphys*fv_nphys - ! Create a global(ish) column index - glob_ind(j) = elem(ie)%GlobalId - j = j + 1 - end do - end do - - call analytic_ic_set_ic(vcoord, latvals_phys, lonvals_phys, glob_ind, & - PHIS_OUT=phis_phys_tmp, mask=pmask_phys) - - deallocate(latvals_phys) - deallocate(lonvals_phys) - deallocate(pmask_phys) - deallocate(glob_ind) - end if - - end if deallocate(pmask) @@ -2114,16 +2195,7 @@ subroutine set_phis(dyn_in) end do end do end do - if (fv_nphys > 0) then - do ie = 1, nelemd - dyn_in%fvm(ie)%phis_physgrid = RESHAPE(phis_phys_tmp(:,ie),(/fv_nphys,fv_nphys/)) - end do - end if - deallocate(phis_tmp) - if (fv_nphys > 0) then - deallocate(phis_phys_tmp) - end if ! boundary exchange to update the redundent columns in the element objects do ie = 1, nelemd @@ -2451,7 +2523,7 @@ subroutine write_dyn_vars(dyn_out) integer :: ie, m !---------------------------------------------------------------------------- - if (ntrac > 0) then + if (use_cslam) then do ie = 1, nelemd call outfld('dp_fvm', RESHAPE(dyn_out%fvm(ie)%dp_fvm(1:nc,1:nc,:), & (/nc*nc,nlev/)), nc*nc, ie) diff --git a/src/dynamics/se/dyn_grid.F90 b/src/dynamics/se/dyn_grid.F90 index 51fdb2da..09b40170 100644 --- a/src/dynamics/se/dyn_grid.F90 +++ b/src/dynamics/se/dyn_grid.F90 @@ -42,14 +42,14 @@ module dyn_grid !SE dycore: use dimensions_mod, only: globaluniquecols, nelem, nelemd, nelemdmax, & - ne, np, npsq, fv_nphys, nlev, nlevp, nc, ntrac + ne, np, npsq, fv_nphys, nlev, use_cslam, nlevp, nc use element_mod, only: element_t use fvm_control_volume_mod, only: fvm_struct use hybvcoord_mod, only: hvcoord_t use prim_init, only: prim_init1 use edge_mod, only: initEdgeBuffer use edgetype_mod, only: EdgeBuffer_t -use time_mod, only: TimeLevel_t +use se_dyn_time_mod, only: TimeLevel_t use dof_mod, only: UniqueCoords, UniquePoints implicit none @@ -60,6 +60,7 @@ module dyn_grid integer, parameter :: fvm_decomp = 102 ! The FVM (CSLAM) grid integer, parameter :: physgrid_d = 103 ! physics grid on dynamics decomp integer, parameter :: ini_decomp = 104 ! alternate dynamics grid for reading initial file +integer, parameter :: ini_decomp_scm = 205 ! alternate dynamics grid for reading initial file character(len=3), protected :: ini_grid_name @@ -135,7 +136,7 @@ subroutine model_grid_init() use hybrid_mod, only: hybrid_t, init_loop_ranges, & get_loop_ranges, config_thread_region use control_mod, only: qsplit, rsplit - use time_mod, only: tstep, nsplit + use se_dyn_time_mod, only: tstep, nsplit use fvm_mod, only: fvm_init2, fvm_init3, fvm_pg_init use dimensions_mod, only: irecons_tracer, dimensions_mod_init, qsize use comp_gll_ctr_vol, only: gll_grid_write @@ -248,7 +249,7 @@ subroutine model_grid_init() if (iam < par%nprocs) then call prim_init1(elem, fvm, par, TimeLevel) - if (fv_nphys > 0) then + if (use_cslam) then call dp_init(elem, fvm) end if @@ -779,7 +780,9 @@ subroutine define_cam_grids() use cam_grid_support, only: horiz_coord_t, horiz_coord_create use cam_grid_support, only: cam_grid_register, cam_grid_attribute_register - +#ifdef SCAM + use scamMod, only: closeioplon,closeioplat,closeioplonidx,single_column +#endif !SE dycore: use dimensions_mod, only: nc @@ -790,6 +793,7 @@ subroutine define_cam_grids() type(horiz_coord_t), pointer :: lat_coord type(horiz_coord_t), pointer :: lon_coord integer(iMap), pointer :: grid_map(:,:) + integer(iMap), pointer :: grid_map_scm(:,:) !grid_map decomp for single column mode real(r8), allocatable :: pelat_deg(:) ! pe-local latitudes (degrees) real(r8), allocatable :: pelon_deg(:) ! pe-local longitudes (degrees) @@ -797,6 +801,7 @@ subroutine define_cam_grids() real(r8) :: areaw(np,np) integer(iMap) :: fdofP_local(npsq,nelemd) ! pe-local map for dynamics decomp integer(iMap), allocatable :: pemap(:) ! pe-local map for PIO decomp + integer(iMap), allocatable :: pemap_scm(:) ! pe-local map for single column PIO decomp integer :: ncols_fvm, ngcols_fvm real(r8), allocatable :: fvm_coord(:) @@ -933,12 +938,48 @@ subroutine define_cam_grids() ! grid_map cannot be deallocated as the cam_filemap_t object just points ! to it. It can be nullified. nullify(grid_map) +#ifdef SCAM + !--------------------------------- + ! Create SCM grid object when running single column mode + !--------------------------------- + + if ( single_column) then + allocate(pemap_scm(1)) + pemap_scm = 0_iMap + pemap_scm = closeioplonidx + ! Map for scm grid + allocate(grid_map_scm(3,npsq)) + grid_map_scm = 0_iMap + mapind = 1 + j = 1 + do i = 1, npsq + grid_map_scm(1, mapind) = i + grid_map_scm(2, mapind) = j + grid_map_scm(3, mapind) = pemap_scm(1) + mapind = mapind + 1 + end do + latval=closeioplat + lonval=closeioplon + + lat_coord => horiz_coord_create('lat', 'ncol', 1, & + 'latitude', 'degrees_north', 1, 1, latval, map=pemap_scm) + lon_coord => horiz_coord_create('lon', 'ncol', 1, & + 'longitude', 'degrees_east', 1, 1, lonval, map=pemap_scm) + + call cam_grid_register('SCM', ini_decomp_scm, lat_coord, lon_coord, & + grid_map_scm, block_indexed=.false., unstruct=.true.) + deallocate(pemap_scm) + ! grid_map cannot be deallocated as the cam_filemap_t object just points + ! to it. It can be nullified. + nullify(grid_map_scm) + end if +#endif !--------------------------------- ! Create FVM grid object for CSLAM !--------------------------------- - if (ntrac > 0) then + if (use_cslam) then ncols_fvm = nc * nc * nelemd ngcols_fvm = nc * nc * nelem_d diff --git a/src/dynamics/se/namelist_definition_se_dycore.xml b/src/dynamics/se/namelist_definition_se_dycore.xml index 12f674aa..0283f71a 100644 --- a/src/dynamics/se/namelist_definition_se_dycore.xml +++ b/src/dynamics/se/namelist_definition_se_dycore.xml @@ -89,66 +89,16 @@ 4 - - integer - se - dyn_se_nl - - Variable to specify the vertical index at which the - Rayleigh friction term is centered (the peak value). - Default: 2 - - - 2 - - - - real - se - dyn_se_nl - - Rayleigh friction parameter to determine the width of the profile. If set - to 0 then a width is chosen by the algorithm (see rayleigh_friction.F90). - Default: 0.5. - - - 0.5 - 3 - - - - real - se - dyn_se_nl - - Rayleigh friction parameter to determine the approximate value of the decay - time (days) at model top. If 0.0 then no Rayleigh friction is applied. - Default: 0. - - - 0.0 - - real se dyn_se_nl - Used by SE dycore to apply sponge layer diffusion to u, v, and T for - stability of WACCM configurations. The diffusion is modeled on 3D molecular - diffusion and thermal conductivity by using actual molecular diffusion and - thermal conductivity coefficients multiplied by the value of - se_molecular_diff. - - If set <= 0.0 then the code is not activated. If set > 0.0 then - the molecular diffusion and thermal conductivity coefficients will be - multiplied by a factor of se_molecular_diff. - - Default: 0. + Enable thermal conductivity and molecular diffusion in the horizontal in SE dycore. 0.0 - 100.0 + 1.0 @@ -255,22 +205,6 @@ 7 - - integer - se - dyn_se_nl - 0,1,2 - - Scaling of temperature increment for different levels of - thermal energy consistency. - 0: no scaling - 1: scale increment for cp consistency between dynamics and physics - 2: do 1 as well as take into account condensate effect on thermal energy - - - 1 - - real se @@ -318,45 +252,66 @@ Second-order viscosity applied only near the model top [m^2/s]. - 5.0e5 - 1.0e6 - - 0.0 + 1.25e5 + 1.0e6 + 1.0e6 + 1.0e6 2.0e5 - - logical + + real se dyn_se_nl - Hyperscosity for T and dp is applied to (T-Tref) and (dp-dp_ref) where - Xref are reference states where the effect of topography has been removed - (Simmons and Jiabin, 1991, QJRMS, Section 2a). - If TRUE dp_ref is dynamic smoothed reference state derived by Patrick Callaghan - (Lauritzen et al., 2018, JAMES, Appendix A.2) and temperature reference state - based on Simmons and Jiabin (1991) but using smoothed dp_ref. - If FALSE Tref is static reference state (Simmons and Jiabin) and dp_ref state - derived from hydrostatic balance. + Hyperviscosity coefficient se_nu [m^4/s] for u,v, T is increased to + se_nu_p*se_sponge_del4_nu_fac following a hyperbolic tangent function + centered around pressure at vertical index se_sponge_del4_lev: + + 0.5_r8*(1.0_r8+tanh(2.0_r8*log(pmid(se_sponge_del4_lev)/press))) + + where press is pressure + + If < 0, se_sponge_del4_nu_fac is automatically set based on model top location. + Default: Set by build-namelist. - .false. + -1 - - logical - se + + real + se> dyn_se_nl - If TRUE the continous equations the dynamical core is based on will conserve a - comprehensive moist total energy - If FALSE the continous equations the dynamical core is based on will conserve - a total energy based on cp for dry air and no condensates (same total energy as - CAM physics uses). - For more details see Lauritzen et al., (2018;DOI:10.1029/2017MS001257) + Divergence damping hyperviscosity coefficient se_nu_div [m^4/s] for u,v is increased to + se_nu_p*se_sponge_del4_nu_div_fac following a hyperbolic tangent function + centered around pressure at vertical index se_sponge_del4_lev: + + 0.5_r8*(1.0_r8+tanh(2.0_r8*log(pmid(se_sponge_del4_lev)/press))) + + where press is pressure + + If < 0, se_sponge_del4_nu_div_fac is automatically set based on model top location. - .true. + -1 + + + + real + se> + dyn_se_nl + + Level index around which increased del4 damping is centered. + + See se_sponge_del4_nu_fac and se_sponge_del4_nu_div_fac + + If < 0, se_sponge_del4_lev is automatically set based on model top location. + Default: Set by build-namelist. + + + -1 @@ -689,4 +644,43 @@ 0 + + integer + se + dyn_se_nl + 1,2,3 + + 1: Exner version of pressure gradient force (PGF) + see Appendix A in https://agupubs.onlinelibrary.wiley.com/doi/epdf/10.1029/2022MS003192 + + 2: Traditional pressure gradient formulation (grad p) + + 3: Hybrid (formulation 1 where hybm>0 else formulation 2) + Use hybrid PGF option for WACCM-x to make WACCM-x consistent with PGF + used in CAM in the troposphere and traditional PGF formulation above + + + 1 + 3 + + + + integer + se + dyn_se_nl + 0,1 + + 0: physics tendencies will be added every vertical remapping time-step (dt_phys/se_nsplit) + for se_ftype=0,2 + + 1: physics tendencies will be added every dynamics time-step (dt_phys/se_nsplit*se_rsplit) + for se_ftype=0,2 + + If se_ftype=1 then se_dribble_in_rsplit_loop has no effect since physics tendencies are added as an adjustment + + + 0 + 1 + + diff --git a/src/dynamics/se/stepon.F90 b/src/dynamics/se/stepon.F90 index 138a6125..11118bdb 100644 --- a/src/dynamics/se/stepon.F90 +++ b/src/dynamics/se/stepon.F90 @@ -10,7 +10,11 @@ module stepon !SE dycore: use parallel_mod, only: par use dimensions_mod, only: nelemd - +#ifdef scam +use scamMod, only: use_iop, doiopupdate, single_column, & + setiopupdate, readiopdata +use se_single_column_mod, only: scm_setfield, iop_broadcast +#endif implicit none private save @@ -26,12 +30,52 @@ module stepon !========================================================================================= subroutine stepon_init(cam_runtime_opts, dyn_in, dyn_out) - +#ifdef constituents + use constituents, only: pcnst, cnst_name, cnst_longname + use dimensions_mod, only: fv_nphys, cnst_name_gll, cnst_longname_gll, qsize +#endif ! Dummy arguments type(runtime_options), intent(in) :: cam_runtime_opts ! Runtime settings object type(dyn_import_t), intent(in) :: dyn_in ! Dynamics import container type(dyn_export_t), intent(in) :: dyn_out ! Dynamics export container + ! local variables + integer :: m, m_cnst +#ifdef constituents + !---------------------------------------------------------------------------- + ! These fields on dynamics grid are output before the call to d_p_coupling. + do m_cnst = 1, qsize + call addfld(trim(cnst_name_gll(m_cnst))//'_gll', (/ 'lev' /), 'I', 'kg/kg', & + trim(cnst_longname_gll(m_cnst)), gridname='GLL') + call addfld(trim(cnst_name_gll(m_cnst))//'dp_gll', (/ 'lev' /), 'I', 'kg/kg', & + trim(cnst_longname_gll(m_cnst))//'*dp', gridname='GLL') + end do + call addfld('U_gll' ,(/ 'lev' /), 'I', 'm/s ','U wind on gll grid',gridname='GLL') + call addfld('V_gll' ,(/ 'lev' /), 'I', 'm/s ','V wind on gll grid',gridname='GLL') + call addfld('T_gll' ,(/ 'lev' /), 'I', 'K ' ,'T on gll grid' ,gridname='GLL') + call addfld('dp_ref_gll' ,(/ 'lev' /), 'I', ' ' ,'dp dry / dp_ref on gll grid' ,gridname='GLL') + call addfld('PSDRY_gll' ,horiz_only , 'I', 'Pa ' ,'psdry on gll grid' ,gridname='GLL') + call addfld('PS_gll' ,horiz_only , 'I', 'Pa ' ,'ps on gll grid' ,gridname='GLL') + call addfld('PHIS_gll' ,horiz_only , 'I', 'Pa ' ,'PHIS on gll grid' ,gridname='GLL') + + ! Fields for initial condition files + call addfld('U&IC', (/ 'lev' /), 'I', 'm/s', 'Zonal wind', gridname='GLL' ) + call addfld('V&IC', (/ 'lev' /), 'I', 'm/s', 'Meridional wind',gridname='GLL' ) + ! Don't need to register U&IC V&IC as vector components since we don't interpolate IC files + call add_default('U&IC',0, 'I') + call add_default('V&IC',0, 'I') + + call addfld('PS&IC', horiz_only, 'I', 'Pa', 'Surface pressure', gridname='GLL') + call addfld('T&IC', (/ 'lev' /), 'I', 'K', 'Temperature', gridname='GLL') + call add_default('PS&IC', 0, 'I') + call add_default('T&IC', 0, 'I') + + do m_cnst = 1,pcnst + call addfld(trim(cnst_name(m_cnst))//'&IC', (/ 'lev' /), 'I', 'kg/kg', & + trim(cnst_longname(m_cnst)), gridname='GLL') + call add_default(trim(cnst_name(m_cnst))//'&IC', 0, 'I') + end do +#endif end subroutine stepon_init !========================================================================================= @@ -44,7 +88,7 @@ subroutine stepon_timestep_init(dtime_out, cam_runtime_opts, phys_state, & use dp_coupling, only: d_p_coupling ! dynamics-physics coupling !SE dycore: - use time_mod, only: tstep ! dynamics timestep + use se_dyn_time_mod, only: tstep ! dynamics timestep ! Dummy arguments real(r8), intent(out) :: dtime_out ! Time-step (s) @@ -66,14 +110,39 @@ subroutine stepon_timestep_init(dtime_out, cam_runtime_opts, phys_state, & ! write diagnostic fields on gll grid and initial file call diag_dynvar_ic(dyn_out%elem, dyn_out%fvm) end if +#ifdef scam + + ! Determine whether it is time for an IOP update; + ! doiopupdate set to true if model time step > next available IOP + + + if (use_iop .and. masterproc) then + call setiopupdate + end if + if (single_column) then + + ! If first restart step then ensure that IOP data is read + if (is_first_restart_step()) then + if (masterproc) call readiopdata( hvcoord%hyam, hvcoord%hybm, hvcoord%hyai, hvcoord%hybi, hvcoord%ps0 ) + call iop_broadcast() + endif + + iop_update_phase1 = .true. + if ((is_first_restart_step() .or. doiopupdate) .and. masterproc) then + call readiopdata( hvcoord%hyam, hvcoord%hybm, hvcoord%hyai, hvcoord%hybi, hvcoord%ps0 ) + endif + call iop_broadcast() + + call scm_setfield(dyn_out%elem,iop_update_phase1) + endif +#endif ! Synchronize all PEs and then transfer dynamics variables to physics: call t_barrierf('sync_d_p_coupling', mpicom) call t_startf('d_p_coupling') ! Move data into phys_state structure. call d_p_coupling(cam_runtime_opts, phys_state, phys_tend, dyn_out) call t_stopf('d_p_coupling') - end subroutine stepon_timestep_init !========================================================================================= @@ -85,9 +154,9 @@ subroutine stepon_run2(cam_runtime_opts, phys_state, phys_tend, dyn_in, dyn_out) use dyn_grid, only: TimeLevel !SE dycore: - use time_mod, only: TimeLevel_Qdp + use se_dyn_time_mod, only: TimeLevel_Qdp use control_mod, only: qsplit - use prim_advance_mod, only: calc_tot_energy_dynamics + use prim_advance_mod, only: tot_energy_dyn ! Dummy arguments type(runtime_options), intent(in) :: cam_runtime_opts ! Runtime settings object @@ -98,12 +167,12 @@ subroutine stepon_run2(cam_runtime_opts, phys_state, phys_tend, dyn_in, dyn_out) ! Local variables integer :: tl_f, tl_fQdp + !---------------------------------------------------------------------------- !Determine appropriate time values: tl_f = TimeLevel%n0 ! timelevel which was adjusted by physics call TimeLevel_Qdp(TimeLevel, qsplit, tl_fQdp) - ! Synchronize all PEs and then transfer physics variables to dynamics: call t_barrierf('sync_p_d_coupling', mpicom) call t_startf('p_d_coupling') @@ -112,7 +181,7 @@ subroutine stepon_run2(cam_runtime_opts, phys_state, phys_tend, dyn_in, dyn_out) call t_stopf('p_d_coupling') if (iam < par%nprocs) then - call calc_tot_energy_dynamics(dyn_in%elem,dyn_in%fvm, 1, nelemd, tl_f, tl_fQdp,'dED') + call tot_energy_dyn(dyn_in%elem,dyn_in%fvm, 1, nelemd, tl_f, tl_fQdp,'dED') end if end subroutine stepon_run2 @@ -126,10 +195,12 @@ subroutine stepon_run3(dtime, cam_runtime_opts, cam_out, phys_state, dyn_in, dyn !SE/CAM interface: use dyn_comp, only: dyn_run use dyn_grid, only: TimeLevel +#ifdef scam + use advect_tend, only: compute_write_iop_fields +#endif use advect_tend, only: compute_adv_tends_xyz - !SE dycore: - use time_mod, only: TimeLevel_Qdp + use se_dyn_time_mod,only: TimeLevel_Qdp use control_mod, only: qsplit ! Dummy arguments @@ -143,13 +214,26 @@ subroutine stepon_run3(dtime, cam_runtime_opts, cam_out, phys_state, dyn_in, dyn ! Local variables integer :: tl_f, tl_fQdp !-------------------------------------------------------------------------------------- - +#ifdef scam + if (single_column) then + ! Update IOP properties e.g. omega, divT, divQ + iop_update_phase1 = .false. + if (doiopupdate) then + if (masterproc) call readiopdata( hvcoord%hyam, hvcoord%hybm, hvcoord%hyai, hvcoord%hybi, hvcoord%ps0 ) + call iop_broadcast() + call scm_setfield(dyn_out%elem,iop_update_phase1) + endif + endif +#endif ! Determine appropriate time values and ! initalize advected constituent mixing ratios: call t_startf('comp_adv_tends1') tl_f = TimeLevel%n0 call TimeLevel_Qdp(TimeLevel, qsplit, tl_fQdp) call compute_adv_tends_xyz(dyn_in%elem,dyn_in%fvm,1,nelemd,tl_fQdp,tl_f) +#ifdef scam + if (write_camiop) call compute_write_iop_fields(dyn_in%elem,dyn_in%fvm,1,nelemd,tl_fQdp,tl_f) +#endif call t_stopf('comp_adv_tends1') ! Synchronize all PEs and then run dynamics (dyn_run): @@ -164,6 +248,9 @@ subroutine stepon_run3(dtime, cam_runtime_opts, cam_out, phys_state, dyn_in, dyn tl_f = TimeLevel%n0 call TimeLevel_Qdp(TimeLevel, qsplit, tl_fQdp) call compute_adv_tends_xyz(dyn_in%elem,dyn_in%fvm,1,nelemd,tl_fQdp,tl_f) +#ifdef scam + if (write_camiop) call compute_write_iop_fields(dyn_in%elem,dyn_in%fvm,1,nelemd,tl_fQdp,tl_f) +#endif call t_stopf('comp_adv_tends2') end subroutine stepon_run3 @@ -192,7 +279,7 @@ subroutine diag_dynvar_ic(elem, fvm) use cam_abortutils, only: endrun, check_allocate !SE dycore: - use time_mod, only: TimeLevel_Qdp ! dynamics typestep + use se_dyn_time_mod, only: TimeLevel_Qdp ! dynamics typestep use control_mod, only: qsplit use hybrid_mod, only: config_thread_region, get_loop_ranges use hybrid_mod, only: hybrid_t diff --git a/src/dynamics/se/test_fvm_mapping.F90 b/src/dynamics/se/test_fvm_mapping.F90 index 1fada43a..308573d9 100644 --- a/src/dynamics/se/test_fvm_mapping.F90 +++ b/src/dynamics/se/test_fvm_mapping.F90 @@ -5,7 +5,7 @@ module test_fvm_mapping !SE dycore: use fvm_control_volume_mod, only: fvm_struct - use dimensions_mod, only: np, nelemd, nlev, npsq, ntrac + use dimensions_mod, only: np, nelemd, nlev, npsq, ntrac, use_cslam use element_mod, only: element_t implicit none private @@ -252,7 +252,7 @@ subroutine test_mapping_output_mapped_tendencies(fvm,elem,nets,nete,tl_f,tl_qdp) name = 'p2d_'//trim(const_name(m_cnst))//'_err_gll' call outfld(TRIM(name), RESHAPE(elem(ie)%derived%fq(:,:,:,nq),(/npsq,nlev/)), npsq, ie) end do - if (ntrac>0) then + if (use_cslam) then do nq=ntrac,ntrac m_cnst = nq name = 'p2f_'//trim(const_name(m_cnst))//'_fvm' @@ -390,7 +390,7 @@ subroutine test_mapping_output_phys_state(phys_state,fvm) call outfld('d2p_scalar', phys_state(lchnk)%omega(1:pcols,1:pver), pcols, lchnk) call outfld('d2p_u', phys_state(lchnk)%U(1:pcols,1:pver), pcols, lchnk) call outfld('d2p_v', phys_state(lchnk)%V(1:pcols,1:pver), pcols, lchnk) - if (ntrac>0) then + if (use_cslam) then do nq=ntrac,ntrac m_cnst = nq name = 'f2p_'//trim(const_name(m_cnst)) diff --git a/src/dynamics/utils/dynconst.F90 b/src/dynamics/utils/dynconst.F90 index 78c5b04c..93c2d863 100644 --- a/src/dynamics/utils/dynconst.F90 +++ b/src/dynamics/utils/dynconst.F90 @@ -45,6 +45,8 @@ module dynconst real(kind_dyn), protected, public :: lapse_rate ! R/Cp real(kind_dyn), protected, public :: cappa + ! Standard pressure [Pa] + real(kind_dyn), protected, public :: pstd !Public routines: @@ -72,6 +74,7 @@ subroutine dynconst_init use physconst, only: phys_cappa=>cappa use physconst, only: phys_rair=>rair use physconst, only: phys_rh2o=>rh2o + use physconst, only: phys_pstd=>pstd !Set constants used by the dynamics: @@ -86,7 +89,7 @@ subroutine dynconst_init tref = real(phys_tref, kind_dyn) lapse_rate = real(phys_lapse_rate, kind_dyn) cappa = real(phys_cappa, kind_dyn) - + pstd = real(phys_pstd, kind_dyn) end subroutine dynconst_init end module dynconst