Skip to content

Commit

Permalink
Merge pull request #352 from laurenchilutti/cherrypicks
Browse files Browse the repository at this point in the history 
Cherrypicks PR 322 and 324
  • Loading branch information
@laurenchilutti
laurenchilutti authored Jul 18, 2024
2 parents 1a02369 + 8498046 commit add33b9
Show file tree
Hide file tree
Showing 5 changed files with 37 additions and 22 deletions.
2 changes: 1 addition & 1 deletion model/fv_dynamics.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -233,7 +233,7 @@ subroutine fv_dynamics(npx, npy, npz, nq_tot, ng, bdt, consv_te, fill,

reg_bc_update_time=current_time_in_seconds
call set_regional_BCs & !<-- Insert values into the boundary region valid for the start of this large timestep.
(delp,delz,w,pt &
(delp,w,pt &
#ifdef USE_COND
,q_con &
#endif
Expand Down
16 changes: 8 additions & 8 deletions model/fv_regional_bc.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -94,6 +94,7 @@ module fv_regional_mod
integer,parameter :: bc_time_interval=3 &
,nhalo_data =4 &
,nhalo_model=3
integer, public, parameter :: int_init_default = -9999999
!
integer, public, parameter :: H_STAGGER = 1
integer, public, parameter :: U_STAGGER = 2
Expand Down Expand Up @@ -4033,7 +4034,7 @@ end subroutine remap_dwinds_regional_bc
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!---------------------------------------------------------------------

subroutine set_regional_BCs(delp,delz,w,pt &
subroutine set_regional_BCs(delp,w,pt &
#ifdef USE_COND
,q_con &
#endif
Expand All @@ -4042,7 +4043,7 @@ subroutine set_regional_BCs(delp,delz,w,pt &
#endif
,q &
,u,v,uc,vc &
,bd, nlayers &
,bd, nlayers &
,fcst_time )
!
!---------------------------------------------------------------------
Expand Down Expand Up @@ -4074,7 +4075,6 @@ subroutine set_regional_BCs(delp,delz,w,pt &
,pt
!
real,dimension(bd%isd:,bd%jsd:,1:),intent(out) :: w
real,dimension(bd%is:,bd%js:,1:),intent(out) :: delz
#ifdef USE_COND
real,dimension(bd%isd:,bd%jsd:,1:),intent(out) :: q_con
#endif
Expand Down Expand Up @@ -4363,7 +4363,7 @@ subroutine regional_boundary_update(array &
!
integer,intent(in) :: is,ie,js,je & !<-- Compute limits
,isd,ied,jsd,jed & !<-- Memory limits
,it !<-- Acoustic step
,it !<-- Acoustic step
!
integer,intent(in),optional :: index4 !<-- Index for the 4-D tracer array.
!
Expand Down Expand Up @@ -4453,7 +4453,7 @@ subroutine regional_boundary_update(array &
endif
j1_blend=js
j2_blend=js+nrows_blend_user-1
i_bc=-9e9
i_bc=int_init_default
j_bc=j2
!
endif
Expand Down Expand Up @@ -4503,7 +4503,7 @@ subroutine regional_boundary_update(array &
j2_blend=je+1
endif
j1_blend=j2_blend-nrows_blend_user+1
i_bc=-9e9
i_bc=int_init_default
j_bc=j1
!
endif
Expand Down Expand Up @@ -4560,7 +4560,7 @@ subroutine regional_boundary_update(array &
j2_blend=j2_blend+1
endif
i_bc=i2
j_bc=-9e9
j_bc=int_init_default
!
endif
endif
Expand Down Expand Up @@ -4619,7 +4619,7 @@ subroutine regional_boundary_update(array &
j2_blend=j2_blend+1
endif
i_bc=i1
j_bc=-9e9
j_bc=int_init_default
!
endif
endif
Expand Down
34 changes: 25 additions & 9 deletions tools/fv_diagnostics.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1260,6 +1260,8 @@ subroutine fv_diag_init(Atm, axes, Time, npx, npy, npz, p_ref)
'100-m AGL u-wind', 'm/s', missing_value=missing_value )
id_v100m = register_diag_field ( trim(field), 'v100m', axes(1:2), Time, &
'100-m AGL v-wind', 'm/s', missing_value=missing_value )
id_wind100m = register_diag_field ( trim(field), 'wind100m', axes(1:2), Time, &
'100-m AGL windspeed', 'm/s', missing_value=missing_value )
!--------------------------
! relative humidity (physics definition):
!--------------------------
Expand Down Expand Up @@ -3191,7 +3193,7 @@ subroutine fv_diag(Atm, zvir, Time, print_freq)
used=send_data(id_pmaskv2, a2, Time)
endif

if ( id_u100m>0 .or. id_v100m>0 .or. id_w100m>0 .or. id_w5km>0 .or. id_w2500m>0 &
if ( id_u100m>0 .or. id_v100m>0 .or. id_wind100m>0 .or. id_w100m>0 .or. id_w5km>0 .or. id_w2500m>0 &
& .or. id_w1km>0 .or. id_basedbz>0 .or. id_dbz4km>0) then
if (.not.allocated(wz)) allocate ( wz(isc:iec,jsc:jec,npz+1) )
if ( Atm(n)%flagstruct%hydrostatic) then
Expand Down Expand Up @@ -3252,15 +3254,29 @@ subroutine fv_diag(Atm, zvir, Time, print_freq)
used=send_data(id_w100m, a2, Time)
if(prt_minmax) call prt_mxm('w100m', a2, isc, iec, jsc, jec, 0, 1, 1., Atm(n)%gridstruct%area_64, Atm(n)%domain)
endif
if ( id_u100m>0 ) then
call interpolate_z(isc, iec, jsc, jec, npz, 100., wz, Atm(n)%ua(isc:iec,jsc:jec,:), a2)
used=send_data(id_u100m, a2, Time)
if(prt_minmax) call prt_mxm('u100m', a2, isc, iec, jsc, jec, 0, 1, 1., Atm(n)%gridstruct%area_64, Atm(n)%domain)

if ( id_u100m>0 .or. id_wind100m>0 ) then
call interpolate_z(isc, iec, jsc, jec, npz, 100., wz, Atm(n)%ua(isc:iec,jsc:jec,:), u2)
if (id_u100m>0) then
used=send_data(id_u100m, u2, Time)
if(prt_minmax) call prt_mxm('u100m', u2, isc, iec, jsc, jec, 0, 1, 1., Atm(n)%gridstruct%area_64, Atm(n)%domain)
endif
endif
if ( id_v100m>0 ) then
call interpolate_z(isc, iec, jsc, jec, npz, 100., wz, Atm(n)%va(isc:iec,jsc:jec,:), a2)
used=send_data(id_v100m, a2, Time)
if(prt_minmax) call prt_mxm('v100m', a2, isc, iec, jsc, jec, 0, 1, 1., Atm(n)%gridstruct%area_64, Atm(n)%domain)
if ( id_v100m>0 .or. id_wind100m>0 ) then
call interpolate_z(isc, iec, jsc, jec, npz, 100., wz, Atm(n)%va(isc:iec,jsc:jec,:), v2)
if (id_v100m > 0) then
used=send_data(id_v100m, v2, Time)
if(prt_minmax) call prt_mxm('v100m', v2, isc, iec, jsc, jec, 0, 1, 1., Atm(n)%gridstruct%area_64, Atm(n)%domain)
endif
endif
if ( id_wind100m > 0) then
do j=jsc,jec
do i=isc,iec
a2(i,j) = sqrt(u2(i,j)**2 + v2(i,j)**2)
enddo
enddo
used=send_data(id_wind100m, a2, Time)
if(prt_minmax) call prt_mxm('wind100m', a2, isc, iec, jsc, jec, 0, 1, 1., Atm(n)%gridstruct%area_64, Atm(n)%domain)
endif

if ( rainwat > 0 .and. (id_dbz>0 .or. id_maxdbz>0 .or. id_basedbz>0 .or. id_dbz4km>0 &
Expand Down
2 changes: 1 addition & 1 deletion tools/fv_diagnostics.h
View file
Original file line number Diff line number Diff line change
Expand Up @@ -64,7 +64,7 @@
id_rh300_cmip, id_rh250_cmip, id_rh100_cmip, id_rh50_cmip, id_rh10_cmip

integer :: id_hght3d, id_any_hght
integer :: id_u100m, id_v100m, id_w100m
integer :: id_u100m, id_v100m, id_w100m, id_wind100m

! For initial conditions:
integer ic_ps, ic_ua, ic_va, ic_ppt
Expand Down
5 changes: 2 additions & 3 deletions tools/test_cases.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3029,7 +3029,7 @@ subroutine init_case(u,v,w,pt,delp,q,phis, ps,pe,peln,pk,pkz, uc,vc, ua,va, ak,
! Iterate then interpolate to get balanced pt & pk on the sphere
! Adjusting ptop
call SuperK_u(npz, zs1, uz1, dudz)
call balanced_K(npz, is, ie, js, je, ng, pe1(npz+1), ze1, ts1, qs1, uz1, dudz, pe, pk, pt, &
call balanced_K(npz, is, ie, js, je, ng, pe1(npz+1), ze1, ts1, qs1, uz1, dudz, pe, pt, &
delz, zvir, ptop, ak, bk, agrid)
do j=js,je
do i=is,ie
Expand Down Expand Up @@ -6300,7 +6300,7 @@ subroutine SuperK_Sounding(km, pe, p00, ze, pt, qz)

end subroutine SuperK_Sounding

subroutine balanced_K(km, is, ie, js, je, ng, ps0, ze1, ts1, qs1, uz1, dudz, pe, pk, pt, &
subroutine balanced_K(km, is, ie, js, je, ng, ps0, ze1, ts1, qs1, uz1, dudz, pe, pt, &
delz, zvir, ptop, ak, bk, agrid)
integer, intent(in):: is, ie, js, je, ng, km
real, intent(in), dimension(km ):: ts1, qs1, uz1, dudz
Expand All @@ -6311,7 +6311,6 @@ subroutine balanced_K(km, is, ie, js, je, ng, ps0, ze1, ts1, qs1, uz1, dudz, pe,
real, intent(inout), dimension(km+1):: ak, bk
real, intent(inout), dimension(is:ie,js:je,km):: pt
real, intent(inout), dimension(is:,js:,1:) :: delz
real, intent(out), dimension(is:ie,js:je,km+1):: pk
! pt is FV's cp*thelta_v
real, intent(inout), dimension(is-1:ie+1,km+1,js-1:je+1):: pe
! Local
Expand Down

0 comments on commit add33b9

Please sign in to comment.