Skip to content

Commit

Permalink
Remove comments and move check for use_gw_movmtn_pbl using the SE dyc…
Browse files Browse the repository at this point in the history 
…ore to build-namelist
  • Loading branch information
@cacraigucar
cacraigucar committed Jan 29, 2025
1 parent ea056d2 commit 5f7ac9c
Show file tree
Hide file tree
Showing 5 changed files with 27 additions and 41 deletions.
8 changes: 8 additions & 0 deletions bld/build-namelist
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3772,6 +3772,14 @@ if (!$simple_phys) {
add_default($nl, 'use_gw_movmtn_pbl', 'val'=>'.true.');
}

my $use_gw_movmtn_pbl = $nl->get_value('use_gw_movmtn_pbl');
if ($use_gw_movmtn_pbl =~ /$TRUE/io) {
if ( ! ($dyn =~ /se/) ) {
die "$ProgName - ERROR: use_gw_movmtn_pbl is only available with the SE dycore \n";

}
}

add_default($nl, 'use_gw_rdg_gamma' , 'val'=>'.false.');
add_default($nl, 'use_gw_front_igw' , 'val'=>'.false.');
add_default($nl, 'use_gw_convect_sh', 'val'=>'.false.');
Expand Down
14 changes: 2 additions & 12 deletions src/dynamics/se/dp_coupling.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -85,16 +85,14 @@ subroutine d_p_coupling(phys_state, phys_tend, pbuf2d, dyn_out)
real (kind=r8), allocatable :: frontgf_phys(:,:,:)
real (kind=r8), allocatable :: frontga_phys(:,:,:)

!++jtb 01/14/25
! Vorticity
real (kind=r8), allocatable :: vort4gw(:,:,:) ! temp arrays to hold vorticity
real (kind=r8), allocatable :: vort4gw_phys(:,:,:)


! Pointers to pbuf
real (kind=r8), pointer :: pbuf_frontgf(:,:)
real (kind=r8), pointer :: pbuf_frontga(:,:)
!++jtb 12/31/24
real (kind=r8), pointer :: pbuf_vort4gw(:,:)

integer :: ncols, ierr
Expand All @@ -119,10 +117,9 @@ subroutine d_p_coupling(phys_state, phys_tend, pbuf2d, dyn_out)
nullify(pbuf_chnk)
nullify(pbuf_frontgf)
nullify(pbuf_frontga)
!++jtb
nullify(pbuf_vort4gw)



if (fv_nphys > 0) then
nphys = fv_nphys
Expand Down Expand Up @@ -150,12 +147,10 @@ subroutine d_p_coupling(phys_state, phys_tend, pbuf2d, dyn_out)
if (ierr /= 0) call endrun("dp_coupling: Allocate of frontga failed.")
end if
if (use_gw_movmtn_pbl) then
!++jtb 01/14/25
allocate(vort4gw(nphys_pts,pver,nelemd), stat=ierr)
if (ierr /= 0) call endrun("dp_coupling: Allocate of vort4gw failed.")
end if

!++jtb 01/20/25
if (iam < par%nprocs) then
if (use_gw_front .or. use_gw_front_igw ) then
call gws_src_fnct(elem, tl_f, tl_qdp_np0, frontgf, frontga, nphys)
Expand Down Expand Up @@ -228,7 +223,6 @@ subroutine d_p_coupling(phys_state, phys_tend, pbuf2d, dyn_out)
frontga(:,:,:) = 0._r8
end if
if (use_gw_movmtn_pbl) then
!++jtb 01/14/25
vort4gw(:,:,:) = 0._r8
end if

Expand All @@ -250,7 +244,6 @@ subroutine d_p_coupling(phys_state, phys_tend, pbuf2d, dyn_out)
allocate(frontga_phys(pcols, pver, begchunk:endchunk))
end if
if (use_gw_movmtn_pbl) then
!++jtb 01/14/25
allocate(vort4gw_phys(pcols, pver, begchunk:endchunk))
end if
!$omp parallel do num_threads(max_num_threads) private (col_ind, lchnk, icol, ie, blk_ind, ilyr, m)
Expand All @@ -271,7 +264,6 @@ subroutine d_p_coupling(phys_state, phys_tend, pbuf2d, dyn_out)
frontga_phys(icol, ilyr, lchnk) = frontga(blk_ind(1), ilyr, ie)
end if
if (use_gw_movmtn_pbl) then
!++jtb 01/14/25
vort4gw_phys(icol, ilyr, lchnk) = vort4gw(blk_ind(1), ilyr, ie)
end if
end do
Expand Down Expand Up @@ -299,7 +291,6 @@ subroutine d_p_coupling(phys_state, phys_tend, pbuf2d, dyn_out)
deallocate(frontgf_phys)
deallocate(frontga_phys)
end if
!++jtb 01/20/25
if (use_gw_movmtn_pbl) then
!$omp parallel do num_threads(max_num_threads) private (lchnk, ncols, icol, ilyr, pbuf_chnk, pbuf_vort4gw)
do lchnk = begchunk, endchunk
Expand All @@ -312,7 +303,6 @@ subroutine d_p_coupling(phys_state, phys_tend, pbuf2d, dyn_out)
end do
end do
end do
!++jtb 01/14/25
deallocate(vort4gw_phys)
end if

