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 @@
<value>UNSET_PATH</value>
</values>
</entry>
-
+ <entry id="scale_dry_air_mass">
+ <type>real</type>
+ <category>initial_conditions</category>
+ <group>cam_initfiles_nl</group>
+ <desc>
+ 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.
+ </desc>
+ <values>
+ <value>0.0D0</value>
+ <value aquaplanet="1"> 101080.0D0 </value>
+ <!-- Scale Dry Air Mass: for cases with topography -->
+ <value phys="cam4" > 98288.0D0 </value>
+ <value phys="cam5" > 98288.0D0 </value>
+ <value phys="cam6" > 98288.0D0 </value>
+ <value phys="cam7" > 98288.0D0 </value>
+ </values>
+ </entry>
<!-- Topography -->
<entry id="bnd_topo">
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. ntrac<tracer_num_threads) &
+ if(use_cslam .and. ntrac<tracer_num_threads) &
print *,'WARNING: insufficient CSLAM tracer parallelism to support ',tracer_num_threads,' tracer threads'
if ( .NOT. allocated(work_pool_ctrac) ) then
allocate(work_pool_ctrac(tracer_num_threads,2), stat=iret)
diff --git a/src/dynamics/se/dycore/namelist_mod.F90 b/src/dynamics/se/dycore/namelist_mod.F90
index 8db0b627..7e375a09 100644
--- a/src/dynamics/se/dycore/namelist_mod.F90
+++ b/src/dynamics/se/dycore/namelist_mod.F90
@@ -70,7 +70,7 @@ end subroutine homme_set_defaults
subroutine homme_postprocess_namelist(mesh_file, par)
use mesh_mod, only: MeshOpen
- use dimensions_mod, only: ntrac
+ use dimensions_mod, only: use_cslam
! Dummy arguments
character(len=*), intent(in) :: mesh_file
type (parallel_t), intent(in) :: par
@@ -120,7 +120,7 @@ subroutine homme_postprocess_namelist(mesh_file, par)
end if
end if
- if ((cubed_sphere_map /= 0) .AND. ntrac>0) 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<T>/d<PHI> 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 > = <PHI, curl(elem%state%v >
!
! 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 > = <PHI, div(elem%state%v >
!
! 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 > = <PHI, curl(elem%state%v >
!
! 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 > = <PHI, div(elem%state%v >
!
! 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 > = <PHI, curl(elem%state%v >
!
! 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 > = <PHI, div(elem%state%v >
!
! 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 @@
<value hgrid="ne120np4">4</value>
</values>
</entry>
- <entry id="se_rayk0">
- <type>integer</type>
- <category>se</category>
- <group>dyn_se_nl</group>
- <desc>
- Variable to specify the vertical index at which the
- Rayleigh friction term is centered (the peak value).
- Default: 2
- </desc>
- <values>
- <value>2</value>
- </values>
- </entry>
- <entry id="se_raykrange">
- <type>real</type>
- <category>se</category>
- <group>dyn_se_nl</group>
- <desc>
- 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.
- </desc>
- <values>
- <value>0.5</value>
- <value waccm_phys="1">3</value>
- </values>
- </entry>
- <entry id="se_raytau0">
- <type>real</type>
- <category>se</category>
- <group>dyn_se_nl</group>
- <desc>
- 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.
- </desc>
- <values>
- <value>0.0</value>
- </values>
- </entry>
<entry id="se_molecular_diff">
<type>real</type>
<category>se</category>
<group>dyn_se_nl</group>
<desc>
- 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.
</desc>
<values>
<value>0.0</value>
- <value waccm_phys="1" waccmx="0">100.0</value>
+ <value waccmx="1">1.0</value>
</values>
</entry>
<entry id="se_hypervis_subcycle_q">
@@ -255,22 +205,6 @@
<value hgrid="ne0np4TESTONLY.ne5x4">7</value>
</values>
</entry>
- <entry id="se_phys_dyn_cp">
- <type>integer</type>
- <category>se</category>
- <group>dyn_se_nl</group>
- <valid_values>0,1,2</valid_values>
- <desc>
- 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
- </desc>
- <values>
- <value>1</value>
- </values>
- </entry>
<entry id="se_nu">
<type>real</type>
<category>se</category>
@@ -318,45 +252,66 @@
Second-order viscosity applied only near the model top [m^2/s].
</desc>
<values>
- <value>5.0e5</value>
- <value waccmx="1">1.0e6</value>
- <!-- WACCM uses molecular/thermal diffusion in sponge -->
- <value waccm_phys="1">0.0</value>
+ <value>1.25e5</value>
+ <value waccmx="1" >1.0e6</value>
+ <value waccm_phys="1">1.0e6</value>
+ <value model_top="mt">1.0e6</value>
<value se_refined_mesh="1">2.0e5</value>
</values>
</entry>
- <entry id="se_hypervis_dynamic_ref_state">
- <type>logical</type>
+ <entry id="se_sponge_del4_nu_fac">
+ <type>real</type>
<category>se</category>
<group>dyn_se_nl</group>
<desc>
- 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.
</desc>
<values>
- <value>.false.</value>
+ <value>-1</value>
</values>
</entry>
- <entry id="se_lcp_moist">
- <type>logical</type>
- <category>se</category>
+ <entry id="se_sponge_del4_nu_div_fac">
+ <type>real</type>
+ <category>se></category>
<group>dyn_se_nl</group>
<desc>
- 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.
</desc>
<values>
- <value>.true.</value>
+ <value>-1</value>
+ </values>
+ </entry>
+ <entry id="se_sponge_del4_lev">
+ <type>real</type>
+ <category>se></category>
+ <group>dyn_se_nl</group>
+ <desc>
+ 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.
+ </desc>
+ <values>
+ <value>-1</value>
</values>
</entry>
<entry id="se_large_Courant_incr">
@@ -689,4 +644,43 @@
<value>0</value>
</values>
</entry>
+ <entry id="se_pgf_formulation">
+ <type>integer</type>
+ <category>se</category>
+ <group>dyn_se_nl</group>
+ <valid_values>1,2,3</valid_values>
+ <desc>
+ 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
+ </desc>
+ <values>
+ <value>1</value>
+ <value waccmx="1">3</value>
+ </values>
+ </entry>
+ <entry id="se_dribble_in_rsplit_loop">
+ <type>integer</type>
+ <category>se</category>
+ <group>dyn_se_nl</group>
+ <valid_values>0,1</valid_values>
+ <desc>
+ 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
+ </desc>
+ <values>
+ <value>0</value>
+ <value hgrid="ne16np4" waccm_phys="1" waccmx="0">1</value>
+ </values>
+ </entry>
</entry_id_pg>
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