diff --git a/model/fv_dynamics.F90 b/model/fv_dynamics.F90 index 0642a5e89..3d353d7b2 100644 --- a/model/fv_dynamics.F90 +++ b/model/fv_dynamics.F90 @@ -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 diff --git a/model/fv_regional_bc.F90 b/model/fv_regional_bc.F90 index 2fb814ab5..4e2ca15fc 100644 --- a/model/fv_regional_bc.F90 +++ b/model/fv_regional_bc.F90 @@ -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 @@ -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 @@ -4042,7 +4043,7 @@ subroutine set_regional_BCs(delp,delz,w,pt & #endif ,q & ,u,v,uc,vc & - ,bd, nlayers & + ,bd, nlayers & ,fcst_time ) ! !--------------------------------------------------------------------- @@ -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 @@ -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. ! @@ -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 @@ -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 @@ -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 @@ -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 diff --git a/tools/fv_diagnostics.F90 b/tools/fv_diagnostics.F90 index 6f6a33d42..395632cc0 100644 --- a/tools/fv_diagnostics.F90 +++ b/tools/fv_diagnostics.F90 @@ -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): !-------------------------- @@ -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 @@ -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 & diff --git a/tools/fv_diagnostics.h b/tools/fv_diagnostics.h index ddaafc687..8206f43b2 100644 --- a/tools/fv_diagnostics.h +++ b/tools/fv_diagnostics.h @@ -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 diff --git a/tools/test_cases.F90 b/tools/test_cases.F90 index 7973e60b4..6b9bce76d 100644 --- a/tools/test_cases.F90 +++ b/tools/test_cases.F90 @@ -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 @@ -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 @@ -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