Expand Down
2 changes: 0 additions & 2 deletions src/dynamics/se/dyn_comp.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -79,7 +79,6 @@ module dyn_comp
! Frontogenesis indices
integer, public :: frontgf_idx = -1
integer, public :: frontga_idx = -1
!++jtb
integer, public :: vort4gw_idx = -1

interface read_dyn_var
Expand Down Expand Up @@ -881,7 +880,6 @@ subroutine dyn_init(dyn_in, dyn_out)
call get_loop_ranges(hybrid, ibeg=nets, iend=nete)
call prim_init2(elem, fvm, hybrid, nets, nete, TimeLevel, hvcoord)
!$OMP END PARALLEL
!++jtb 01/14/25
if (use_gw_front .or. use_gw_front_igw .or. use_gw_movmtn_pbl) call gws_init(elem)
end if ! iam < par%nprocs

Expand Down
26 changes: 12 additions & 14 deletions src/dynamics/se/gravity_waves_sources.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -70,7 +70,7 @@ subroutine gws_src_fnct(elem, tl, tlq, frontgf, frontga, nphys)
integer :: nets, nete, ithr, ncols, ie
real(kind=r8), allocatable :: frontgf_thr(:,:,:,:)
real(kind=r8), allocatable :: frontga_thr(:,:,:,:)


! This does not need to be a thread private data-structure
call derivinit(deriv)
Expand All @@ -81,9 +81,9 @@ subroutine gws_src_fnct(elem, tl, tlq, frontgf, frontga, nphys)

allocate(frontgf_thr(nphys,nphys,nlev,nets:nete))
allocate(frontga_thr(nphys,nphys,nlev,nets:nete))

call compute_frontogenesis(frontgf_thr,frontga_thr,tl,tlq,elem,deriv,hybrid,nets,nete,nphys)

if (fv_nphys>0) then
do ie=nets,nete
frontgf(:,:,ie) = RESHAPE(frontgf_thr(:,:,:,ie),(/nphys*nphys,nlev/))
Expand All @@ -98,7 +98,7 @@ subroutine gws_src_fnct(elem, tl, tlq, frontgf, frontga, nphys)
end if
deallocate(frontga_thr)
deallocate(frontgf_thr)

!!$OMP END PARALLEL

end subroutine gws_src_fnct
Expand Down Expand Up @@ -134,9 +134,9 @@ subroutine gws_src_vort(elem, tl, tlq, vort4gw, nphys)
call get_loop_ranges(hybrid,ibeg=nets,iend=nete)

allocate(vort4gw_thr(nphys,nphys,nlev,nets:nete))

call compute_vorticity_4gw(vort4gw_thr,tl,tlq,elem,deriv,hybrid,nets,nete,nphys)

if (fv_nphys>0) then
do ie=nets,nete
vort4gw(:,:,ie) = RESHAPE(vort4gw_thr(:,:,:,ie),(/nphys*nphys,nlev/))
Expand All @@ -148,20 +148,20 @@ subroutine gws_src_vort(elem, tl, tlq, vort4gw, nphys)
end do
end if
deallocate(vort4gw_thr)

!!$OMP END PARALLEL

end subroutine gws_src_vort

