From 0d85b3b9cc9378d8d4314322a05d4bd1945eb620 Mon Sep 17 00:00:00 2001 From: Lucas Harris Date: Mon, 13 Apr 2020 16:08:03 -0400 Subject: [PATCH] Bug fix for two-way nest updating --- model/boundary.F90 | 36 +++++----- model/fv_control.F90 | 85 ++++++++++++++++++---- model/fv_nesting.F90 | 164 ++++++------------------------------------- 3 files changed, 110 insertions(+), 175 deletions(-) diff --git a/model/boundary.F90 b/model/boundary.F90 index 9b3c7a056..b16216b38 100644 --- a/model/boundary.F90 +++ b/model/boundary.F90 @@ -2306,6 +2306,8 @@ subroutine update_coarse_grid_mpp(var_coarse, var_nest, nest_domain, dx, dy, are position = CENTER end if + !Note that *_c does not have values on the parent_proc. + !Must use isu, etc. to get bounds of update region on parent. call mpp_get_F2C_index(nest_domain, is_c, ie_c, js_c, je_c, is_f, ie_f, js_f, je_f, nest_level=nest_level, position=position) if (child_proc) then allocate(coarse_dat_send(is_c:ie_c, js_c:je_c,npz)) @@ -2332,9 +2334,9 @@ subroutine update_coarse_grid_mpp(var_coarse, var_nest, nest_domain, dx, dy, are s = r/2 !rounds down (since r > 0) qr = r*upoff + nsponge - s - if (parent_proc .and. .not. (ie_c < is_c .or. je_c < js_c)) then + if (parent_proc .and. .not. (ieu < isu .or. jeu < jsu)) then call fill_var_coarse(var_coarse, coarse_dat_recv, isd_p, ied_p, jsd_p, jed_p, & - is_c, ie_c, js_c, je_c, npx, npy, npz, istag, jstag, nestupdate, parent_grid) + isu, ieu, jsu, jeu, npx, npy, npz, istag, jstag, nestupdate, parent_grid) endif if (allocated(coarse_dat_recv)) deallocate(coarse_dat_recv) @@ -2454,14 +2456,14 @@ subroutine fill_coarse_data_send(coarse_dat_send, var_nest, dx, dy, area, & end subroutine fill_coarse_data_send subroutine fill_var_coarse(var_coarse, coarse_dat_recv, isd_p, ied_p, jsd_p, jed_p, & - is_c, ie_c, js_c, je_c, npx, npy, npz, istag, jstag, nestupdate, parent_grid) + isu, ieu, jsu, jeu, npx, npy, npz, istag, jstag, nestupdate, parent_grid) !This routine assumes the coarse and nested grids are properly ! aligned, and that in particular for odd refinement ratios all ! coarse-grid cells (faces) coincide with nested-grid cells (faces) integer, intent(IN) :: isd_p, ied_p, jsd_p, jed_p - integer, intent(IN) :: is_c, ie_c, js_c, je_c + integer, intent(IN) :: isu, ieu, jsu, jeu integer, intent(IN) :: istag, jstag integer, intent(IN) :: npx, npy, npz, nestupdate real, intent(INOUT) :: var_coarse(isd_p:ied_p+istag,jsd_p:jed_p+jstag,npz) @@ -2475,10 +2477,10 @@ subroutine fill_var_coarse(var_coarse, coarse_dat_recv, isd_p, ied_p, jsd_p, jed select case (nestupdate) case (1,2,6,7,8) ! 1 = Conserving update on all variables; 2 = conserving update for cell-centered values; 6 = conserving remap-update -!$OMP parallel do default(none) shared(npz,js_c,je_c,is_c,ie_c,coarse_dat_recv,parent_grid,var_coarse) +!$OMP parallel do default(none) shared(npz,jsu,jeu,isu,ieu,coarse_dat_recv,parent_grid,var_coarse) do k=1,npz - do j=js_c,je_c - do i=is_c,ie_c + do j=jsu,jeu + do i=isu,ieu var_coarse(i,j,k) = coarse_dat_recv(i,j,k)*parent_grid%gridstruct%rarea(i,j) end do end do @@ -2498,10 +2500,10 @@ subroutine fill_var_coarse(var_coarse, coarse_dat_recv, isd_p, ied_p, jsd_p, jed select case (nestupdate) case (1,6,7,8) -!$OMP parallel do default(none) shared(npz,js_c,je_c,is_c,ie_c,coarse_dat_recv,parent_grid,var_coarse) +!$OMP parallel do default(none) shared(npz,jsu,jeu,isu,ieu,coarse_dat_recv,parent_grid,var_coarse) do k=1,npz - do j=js_c,je_c+1 - do i=is_c,ie_c + do j=jsu,jeu+1 + do i=isu,ieu var_coarse(i,j,k) = coarse_dat_recv(i,j,k)*parent_grid%gridstruct%rdx(i,j) end do end do @@ -2518,10 +2520,10 @@ subroutine fill_var_coarse(var_coarse, coarse_dat_recv, isd_p, ied_p, jsd_p, jed select case (nestupdate) case (1,6,7,8) !averaging update; in-line average for face-averaged values instead of areal average -!$OMP parallel do default(none) shared(npz,js_c,je_c,is_c,ie_c,coarse_dat_recv,parent_grid,var_coarse) +!$OMP parallel do default(none) shared(npz,jsu,jeu,isu,ieu,coarse_dat_recv,parent_grid,var_coarse) do k=1,npz - do j=js_c,je_c - do i=is_c,ie_c+1 + do j=jsu,jeu + do i=isu,ieu+1 var_coarse(i,j,k) = coarse_dat_recv(i,j,k)*parent_grid%gridstruct%rdy(i,j) end do end do @@ -2611,13 +2613,13 @@ subroutine update_coarse_grid_mpp_vector(u_coarse, v_coarse, u_nest, v_nest, nes s = r/2 !rounds down (since r > 0) qr = r*upoff + nsponge - s - if (parent_proc .and. .not. (ie_cx < is_cx .or. je_cx < js_cx)) then + if (parent_proc .and. .not. (ieu < isu .or. jeu < jsu)) then call fill_var_coarse(u_coarse, coarse_dat_recv_u, isd_p, ied_p, jsd_p, jed_p, & - is_cx, ie_cx, js_cx, je_cx, npx, npy, npz, istag_u, jstag_u, nestupdate, parent_grid) + isu, ieu, jsu, jeu, npx, npy, npz, istag_u, jstag_u, nestupdate, parent_grid) endif - if (parent_proc .and. .not. (ie_cy < is_cy .or. je_cy < js_cy)) then + if (parent_proc .and. .not. (ieu < isu .or. jeu < jsu)) then call fill_var_coarse(v_coarse, coarse_dat_recv_v, isd_p, ied_p, jsd_p, jed_p, & - is_cy, ie_cy, js_cy, je_cy, npx, npy, npz, istag_v, jstag_v, nestupdate, parent_grid) + isu, ieu, jsu, jeu, npx, npy, npz, istag_v, jstag_v, nestupdate, parent_grid) endif if (allocated(coarse_dat_recv_u)) deallocate(coarse_dat_recv_u) diff --git a/model/fv_control.F90 b/model/fv_control.F90 index 29fc68420..efa33224d 100644 --- a/model/fv_control.F90 +++ b/model/fv_control.F90 @@ -103,11 +103,12 @@ subroutine fv_control_init(Atm, dt_atmos, this_grid, grids_on_this_pe, p_split) integer, dimension(MAX_NNEST) :: grid_pes = 0 integer, dimension(MAX_NNEST) :: grid_coarse = -1 integer, dimension(MAX_NNEST) :: nest_refine = 3 - integer, dimension(MAX_NNEST) :: nest_ioffsets = -999, nest_joffsets = -999 + integer, dimension(MAX_NNEST) :: nest_ioffsets, nest_joffsets integer, dimension(MAX_NNEST) :: all_npx = 0 integer, dimension(MAX_NNEST) :: all_npy = 0 integer, dimension(MAX_NNEST) :: all_npz = 0 integer, dimension(MAX_NNEST) :: all_ntiles = 0 + integer, dimension(MAX_NNEST) :: all_twowaynest = 0 ! > 0 implies two-way !integer, dimension(MAX_NNEST) :: tile_fine = 0 integer, dimension(MAX_NNEST) :: icount_coarse = 1 integer, dimension(MAX_NNEST) :: jcount_coarse = 1 @@ -468,6 +469,8 @@ subroutine fv_control_init(Atm, dt_atmos, this_grid, grids_on_this_pe, p_split) all_npz(this_grid) = npz call mpp_max(all_npz, ngrids, global_pelist) + if (Atm(this_grid)%neststruct%twowaynest) all_twowaynest(this_grid) = 1 + call mpp_max(all_twowaynest, ngrids, global_pelist) ntiles_nest_all = 0 do n=1,ngrids if (n/=this_grid) then @@ -475,6 +478,7 @@ subroutine fv_control_init(Atm, dt_atmos, this_grid, grids_on_this_pe, p_split) Atm(n)%flagstruct%npy = all_npy(n) Atm(n)%flagstruct%npz = all_npz(n) Atm(n)%flagstruct%ntiles = all_ntiles(n) + Atm(n)%neststruct%twowaynest = (all_twowaynest(n) > 0) ! disabled endif npes_nest_tile(ntiles_nest_all+1:ntiles_nest_all+all_ntiles(n)) = & Atm(n)%npes_this_grid / all_ntiles(n) @@ -494,7 +498,7 @@ subroutine fv_control_init(Atm, dt_atmos, this_grid, grids_on_this_pe, p_split) endif enddo - if (mpp_pe() == 0) then + if (mpp_pe() == 0 .and. ngrids > 1) then print*, ' NESTING TREE' do n=1,ngrids write(*,'(12i4)') n, nest_level(n), nest_ioffsets(n), nest_joffsets(n), icount_coarse(n), jcount_coarse(n), tile_fine(n), tile_coarse(n), nest_refine(n), all_ntiles(n), all_npx(n), all_npy(n) @@ -564,24 +568,20 @@ subroutine fv_control_init(Atm, dt_atmos, this_grid, grids_on_this_pe, p_split) endif - allocate(Atm(this_grid)%neststruct%child_grids(ngrids)) !only temporary? + allocate(Atm(this_grid)%neststruct%child_grids(ngrids)) do n=1,ngrids Atm(this_grid)%neststruct%child_grids(n) = (grid_coarse(n) == this_grid) allocate(Atm(n)%neststruct%do_remap_bc(ngrids)) Atm(n)%neststruct%do_remap_bc(:) = .false. enddo - Atm(this_grid)%neststruct%parent_proc = ANY(tile_coarse == Atm(this_grid)%global_tile) - !Atm(this_grid)%neststruct%child_proc = ANY(Atm(this_grid)%pelist == gid) !this means a nested grid -!!$ if (Atm(this_grid)%neststruct%nestbctype > 1) then -!!$ call mpp_error(FATAL, 'nestbctype > 1 not yet implemented') -!!$ Atm(this_grid)%neststruct%upoff = 0 -!!$ endif -!!$ end if -!!$ -!!$ do nn=1,size(Atm) -!!$ if (n == 1) allocate(Atm(nn)%neststruct%nest_domain_all(size(Atm))) -!!$ Atm(nn)%neststruct%nest_domain_all(n) = Atm(this_grid)%neststruct%nest_domain -!!$ enddo + Atm(this_grid)%neststruct%parent_proc = ANY(Atm(this_grid)%neststruct%child_grids) !ANY(tile_coarse == Atm(this_grid)%global_tile) + Atm(this_grid)%neststruct%child_proc = ASSOCIATED(Atm(this_grid)%parent_grid) !this means a nested grid + + if (ngrids > 1) call setup_update_regions + if (Atm(this_grid)%neststruct%nestbctype > 1) then + call mpp_error(FATAL, 'nestbctype > 1 not yet implemented') + Atm(this_grid)%neststruct%upoff = 0 + endif if (Atm(this_grid)%gridstruct%bounded_domain .and. is_master()) print*, & ' Bounded domain: nested = ', Atm(this_grid)%neststruct%nested, ', regional = ', Atm(this_grid)%flagstruct%regional @@ -1045,6 +1045,61 @@ subroutine read_namelist_fv_core_nml(Atm) end subroutine read_namelist_fv_core_nml + subroutine setup_update_regions + + integer :: isu, ieu, jsu, jeu ! update regions + integer :: isc, jsc, iec, jec + integer :: upoff + + isc = Atm(this_grid)%bd%isc + jsc = Atm(this_grid)%bd%jsc + iec = Atm(this_grid)%bd%iec + jec = Atm(this_grid)%bd%jec + + upoff = Atm(this_grid)%neststruct%upoff + + do n=2,ngrids + write(*,'(I, A, 4I)') mpp_pe(), 'SETUP_UPDATE_REGIONS 0: ', mpp_pe(), tile_coarse(n), Atm(this_grid)%global_tile + if (tile_coarse(n) == Atm(this_grid)%global_tile) then + + isu = nest_ioffsets(n) + ieu = isu + icount_coarse(n) - 1 + jsu = nest_joffsets(n) + jeu = jsu + jcount_coarse(n) - 1 + + !update offset adjustment + isu = isu + upoff + ieu = ieu - upoff + jsu = jsu + upoff + jeu = jeu - upoff + + !restriction to current domain +!!$ !!! DEBUG CODE +!!$ if (Atm(this_grid)%flagstruct%fv_debug) then +!!$ write(*,'(I, A, 4I)') mpp_pe(), 'SETUP_UPDATE_REGIONS : ', isu, jsu, ieu, jeu +!!$ write(*,'(I, A, 4I)') mpp_pe(), 'SETUP_UPDATE_REGIONS 2: ', isc, jsc, iec, jsc +!!$ endif +!!$ !!! END DEBUG CODE + if (isu > iec .or. ieu < isc .or. & + jsu > jec .or. jeu < jsc ) then + isu = -999 ; jsu = -999 ; ieu = -1000 ; jeu = -1000 + else + isu = max(isu,isc) ; jsu = max(jsu,jsc) + ieu = min(ieu,iec) ; jeu = min(jeu,jec) + endif +!!$ !!! DEBUG CODE +!!$ if (Atm(this_grid)%flagstruct%fv_debug) & +!!$ write(*,'(I, A, 4I)') mpp_pe(), 'SETUP_UPDATE_REGIONS 3: ', isu, jsu, ieu, jeu +!!$ !!! END DEBUG CODE + + Atm(n)%neststruct%isu = isu + Atm(n)%neststruct%ieu = ieu + Atm(n)%neststruct%jsu = jsu + Atm(n)%neststruct%jeu = jeu + endif + enddo + + end subroutine setup_update_regions end subroutine fv_control_init diff --git a/model/fv_nesting.F90 b/model/fv_nesting.F90 index dd5d1011b..aab034ef3 100644 --- a/model/fv_nesting.F90 +++ b/model/fv_nesting.F90 @@ -65,9 +65,6 @@ module fv_nesting_mod contains -!!!!NOTE: Later we can add a flag to see if remap BCs are needed -!!! if not we can save some code complexity and cycles by skipping it - subroutine setup_nested_grid_BCs(npx, npy, npz, zvir, ncnst, & u, v, w, pt, delp, delz,q, uc, vc, & #ifdef USE_COND @@ -863,9 +860,6 @@ subroutine setup_eul_delp_BC_k(delplagBC, delpeulBC, pelagBC, peeulBC, ptop_src, character(len=120) :: errstring -!!$!!! DEBUG CODE -!!$ write(*, '(A, 7I5)') 'setup_eul_delp_BC_k', mpp_pe(), isd_BC, ied_BC, istart, iend, lbound(pelagBC,1), ubound(pelagBC,1) -!!$!!! END DEBUG CODE !$OMP parallel do default(none) shared(istart,iend,jstart,jend,pelagBC,ptop_src) do j=jstart,jend @@ -2286,6 +2280,10 @@ end subroutine twoway_nesting !!!CLEANUP: this routine assumes that the PARENT GRID has pt = (regular) temperature, !!!not potential temperature; which may cause problems when updating if this is not the case. + +!!! NOTE ALSO: parent_grid%flagstruct is NOT SET UP by default and may be missing much information +!!! Either make sure that parent_grid%flagstruct is filled in fv_control or that proper steps +!!! are taken to make sure null flags are not used subroutine twoway_nest_update(npx, npy, npz, zvir, ncnst, sphum, & u, v, w, pt, delp, q, & pe, pkz, delz, ps, ptop, ak, bk, & @@ -2359,7 +2357,7 @@ subroutine twoway_nest_update(npx, npy, npz, zvir, ncnst, sphum, & !If pt is actual temperature, set conv_theta to .false. if (present(conv_theta_in)) conv_theta = conv_theta_in - if ((.not. neststruct%parent_proc) .and. (.not. neststruct%child_proc)) return + if ((.not. parent_grid%neststruct%parent_proc) .and. (.not. neststruct%child_proc)) return call mpp_get_data_domain( parent_grid%domain, & isd_p, ied_p, jsd_p, jed_p ) @@ -2388,7 +2386,7 @@ subroutine twoway_nest_update(npx, npy, npz, zvir, ncnst, sphum, & endif enddo - if (neststruct%parent_proc .and. is_master() .and. first_timestep) then + if (parent_grid%neststruct%parent_proc .and. is_master() .and. first_timestep) then print*, ' TWO-WAY BLENDING WEIGHTS' ph2 = parent_grid%ak(1) do k=1,parent_grid%npz @@ -2400,130 +2398,6 @@ subroutine twoway_nest_update(npx, npy, npz, zvir, ncnst, sphum, & first_timestep = .false. endif - - !!! RENORMALIZATION UPDATE OPTION - if (neststruct%nestupdate /= 3 .and. neststruct%nestupdate /= 7 .and. neststruct%nestupdate /= 8) then - -!!$ allocate(qdp_coarse(isd_p:ied_p,jsd_p:jed_p,npz)) -!!$ if (parent_grid%flagstruct%nwat > 0) then -!!$ allocate(q_diff(isd_p:ied_p,jsd_p:jed_p,npz)) -!!$ q_diff = 0. -!!$ endif -!!$ -!!$ do n=1,parent_grid%flagstruct%nwat -!!$ -!!$ qdp_coarse = 0. -!!$ if (neststruct%child_proc) then -!!$ do k=1,npz -!!$ do j=jsd,jed -!!$ do i=isd,ied -!!$ qdp(i,j,k) = q(i,j,k,n)*delp(i,j,k) -!!$ enddo -!!$ enddo -!!$ enddo -!!$ else -!!$ qdp = 0. -!!$ endif -!!$ -!!$ if (neststruct%parent_proc) then -!!$ !Add up ONLY region being replaced by nested grid -!!$ do k=1,npz -!!$ do j=jsu,jeu -!!$ do i=isu,ieu -!!$ qdp_coarse(i,j,k) = parent_grid%q(i,j,k,n)*parent_grid%delp(i,j,k) -!!$ enddo -!!$ enddo -!!$ enddo -!!$ call level_sum(qdp_coarse, parent_grid%gridstruct%area, parent_grid%domain, & -!!$ parent_grid%bd, npz, L_sum_b) -!!$ else -!!$ qdp_coarse = 0. -!!$ endif -!!$ if (neststruct%parent_proc) then -!!$ if (n <= parent_grid%flagstruct%nwat) then -!!$ do k=1,npz -!!$ do j=jsu,jeu -!!$ do i=isu,ieu -!!$ q_diff(i,j,k) = q_diff(i,j,k) - qdp_coarse(i,j,k) -!!$ enddo -!!$ enddo -!!$ enddo -!!$ endif -!!$ endif -!!$ -!!$ call mpp_update_domains(qdp, domain) -!!$ call update_coarse_grid(var_src, qdp, global_nest_domain, & -!!$ gridstruct%dx, gridstruct%dy, gridstruct%area, & -!!$ bd, isd_p, ied_p, jsd_p, jed_p, isd, ied, jsd, jed, & -!!$ neststruct%isu, neststruct%ieu, neststruct%jsu, neststruct%jeu, & -!!$ npx, npy, npz, 0, 0, & -!!$ neststruct%refinement, neststruct%nestupdate, upoff, 0, & -!!$ neststruct%parent_proc, neststruct%child_proc, parent_grid) -!!$ if (neststruct%parent_proc) call remap_up_k(ps0, parent_grid%ps, & -!!$ ak, bk, parent_grid%ak, parent_grid%bk, var_src, qdp_coarse, & -!!$ parent_grid%bd, neststruct%isu, neststruct%ieu, neststruct%jsu, neststruct%jeu, & -!!$ 0, 0, npz, parent_grid%npz, 0, parent_grid%flagstruct%kord_tr, blend_wt, log_pe=.false.) -!!$ -!!$ call mpp_sync!self -!!$ -!!$ if (neststruct%parent_proc) then -!!$ call level_sum(qdp_coarse, parent_grid%gridstruct%area, parent_grid%domain, & -!!$ parent_grid%bd, npz, L_sum_a) -!!$ do k=1,npz -!!$ if (L_sum_a(k) > 0.) then -!!$ fix = L_sum_b(k)/L_sum_a(k) -!!$ do j=jsu,jeu -!!$ do i=isu,ieu -!!$ !Normalization mass fixer -!!$ parent_grid%q(i,j,k,n) = qdp_coarse(i,j,k)*fix -!!$ enddo -!!$ enddo -!!$ endif -!!$ enddo -!!$ if (n == 1) sphum_ll_fix = 1. - fix -!!$ endif -!!$ if (neststruct%parent_proc) then -!!$ if (n <= parent_grid%flagstruct%nwat) then -!!$ do k=1,npz -!!$ do j=jsu,jeu -!!$ do i=isu,ieu -!!$ q_diff(i,j,k) = q_diff(i,j,k) + parent_grid%q(i,j,k,n) -!!$ enddo -!!$ enddo -!!$ enddo -!!$ endif -!!$ endif -!!$ -!!$ end do -!!$ -!!$ if (neststruct%parent_proc) then -!!$ if (parent_grid%flagstruct%nwat > 0) then -!!$ do k=1,npz -!!$ do j=jsu,jeu -!!$ do i=isu,ieu -!!$ parent_grid%delp(i,j,k) = parent_grid%delp(i,j,k) + q_diff(i,j,k) -!!$ enddo -!!$ enddo -!!$ enddo -!!$ endif -!!$ -!!$ do n=1,parent_grid%flagstruct%nwat -!!$ do k=1,npz -!!$ do j=jsu,jeu -!!$ do i=isu,ieu -!!$ parent_grid%q(i,j,k,n) = parent_grid%q(i,j,k,n)/parent_grid%delp(i,j,k) -!!$ enddo -!!$ enddo -!!$ enddo -!!$ enddo -!!$ endif -!!$ -!!$ deallocate(qdp_coarse) -!!$ if (allocated(q_diff)) deallocate(q_diff) - - endif - !!! END RENORMALIZATION UPDATE - #ifndef SW_DYNAMICS if (neststruct%nestupdate /= 3 .and. neststruct%nestupdate /= 8) then @@ -2561,7 +2435,7 @@ subroutine twoway_nest_update(npx, npy, npz, zvir, ncnst, sphum, & neststruct%isu, neststruct%ieu, neststruct%jsu, neststruct%jeu, & npx, npy, npz, 0, 0, & neststruct%refinement, neststruct%nestupdate, upoff, 0, & - neststruct%parent_proc, neststruct%child_proc, parent_grid, grid_number-1) + parent_grid%neststruct%parent_proc, neststruct%child_proc, parent_grid, grid_number-1) if (neststruct%child_proc) deallocate(t_nest) else if (neststruct%child_proc) call mpp_update_domains(pt, domain, complete=.true.) @@ -2573,14 +2447,18 @@ subroutine twoway_nest_update(npx, npy, npz, zvir, ncnst, sphum, & neststruct%isu, neststruct%ieu, neststruct%jsu, neststruct%jeu, & npx, npy, npz, 0, 0, & neststruct%refinement, neststruct%nestupdate, upoff, 0, & - neststruct%parent_proc, neststruct%child_proc, parent_grid, grid_number-1) + parent_grid%neststruct%parent_proc, neststruct%child_proc, parent_grid, grid_number-1) endif !conv_theta call mpp_sync!self - if (.not. flagstruct%hydrostatic) then + !We don't currently have a good way to communicate all namelist items between + ! grids (since we cannot assume that we have internal namelists available), so + ! we get the clutzy structure here. + if ( (neststruct%child_proc .and. .not. flagstruct%hydrostatic) .or. & + (parent_grid%neststruct%parent_proc .and. .not. parent_grid%flagstruct%hydrostatic) ) then allocate(w_src(isd_p:ied_p,jsd_p:jed_p,npz)) w_src = -999. @@ -2590,7 +2468,7 @@ subroutine twoway_nest_update(npx, npy, npz, zvir, ncnst, sphum, & neststruct%isu, neststruct%ieu, neststruct%jsu, neststruct%jeu, & npx, npy, npz, 0, 0, & neststruct%refinement, neststruct%nestupdate, upoff, 0, & - neststruct%parent_proc, neststruct%child_proc, parent_grid, grid_number-1) + parent_grid%neststruct%parent_proc, neststruct%child_proc, parent_grid, grid_number-1) call mpp_sync!self !Updating for delz not yet implemented; @@ -2598,7 +2476,7 @@ subroutine twoway_nest_update(npx, npy, npz, zvir, ncnst, sphum, & ! consider updating specific volume instead? !!$ call update_coarse_grid(parent_grid%delz, delz, global_nest_domain, & !!$ bd, isd_p, ied_p, jsd_p, jed_p, isd, ied, jsd, jed, npz, 0, 0, & -!!$ neststruct%refinement, neststruct%nestupdate, upoff, 0, neststruct%parent_proc, neststruct%child_proc) +!!$ neststruct%refinement, neststruct%nestupdate, upoff, 0, parent_grid%neststruct%parent_proc, neststruct%child_proc) end if @@ -2616,7 +2494,7 @@ subroutine twoway_nest_update(npx, npy, npz, zvir, ncnst, sphum, & neststruct%isu, neststruct%ieu, neststruct%jsu, neststruct%jeu, & npx, npy, npz, 0, 1, 1, 0, & neststruct%refinement, neststruct%nestupdate, upoff, 0, & - neststruct%parent_proc, neststruct%child_proc, parent_grid, grid_number-1, gridtype=DGRID_NE) + parent_grid%neststruct%parent_proc, neststruct%child_proc, parent_grid, grid_number-1, gridtype=DGRID_NE) call mpp_sync() @@ -2629,7 +2507,7 @@ subroutine twoway_nest_update(npx, npy, npz, zvir, ncnst, sphum, & !Re-compute nested (AND COARSE) grid ps allocate(ps0(isd_p:ied_p,jsd_p:jed_p)) - if (neststruct%parent_proc) then + if (parent_grid%neststruct%parent_proc) then parent_grid%ps = parent_grid%ptop !$OMP parallel do default(none) shared(jsd_p,jed_p,isd_p,ied_p,parent_grid) @@ -2663,13 +2541,13 @@ subroutine twoway_nest_update(npx, npy, npz, zvir, ncnst, sphum, & bd, isd_p, ied_p, jsd_p, jed_p, isd, ied, jsd, jed, & neststruct%isu, neststruct%ieu, neststruct%jsu, neststruct%jeu, & npx, npy, 0, 0, & - neststruct%refinement, neststruct%nestupdate, upoff, 0, neststruct%parent_proc, neststruct%child_proc, parent_grid, grid_number-1) + neststruct%refinement, neststruct%nestupdate, upoff, 0, parent_grid%neststruct%parent_proc, neststruct%child_proc, parent_grid, grid_number-1) !!! The mpp version of update_coarse_grid does not return a consistent value of ps !!! across PEs, as it does not go into the haloes of a given coarse-grid PE. This !!! update_domains call takes care of the problem. - if (neststruct%parent_proc) then + if (parent_grid%neststruct%parent_proc) then call mpp_update_domains(parent_grid%ps, parent_grid%domain, complete=.false.) call mpp_update_domains(ps0, parent_grid%domain, complete=.true.) endif @@ -2678,7 +2556,7 @@ subroutine twoway_nest_update(npx, npy, npz, zvir, ncnst, sphum, & if (parent_grid%global_tile == neststruct%parent_tile) then - if (neststruct%parent_proc) then + if (parent_grid%neststruct%parent_proc) then !comment out if statement to always remap theta instead of t in the remap-update. !(In LtE typically we use remap_t = .true.: remapping t is better (except in @@ -2736,7 +2614,7 @@ subroutine twoway_nest_update(npx, npy, npz, zvir, ncnst, sphum, & isc_p, iec_p, jsc_p, jec_p, isd_p, ied_p, jsd_p, jed_p, parent_grid%ptop, & neststruct%isu, neststruct%ieu, neststruct%jsu, neststruct%jeu, blend_wt) - endif !neststruct%parent_proc + endif !parent_grid%neststruct%parent_proc end if