Skip to content

Commit

Permalink
Add SE dycore updates from ESCOMP/CAM PR ESCOMP#264
Browse files Browse the repository at this point in the history
  • Loading branch information
@nusbaume
nusbaume committed Jun 12, 2024
1 parent b7d9dbb commit d6887a6
Show file tree
Hide file tree
Showing 2 changed files with 20 additions and 23 deletions.
3 changes: 0 additions & 3 deletions src/dynamics/se/dycore/prim_advance_mod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -120,9 +120,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
Expand Down
40 changes: 20 additions & 20 deletions src/dynamics/se/dycore/prim_advection_mod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -333,7 +333,7 @@ subroutine qdp_time_avg( elem , rkstage , n0_qdp , np1_qdp , hybrid , nets , net
do ie=nets,nete
do q=qbeg,qend
do k=kbeg,kend
!OMP_COLLAPSE_SIMD
!OMP_COLLAPSE_SIMD
!DIR_VECTOR_ALIGNED
do j=1,np
do i=1,np
Expand Down Expand Up @@ -446,7 +446,7 @@ subroutine euler_step( np1_qdp , n0_qdp , dt , elem , hvcoord , hybrid , deriv ,
do ie = nets, nete
! add hyperviscosity to RHS. apply to Q at timelevel n0, Qdp(n0)/dp
do k = kbeg, kend
!OMP_COLLAPSE_SIMD
!OMP_COLLAPSE_SIMD
!DIR_VECTOR_ALIGNED
do j=1,np
do i=1,np
Expand Down Expand Up @@ -486,7 +486,7 @@ subroutine euler_step( np1_qdp , n0_qdp , dt , elem , hvcoord , hybrid , deriv ,
if ( nu_p > 0 ) then
do ie = nets, nete
do k = kbeg, kend
!OMP_COLLAPSE_SIMD
!OMP_COLLAPSE_SIMD
!DIR_VECTOR_ALIGNED
do j=1,np
do i=1,np
Expand All @@ -497,7 +497,7 @@ subroutine euler_step( np1_qdp , n0_qdp , dt , elem , hvcoord , hybrid , deriv ,
do q = qbeg,qend
do k = kbeg, kend
! NOTE: divide by dp0 since we multiply by dp0 below
!OMP_COLLAPSE_SIMD
!OMP_COLLAPSE_SIMD
!DIR_VECTOR_ALIGNED
do j=1,np
do i=1,np
Expand All @@ -521,7 +521,7 @@ subroutine euler_step( np1_qdp , n0_qdp , dt , elem , hvcoord , hybrid , deriv ,
do ie = nets, nete
do q = qbeg, qend
do k = kbeg, kend
!OMP_COLLAPSE_SIMD
!OMP_COLLAPSE_SIMD
!DIR_VECTOR_ALIGNED
do j=1,np
do i=1,np
Expand All @@ -543,7 +543,7 @@ subroutine euler_step( np1_qdp , n0_qdp , dt , elem , hvcoord , hybrid , deriv ,
do ie = nets, nete
do q = qbeg, qend
do k = kbeg, kend
!OMP_COLLAPSE_SIMD
!OMP_COLLAPSE_SIMD
!DIR_VECTOR_ALIGNED
do j=1,np
do i=1,np
Expand Down Expand Up @@ -572,7 +572,7 @@ subroutine euler_step( np1_qdp , n0_qdp , dt , elem , hvcoord , hybrid , deriv ,
do k = kbeg, kend
! derived variable divdp_proj() (DSS'd version of divdp) will only be correct on 2nd and 3rd stage
! but that's ok because rhs_multiplier=0 on the first stage:
!OMP_COLLAPSE_SIMD
!OMP_COLLAPSE_SIMD
!DIR_VECTOR_ALIGNED
do j=1,np
do i=1,np
Expand All @@ -586,7 +586,7 @@ subroutine euler_step( np1_qdp , n0_qdp , dt , elem , hvcoord , hybrid , deriv ,
! Note that the term dpdissk is independent of Q
do k = kbeg, kend
! UN-DSS'ed dp at timelevel n0+1:
!OMP_COLLAPSE_SIMD
!OMP_COLLAPSE_SIMD
!DIR_VECTOR_ALIGNED
do j=1,np
do i=1,np
Expand All @@ -597,7 +597,7 @@ subroutine euler_step( np1_qdp , n0_qdp , dt , elem , hvcoord , hybrid , deriv ,
! add contribution from UN-DSS'ed PS dissipation
! dpdiss(:,:) = ( hvcoord%hybi(k+1) - hvcoord%hybi(k) ) *
! elem(ie)%derived%psdiss_biharmonic(:,:)
!OMP_COLLAPSE_SIMD
!OMP_COLLAPSE_SIMD
!DIR_VECTOR_ALIGNED
do j=1,np
do i=1,np
Expand All @@ -619,7 +619,7 @@ subroutine euler_step( np1_qdp , n0_qdp , dt , elem , hvcoord , hybrid , deriv ,
do q = qbeg, qend
do k = kbeg, kend
! div( U dp Q),
!OMP_COLLAPSE_SIMD
!OMP_COLLAPSE_SIMD
!DIR_VECTOR_ALIGNED
do j=1,np
do i=1,np
Expand All @@ -640,8 +640,8 @@ subroutine euler_step( np1_qdp , n0_qdp , dt , elem , hvcoord , hybrid , deriv ,
enddo

! optionally add in hyperviscosity computed above:
if ( rhs_viss /= 0 ) then
!OMP_COLLAPSE_SIMD
if ( rhs_viss /= 0 ) then
!OMP_COLLAPSE_SIMD
!DIR_VECTOR_ALIGNED
do j=1,np
do i=1,np
Expand All @@ -662,7 +662,7 @@ subroutine euler_step( np1_qdp , n0_qdp , dt , elem , hvcoord , hybrid , deriv ,
! dont do this earlier, since we allow np1_qdp == n0_qdp
! and we dont want to overwrite n0_qdp until we are done using it
do k = kbeg, kend
!OMP_COLLAPSE_SIMD
!OMP_COLLAPSE_SIMD
!DIR_VECTOR_ALIGNED
do j=1,np
do i=1,np
Expand Down Expand Up @@ -693,7 +693,7 @@ subroutine euler_step( np1_qdp , n0_qdp , dt , elem , hvcoord , hybrid , deriv ,
if ( DSSopt == DSSdiv_vdp_ave ) DSSvar => elem(ie)%derived%divdp_proj(:,:,:)
! also DSS extra field
do k = kbeg, kend
!OMP_COLLAPSE_SIMD
!OMP_COLLAPSE_SIMD
!DIR_VECTOR_ALIGNED
do j=1,np
do i=1,np
Expand All @@ -718,7 +718,7 @@ subroutine euler_step( np1_qdp , n0_qdp , dt , elem , hvcoord , hybrid , deriv ,
kptr = qsize*nlev + kbeg -1
call edgeVunpack( edgeAdvp1 , DSSvar(:,:,kbeg:kend) , kblk , kptr , ie )
do k = kbeg, kend
!OMP_COLLAPSE_SIMD
!OMP_COLLAPSE_SIMD
!DIR_VECTOR_ALIGNED
do j=1,np
do i=1,np
Expand All @@ -732,7 +732,7 @@ subroutine euler_step( np1_qdp , n0_qdp , dt , elem , hvcoord , hybrid , deriv ,
kptr = nlev*(q-1) + kbeg - 1
call edgeVunpack( edgeAdvp1 , elem(ie)%state%Qdp(:,:,kbeg:kend,q,np1_qdp) , kblk , kptr , ie )
do k = kbeg, kend
!OMP_COLLAPSE_SIMD
!OMP_COLLAPSE_SIMD
!DIR_VECTOR_ALIGNED
do j=1,np
do i=1,np
Expand Down Expand Up @@ -1037,7 +1037,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
Expand Down Expand Up @@ -1112,14 +1112,14 @@ 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)
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, &
Expand Down

0 comments on commit d6887a6

Please sign in to comment.