From 80d5633f4b379e7fb983e885a54b49c1dfa5bdcf Mon Sep 17 00:00:00 2001 From: Rusty Benson Date: Tue, 19 Apr 2022 10:51:48 -0400 Subject: [PATCH 1/2] cherry pick 5193c6b60c02c744b1ffe27078eccbeed2a22ad8 from dev/emc --- tools/fv_iau_mod.F90 | 37 ++++++++++++++++++++++--------------- 1 file changed, 22 insertions(+), 15 deletions(-) diff --git a/tools/fv_iau_mod.F90 b/tools/fv_iau_mod.F90 index f8840f60e..fd8125716 100644 --- a/tools/fv_iau_mod.F90 +++ b/tools/fv_iau_mod.F90 @@ -256,6 +256,7 @@ subroutine IAU_initialize (IPD_Control, IAU_Data,Init_parm) iau_state%hr1=IPD_Control%iaufhrs(1) iau_state%wt = 1.0 ! IAU increment filter weights (default 1.0) + iau_state%wt_normfact = 1.0 if (IPD_Control%iau_filter_increments) then ! compute increment filter weights, sum to obtain normalization factor dtp=IPD_control%dtp @@ -302,26 +303,31 @@ subroutine getiauforcing(IPD_Control,IAU_Data) type (IPD_control_type), intent(in) :: IPD_Control type(IAU_external_data_type), intent(inout) :: IAU_Data real(kind=kind_phys) t1,t2,sx,wx,wt,dtp - integer n,i,j,k,sphum,kstep,nstep + integer n,i,j,k,sphum,kstep,nstep,itnext IAU_Data%in_interval=.false. if (nfiles.LE.0) then return endif - t1=iau_state%hr1 - IPD_Control%iau_delthrs*0.5 - t2=iau_state%hr1 + IPD_Control%iau_delthrs*0.5 + if (nfiles .eq. 1) then + t1 = IPD_Control%iaufhrs(1)-0.5*IPD_Control%iau_delthrs + t2 = IPD_Control%iaufhrs(1)+0.5*IPD_Control%iau_delthrs + else + t1 = IPD_Control%iaufhrs(1) + t2 = IPD_Control%iaufhrs(nfiles) + endif if (IPD_Control%iau_filter_increments) then ! compute increment filter weight - ! t1 beginning of window, t2 end of window + ! t1 is beginning of window, t2 end of window ! IPD_Control%fhour current time ! in window kstep=-nstep,nstep (2*nstep+1 total) ! time step IPD_control%dtp dtp=IPD_control%dtp nstep = 0.5*IPD_Control%iau_delthrs*3600/dtp ! compute normalized filter weight - kstep = (IPD_Control%fhour-(t1+IPD_Control%iau_delthrs*0.5))*3600./dtp - if (kstep .ge. -nstep .and. kstep .le. nstep) then + kstep = ((IPD_Control%fhour-t1) - 0.5*IPD_Control%iau_delthrs)*3600./dtp + if (IPD_Control%fhour >= t1 .and. IPD_Control%fhour < t2) then sx = acos(-1.)*kstep/nstep wx = acos(-1.)*kstep/(nstep+1) if (kstep .ne. 0) then @@ -330,7 +336,7 @@ subroutine getiauforcing(IPD_Control,IAU_Data) wt = 1. endif iau_state%wt = iau_state%wt_normfact*wt - if (is_master()) print *,'filter wt',kstep,IPD_Control%fhour,iau_state%wt + !if (is_master()) print *,'kstep,t1,t,t2,filter wt=',kstep,t1,IPD_Control%fhour,t2,iau_state%wt/iau_state%wt_normfact else iau_state%wt = 0. endif @@ -344,31 +350,32 @@ subroutine getiauforcing(IPD_Control,IAU_Data) IAU_Data%in_interval=.false. else if (IPD_Control%iau_filter_increments) call setiauforcing(IPD_Control,IAU_Data,iau_state%wt) - if (is_master()) print *,'apply iau forcing',t1,IPD_Control%fhour,t2 + if (is_master()) print *,'apply iau forcing t1,t,t2,filter wt=',t1,IPD_Control%fhour,t2,iau_state%wt/iau_state%wt_normfact IAU_Data%in_interval=.true. endif return endif if (nfiles > 1) then - t2=2 - if (IPD_Control%fhour < IPD_Control%iaufhrs(1) .or. IPD_Control%fhour >= IPD_Control%iaufhrs(nfiles)) then + itnext=2 + if (IPD_Control%fhour < t1 .or. IPD_Control%fhour >= t2) then ! if (is_master()) print *,'no iau forcing',IPD_Control%iaufhrs(1),IPD_Control%fhour,IPD_Control%iaufhrs(nfiles) IAU_Data%in_interval=.false. else + if (is_master()) print *,'apply iau forcing t1,t,t2,filter wt=',t1,IPD_Control%fhour,t2,iau_state%wt/iau_state%wt_normfact IAU_Data%in_interval=.true. do k=nfiles,1,-1 if (IPD_Control%iaufhrs(k) > IPD_Control%fhour) then - t2=k + itnext=k endif enddo -! if (is_master()) print *,'t2=',t2 +! if (is_master()) print *,'itnext=',itnext if (IPD_Control%fhour >= iau_state%hr2) then ! need to read in next increment file iau_state%hr1=iau_state%hr2 - iau_state%hr2=IPD_Control%iaufhrs(t2) + iau_state%hr2=IPD_Control%iaufhrs(itnext) iau_state%inc1=iau_state%inc2 - if (is_master()) print *,'reading next increment file',trim(IPD_Control%iau_inc_files(t2)) - call read_iau_forcing(IPD_Control,iau_state%inc2,'INPUT/'//trim(IPD_Control%iau_inc_files(t2))) + if (is_master()) print *,'reading next increment file',trim(IPD_Control%iau_inc_files(itnext)) + call read_iau_forcing(IPD_Control,iau_state%inc2,'INPUT/'//trim(IPD_Control%iau_inc_files(itnext))) endif call updateiauforcing(IPD_Control,IAU_Data,iau_state%wt) endif From 60e406a07b278851f46fdc149f3669bb1b5e2bc9 Mon Sep 17 00:00:00 2001 From: MatthewPyle-NOAA <48285220+MatthewPyle-NOAA@users.noreply.github.com> Date: Fri, 25 Feb 2022 13:14:02 -0500 Subject: [PATCH 2/2] Attempt at integrating fixes on top of dev/emc branch. (#173) --- model/dyn_core.F90 | 26 +++++++++++++------------- model/fv_dynamics.F90 | 2 +- model/fv_regional_bc.F90 | 24 +++++++++++++++++++----- model/fv_tracer2d.F90 | 2 +- 4 files changed, 34 insertions(+), 20 deletions(-) diff --git a/model/dyn_core.F90 b/model/dyn_core.F90 index 1a3c79a88..cd1c37624 100644 --- a/model/dyn_core.F90 +++ b/model/dyn_core.F90 @@ -459,13 +459,13 @@ subroutine dyn_core(npx, npy, npz, ng, sphum, nq, bdt, n_map, n_split, zvir, cp, isd, ied, jsd, jed, npz, & is, ie, js, je, & isd, ied, jsd, jed, & - reg_bc_update_time ) + reg_bc_update_time,it ) #ifndef SW_DYNAMICS call regional_boundary_update(ptc, 'pt', & isd, ied, jsd, jed, npz, & is, ie, js, je, & isd, ied, jsd, jed, & - reg_bc_update_time ) + reg_bc_update_time,it ) #endif endif if ( hydrostatic ) then @@ -615,12 +615,12 @@ subroutine dyn_core(npx, npy, npz, ng, sphum, nq, bdt, n_map, n_split, zvir, cp, isd, ied, jsd, jed+1, npz, & is, ie, js, je, & isd, ied, jsd, jed, & - reg_bc_update_time ) + reg_bc_update_time,it ) call regional_boundary_update(uc, 'uc', & isd, ied+1, jsd, jed, npz, & is, ie, js, je, & isd, ied, jsd, jed, & - reg_bc_update_time ) + reg_bc_update_time,it ) call mpp_update_domains(uc, vc, domain, gridtype=CGRID_NE) !!! Currently divgd is always 0.0 in the regional domain boundary area. reg_bc_update_time=current_time_in_seconds+bdt*(n_map-1)+(it-1)*dt @@ -628,7 +628,7 @@ subroutine dyn_core(npx, npy, npz, ng, sphum, nq, bdt, n_map, n_split, zvir, cp, isd, ied+1, jsd, jed+1, npz, & is, ie, js, je, & isd, ied, jsd, jed, & - reg_bc_update_time ) + reg_bc_update_time,it ) endif if ( flagstruct%inline_q ) then @@ -646,7 +646,7 @@ subroutine dyn_core(npx, npy, npz, ng, sphum, nq, bdt, n_map, n_split, zvir, cp, isd, ied, jsd, jed, npz, & is, ie, js, je, & isd, ied, jsd, jed, & - reg_bc_update_time ) + reg_bc_update_time,it ) enddo endif @@ -870,20 +870,20 @@ subroutine dyn_core(npx, npy, npz, ng, sphum, nq, bdt, n_map, n_split, zvir, cp, isd, ied, jsd, jed, npz, & is, ie, js, je, & isd, ied, jsd, jed, & - reg_bc_update_time ) + reg_bc_update_time,it ) #ifndef SW_DYNAMICS call regional_boundary_update(pt, 'pt', & isd, ied, jsd, jed, npz, & is, ie, js, je, & isd, ied, jsd, jed, & - reg_bc_update_time ) + reg_bc_update_time,it ) #ifdef USE_COND call regional_boundary_update(q_con, 'q_con', & isd, ied, jsd, jed, npz, & is, ie, js, je, & isd, ied, jsd, jed, & - reg_bc_update_time ) + reg_bc_update_time,it ) #endif #endif @@ -1179,14 +1179,14 @@ subroutine dyn_core(npx, npy, npz, ng, sphum, nq, bdt, n_map, n_split, zvir, cp, if (flagstruct%regional) then + reg_bc_update_time=current_time_in_seconds+bdt*(n_map-1)+it*dt #ifndef SW_DYNAMICS if (.not. hydrostatic) then - reg_bc_update_time=current_time_in_seconds+bdt*(n_map-1)+it*dt call regional_boundary_update(w, 'w', & isd, ied, jsd, jed, ubound(w,3), & is, ie, js, je, & isd, ied, jsd, jed, & - reg_bc_update_time ) + reg_bc_update_time,it ) endif #endif SW_DYNAMICS @@ -1194,12 +1194,12 @@ subroutine dyn_core(npx, npy, npz, ng, sphum, nq, bdt, n_map, n_split, zvir, cp, isd, ied, jsd, jed+1, npz, & is, ie, js, je, & isd, ied, jsd, jed, & - reg_bc_update_time ) + reg_bc_update_time,it ) call regional_boundary_update(v, 'v', & isd, ied+1, jsd, jed, npz, & is, ie, js, je, & isd, ied, jsd, jed, & - reg_bc_update_time ) + reg_bc_update_time,it ) call mpp_update_domains(u, v, domain, gridtype=DGRID_NE) end if diff --git a/model/fv_dynamics.F90 b/model/fv_dynamics.F90 index f8ebaff08..597448129 100644 --- a/model/fv_dynamics.F90 +++ b/model/fv_dynamics.F90 @@ -633,7 +633,7 @@ subroutine fv_dynamics(npx, npy, npz, nq_tot, ng, bdt, consv_te, fill, isd, ied, jsd, jed, npz, & is, ie, js, je, & isd, ied, jsd, jed, & - reg_bc_update_time ) + reg_bc_update_time,1 ) endif #endif !-------------------------- diff --git a/model/fv_regional_bc.F90 b/model/fv_regional_bc.F90 index cca3a0d30..574850551 100644 --- a/model/fv_regional_bc.F90 +++ b/model/fv_regional_bc.F90 @@ -4331,7 +4331,7 @@ subroutine regional_boundary_update(array & ,is,ie,js,je & ,isd,ied,jsd,jed & ,fcst_time & - ,index4 ) + ,it,index4 ) ! !--------------------------------------------------------------------- !*** Select the given variable's boundary data at the two @@ -4349,7 +4349,8 @@ subroutine regional_boundary_update(array & integer,intent(in) :: lbnd_x,ubnd_x,lbnd_y,ubnd_y,ubnd_z !<-- Dimensions of full prognostic array to be updated. ! integer,intent(in) :: is,ie,js,je & !<-- Compute limits - ,isd,ied,jsd,jed !<-- Memory limits + ,isd,ied,jsd,jed & !<-- Memory limits + ,it !<-- Acoustic step ! integer,intent(in),optional :: index4 !<-- Index for the 4-D tracer array. ! @@ -4605,7 +4606,7 @@ subroutine regional_boundary_update(array & ,fcst_time & ,bc_update_interval & ,i1_blend,i2_blend,j1_blend,j2_blend & - ,i_bc,j_bc,nside,bc_vbl_name,blend ) + ,i_bc,j_bc,nside,bc_vbl_name,blend,it ) endif ! !--------------------------------------------------------------------- @@ -4737,7 +4738,7 @@ subroutine bc_time_interpolation(array & ,fcst_time & ,bc_update_interval & ,i1_blend,i2_blend,j1_blend,j2_blend & - ,i_bc,j_bc,nside,bc_vbl_name,blend ) + ,i_bc,j_bc,nside,bc_vbl_name,blend,it ) !--------------------------------------------------------------------- !*** Update the boundary region of the input array at the given @@ -4762,7 +4763,7 @@ subroutine bc_time_interpolation(array & ! integer,intent(in) :: is,ie,js,je !<-- Min/Max index limits on task's computational subdomain ! - integer,intent(in) :: bc_update_interval !<-- Time (hours) between BC data states + integer,intent(in) :: bc_update_interval,it !<-- Time (hours) between BC data states, acoustic step ! real,intent(in) :: fcst_time !<-- Current forecast time (sec) ! @@ -4799,6 +4800,19 @@ subroutine bc_time_interpolation(array & ! fraction_interval=mod(fcst_time,(bc_update_interval*3600.)) & /(bc_update_interval*3600.) + +!--------------------------------------------------------------------- +!*** Special check for final acoustic step prior to new boundary information +!*** being ingested. +!--------------------------------------------------------------------- + + if (fraction_interval .eq. 0.0 .and. it .gt. 1) then + fraction_interval=1.0 + if (is_master()) then + write(0,*) 'reset of fraction_interval ', trim(bc_vbl_name),it, fcst_time + endif + endif + ! !--------------------------------------------------------------------- ! diff --git a/model/fv_tracer2d.F90 b/model/fv_tracer2d.F90 index 54b156f31..ea102da32 100644 --- a/model/fv_tracer2d.F90 +++ b/model/fv_tracer2d.F90 @@ -723,7 +723,7 @@ subroutine tracer_2d_nested(q, dp1, mfx, mfy, cx, cy, gridstruct, bd, domain, np is, ie, js, je, & isd, ied, jsd, jed, & reg_bc_update_time, & - iq ) + it, iq ) enddo endif