subroutine compute_vorticity_4gw(vort4gw,tl,tlq,elem,ederiv,hybrid,nets,nete,nphys)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! compute vorticity for use in gw params
! compute vorticity for use in gw params
! F = ( curl ) [U,V]
!
! Original by Peter Lauritzen, Julio Bacmeister*, Dec 2024
! Patterned on 'compute_frontogenesis'
!
! * corresponding/blame-able
! * corresponding/blame-able
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
use derivative_mod, only: vorticity_sphere
use edge_mod, only: edgevpack, edgevunpack
Expand All @@ -176,10 +176,9 @@ subroutine compute_vorticity_4gw(vort4gw,tl,tlq,elem,ederiv,hybrid,nets,nete,nph
integer, intent(in) :: nets,nete,nphys
integer, intent(in) :: tl,tlq
real(r8), intent(out) :: vort4gw(nphys,nphys,nlev,nets:nete)

! local
real(r8) :: area_inv(fv_nphys,fv_nphys), tmp(np,np)
!!real(r8) :: vort_tmp(fv_nphys*fv_nphys,nlev)
real(r8) :: vort_gll(np,np,nlev,nets:nete)
integer :: k,kptr,i,j,ie,component,h,nq,m_cnst,n0

Expand All @@ -195,7 +194,7 @@ subroutine compute_vorticity_4gw(vort4gw,tl,tlq,elem,ederiv,hybrid,nets,nete,nph
do k=1,nlev
vort_gll(:,:,k,ie) = vort_gll(:,:,k,ie)*elem(ie)%spheremp(:,:)
end do
! pack
! pack
call edgeVpack(edge1, vort_gll(:,:,:,ie),nlev,0,ie)
enddo
call bndry_exchange(hybrid,edge1,location='compute_vorticity_4gw')
Expand All @@ -214,7 +213,6 @@ subroutine compute_vorticity_4gw(vort4gw,tl,tlq,elem,ederiv,hybrid,nets,nete,nph
tmp = 1.0_r8
area_inv = dyn2phys(tmp,elem(ie)%metdet)
area_inv = 1.0_r8/area_inv
!!! vort_tmp(:,:) = dyn2phys(vort_gll(:,:,:,ie),elem(ie)) !peter replace with scalar mapping !++jtb: Think I did that ...
do k=1,nlev
vort4gw(:,:,k,ie) = dyn2phys( vort_gll(:,:,k,ie) , elem(ie)%metdet , area_inv )
end do
Expand All @@ -228,7 +226,7 @@ subroutine compute_vorticity_4gw(vort4gw,tl,tlq,elem,ederiv,hybrid,nets,nete,nph

end subroutine compute_vorticity_4gw


subroutine compute_frontogenesis(frontgf,frontga,tl,tlq,elem,ederiv,hybrid,nets,nete,nphys)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! compute frontogenesis function F
Expand Down
18 changes: 5 additions & 13 deletions src/physics/cam/gw_drag.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -169,7 +169,7 @@ module gw_drag
integer :: frontga_idx = -1
!
integer :: vort4gw_idx = -1

integer :: sgh_idx = -1

! From CLUBB
Expand Down Expand Up @@ -956,7 +956,7 @@ subroutine gw_init()
end if

end if

if (use_gw_movmtn_pbl) then
do k = 1, pver
! Find steering level
Expand All @@ -975,7 +975,7 @@ subroutine gw_init()
write (iulog,*) 'MOVMTN K_STEER =', movmtn_ksteer
write (iulog,*) 'MOVMTN K_LAUNCH =', movmtn_klaunch
write (iulog,*) 'K_STEER hardw =', pver - 20 !++ ?????
write (iulog,*) 'K_LAUNCH hardw =', pver - 20 - 10 !++ ?????
write (iulog,*) 'K_LAUNCH hardw =', pver - 20 - 10 !++ ?????
write(iulog,*) ' '
end if

Expand Down Expand Up @@ -1831,15 +1831,7 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat)
call pbuf_get_field(pbuf, wpthlp_clubb_gw_idx, wpthlp_clubb_gw)
call pbuf_get_field(pbuf, upwp_clubb_gw_idx, upwp_clubb_gw)
call pbuf_get_field(pbuf, vpwp_clubb_gw_idx, vpwp_clubb_gw)

! Vorticity from SE dycore. This needs to be either
! generalized to other dycores or protected with some
! endrun if dycore != SE
if (dycore_is('SE')) then
call pbuf_get_field(pbuf, vort4gw_idx, vort4gw)
else
call endrun( 'gw_drag: vort4gw only with SE')
end if
call pbuf_get_field(pbuf, vort4gw_idx, vort4gw)

xpwp_clubb(:ncol,:) = sqrt( upwp_clubb_gw(:ncol,:)**2 + vpwp_clubb_gw(:ncol,:)**2 )

Expand Down Expand Up @@ -2511,7 +2503,7 @@ subroutine gw_rdg_calc( &
real(r8), intent(in) :: effgw_rdg ! Tendency efficiency.
real(r8), intent(in) :: effgw_rdg_max
real(r8), intent(in) :: effgw_rdg_resid ! Tendency efficiency.
logical, intent(in) :: luse_gw_rdg_resid ! On-Off switch
logical, intent(in) :: luse_gw_rdg_resid ! On-Off switch
real(r8), intent(in) :: hwdth(ncol,prdg) ! width of ridges.
real(r8), intent(in) :: clngt(ncol,prdg) ! length of ridges.
real(r8), intent(in) :: gbxar(ncol) ! gridbox area
Expand Down

0 comments on commit 5f7ac9c

Please sign in to comment.