From 28a9fee02eabe35e9e2a22cd1937399a7d49e8de Mon Sep 17 00:00:00 2001 From: AlysonStahl-NOAA <166434581+AlysonStahl-NOAA@users.noreply.github.com> Date: Wed, 10 Apr 2024 15:07:15 -0600 Subject: [PATCH 1/5] doxygenated fv3_cap.F90 --- fv3_cap.F90 | 123 ++++++++++++++++++++++++++++++++++++++++++++++------ 1 file changed, 109 insertions(+), 14 deletions(-) diff --git a/fv3_cap.F90 b/fv3_cap.F90 index 713460fe3..7540b6efe 100644 --- a/fv3_cap.F90 +++ b/fv3_cap.F90 @@ -1,16 +1,20 @@ -!--------------- FV3 ATM solo model ---------------- -! -!*** The FV3 atmosphere grid component nuopc cap -! -! Author: Jun Wang@noaa.gov -! -! revision history -! 11 Oct 2016: J. Wang Initial code -! 18 Apr 2017: J. Wang set up fcst grid component and write grid components -! 24 Jul 2017: J. Wang initialization and time stepping changes for coupling -! 02 Nov 2017: J. Wang Use Gerhard's transferable RouteHandle -! - +!> @file +!> @brief The FV3 atmosphere grid component nuopc cap. +!> @author Jun Wang @date 01/2017 + +!> @brief The FV3 atmosphere grid component nuopc cap. +!> +!> FV3 ATM solo model +!> +!> ## Module History +!> Date | Author | Modification +!> -----|--------|------------- +!> 11 Oct 2016 | J. Wang | Initial code +!> 18 Apr 2017 | J. Wang | set up fcst grid component and write grid components +!> 24 Jul 2017 | J. Wang | initialization and time stepping changes for coupling +!> 02 Nov 2017 | J. Wang | Use Gerhard's transferable RouteHandle +!> +!> @author Jun Wang @date 01/2017 module fv3atm_cap_mod use ESMF @@ -56,30 +60,61 @@ module fv3atm_cap_mod ! !----------------------------------------------------------------------- ! - + !> ??? type(ESMF_GridComp) :: fcstComp + + !> ??? type(ESMF_State) :: fcstState + + !> ??? type(ESMF_FieldBundle), allocatable :: fcstFB(:) + + !> ??? integer,dimension(:), allocatable :: fcstPetList + + !> ??? integer, save :: FBCount + !> ??? type(ESMF_GridComp), allocatable :: wrtComp(:) + + !> ??? type(ESMF_State), allocatable :: wrtState(:) + + !> ??? type(ESMF_FieldBundle), allocatable :: wrtFB(:,:) + !> ??? type(ESMF_RouteHandle), allocatable :: routehandle(:,:) + + !> ??? type(ESMF_RouteHandle), allocatable :: gridRedistRH(:,:) + + !> ??? type(ESMF_Grid), allocatable :: srcGrid(:,:), dstGrid(:,:) + + !> ??? logical, allocatable :: is_moving_FB(:) + !> ??? logical :: profile_memory = .true. + + !> ??? logical :: write_runtimelog = .false. + + !> ??? logical :: lprint = .false. + !> ??? integer :: mype = -1 + + !> ??? integer :: dbug = 0 + + !> ??? integer :: frestart(999) = -1 + !> ??? real(kind=8) :: timere, timep2re !----------------------------------------------------------------------- @@ -89,6 +124,12 @@ module fv3atm_cap_mod !------------------- Solo fv3atm code starts here ---------------------- !----------------------------------------------------------------------- + !> ??? + !> + !> @param gcomp ??? + !> @param rc Return code. + !> + !> @author subroutine SetServices(gcomp, rc) type(ESMF_GridComp) :: gcomp @@ -169,6 +210,12 @@ end subroutine SetServices !----------------------------------------------------------------------------- + !> ??? + !> + !> @param gcomp ??? + !> @param rc Return code. + !> + !> @author subroutine InitializeAdvertise(gcomp, rc) type(ESMF_GridComp) :: gcomp @@ -972,6 +1019,12 @@ end subroutine InitializeAdvertise !----------------------------------------------------------------------------- + !> ??? + !> + !> @param gcomp ??? + !> @param rc Return code. + !> + !> @author subroutine InitializeRealize(gcomp, rc) type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -1009,6 +1062,12 @@ end subroutine InitializeRealize !----------------------------------------------------------------------------- + !> ??? + !> + !> @param gcomp ??? + !> @param rc Return code. + !> + !> @author subroutine ModelAdvance(gcomp, rc) type(ESMF_GridComp) :: gcomp @@ -1038,6 +1097,12 @@ end subroutine ModelAdvance !----------------------------------------------------------------------------- + !> ??? + !> + !> @param gcomp ??? + !> @param rc Return code. + !> + !> @author subroutine ModelAdvance_phase1(gcomp, rc) type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -1092,6 +1157,12 @@ end subroutine ModelAdvance_phase1 !----------------------------------------------------------------------------- + !> ??? + !> + !> @param gcomp ??? + !> @param rc Return code. + !> + !> @author subroutine ModelAdvance_phase2(gcomp, rc) type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -1229,6 +1300,12 @@ end subroutine ModelAdvance_phase2 !----------------------------------------------------------------------------- + !> ??? + !> + !> @param gcomp ??? + !> @param rc Return code. + !> + !> @author subroutine ModelSetRunClock(gcomp, rc) type(ESMF_GridComp) :: gcomp @@ -1263,6 +1340,12 @@ end subroutine ModelSetRunClock !----------------------------------------------------------------------------- + !> ??? + !> + !> @param gcomp ??? + !> @param rc Return code. + !> + !> @author subroutine fv3_checkimport(gcomp, rc) !*** Check the import state fields @@ -1352,6 +1435,12 @@ end subroutine fv3_checkimport !----------------------------------------------------------------------------- + !> ??? + !> + !> @param gcomp ??? + !> @param rc Return code. + !> + !> @author subroutine TimestampExport_phase1(gcomp, rc) ! input arguments @@ -1382,6 +1471,12 @@ end subroutine TimestampExport_phase1 !----------------------------------------------------------------------------- + !> ??? + !> + !> @param gcomp ??? + !> @param rc Return code. + !> + !> @author subroutine ModelFinalize(gcomp, rc) ! input arguments From 6111fcd942fb4cdbe7846dbfb8a967e7d48f4475 Mon Sep 17 00:00:00 2001 From: AlysonStahl-NOAA <166434581+AlysonStahl-NOAA@users.noreply.github.com> Date: Thu, 11 Apr 2024 14:22:57 -0600 Subject: [PATCH 2/5] more doxygen updates --- moving_nest/bounding_box.F90 | 80 +- moving_nest/fv_moving_nest.F90 | 746 +++++++-- moving_nest/fv_moving_nest_main.F90 | 2305 ++++++++++++++------------- 3 files changed, 1886 insertions(+), 1245 deletions(-) diff --git a/moving_nest/bounding_box.F90 b/moving_nest/bounding_box.F90 index b2eab8b78..00ff88e26 100644 --- a/moving_nest/bounding_box.F90 +++ b/moving_nest/bounding_box.F90 @@ -1,3 +1,7 @@ +!> @file +!> @brief Provides subroutines for grid bounding boxes for moving nest. +!> @author W. Ramstrom (William.Ramstrom@noaa.gov), AOML/HRD @date 07/28/2021 + !*********************************************************************** !* GNU General Public License * !* This file is a part of fvGFS. * @@ -18,14 +22,9 @@ !* or see: http://www.gnu.org/licenses/gpl.html * !*********************************************************************** -!*********************************************************************** -!> @file -!! @brief Provides subroutines for grid bounding boxes for moving nest -!! @author W. Ramstrom, AOML/HRD 07/28/2021 -!! @email William.Ramstrom@noaa.gov -!=======================================================================! - - +!> @brief Provides subroutines for grid bounding boxes for moving nest. +!> +!> @author W. Ramstrom, AOML/HRD @date 07/28/2021 module bounding_box_mod use mpp_domains_mod, only : mpp_get_C2F_index, nest_domain_type use mpp_mod, only : mpp_pe @@ -37,12 +36,16 @@ module bounding_box_mod use IPD_typedefs, only : kind_phys => IPD_kind_phys #endif - ! Simple aggregation of the start and end indices of a 2D grid - ! Makes argument lists clearer to read + !> Simple aggregation of the start and end indices of a 2D grid. + !> Makes argument lists clearer to read. type bbox - integer :: is, ie, js, je + integer :: is !< ??? + integer :: ie !< ??? + integer :: js !< ??? + integer :: je !< ??? end type bbox + !> ??? interface fill_bbox module procedure fill_bbox_r4_2d module procedure fill_bbox_r4_3d @@ -54,6 +57,12 @@ module bounding_box_mod contains + !> ??? + !> + !> @param[out] out_bbox ??? + !> @param[out] in_grid ??? + !> + !> @author W. Ramstrom, AOML/HRD @date 07/28/2021 subroutine fill_bbox_r4_2d(out_bbox, in_grid) type(bbox), intent(out) :: out_bbox real*4, allocatable, intent(in) :: in_grid(:,:) @@ -64,7 +73,12 @@ subroutine fill_bbox_r4_2d(out_bbox, in_grid) out_bbox%je = ubound(in_grid, 2) end subroutine fill_bbox_r4_2d - + !> ??? + !> + !> @param[out] out_bbox ??? + !> @param[out] in_grid ??? + !> + !> @author W. Ramstrom, AOML/HRD @date 07/28/2021 subroutine fill_bbox_r4_3d(out_bbox, in_grid) type(bbox), intent(out) :: out_bbox real*4, allocatable, intent(in) :: in_grid(:,:,:) @@ -75,6 +89,12 @@ subroutine fill_bbox_r4_3d(out_bbox, in_grid) out_bbox%je = ubound(in_grid, 2) end subroutine fill_bbox_r4_3d + !> ??? + !> + !> @param[out] out_bbox ??? + !> @param[out] in_grid ??? + !> + !> @author W. Ramstrom, AOML/HRD @date 07/28/2021 subroutine fill_bbox_r4_4d(out_bbox, in_grid) type(bbox), intent(out) :: out_bbox real*4, allocatable, intent(in) :: in_grid(:,:,:,:) @@ -85,7 +105,12 @@ subroutine fill_bbox_r4_4d(out_bbox, in_grid) out_bbox%je = ubound(in_grid, 2) end subroutine fill_bbox_r4_4d - + !> ??? + !> + !> @param[out] out_bbox ??? + !> @param[out] in_grid ??? + !> + !> @author W. Ramstrom, AOML/HRD @date 07/28/2021 subroutine fill_bbox_r8_2d(out_bbox, in_grid) type(bbox), intent(out) :: out_bbox real*8, allocatable, intent(in) :: in_grid(:,:) @@ -96,6 +121,12 @@ subroutine fill_bbox_r8_2d(out_bbox, in_grid) out_bbox%je = ubound(in_grid, 2) end subroutine fill_bbox_r8_2d + !> ??? + !> + !> @param[out] out_bbox ??? + !> @param[out] in_grid ??? + !> + !> @author W. Ramstrom, AOML/HRD @date 07/28/2021 subroutine fill_bbox_r8_3d(out_bbox, in_grid) type(bbox), intent(out) :: out_bbox real*8, allocatable, intent(in) :: in_grid(:,:,:) @@ -106,7 +137,12 @@ subroutine fill_bbox_r8_3d(out_bbox, in_grid) out_bbox%je = ubound(in_grid, 2) end subroutine fill_bbox_r8_3d - + !> ??? + !> + !> @param[out] out_bbox ??? + !> @param[out] in_grid ??? + !> + !> @author W. Ramstrom, AOML/HRD @date 07/28/2021 subroutine fill_bbox_r8_4d(out_bbox, in_grid) type(bbox), intent(out) :: out_bbox real*8, allocatable, intent(in) :: in_grid(:,:,:,:) @@ -117,9 +153,17 @@ subroutine fill_bbox_r8_4d(out_bbox, in_grid) out_bbox%je = ubound(in_grid, 2) end subroutine fill_bbox_r8_4d - - !>@brief This subroutine returns the nest grid indices that correspond to the input nest domain, direction, and position - !>@details Simplifies the call signature with the bbox type rather than 4 separate integers + !> This subroutine returns the nest grid indices that correspond to + !> the input nest domain, direction, and position @details Simplifies + !> the call signature with the bbox type rather than 4 separate + !> integers. + !> @param[out] nest_domain ??? + !> @param[out] bbox_fine ??? + !> @param[out] bbox_coarse ??? + !> @param[out] direction ??? + !> @param[out] position ??? + !> + !> @author W. Ramstrom, AOML/HRD @date 07/28/2021 subroutine bbox_get_C2F_index(nest_domain, bbox_fine, bbox_coarse, direction, position) implicit none type(nest_domain_type), intent(in) :: nest_domain @@ -133,4 +177,4 @@ subroutine bbox_get_C2F_index(nest_domain, bbox_fine, bbox_coarse, direction, p end subroutine bbox_get_C2F_index -end module bounding_box_mod +end module bounding_box_mod \ No newline at end of file diff --git a/moving_nest/fv_moving_nest.F90 b/moving_nest/fv_moving_nest.F90 index 6ef5ab384..fd0341e2a 100644 --- a/moving_nest/fv_moving_nest.F90 +++ b/moving_nest/fv_moving_nest.F90 @@ -1,3 +1,8 @@ +!> @file +!> @brief Provides Moving Nest functionality in FV3 dynamic core. +!> @author W. Ramstrom, AOML/HRD @date 01/15/2021 +!> @email William.Ramstrom@noaa.gov + !*********************************************************************** !* GNU General Public License * !* This file is a part of fvGFS. * @@ -18,38 +23,29 @@ !* or see: http://www.gnu.org/licenses/gpl.html * !*********************************************************************** -!*********************************************************************** -!> @file -!! @brief Provides Moving Nest functionality in FV3 dynamic core -!! @author W. Ramstrom, AOML/HRD 01/15/2021 -!! @email William.Ramstrom@noaa.gov -!=======================================================================! - - -!=======================================================================! -! -! Notes -! -!------------------------------------------------------------------------ -! Moving Nest Subroutine Naming Convention -!----------------------------------------------------------------------- -! -! mn_meta_* subroutines perform moving nest operations for FV3 metadata. -! These routines will run only once per nest move. -! -! mn_var_* subroutines perform moving nest operations for an individual FV3 variable. -! These routines will run many times per nest move. -! -! mn_prog_* subroutines perform moving nest operations for the list of prognostic fields. -! These routines will run only once per nest move. -! -! mn_phys_* subroutines perform moving nest operations for the list of physics fields. -! These routines will run only once per nest move. -! -! =======================================================================! - +!> ??? #define REMAP 1 +!> @brief Provides Moving Nest functionality in FV3 dynamic core. +!> +!> ## Moving Nest Subroutine Naming Convention +!> +!> - mn_meta_* subroutines perform moving nest operations for FV3 +!> metadata. These routines will run only once per nest move. +!> +!> - mn_var_* subroutines perform moving nest operations for an +!> individual FV3 variable. These routines will run many times per +!> nest move. +!> +!> - mn_prog_* subroutines perform moving nest operations for the list +!> of prognostic fields. These routines will run only once per nest +!> move. +!> +!> - mn_phys_* subroutines perform moving nest operations for the list +!> of physics fields. These routines will run only once per nest +!> move. +!> +!> @author W. Ramstrom, AOML/HRD @date 01/15/2021 module fv_moving_nest_mod use block_control_mod, only : block_control_type @@ -96,24 +92,24 @@ module fv_moving_nest_mod implicit none #ifdef NO_QUAD_PRECISION - ! 64-bit precision (kind=8) + !> 64-bit precision (kind=8) integer, parameter:: f_p = selected_real_kind(15) #else - ! Higher precision (kind=16) for grid geometrical factors: + !> Higher precision (kind=16) for grid geometrical factors: integer, parameter:: f_p = selected_real_kind(20) #endif #ifdef OVERLOAD_R4 - real, parameter:: real_snan=x'FFBFFFFF' + real, parameter:: real_snan=x'FFBFFFFF' !< ??? #else - real, parameter:: real_snan=x'FFF7FFFFFFFFFFFF' + real, parameter:: real_snan=x'FFF7FFFFFFFFFFFF' !< ??? #endif - logical :: debug_log = .false. + logical :: debug_log = .false. !< ??? #include - !! Step 2 + !> Step 2 interface mn_var_fill_intern_nest_halos module procedure mn_var_fill_intern_nest_halos_r4_2d module procedure mn_var_fill_intern_nest_halos_r4_3d @@ -127,7 +123,7 @@ module fv_moving_nest_mod end interface mn_var_fill_intern_nest_halos - !! Step 6 + !> Step 6 interface mn_var_shift_data module procedure mn_var_shift_data_r4_2d module procedure mn_var_shift_data_r4_3d @@ -138,12 +134,13 @@ module fv_moving_nest_mod module procedure mn_var_shift_data_r8_4d end interface mn_var_shift_data - !! Step 8 + !> Step 8 interface mn_var_dump_to_netcdf module procedure mn_var_dump_2d_to_netcdf module procedure mn_var_dump_3d_to_netcdf end interface mn_var_dump_to_netcdf + !> ??? interface mn_static_read_hires module procedure mn_static_read_hires_r4 module procedure mn_static_read_hires_r8 @@ -157,8 +154,19 @@ module fv_moving_nest_mod !! on the Atm structure !!===================================================================================== - !>@brief The subroutine 'mn_prog_fill_temp_variables' fills the temporary variable for delz - !>@details The delz variable does not have haloes so we need a temporary variable to move it. + !> The subroutine 'mn_prog_fill_temp_variables' fills the temporary + !> variable for delz. + !> + !> The delz variable does not have haloes so we need a temporary + !> variable to move it. + !> + !> @param[in] Atm Array of atmospheric data. + !> @param[in] n This level. + !> @param[in] child_grid_num Nest level. + !> @param[in] is_fine_pe Is this the nest PE? + !> @param[in] npz Number of vertical levels. + !> + !> @author W. Ramstrom, AOML/HRD @date 01/15/2021 subroutine mn_prog_fill_temp_variables(Atm, n, child_grid_num, is_fine_pe, npz) type(fv_atmos_type), allocatable, target, intent(in) :: Atm(:) !< Array of atmospheric data integer, intent(in) :: n, child_grid_num !< This level and nest level @@ -190,8 +198,19 @@ subroutine mn_prog_fill_temp_variables(Atm, n, child_grid_num, is_fine_pe, npz) end subroutine mn_prog_fill_temp_variables - !>@brief The subroutine 'mn_prog_apply_temp_variables' fills the Atm%delz value from the temporary variable after nest move - !>@details The delz variable does not have haloes so we need a temporary variable to move it. + !> The subroutine 'mn_prog_apply_temp_variables' fills the Atm%delz + !> value from the temporary variable after nest move. + !> + !> The delz variable does not have haloes so we need a temporary + !> variable to move it. + !> + !> @param[inout] Atm Array of atmospheric data. + !> @param[in] n This level. + !> @param[in] child_grid_num Nest level. + !> @param[in] is_fine_pe Is this the nest PE? + !> @param[in] npz Number of vertical levels. + !> + !> @author W. Ramstrom, AOML/HRD @date 01/15/2021 subroutine mn_prog_apply_temp_variables(Atm, n, child_grid_num, is_fine_pe, npz) type(fv_atmos_type), allocatable, target, intent(inout) :: Atm(:) !< Array of atmospheric data integer, intent(in) :: n, child_grid_num !< This level and nest level @@ -221,8 +240,20 @@ end subroutine mn_prog_apply_temp_variables !! Parent and nest PEs need to execute these subroutines !!===================================================================================== - !>@brief The subroutine 'mn_prog_fill_nest_halos_from_parent' fills the nest edge halos from the parent - !>@details Parent and nest PEs must run this subroutine. It transfers data and interpolates onto fine nest. + !> The subroutine 'mn_prog_fill_nest_halos_from_parent' fills the + !> nest edge halos from the parent. + !> + !> Parent and nest PEs must run this subroutine. It transfers data + !> and interpolates onto fine nest. + !> + !> @param[inout] Atm Array of atmospheric data. + !> @param[in] n This level. + !> @param[in] child_grid_num Nest level. + !> @param[in] is_fine_pe Is this the nest PE? + !> @param[inout] nest_domain Domain structure for nest. + !> @param[in] nz Number of vertical levels. + !> + !> @author W. Ramstrom, AOML/HRD @date 01/15/2021 subroutine mn_prog_fill_nest_halos_from_parent(Atm, n, child_grid_num, is_fine_pe, nest_domain, nz) type(fv_atmos_type), allocatable, target, intent(inout) :: Atm(:) !< Array of atmospheric data integer, intent(in) :: n, child_grid_num !< This level and nest level @@ -291,8 +322,27 @@ end subroutine mn_prog_fill_nest_halos_from_parent !! -- Similar to med_nest_configure() from HWRF !!============================================================================ - !>@brief The subroutine 'mn_meta_move_nest' resets the metadata for the nest - !>@details Parent and nest PEs run this subroutine. + !> The subroutine 'mn_meta_move_nest' resets the metadata for the nest. + !> + !> Parent and nest PEs run this subroutine. + !> + !> @param[in] delta_i_c Coarse grid delta i for nest move. + !> @param[in] delta_j_c Coarse grid delta j for nest move. + !> @param[in] pelist List of involved PEs. + !> @param[in] extra_halo Extra halo points (not fully implemented). + !> @param[inout] nest_domain Nest domain structure. + !> @param[inout] domain_fine Fine domain structures. + !> @param[inout] domain_coarse Coarse domain structures. + !> @param[inout] istart_coarse Start i of coarse grid. + !> @param[inout] iend_coarse End i of coarse grid. + !> @param[inout] jstart_coarse Start j of course grid. + !> @param[inout] jend_coarse End j of coarse grid. + !> @param[in] istart_fine Start i of fine grid. + !> @param[in] iend_fine End i of coarse grid. + !> @param[in] jstart_fine Start j of coarse grid. + !> @param[in] jend_fine End j of coarse grid. + !> + !> @author W. Ramstrom, AOML/HRD @date 01/15/2021 subroutine mn_meta_move_nest(delta_i_c, delta_j_c, pelist, is_fine_pe, extra_halo, nest_domain, domain_fine, domain_coarse, & istart_coarse, iend_coarse, jstart_coarse, jend_coarse, istart_fine, iend_fine, jstart_fine, jend_fine) @@ -350,8 +400,16 @@ end subroutine mn_meta_move_nest !! Step 4 -- Updates the internal nest tile halos !================================================================================ - !>@brief The subroutine 'mn_prog_fill_intern_nest_halos' fill internal nest halos for prognostic variables - !>@details Only nest PEs call this subroutine. + !> The subroutine 'mn_prog_fill_intern_nest_halos' fill internal + !> nest halos for prognostic variables. + !> + !> Only nest PEs call this subroutine. + !> + !> @param[inout] Atm Single instance of atmospheric data. + !> @param[inout] domain_fine Domain structure for nest. + !> @param[in] is_fine_pe Is this a nest PE? + !> + !> @author W. Ramstrom, AOML/HRD @date 01/15/2021 subroutine mn_prog_fill_intern_nest_halos(Atm, domain_fine, is_fine_pe) type(fv_atmos_type), target, intent(inout) :: Atm !< Single instance of atmospheric data type(domain2d), intent(inout) :: domain_fine !< Domain structure for nest @@ -393,8 +451,15 @@ end subroutine mn_prog_fill_intern_nest_halos ! !================================================================================ - !>@brief The subroutine 'mn_var_fill_intern_nest_halos_r4_2d' fills internal nest halos - !>@details This version of the subroutine is for 2D arrays of single precision reals. + !> The subroutine 'mn_var_fill_intern_nest_halos_r4_2d' fills internal nest halos. + !> + !> This version of the subroutine is for 2D arrays of single precision reals. + !> + !> @param[inout] data_var Model variable data. + !> @param[inout] domain_fine Nest domain structure. + !> @param[in] is_fine_pe Is this the nest PE? + !> + !> @author W. Ramstrom, AOML/HRD @date 01/15/2021 subroutine mn_var_fill_intern_nest_halos_r4_2d(data_var, domain_fine, is_fine_pe) real*4, allocatable, intent(inout) :: data_var(:,:) !< Model variable data type(domain2d), intent(inout) :: domain_fine !< Nest domain structure @@ -413,8 +478,15 @@ subroutine mn_var_fill_intern_nest_halos_r4_2d(data_var, domain_fine, is_fine_pe end subroutine mn_var_fill_intern_nest_halos_r4_2d - !>@brief The subroutine 'mn_var_fill_intern_nest_halos_r8_2d' fills internal nest halos - !>@details This version of the subroutine is for 2D arrays of double precision reals. + !> The subroutine 'mn_var_fill_intern_nest_halos_r8_2d' fills internal nest halos. + !> + !> This version of the subroutine is for 2D arrays of double precision reals. + !> + !> @param[inout] data_var Model variable data. + !> @param[inout] domain_fine Nest domain structure. + !> @param[in] is_fine_pe Is this the nest PE? + !> + !> @author W. Ramstrom, AOML/HRD @date 01/15/2021 subroutine mn_var_fill_intern_nest_halos_r8_2d(data_var, domain_fine, is_fine_pe) real*8, allocatable, intent(inout) :: data_var(:,:) !< Double precision model variable type(domain2d), intent(inout) :: domain_fine !< Nest domain structure @@ -426,8 +498,14 @@ subroutine mn_var_fill_intern_nest_halos_r8_2d(data_var, domain_fine, is_fine_pe end subroutine mn_var_fill_intern_nest_halos_r8_2d - !>@brief The subroutine 'mn_var_fill_intern_nest_halos_r4_3d' fills internal nest halos - !>@details This version of the subroutine is for 3D arrays of single precision reals. + !> The subroutine 'mn_var_fill_intern_nest_halos_r4_3d' fills internal nest halos. + !> This version of the subroutine is for 3D arrays of single precision reals. + !> + !> @param[inout] data_var Model variable data. + !> @param[inout] domain_fine Nest domain structure. + !> @param[in] is_fine_pe Is this the nest PE? + !> + !> @author W. Ramstrom, AOML/HRD @date 01/15/2021 subroutine mn_var_fill_intern_nest_halos_r4_3d(data_var, domain_fine, is_fine_pe) real*4, allocatable, intent(inout) :: data_var(:,:,:) !< Single precision model variable type(domain2d), intent(inout) :: domain_fine !< Nest domain structure @@ -441,6 +519,12 @@ end subroutine mn_var_fill_intern_nest_halos_r4_3d !>@brief The subroutine 'mn_var_fill_intern_nest_halos_r8_3d' fills internal nest halos !>@details This version of the subroutine is for 3D arrays of double precision reals. + !> + !> @param[inout] data_var Model variable data. + !> @param[inout] domain_fine Nest domain structure. + !> @param[in] is_fine_pe Is this the nest PE? + !> + !> @author W. Ramstrom, AOML/HRD @date 01/15/2021 subroutine mn_var_fill_intern_nest_halos_r8_3d(data_var, domain_fine, is_fine_pe) real*8, allocatable, intent(inout) :: data_var(:,:,:) !< Double precision model variable type(domain2d), intent(inout) :: domain_fine !< Nest domain structure @@ -452,8 +536,18 @@ subroutine mn_var_fill_intern_nest_halos_r8_3d(data_var, domain_fine, is_fine_pe end subroutine mn_var_fill_intern_nest_halos_r8_3d - !>@brief The subroutine 'mn_var_fill_intern_nest_halos_wind' fills internal nest halos for u and v wind - !>@details This version of the subroutine is for 3D arrays of single precision reals for each wind component + !> The subroutine 'mn_var_fill_intern_nest_halos_wind' fills + !> internal nest halos for u and v wind. + !> + !> This version of the subroutine is for 3D arrays of single + !> precision reals for each wind component. + !> + !> @param[inout] u_var Staggered u wind. + !> @param[inout] v_var Staggered v wind. + !> @param[inout] domain_fine Nest domain structure. + !> @param[in] is_fine_pe Is this the nest PE? + !> + !> @author W. Ramstrom, AOML/HRD @date 01/15/2021 subroutine mn_var_fill_intern_nest_halos_wind(u_var, v_var, domain_fine, is_fine_pe) real, allocatable, intent(inout) :: u_var(:,:,:) !< Staggered u wind real, allocatable, intent(inout) :: v_var(:,:,:) !< Staggered v wind @@ -467,8 +561,17 @@ subroutine mn_var_fill_intern_nest_halos_wind(u_var, v_var, domain_fine, is_fine end subroutine mn_var_fill_intern_nest_halos_wind - !>@brief The subroutine 'mn_var_fill_intern_nest_halos_r4_4d' fills internal nest halos - !>@details This version of the subroutine is for 4D arrays of single precision reals. + !> The subroutine 'mn_var_fill_intern_nest_halos_r4_4d' fills + !> internal nest halos. + !> + !> This version of the subroutine is for 4D arrays of single + !> precision reals. + !> + !> @param[inout] data_var Single prevision variable. + !> @param[inout] domain_fine Nest domain structure. + !> @param[in] is_fine_pe Is this the nest PE? + !> + !> @author W. Ramstrom, AOML/HRD @date 01/15/2021 subroutine mn_var_fill_intern_nest_halos_r4_4d(data_var, domain_fine, is_fine_pe) real*4, allocatable, intent(inout) :: data_var(:,:,:,:) !< Single prevision variable type(domain2d), intent(inout) :: domain_fine !< Nest domain structure @@ -480,8 +583,16 @@ subroutine mn_var_fill_intern_nest_halos_r4_4d(data_var, domain_fine, is_fine_pe end subroutine mn_var_fill_intern_nest_halos_r4_4d - !>@brief The subroutine 'mn_var_fill_intern_nest_halos_r8_4d' fills internal nest halos - !>@details This version of the subroutine is for 4D arrays of double precision reals. + !> The subroutine 'mn_var_fill_intern_nest_halos_r8_4d' fills + !> internal nest halos. + !> + !> This version of the subroutine is for 4D arrays of double precision reals. + !> + !> @param[inout] data_var Single prevision variable. + !> @param[inout] domain_fine Nest domain structure. + !> @param[in] is_fine_pe Is this the nest PE? + !> + !> @author W. Ramstrom, AOML/HRD @date 01/15/2021 subroutine mn_var_fill_intern_nest_halos_r8_4d(data_var, domain_fine, is_fine_pe) real*8, allocatable, intent(inout) :: data_var(:,:,:,:) !< Double precision variable type(domain2d), intent(inout) :: domain_fine !< Nest domain structure @@ -493,7 +604,17 @@ subroutine mn_var_fill_intern_nest_halos_r8_4d(data_var, domain_fine, is_fine_pe end subroutine mn_var_fill_intern_nest_halos_r8_4d - !>@brief Find the parent point that corresponds to the is,js point of the nest, and returns that nest point also + !> Find the parent point that corresponds to the is,js point of the + !> nest, and returns that nest point also. + !> + !> @param[in] Atm data array + !> @param[in] n Grid numbers. + !> @param[out] nest_x ??? + !> @param[out] nest_y ??? + !> @param[out] parent_x ??? + !> @param[out] parent_y ??? + !> + !> @author W. Ramstrom, AOML/HRD @date 01/15/2021 subroutine calc_nest_alignment(Atm, n, nest_x, nest_y, parent_x, parent_y) type(fv_atmos_type), allocatable, intent(in) :: Atm(:) !< Atm data array integer, intent(in) :: n !< Grid numbers @@ -522,7 +643,17 @@ subroutine calc_nest_alignment(Atm, n, nest_x, nest_y, parent_x, parent_y) end subroutine calc_nest_alignment - + !> ??? + !> + !> @param[in] nest_geo ??? + !> @param[in] parent_geo ??? + !> @param[in] nest_x ??? + !> @param[in] nest_y ??? + !> @param[in] parent_x ??? + !> @param[in] parent_y ??? + !> @param[out] found ??? + !> + !> @author W. Ramstrom, AOML/HRD @date 01/15/2021 subroutine check_nest_alignment(nest_geo, parent_geo, nest_x, nest_y, parent_x, parent_y, found) type(grid_geometry), intent(in) :: nest_geo !< Tile geometry type(grid_geometry), intent(in) :: parent_geo !< Parent grid at high-resolution geometry @@ -554,8 +685,31 @@ end subroutine check_nest_alignment !! update parent_geo, tile_geo*, p_grid*, n_grid* !!============================================================================ - !>@brief The subroutine 'mn_latlon_load_parent' loads parent latlon data from netCDF - !>@details Updates parent_geo, tile_geo*, p_grid*, n_grid* + !> The subroutine 'mn_latlon_load_parent' loads parent latlon data from netCDF. + !> + !> Updates parent_geo, tile_geo*, p_grid*, n_grid*, + !> + !> @param[in] surface_dir Directory for static files + !> @param[in] Atm Atm data array + !> @param[in] n Grid numbers + !> @param[in] parent_tile Grid numbers + !> @param[in] delta_i_c Nest motion in delta i + !> @param[in] delta_j_c Nest motion in delta j + !> @param[in] pelist PE list for fms2_io + !> @param[in] child_grid_num Grid numbers + !> @param[inout] parent_geo Tile geometries + !> @param[inout] tile_geo Tile geometries + !> @param[inout] tile_geo_u Tile geometries + !> @param[inout] tile_geo_v Tile geometries + !> @param[in] fp_super_tile_geo Parent grid at high-resolution geometry + !> @param[inout] p_grid A-stagger lat/lon grids + !> @param[out] n_grid A-stagger lat/lon grids + !> @param[inout] p_grid_u u-wind staggered lat/lon grids + !> @param[out] n_grid_u u-wind staggered lat/lon grids + !> @param[inout] p_grid_v v-wind staggered lat/lon grids + !> @param[out] n_grid_v v-wind staggered lat/lon grids + !> + !> @author W. Ramstrom, AOML/HRD @date 01/15/2021 subroutine mn_latlon_load_parent(surface_dir, Atm, n, parent_tile, delta_i_c, delta_j_c, pelist, child_grid_num, parent_geo, tile_geo, tile_geo_u, tile_geo_v, fp_super_tile_geo, p_grid, n_grid, p_grid_u, n_grid_u, p_grid_v, n_grid_v) character(len=*), intent(in) :: surface_dir !< Directory for static files type(fv_atmos_type), allocatable, intent(in) :: Atm(:) !< Atm data array @@ -749,8 +903,19 @@ subroutine mn_latlon_load_parent(surface_dir, Atm, n, parent_tile, delta_i_c, de end subroutine mn_latlon_load_parent - !>@brief The subroutine 'mn_static_filename' generates the full pathname for a static file for each run - !>@details Constructs the full pathname for a variable and refinement level and tests whether it exists + !> The subroutine 'mn_static_filename' generates the full pathname + !> for a static file for each run. + !> + !> Constructs the full pathname for a variable and refinement level + !> and tests whether it exists + !> + !> @param[in] surface_dir Directory. + !> @param[in] tile_num Variable name. + !> @param[in] tag Tile number. + !> @param[in] refine Nest refinement. + !> @param[out] grid_filename Output pathname to netCDF file. + !> + !> @author W. Ramstrom, AOML/HRD @date 01/15/2021 subroutine mn_static_filename(surface_dir, tile_num, tag, refine, grid_filename) character(len=*), intent(in) :: surface_dir !< Directory character(len=*), intent(in) :: tag !< Variable name @@ -785,7 +950,18 @@ subroutine mn_static_filename(surface_dir, tile_num, tag, refine, grid_filename) end subroutine mn_static_filename - !>@brief The subroutine 'mn_latlon_read_hires_parent' reads in static data from a netCDF file + !> The subroutine 'mn_latlon_read_hires_parent' reads in static data + !> from a netCDF file. + !> + !> @param[in] npx Number of points in x. + !> @param[in] npy Number of points in y. + !> @param[in] refine Number of points in refinement. + !> @param[in] pelist PE list for fms2_io. + !> @param[inout] fp_super_tile_geo Geometry of supergrid for parent tile at high resolution. + !> @param[in] surface_dir Surface directory to read netCDF file from. + !> @param[in] parent_tile Parent tile number. + !> + !> @author W. Ramstrom, AOML/HRD @date 01/15/2021 subroutine mn_latlon_read_hires_parent(npx, npy, refine, pelist, fp_super_tile_geo, surface_dir, parent_tile) integer, intent(in) :: npx, npy, refine !< Number of points in x,y, and refinement integer, allocatable, intent(in) :: pelist(:) !< PE list for fms2_io @@ -805,8 +981,24 @@ subroutine mn_latlon_read_hires_parent(npx, npy, refine, pelist, fp_super_tile_g end subroutine mn_latlon_read_hires_parent - !>@brief The subroutine 'mn_orog_read_hires_parent' loads parent orography data from netCDF - !>@details Gathers a number of terrain-related variables from the netCDF file + !> The subroutine 'mn_orog_read_hires_parent' loads parent orography + !> data from netCDF. + !> + !> Gathers a number of terrain-related variables from the netCDF file. + !> + !> @param[in] npx Number of points in x. + !> @param[in] npy Number of points in y. + !> @param[in] refine Number of points in refinement. + !> @param[in] pelist PE list for fms2_io. + !> @param[in] surface_dir Surface directory to read netCDF file from. + !> @param[in] filtered_terrain Whether to use filtered terrain. + !> @param[out] orog_grid Output orography grid. + !> @param[out] orog_std_grid Output orography standard deviation grid. + !> @param[out] ls_mask_grid Output land sea mask grid. + !> @param[out] land_frac_grid Output land fraction grid. + !> @param[in] parent_tile Parent tile number. + !> + !> @author W. Ramstrom, AOML/HRD @date 01/15/2021 subroutine mn_orog_read_hires_parent(npx, npy, refine, pelist, surface_dir, filtered_terrain, orog_grid, orog_std_grid, ls_mask_grid, land_frac_grid, parent_tile) integer, intent(in) :: npx, npy, refine !< Number of points in x,y, and refinement integer, allocatable, intent(in) :: pelist(:) !< PE list for fms2_io @@ -857,8 +1049,23 @@ subroutine mn_orog_read_hires_parent(npx, npy, refine, pelist, surface_dir, filt end subroutine mn_orog_read_hires_parent - !>@brief The subroutine 'mn_static_read_hires_r4' loads high resolution data from netCDF - !>@details Gathers a single variable from the netCDF file + !> The subroutine 'mn_static_read_hires_r4' loads high resolution + !> data from netCDF. + !> + !> Gathers a single variable from the netCDF file + !> + !> @param[in] npx Number of points in x. + !> @param[in] npy Number of points in y. + !> @param[in] refine Number of points in refinement. + !> @param[in] pelist PE list for fms2_io. + !> @param[in] surface_dir Surface directory to read netCDF file from. + !> @param[in] file_prefix File tag. + !> @param[in] var_name Variable name in netCDF file. + !> @param[out] data_grid Output data grid. + !> @param[in] parent_tile Parent tile number. + !> @param[in] time Optional month number for time-varying parameters. + !> + !> @author W. Ramstrom, AOML/HRD @date 01/15/2021 subroutine mn_static_read_hires_r4(npx, npy, refine, pelist, surface_dir, file_prefix, var_name, data_grid, parent_tile, time) integer, intent(in) :: npx, npy, refine !< Number of x,y points and nest refinement integer, allocatable, intent(in) :: pelist(:) !< PE list for fms2_io @@ -894,8 +1101,22 @@ subroutine mn_static_read_hires_r4(npx, npy, refine, pelist, surface_dir, file_p end subroutine mn_static_read_hires_r4 - !>@brief The subroutine 'mn_static_read_hires_r8' loads high resolution data from netCDF - !>@details Gathers a single variable from the netCDF file + !> The subroutine 'mn_static_read_hires_r8' loads high resolution + !> data from netCDF. + !> + !> Gathers a single variable from the netCDF file. + !> + !> @param[in] npx Number of points in x. + !> @param[in] npy Number of points in y. + !> @param[in] refine Number of points in refinement. + !> @param[in] pelist PE list for fms2_io. + !> @param[in] surface_dir Surface directory to read netCDF file from. + !> @param[in] file_prefix File tag. + !> @param[in] var_name Variable name in netCDF file. + !> @param[out] data_grid Output data grid. + !> @param[in] parent_tile Parent tile number. + !> + !> @author W. Ramstrom, AOML/HRD @date 01/15/2021 subroutine mn_static_read_hires_r8(npx, npy, refine, pelist, surface_dir, file_prefix, var_name, data_grid, parent_tile) integer, intent(in) :: npx, npy, refine !< Number of x,y points and nest refinement integer, allocatable, intent(in) :: pelist(:) !< PE list for fms2_io @@ -934,7 +1155,26 @@ end subroutine mn_static_read_hires_r8 !! Step 5.2 -- Recalculate nest halo weights !!============================================================================ - !>@brief The subroutine 'mn_meta_recalc' recalculates nest halo weights + !> The subroutine 'mn_meta_recalc' recalculates nest halo weights. + !> + !> @param[in] delta_i_c Nest motion in delta i + !> @param[in] delta_j_c Nest motion in delta j + !> @param[in] x_refine Nest refinement + !> @param[in] y_refine Nest refinement + !> @param[inout] tile_geo tile geometries + !> @param[inout] parent_geo tile geometries + !> @param[in] fp_super_tile_geo tile geometries + !> @param[in] is_fine_pe Is this a nest PE? + !> @param[in] nest_domain Nest domain structure + !> @param[in] position Stagger + !> @param[inout] p_grid Parent lat/lon grid + !> @param[inout] n_grid Nest lat/lon grid + !> @param[inout] wt Interpolation weights + !> @param[in] istart_coarse Initial nest offsets + !> @param[in] jstart_coarse Initial nest offsets + !> @param[in] ind ??? + !> + !> @author W. Ramstrom, AOML/HRD @date 01/15/2021 subroutine mn_meta_recalc( delta_i_c, delta_j_c, x_refine, y_refine, tile_geo, parent_geo, fp_super_tile_geo, & is_fine_pe, nest_domain, position, p_grid, n_grid, wt, istart_coarse, jstart_coarse, ind) integer, intent(in) :: delta_i_c, delta_j_c !< Nest motion in delta i,j @@ -1009,8 +1249,16 @@ end subroutine mn_meta_recalc !! Step 5.3 -- Adjust index by delta_i_c, delta_j_c !!============================================================================ - !>@brief The subroutine 'mn_shift_index' adjusts the index array for a nest move - !>@details Fast routine to increment indices by the delta in i,j direction + !> The subroutine 'mn_shift_index' adjusts the index array for a + !> nest move. + !> + !> Fast routine to increment indices by the delta in i,j direction. + !> + !> @param[in] delta_i_c Coarse grid delta i for nest move. + !> @param[in] delta_j_c Coarse grid delta j for nest move. + !> @param[inout] ind ??? + !> + !> @author W. Ramstrom, AOML/HRD @date 01/15/2021 subroutine mn_shift_index(delta_i_c, delta_j_c, ind) integer, intent(in) :: delta_i_c, delta_j_c !< Nest move deltas in i,j integer, allocatable, intent(inout) :: ind(:,:,:) !< Nest to parent index @@ -1040,8 +1288,26 @@ end subroutine mn_shift_index !! -- similar to med_nest_move in HWRF !!============================================================================ - !>@brief The subroutine 'mn_prog_shift_data' shifts the data on each nest PE - !>@details Iterates through the prognostic variables + !> The subroutine 'mn_prog_shift_data' shifts the data on each nest + !> PE. + !> + !> Iterates through the prognostic variables. + !> + !> @param[inout] Atm Atm data array. + !> @param[in] n Grid numbers. + !> @param[in] child_grid_num Grid numbers. + !> @param[in] wt_h Interpolation weights. + !> @param[in] wt_u Interpolation weights. + !> @param[in] wt_v Interpolation weights. + !> @param[in] delta_i_c Delta i. + !> @param[in] delta_j_c Delta j. + !> @param[in] x_refine Nest refinement. + !> @param[in] y_refine Nest refinement. + !> @param[in] is_fine_pe Is this is a nest PE? + !> @param[inout] nest_domain Nest domain structure. + !> @param[in] nz Number of vertical levels. + !> + !> @author W. Ramstrom, AOML/HRD @date 01/15/2021 subroutine mn_prog_shift_data(Atm, n, child_grid_num, wt_h, wt_u, wt_v, & delta_i_c, delta_j_c, x_refine, y_refine, & is_fine_pe, nest_domain, nz) @@ -1113,8 +1379,24 @@ end subroutine mn_prog_shift_data !! Step 6 - per variable !!============================================================================ - !>@brief The subroutine 'mn_prog_shift_data_r4_2d' shifts the data for a variable on each nest PE - !>@details For single variable + !> The subroutine 'mn_prog_shift_data_r4_2d' shifts the data for a + !> variable on each nest PE. + !> + !> For single variable. + !> + !> @param[inout] data_var Data variable. + !> @param[in] interp_type Interpolation stagger type. + !> @param[in] wt Interpolation weight array. + !> @param[in] ind Fine to coarse index array. + !> @param[in] delta_i_c Delta i. + !> @param[in] delta_j_c Delta j. + !> @param[in] x_refine Nest refinement. + !> @param[in] y_refine Nest refinement. + !> @param[in] is_fine_pe Is this is a nest PE? + !> @param[inout] nest_domain Nest domain structure. + !> @param[in] position Grid offset + !> + !> @author W. Ramstrom, AOML/HRD @date 01/15/2021 subroutine mn_var_shift_data_r4_2d(data_var, interp_type, wt, ind, delta_i_c, delta_j_c, x_refine, y_refine, is_fine_pe, nest_domain, position) real*4, allocatable, intent(inout) :: data_var(:,:) !< Data variable integer, intent(in) :: interp_type !< Interpolation stagger type @@ -1183,8 +1465,24 @@ subroutine mn_var_shift_data_r4_2d(data_var, interp_type, wt, ind, delta_i_c, de end subroutine mn_var_shift_data_r4_2d - !>@brief The subroutine 'mn_prog_shift_data_r8_2d' shifts the data for a variable on each nest PE - !>@details For one double precision 2D variable + !> The subroutine 'mn_prog_shift_data_r8_2d' shifts the data for a + !> variable on each nest PE. + !> + !> For one double precision 2D variable. + !> + !> @param[inout] data_var Data variable. + !> @param[in] interp_type Interpolation stagger type. + !> @param[in] wt Interpolation weight array. + !> @param[in] ind Fine to coarse index array. + !> @param[in] delta_i_c Delta i. + !> @param[in] delta_j_c Delta j. + !> @param[in] x_refine Nest refinement. + !> @param[in] y_refine Nest refinement. + !> @param[in] is_fine_pe Is this is a nest PE? + !> @param[inout] nest_domain Nest domain structure. + !> @param[in] position Grid offset + !> + !> @author W. Ramstrom, AOML/HRD @date 01/15/2021 subroutine mn_var_shift_data_r8_2d(data_var, interp_type, wt, ind, delta_i_c, delta_j_c, x_refine, y_refine, is_fine_pe, nest_domain, position) real*8, allocatable, intent(inout) :: data_var(:,:) !< Data variable @@ -1252,8 +1550,24 @@ subroutine mn_var_shift_data_r8_2d(data_var, interp_type, wt, ind, delta_i_c, de end subroutine mn_var_shift_data_r8_2d - !>@brief The subroutine 'mn_prog_shift_data_r4_3d' shifts the data for a variable on each nest PE - !>@details For one single precision 3D variable + !> The subroutine 'mn_prog_shift_data_r4_3d' shifts the data for a + !> variable on each nest PE. + !> + !> For one single precision 3D variable. + !> + !> @param[inout] data_var Data variable. + !> @param[in] interp_type Interpolation stagger type. + !> @param[in] wt Interpolation weight array. + !> @param[in] ind Fine to coarse index array. + !> @param[in] delta_i_c Delta i. + !> @param[in] delta_j_c Delta j. + !> @param[in] x_refine Nest refinement. + !> @param[in] y_refine Nest refinement. + !> @param[in] is_fine_pe Is this is a nest PE? + !> @param[inout] nest_domain Nest domain structure. + !> @param[in] position Grid offset + !> + !> @author W. Ramstrom, AOML/HRD @date 01/15/2021 subroutine mn_var_shift_data_r4_3d(data_var, interp_type, wt, ind, delta_i_c, delta_j_c, x_refine, y_refine, is_fine_pe, nest_domain, position, nz) real*4, allocatable, intent(inout) :: data_var(:,:,:) !< Data variable @@ -1324,8 +1638,25 @@ subroutine mn_var_shift_data_r4_3d(data_var, interp_type, wt, ind, delta_i_c, de end subroutine mn_var_shift_data_r4_3d - !>@brief The subroutine 'mn_prog_shift_data_r8_3d' shifts the data for a variable on each nest PE - !>@details For one double precision 3D variable + !> The subroutine 'mn_prog_shift_data_r8_3d' shifts the data for a + !> variable on each nest PE. + !> + !> For one double precision 3D variable. + !> + !> @param[inout] data_var Data variable. + !> @param[in] interp_type Interpolation stagger type. + !> @param[in] wt Interpolation weight array. + !> @param[in] ind Fine to coarse index array. + !> @param[in] delta_i_c Delta i. + !> @param[in] delta_j_c Delta j. + !> @param[in] x_refine Nest refinement. + !> @param[in] y_refine Nest refinement. + !> @param[in] is_fine_pe Is this is a nest PE? + !> @param[inout] nest_domain Nest domain structure. + !> @param[in] position Grid offset. + !> @param[in] nz Number vertical levels. + !> + !> @author W. Ramstrom, AOML/HRD @date 01/15/2021 subroutine mn_var_shift_data_r8_3d(data_var, interp_type, wt, ind, delta_i_c, delta_j_c, x_refine, y_refine, is_fine_pe, nest_domain, position, nz) real*8, allocatable, intent(inout) :: data_var(:,:,:) !< Data variable @@ -1394,8 +1725,25 @@ subroutine mn_var_shift_data_r8_3d(data_var, interp_type, wt, ind, delta_i_c, de end subroutine mn_var_shift_data_r8_3d - !>@brief The subroutine 'mn_prog_shift_data_r4_4d' shifts the data for a variable on each nest PE - !>@details For one single precision 4D variable + !> The subroutine 'mn_prog_shift_data_r4_4d' shifts the data for a + !> variable on each nest PE. + !> + !> For one single precision 4D variable. + !> + !> @param[inout] data_var Data variable. + !> @param[in] interp_type Interpolation stagger type. + !> @param[in] wt Interpolation weight array. + !> @param[in] ind Fine to coarse index array. + !> @param[in] delta_i_c Delta i. + !> @param[in] delta_j_c Delta j. + !> @param[in] x_refine Nest refinement. + !> @param[in] y_refine Nest refinement. + !> @param[in] is_fine_pe Is this is a nest PE? + !> @param[inout] nest_domain Nest domain structure. + !> @param[in] position Grid offset. + !> @param[in] nz Number vertical levels. + !> + !> @author W. Ramstrom, AOML/HRD @date 01/15/2021 subroutine mn_var_shift_data_r4_4d(data_var, interp_type, wt, ind, delta_i_c, delta_j_c, x_refine, y_refine, is_fine_pe, nest_domain, position, nz) real*4, allocatable, intent(inout) :: data_var(:,:,:,:) !< Data variable integer, intent(in) :: interp_type !< Interpolation stagger type @@ -1467,8 +1815,25 @@ subroutine mn_var_shift_data_r4_4d(data_var, interp_type, wt, ind, delta_i_c, de end subroutine mn_var_shift_data_r4_4d - !>@brief The subroutine 'mn_prog_shift_data_r8_4d' shifts the data for a variable on each nest PE - !>@details For one double precision 4D variable + !> The subroutine 'mn_prog_shift_data_r8_4d' shifts the data for a + !> variable on each nest PE. + !> + !> For one double precision 4D variable. + !> + !> @param[inout] data_var Data variable. + !> @param[in] interp_type Interpolation stagger type. + !> @param[in] wt Interpolation weight array. + !> @param[in] ind Fine to coarse index array. + !> @param[in] delta_i_c Delta i. + !> @param[in] delta_j_c Delta j. + !> @param[in] x_refine Nest refinement. + !> @param[in] y_refine Nest refinement. + !> @param[in] is_fine_pe Is this is a nest PE? + !> @param[inout] nest_domain Nest domain structure. + !> @param[in] position Grid offset. + !> @param[in] nz Number vertical levels. + !> + !> @author W. Ramstrom, AOML/HRD @date 01/15/2021 subroutine mn_var_shift_data_r8_4d(data_var, interp_type, wt, ind, delta_i_c, delta_j_c, x_refine, y_refine, is_fine_pe, nest_domain, position, nz) real*8, allocatable, intent(inout) :: data_var(:,:,:,:) !< Data variable integer, intent(in) :: interp_type !< Interpolation stagger type @@ -1545,8 +1910,26 @@ end subroutine mn_var_shift_data_r8_4d ! init_grid() also updates the wt arrays !================================================================================ - !>@brief The subroutine 'mn_meta_reset_gridstruct' resets navigation data and reallocates needed data in the gridstruct after nest move - !>@details This routine is computationally demanding and is a target for later optimization. + !> The subroutine 'mn_meta_reset_gridstruct' resets navigation data + !> and reallocates needed data in the gridstruct after nest move. + !> + !> This routine is computationally demanding and is a target for later optimization. + !> + !> @param[inout] Atm Array of atmospheric data. + !> @param[in] n This level. + !> @param[in] child_grid_num Nest level. + !> @param[in] nest_domain Nest domain structure. + !> @param[in] fp_super_tile_geo tile geometries + !> @param[in] x_refine Nest refinement. + !> @param[in] y_refine Nest refinement. + !> @param[in] is_fine_pe Is this is a nest PE? + !> @param[in] wt_h Interpolation weights. + !> @param[in] wt_u Interpolation weights. + !> @param[in] wt_v Interpolation weights. + !> @param[in] a_step Which timestep. + !> @param[in] dt_atmos Timestep duration in seconds. + !> + !> @author W. Ramstrom, AOML/HRD @date 01/15/2021 subroutine mn_meta_reset_gridstruct(Atm, n, child_grid_num, nest_domain, fp_super_tile_geo, x_refine, y_refine, is_fine_pe, wt_h, wt_u, wt_v, a_step, dt_atmos) type(fv_atmos_type), allocatable, target, intent(inout) :: Atm(:) !< Atm data array integer, intent(in) :: n, child_grid_num !< This level and nest level @@ -1795,8 +2178,16 @@ end subroutine mn_meta_reset_gridstruct ! Copied and adapted from fv_control.F90::setup_update_regions(); where it is an internal subroutine ! Modifications only to pass necessary variables as arguments - !>@brief The subroutine 'mn_setup_update_regions' performs some of the tasks of fv_control.F90::setup_update_regions() for nest motion - !>@details This routine only updates indices, so is computationally efficient + !> The subroutine 'mn_setup_update_regions' performs some of the + !> tasks of fv_control.F90::setup_update_regions() for nest motion. + !> + !> This routine only updates indices, so is computationally efficient. + !> + !> @param[inout] Atm Array of atmospheric data. + !> @param[in] this_grid Parent or child grid number + !> @param[in] nest_domain Nest domain structure. + !> + !> @author W. Ramstrom, AOML/HRD @date 01/15/2021 subroutine mn_setup_update_regions(Atm, this_grid, nest_domain) type(fv_atmos_type), allocatable, intent(INOUT) :: Atm(:) !< Array of atmospheric data integer, intent(IN) :: this_grid !< Parent or child grid number @@ -1949,8 +2340,15 @@ end subroutine mn_setup_update_regions ! !================================================================================================== - !>@brief The subroutine 'reallocate_BC_buffers' reallocates boundary condition buffers - some need to change size after a nest move. - !>@details Thought they would be reallocated in boundary.F90 nested_grid_BC_recv() when needed, but seem not to. + !> The subroutine 'reallocate_BC_buffers' reallocates boundary + !> condition buffers - some need to change size after a nest move. + !> + !> Thought they would be reallocated in boundary.F90 + !> nested_grid_BC_recv() when needed, but seem not to. + !> + !> @param[inout] Atm Single instance of atmospheric data. + !> + !> @author W. Ramstrom, AOML/HRD @date 01/15/2021 subroutine reallocate_BC_buffers(Atm) type(fv_atmos_type), intent(inout) :: Atm !< Single instance of atmospheric data @@ -2029,8 +2427,20 @@ end subroutine reallocate_BC_buffers !! Step 8 -- Moving Nest Output to NetCDF !!============================================================================ - !>@brief The subroutine 'mn_prog_dump_to_netcdf' dumps selected prognostic variables to netCDF file. - !>@details Can be modified to output more of the prognostic variables if wanted. Certain 3D variables were commented out for performance. + !> The subroutine 'mn_prog_dump_to_netcdf' dumps selected prognostic + !> variables to netCDF file. + !> + !> Can be modified to output more of the prognostic variables if + !> wanted. Certain 3D variables were commented out for performance. + !> + !> @param[in] Atm Single instance of atmospheric data. + !> @param[in] file_prefix Filename prefix. + !> @param[in] is_fine_pe Is this is a nest PE? + !> @param[in] domain_coarse Domain structure. + !> @param[in] domain_fine Domain structure. + !> @param[in] nz Number of vertical levels. + !> + !> @author W. Ramstrom, AOML/HRD @date 01/15/2021 subroutine mn_prog_dump_to_netcdf(Atm, time_val, file_prefix, is_fine_pe, domain_coarse, domain_fine, nz) type(fv_atmos_type), intent(in) :: Atm !< Single instance of atmospheric data integer, intent(in) :: time_val !< Timestep number @@ -2091,7 +2501,21 @@ end subroutine mn_prog_dump_to_netcdf !! Step 8 -- Moving Nest Output Individual Variables - !>@brief The subroutine 'mn_var_dump_3d_to_netcdf' dumps a 3D single precision variable to netCDF file. + !> The subroutine 'mn_var_dump_3d_to_netcdf' dumps a 3D single + !> precision variable to netCDF file. + !> + !> @param[in] data_var Single precision model variable. + !> @param[in] is_fine_pe Is this is a nest PE? + !> @param[in] domain_coarse Domain structure. + !> @param[in] domain_fine Domain structure. + !> @param[in] position Stagger. + !> @param[in] nz Number of vertical levels. + !> @param[in] time_step Timestep. + !> @param[in] this_tile Tile number. + !> @param[in] file_prefix Filename prefix. + !> @param[in] var_name NetCDF variable name. + !> + !> @author W. Ramstrom, AOML/HRD @date 01/15/2021 subroutine mn_var_dump_3d_to_netcdf( data_var, is_fine_pe, domain_coarse, domain_fine, position, nz, time_step, this_tile, file_prefix, var_name) real, intent(in) :: data_var(:,:,:) !< Single precision model variable logical, intent(in) :: is_fine_pe !< Is nest PE? @@ -2133,7 +2557,20 @@ subroutine mn_var_dump_3d_to_netcdf( data_var, is_fine_pe, domain_coarse, domain end subroutine mn_var_dump_3d_to_netcdf - !>@brief The subroutine 'mn_var_dump_2d_to_netcdf' dumps a 3D single precision variable to netCDF file. + !> The subroutine 'mn_var_dump_2d_to_netcdf' dumps a 3D single + !> precision variable to netCDF file. + !> + !> @param[in] data_var Data variable. + !> @param[in] is_fine_pe Is this is a nest PE? + !> @param[in] domain_coarse Domain structure. + !> @param[in] domain_fine Domain structure. + !> @param[in] position Stagger. + !> @param[in] time_step Timestep. + !> @param[in] this_tile Tile number. + !> @param[in] file_prefix Filename prefix. + !> @param[in] var_name NetCDF variable name. + !> + !> @author W. Ramstrom, AOML/HRD @date 01/15/2021 subroutine mn_var_dump_2d_to_netcdf( data_var, is_fine_pe, domain_coarse, domain_fine, position, time_step, this_tile, file_prefix, var_name) implicit none real, intent(in) :: data_var(:,:) !< Data variable @@ -2190,7 +2627,12 @@ end subroutine mn_var_dump_2d_to_netcdf !! Should help stabilize the fields before dynamics runs !!========================================================================================= - !>@brief The subroutine 'recalc_aux_pressures' updates auxiliary pressures after a nest move. + !> The subroutine 'recalc_aux_pressures' updates auxiliary pressures + !> after a nest move. + !> + !> @param[inout] Atm Single Atm structure. + !> + !> @author W. Ramstrom, AOML/HRD @date 01/15/2021 subroutine recalc_aux_pressures(Atm) type(fv_atmos_type), intent(inout) :: Atm !< Single Atm structure @@ -2221,7 +2663,18 @@ end subroutine recalc_aux_pressures ! !================================================================================================== - !>@brief The subroutine 'init_ijk_mem' was copied from dyn_core.F90 to avoid circular dependencies + !> The subroutine 'init_ijk_mem' was copied from dyn_core.F90 to + !> avoid circular dependencies. + !> + !> @param[in] i1 ??? + !> @param[in] i2 ??? + !> @param[in] j1 ??? + !> @param[in] j1 ??? + !> @param[in] km ??? + !> @param[inout] array ??? + !> @param[in] var ??? + !> + !> @author W. Ramstrom, AOML/HRD @date 01/15/2021 subroutine init_ijk_mem(i1, i2, j1, j2, km, array, var) integer, intent(in):: i1, i2, j1, j2, km real, intent(inout):: array(i1:i2,j1:j2,km) @@ -2239,7 +2692,13 @@ subroutine init_ijk_mem(i1, i2, j1, j2, km, array, var) end subroutine init_ijk_mem - !>@brief The function 'almost_equal' tests whether real values are within a tolerance of one another. + !> The function 'almost_equal' tests whether real values are within + !> a tolerance of one another. + !> + !> @param[in] a ??? + !> @param[in] b ??? + !> + !> @author W. Ramstrom, AOML/HRD @date 01/15/2021 function almost_equal(a, b) logical :: almost_equal real, intent(in):: a,b @@ -2255,7 +2714,21 @@ end function almost_equal - !>@brief The subroutine 'move_nest_geo' shifts tile_geo values using the data from fp_super_tile_geo + !> The subroutine 'move_nest_geo' shifts tile_geo values using the + !> data from fp_super_tile_geo. + !> + !> @param[in] Atm Data array. + !> @param[in] n Grid numbers. + !> @param[inout] tile_geo A-grid tile geometry. + !> @param[inout] tile_geo_u u-wind tile geometry. + !> @param[inout] tile_geo_v v-wind tile geometry. + !> @param[in] fp_super_tile_geo Parent grid at high-resolution geometry + !> @param[in] delta_i_c Coarse grid delta i for nest move. + !> @param[in] delta_j_c Coarse grid delta j for nest move. + !> @param[in] x_refine Nest refinement + !> @param[in] y_refine Nest refinement + !> + !> @author W. Ramstrom, AOML/HRD @date 01/15/2021 subroutine move_nest_geo(Atm, n, tile_geo, tile_geo_u, tile_geo_v, fp_super_tile_geo, delta_i_c, delta_j_c, x_refine, y_refine) implicit none type(fv_atmos_type), allocatable, intent(in) :: Atm(:) !< Atm data array @@ -2354,7 +2827,16 @@ subroutine move_nest_geo(Atm, n, tile_geo, tile_geo_u, tile_geo_v, fp_super_tile end subroutine move_nest_geo - !>@brief The subroutine 'assign_n_p_grids' sets values for parent and nest grid arrays from the grid_geometry structures. + !> The subroutine 'assign_n_p_grids' sets values for parent and nest + !> grid arrays from the grid_geometry structures. + !> + !> @param[in] parent_geo Parent geometry. + !> @param[in] tile_geo Nest geometry. + !> @param[inout] p_grid Parent grid. + !> @param[inout] n_grid Nest grid. + !> @param[in] position Grid offset. + !> + !> @author W. Ramstrom, AOML/HRD @date 01/15/2021 subroutine assign_n_p_grids(parent_geo, tile_geo, p_grid, n_grid, position) type(grid_geometry), intent(in) :: parent_geo, tile_geo !< Parent geometry, nest geometry real(kind=R_GRID), allocatable, intent(inout) :: p_grid(:,:,:) !< Parent grid @@ -2420,7 +2902,15 @@ subroutine assign_n_p_grids(parent_geo, tile_geo, p_grid, n_grid, position) end subroutine assign_n_p_grids - !>@brief The subroutine 'assign_p_grids' sets values for parent grid arrays from the grid_geometry structures. This is static through the model run. + !> The subroutine 'assign_p_grids' sets values for parent grid + !> arrays from the grid_geometry structures. This is static through + !> the model run. + !> + !> @param[in] parent_geo Parent geometry. + !> @param[inout] p_grid Parent grid. + !> @param[in] position Grid offset. + !> + !> @author W. Ramstrom, AOML/HRD @date 01/15/2021 subroutine assign_p_grids(parent_geo, p_grid, position) type(grid_geometry), intent(in) :: parent_geo !< Parent geometry real(kind=R_GRID), allocatable, intent(inout) :: p_grid(:,:,:) !< Parent grid @@ -2549,7 +3039,14 @@ end subroutine assign_p_grids - !>@brief The subroutine 'assign_n_grids' sets values for nest grid arrays from the grid_geometry structures. + !> The subroutine 'assign_n_grids' sets values for nest grid arrays + !> from the grid_geometry structures. + !> + !> @param[in] tile_geo Nest geometry. + !> @param[inout] n_grid Nest grid. + !> @param[in] position Grid offset. + !> + !> @author W. Ramstrom, AOML/HRD @date 01/15/2021 subroutine assign_n_grids(tile_geo, n_grid, position) type(grid_geometry), intent(in) :: tile_geo !< Parent geometry, nest geometry real(kind=R_GRID), allocatable, intent(inout) :: n_grid(:,:,:) !< Nest grid @@ -2590,7 +3087,19 @@ subroutine assign_n_grids(tile_geo, n_grid, position) end subroutine assign_n_grids - + !> ??? + !> + !> @param[in] p_grid ??? + !> @param[in] ic ??? + !> @param[in] jc ??? + !> @param[in] n_grid1 ??? + !> @param[in] n_grid2 ??? + !> @param[in] istag ??? + !> @param[in] jstag ??? + !> @param[out] is_inside ??? + !> @param[in] verbose ??? + !> + !> @author W. Ramstrom, AOML/HRD @date 01/15/2021 subroutine calc_inside(p_grid, ic, jc, n_grid1, n_grid2, istag, jstag, is_inside, verbose) real(kind=R_GRID), allocatable, intent(in) :: p_grid(:,:,:) real(kind=R_GRID), intent(in) :: n_grid1, n_grid2 @@ -2626,8 +3135,24 @@ subroutine calc_inside(p_grid, ic, jc, n_grid1, n_grid2, istag, jstag, is_inside end subroutine calc_inside - !>@brief The subroutine 'calc_nest_halo_weights' calculates the interpolation weights - !>@details Computationally demanding; target for optimization after nest moves + !> The subroutine 'calc_nest_halo_weights' calculates the interpolation weights. + !> + !> Computationally demanding; target for optimization after nest moves. + !> + !> @param[in] bbox_fine Bounding box of parent. + !> @param[in] bbox_coarse Bounding box of nest. + !> @param[in] p_grid Latlon rids of parent in radians. + !> @param[in] n_grid Latlon rids of nest in radians. + !> @param[in] wt Interpolation weight array. + !> @param[inout] istart_coarse Start i of coarse grid. + !> @param[inout] jstart_coarse Start j of coarse grid. + !> @param[in] x_refine Nest refinement. + !> @param[in] y_refine Nest refinement. + !> @param[in] istag Stagger. + !> @param[in] jstag Stagger. + !> @param[in] ind ??? + !> + !> @author W. Ramstrom, AOML/HRD @date 01/15/2021 subroutine calc_nest_halo_weights(bbox_fine, bbox_coarse, p_grid, n_grid, wt, istart_coarse, jstart_coarse, x_refine, y_refine, istag, jstag, ind) implicit none @@ -2743,4 +3268,3 @@ subroutine calc_nest_halo_weights(bbox_fine, bbox_coarse, p_grid, n_grid, wt, is end subroutine calc_nest_halo_weights end module fv_moving_nest_mod - diff --git a/moving_nest/fv_moving_nest_main.F90 b/moving_nest/fv_moving_nest_main.F90 index 34af608c2..9e0b647bd 100644 --- a/moving_nest/fv_moving_nest_main.F90 +++ b/moving_nest/fv_moving_nest_main.F90 @@ -1,3 +1,7 @@ +!> @file +!> @brief Provides top-level interface for moving nest functionality. +!> @author W. Ramstrom, AOML/HRD (William.Ramstrom@noaa.gov) @date 05/27/2021 + !*********************************************************************** !* GNU General Public License * !* This file is a part of fvGFS. * @@ -18,1150 +22,1219 @@ !* or see: http://www.gnu.org/licenses/gpl.html * !*********************************************************************** -!*********************************************************************** -!> @file -!! @brief Provides top-level interface for moving nest functionality -!! @author W. Ramstrom, AOML/HRD 05/27/2021 -!! @email William.Ramstrom@noaa.gov -! =======================================================================! - +!> @brief Provides top-level interface for moving nest functionality. +!> +!> @author W. Ramstrom, AOML/HRD (William.Ramstrom@noaa.gov) @date 05/27/2021 module fv_moving_nest_main_mod -#include - - !----------------- - ! FMS modules: - !----------------- - use block_control_mod, only: block_control_type -#ifdef OVERLOAD_R4 - use constantsR4_mod, only: cp_air, rdgas, grav, rvgas, kappa, pstd_mks -#else - use constants_mod, only: cp_air, rdgas, grav, rvgas, kappa, pstd_mks -#endif - use time_manager_mod, only: time_type, get_time, get_date, set_time, operator(+), & - operator(-), operator(/), time_type_to_real - use fms_mod, only: file_exist, open_namelist_file, & - close_file, error_mesg, FATAL, & - check_nml_error, stdlog, & - write_version_number, & - mpp_clock_id, mpp_clock_begin, & - mpp_clock_end, CLOCK_SUBCOMPONENT, & - clock_flag_default - use mpp_mod, only: mpp_error, stdout, FATAL, WARNING, NOTE, & - input_nml_file, mpp_root_pe, & - mpp_npes, mpp_pe, mpp_chksum, & - mpp_get_current_pelist, & - mpp_set_current_pelist, mpp_sync - use mpp_parameter_mod, only: EUPDATE, WUPDATE, SUPDATE, NUPDATE - use mpp_domains_mod, only: domain2d, mpp_update_domains - use xgrid_mod, only: grid_box_type - use field_manager_mod, only: MODEL_ATMOS - use tracer_manager_mod, only: get_tracer_index, get_number_tracers, & - NO_TRACER, get_tracer_names - use DYCORE_typedefs, only: DYCORE_data_type -#ifdef GFS_TYPES - use GFS_typedefs, only: IPD_data_type => GFS_data_type, & - IPD_control_type => GFS_control_type, kind_phys -#else - use IPD_typedefs, only: IPD_data_type, IPD_control_type, kind_phys => IPD_kind_phys -#endif - - use fv_iau_mod, only: IAU_external_data_type -#ifdef MULTI_GASES - use multi_gases_mod, only: virq, virq_max, num_gas, ri, cpi -#endif - - !----------------- - ! FV core modules: - !----------------- - use atmosphere_mod, only: Atm, mygrid, p_split, dt_atmos - use fv_arrays_mod, only: fv_atmos_type, R_GRID, fv_grid_bounds_type, phys_diag_type - use fv_control_mod, only: ngrids - use fv_diagnostics_mod, only: fv_diag_init, fv_diag_reinit, fv_diag, fv_time, prt_maxmin, prt_height - use fv_restart_mod, only: fv_restart, fv_write_restart - use fv_timing_mod, only: timing_on, timing_off - use fv_mp_mod, only: is_master - use fv_regional_mod, only: start_regional_restart, read_new_bc_data, a_step, p_step, current_time_in_seconds - - !----------------------------------------- - ! External routines - !----------------------------------------- - use mpp_domains_mod, only: NORTH, NORTH_EAST, EAST, SOUTH_EAST, CORNER, CENTER - use mpp_domains_mod, only: nest_domain_type - use mpp_mod, only: mpp_sync, mpp_exit - use mpp_domains_mod, only: mpp_get_global_domain - use mpp_mod, only: mpp_send, mpp_sync_self, mpp_broadcast - - use fv_mp_mod, only: global_nest_domain - - use tracer_manager_mod, only: get_tracer_names - use field_manager_mod, only: MODEL_ATMOS - use fv_io_mod, only: fv_io_exit - !!use fv_restart_mod, only: d2c_setup - - !------------------------------------ - ! Moving Nest Routines - !------------------------------------ - - use fv_moving_nest_types_mod, only: allocate_fv_moving_nest_prog_type, allocate_fv_moving_nest_physics_type - use fv_moving_nest_types_mod, only: deallocate_fv_moving_nests - use fv_moving_nest_types_mod, only: Moving_nest - - ! Prognostic variable routines - use fv_moving_nest_mod, only: mn_prog_fill_intern_nest_halos, mn_prog_fill_nest_halos_from_parent, & - mn_prog_dump_to_netcdf, mn_prog_shift_data - ! Physics variable routines - use fv_moving_nest_physics_mod, only: mn_phys_fill_intern_nest_halos, mn_phys_fill_nest_halos_from_parent, & - mn_phys_dump_to_netcdf, mn_phys_shift_data, mn_phys_reset_sfc_props, move_nsst - - ! Metadata routines - use fv_moving_nest_mod, only: mn_meta_move_nest, mn_meta_recalc, mn_meta_reset_gridstruct, mn_shift_index - - ! Temporary variable routines (delz) - use fv_moving_nest_mod, only: mn_prog_fill_temp_variables, mn_prog_apply_temp_variables - use fv_moving_nest_physics_mod, only: mn_phys_fill_temp_variables, mn_phys_apply_temp_variables - - ! Load static datasets - use fv_moving_nest_mod, only: mn_latlon_read_hires_parent, mn_latlon_load_parent - use fv_moving_nest_mod, only: mn_orog_read_hires_parent, mn_static_read_hires - use fv_moving_nest_utils_mod, only: set_smooth_nest_terrain, set_blended_terrain - - use fv_moving_nest_physics_mod, only: mn_reset_phys_latlon, mn_surface_grids - - ! Grid reset routines - use fv_moving_nest_mod, only: grid_geometry - use fv_moving_nest_utils_mod, only: fill_grid_from_supergrid, fill_weight_grid - - ! Physics moving logical variables - use fv_moving_nest_physics_mod, only: move_physics, move_nsst - - ! Recalculation routines - use fv_moving_nest_mod, only: reallocate_BC_buffers, recalc_aux_pressures - - use fv_tracker_mod, only: Tracker, allocate_tracker, fv_tracker_init, deallocate_tracker - - implicit none - - !----------------------------------------------------------------------- - ! version number of this module - ! Include variable "version" to be written to log file. -#include - character(len=20) :: mod_name = 'fvGFS/fv_moving_nest_main_mod' - -#ifdef OVERLOAD_R4 - real, parameter:: real_snan=x'FFBFFFFF' -#else - real, parameter:: real_snan=x'FFF7FFFFFFFFFFFF' -#endif - - ! Enable these for more debugging outputs - logical :: debug_log = .false. ! Produces logging to out.* file - logical :: tsvar_out = .false. ! Produces netCDF outputs; be careful to not exceed file number limits set in namelist - - ! --- Clock ids for moving_nest performance metering - integer :: id_movnest1, id_movnest1_9, id_movnest2, id_movnest3, id_movnest4, id_movnest5 - integer :: id_movnest5_1, id_movnest5_2, id_movnest5_3, id_movnest5_4 - integer :: id_movnest6, id_movnest7_0, id_movnest7_1, id_movnest7_2, id_movnest7_3, id_movnest8, id_movnest9 - integer :: id_movnestTot - integer, save :: output_step = 0 - -contains - - !>@brief The subroutine 'update_moving_nest' decides whether the nest should be moved, and if so, performs the move. - !>@details This subroutine evaluates the automatic storm tracker (or prescribed motion configuration), then decides - !! if the nest should be moved. If it should be moved, it calls fv_moving_nest_exec() to perform the nest move. - subroutine update_moving_nest(Atm_block, IPD_control, IPD_data, time_step) - type(block_control_type), intent(in) :: Atm_block !< Physics block layout - type(IPD_control_type), intent(in) :: IPD_control !< Physics metadata - type(IPD_data_type), intent(inout) :: IPD_data(:) !< Physics variable data - type(time_type), intent(in) :: time_step !< Current timestep - - logical :: do_move - integer :: delta_i_c, delta_j_c - integer :: parent_grid_num, child_grid_num, nest_num - integer, allocatable :: global_pelist(:) - integer :: n - integer :: this_pe - - this_pe = mpp_pe() - - do_move = .false. - - ! dt_atmos was initialized in atmosphere.F90::atmosphere_init() - - n = mygrid ! Public variable from atmosphere.F90 - - ! Hard-coded for now - these will need to be looked up on each PE when multiple and telescoped nests are enabled. - parent_grid_num = 1 - child_grid_num = 2 - nest_num = 1 - - call eval_move_nest(Atm, a_step, parent_grid_num, child_grid_num, do_move, delta_i_c, delta_j_c, dt_atmos) - - allocate(global_pelist(Atm(parent_grid_num)%npes_this_grid+Atm(child_grid_num)%npes_this_grid)) - global_pelist=(/Atm(parent_grid_num)%pelist, Atm(child_grid_num)%pelist/) - - call mpp_set_current_pelist(global_pelist) - call mpp_broadcast( delta_i_c, Atm(child_grid_num)%pelist(1), global_pelist ) - call mpp_broadcast( delta_j_c, Atm(child_grid_num)%pelist(1), global_pelist ) - call mpp_broadcast( do_move, Atm(child_grid_num)%pelist(1), global_pelist ) - call mpp_set_current_pelist(Atm(n)%pelist) - - if (do_move) then - call fv_moving_nest_exec(Atm, Atm_block, IPD_control, IPD_data, delta_i_c, delta_j_c, n, nest_num, parent_grid_num, child_grid_num, dt_atmos) - endif - - end subroutine update_moving_nest - - - - subroutine moving_nest_end() - integer :: n - - call deallocate_fv_moving_nests(ngrids) - - ! From fv_grid_utils.F90 - n = mygrid - - deallocate ( Atm(n)%gridstruct%area_c_64 ) - deallocate ( Atm(n)%gridstruct%dxa_64 ) - deallocate ( Atm(n)%gridstruct%dya_64 ) - deallocate ( Atm(n)%gridstruct%dxc_64 ) - deallocate ( Atm(n)%gridstruct%dyc_64 ) - deallocate ( Atm(n)%gridstruct%cosa_64 ) - deallocate ( Atm(n)%gridstruct%sina_64 ) - - end subroutine moving_nest_end - - - ! This subroutine sits in this file to have access to Atm structure - subroutine nest_tracker_init() - call fv_tracker_init(size(Atm)) - - if (mygrid .eq. 2) call allocate_tracker(mygrid, Atm(mygrid)%bd%isc, Atm(mygrid)%bd%iec, Atm(mygrid)%bd%jsc, Atm(mygrid)%bd%jec) - end subroutine nest_tracker_init - - subroutine nest_tracker_end() - call deallocate_tracker(ngrids) - end subroutine nest_tracker_end - - - - !>@brief The subroutine 'dump_moving_nest' outputs native grid format data to netCDF files - !>@details This subroutine exports model variables using FMS IO to netCDF files if tsvar_out is set to .True. - subroutine dump_moving_nest(Atm_block, IPD_control, IPD_data, time_step) - type(block_control_type), intent(in) :: Atm_block !< Physics block layout - type(IPD_control_type), intent(in) :: IPD_control !< Physics metadata - type(IPD_data_type), intent(in) :: IPD_data(:) !< Physics variable data - type(time_type), intent(in) :: time_step !< Current timestep - - type(domain2d), pointer :: domain_coarse, domain_fine - logical :: is_fine_pe - integer :: parent_grid_num, child_grid_num, nz, this_pe, n - - this_pe = mpp_pe() - n = mygrid - - parent_grid_num = 1 - child_grid_num = 2 - - domain_fine => Atm(child_grid_num)%domain - domain_coarse => Atm(parent_grid_num)%domain - is_fine_pe = Atm(n)%neststruct%nested .and. ANY(Atm(n)%pelist(:) == this_pe) - nz = Atm(n)%npz - - ! Enable this to dump debug netCDF files. Files are automatically closed when dumped. - !if (mod(a_step, 80) .eq. 0 ) then - ! if (tsvar_out) call mn_prog_dump_to_netcdf(Atm(n), a_step, "tsavar", is_fine_pe, domain_coarse, domain_fine, nz) - ! if (tsvar_out) call mn_phys_dump_to_netcdf(Atm(n), Atm_block, IPD_control, IPD_data, a_step, "tsavar", is_fine_pe, domain_coarse, domain_fine, nz) - !endif - - end subroutine dump_moving_nest - - !>@brief The subroutine 'fv_moving_nest_init_clocks' intializes performance profiling timers of sections of the moving nest code. - !>@details Starts timers for subcomponents of moving nest code to determine performance. mpp routines group them into separate - !! sections for parent and nest PEs. - subroutine fv_moving_nest_init_clocks(use_timers) - logical, intent(in) :: use_timers - - ! --- initialize clocks for moving_nest - if (use_timers) then - id_movnest1 = mpp_clock_id ('MN Part 1 Init', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) - id_movnest1_9 = mpp_clock_id ('MN Part 1.9 Copy delz', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) - id_movnest2 = mpp_clock_id ('MN Part 2 Fill Halos from Parent', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) - id_movnest3 = mpp_clock_id ('MN Part 3 Meta Move Nest', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) - id_movnest4 = mpp_clock_id ('MN Part 4 Fill Intern Nest Halos', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) - id_movnest5 = mpp_clock_id ('MN Part 5 Recalc Weights', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) - id_movnest5_1 = mpp_clock_id ('MN Part 5.1 read_parent', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) - id_movnest5_2 = mpp_clock_id ('MN Part 5.2 reset latlon', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) - id_movnest5_3 = mpp_clock_id ('MN Part 5.3 meta recalc', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) - id_movnest5_4 = mpp_clock_id ('MN Part 5.4 shift indx', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) - - id_movnest6 = mpp_clock_id ('MN Part 6 EOSHIFT', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) - - id_movnest7_0 = mpp_clock_id ('MN Part 7.0 Recalc gridstruct', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) - id_movnest7_1 = mpp_clock_id ('MN Part 7.1 Refill halos from Parent', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) - id_movnest7_2 = mpp_clock_id ('MN Part 7.2 Refill Intern Nest Halos', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) - id_movnest7_3 = mpp_clock_id ('MN Part 7.3 Fill delz', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) - - id_movnest8 = mpp_clock_id ('MN Part 8 Dump to netCDF', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) - id_movnest9 = mpp_clock_id ('MN Part 9 Aux Pressure', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) - endif - - id_movnestTot = mpp_clock_id ('Moving Nest Total', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) - end subroutine fv_moving_nest_init_clocks - - !>@brief The subroutine 'eval_move_nest' determines whether the nest should be moved and in which direction. - !>@details This subroutine can execute prescribed motion or automated storm tracking based on namelist options. - subroutine eval_move_nest(Atm, a_step, parent_grid_num, child_grid_num, do_move, delta_i_c, delta_j_c, dt_atmos) - type(fv_atmos_type), intent(inout) :: Atm(:) !< Input atmospheric data - integer, intent(in) :: a_step !< Timestep - integer, intent(in) :: parent_grid_num, child_grid_num !< Grid numbers of parent and child - logical, intent(out) :: do_move !< Logical for whether to move nest - integer, intent(out) :: delta_i_c, delta_j_c !< Each can be -1, 0, or +1 - real, intent(in) :: dt_atmos !< only needed for the simple version of this subroutine - - integer :: n - integer :: cx, cy - real :: xdiff, ydiff - integer :: nest_i_c, nest_j_c - integer :: nis, nie, njs, nje - integer :: this_pe - character*255 :: message - - ! On the tropical channel configuration, tile 6 numbering starts at 0,0 off the coast of Spain - ! delta_i_c = +1 is westward - ! delta_i_c = -1 is eastward - ! - ! delta_j_c = +1 is southward - ! delta_j_c = -1 is northward - - this_pe = mpp_pe() - n = mygrid ! Public variable from atmosphere.F90 - do_move = .false. - delta_i_c = 0 - delta_j_c = 0 - - if ( Moving_nest(n)%mn_flag%vortex_tracker .eq. 0 .or. Atm(n)%grid_number .eq. 1) then - ! No need to move + #include + + !----------------- + ! FMS modules: + !----------------- + use block_control_mod, only: block_control_type + #ifdef OVERLOAD_R4 + use constantsR4_mod, only: cp_air, rdgas, grav, rvgas, kappa, pstd_mks + #else + use constants_mod, only: cp_air, rdgas, grav, rvgas, kappa, pstd_mks + #endif + use time_manager_mod, only: time_type, get_time, get_date, set_time, operator(+), & + operator(-), operator(/), time_type_to_real + use fms_mod, only: file_exist, open_namelist_file, & + close_file, error_mesg, FATAL, & + check_nml_error, stdlog, & + write_version_number, & + mpp_clock_id, mpp_clock_begin, & + mpp_clock_end, CLOCK_SUBCOMPONENT, & + clock_flag_default + use mpp_mod, only: mpp_error, stdout, FATAL, WARNING, NOTE, & + input_nml_file, mpp_root_pe, & + mpp_npes, mpp_pe, mpp_chksum, & + mpp_get_current_pelist, & + mpp_set_current_pelist, mpp_sync + use mpp_parameter_mod, only: EUPDATE, WUPDATE, SUPDATE, NUPDATE + use mpp_domains_mod, only: domain2d, mpp_update_domains + use xgrid_mod, only: grid_box_type + use field_manager_mod, only: MODEL_ATMOS + use tracer_manager_mod, only: get_tracer_index, get_number_tracers, & + NO_TRACER, get_tracer_names + use DYCORE_typedefs, only: DYCORE_data_type + #ifdef GFS_TYPES + use GFS_typedefs, only: IPD_data_type => GFS_data_type, & + IPD_control_type => GFS_control_type, kind_phys + #else + use IPD_typedefs, only: IPD_data_type, IPD_control_type, kind_phys => IPD_kind_phys + #endif + + use fv_iau_mod, only: IAU_external_data_type + #ifdef MULTI_GASES + use multi_gases_mod, only: virq, virq_max, num_gas, ri, cpi + #endif + + !----------------- + ! FV core modules: + !----------------- + use atmosphere_mod, only: Atm, mygrid, p_split, dt_atmos + use fv_arrays_mod, only: fv_atmos_type, R_GRID, fv_grid_bounds_type, phys_diag_type + use fv_control_mod, only: ngrids + use fv_diagnostics_mod, only: fv_diag_init, fv_diag_reinit, fv_diag, fv_time, prt_maxmin, prt_height + use fv_restart_mod, only: fv_restart, fv_write_restart + use fv_timing_mod, only: timing_on, timing_off + use fv_mp_mod, only: is_master + use fv_regional_mod, only: start_regional_restart, read_new_bc_data, a_step, p_step, current_time_in_seconds + + !----------------------------------------- + ! External routines + !----------------------------------------- + use mpp_domains_mod, only: NORTH, NORTH_EAST, EAST, SOUTH_EAST, CORNER, CENTER + use mpp_domains_mod, only: nest_domain_type + use mpp_mod, only: mpp_sync, mpp_exit + use mpp_domains_mod, only: mpp_get_global_domain + use mpp_mod, only: mpp_send, mpp_sync_self, mpp_broadcast + + use fv_mp_mod, only: global_nest_domain + + use tracer_manager_mod, only: get_tracer_names + use field_manager_mod, only: MODEL_ATMOS + use fv_io_mod, only: fv_io_exit + !!use fv_restart_mod, only: d2c_setup + + !------------------------------------ + ! Moving Nest Routines + !------------------------------------ + + use fv_moving_nest_types_mod, only: allocate_fv_moving_nest_prog_type, allocate_fv_moving_nest_physics_type + use fv_moving_nest_types_mod, only: deallocate_fv_moving_nests + use fv_moving_nest_types_mod, only: Moving_nest + + ! Prognostic variable routines + use fv_moving_nest_mod, only: mn_prog_fill_intern_nest_halos, mn_prog_fill_nest_halos_from_parent, & + mn_prog_dump_to_netcdf, mn_prog_shift_data + ! Physics variable routines + use fv_moving_nest_physics_mod, only: mn_phys_fill_intern_nest_halos, mn_phys_fill_nest_halos_from_parent, & + mn_phys_dump_to_netcdf, mn_phys_shift_data, mn_phys_reset_sfc_props, move_nsst + + ! Metadata routines + use fv_moving_nest_mod, only: mn_meta_move_nest, mn_meta_recalc, mn_meta_reset_gridstruct, mn_shift_index + + ! Temporary variable routines (delz) + use fv_moving_nest_mod, only: mn_prog_fill_temp_variables, mn_prog_apply_temp_variables + use fv_moving_nest_physics_mod, only: mn_phys_fill_temp_variables, mn_phys_apply_temp_variables + + ! Load static datasets + use fv_moving_nest_mod, only: mn_latlon_read_hires_parent, mn_latlon_load_parent + use fv_moving_nest_mod, only: mn_orog_read_hires_parent, mn_static_read_hires + use fv_moving_nest_utils_mod, only: set_smooth_nest_terrain, set_blended_terrain + + use fv_moving_nest_physics_mod, only: mn_reset_phys_latlon, mn_surface_grids + + ! Grid reset routines + use fv_moving_nest_mod, only: grid_geometry + use fv_moving_nest_utils_mod, only: fill_grid_from_supergrid, fill_weight_grid + + ! Physics moving logical variables + use fv_moving_nest_physics_mod, only: move_physics, move_nsst + + ! Recalculation routines + use fv_moving_nest_mod, only: reallocate_BC_buffers, recalc_aux_pressures + + use fv_tracker_mod, only: Tracker, allocate_tracker, fv_tracker_init, deallocate_tracker + + implicit none + + !----------------------------------------------------------------------- + ! version number of this module + ! Include variable "version" to be written to log file. + #include + character(len=20) :: mod_name = 'fvGFS/fv_moving_nest_main_mod' + + #ifdef OVERLOAD_R4 + real, parameter:: real_snan=x'FFBFFFFF' + #else + real, parameter:: real_snan=x'FFF7FFFFFFFFFFFF' + #endif + + ! Enable these for more debugging outputs + logical :: debug_log = .false. ! Produces logging to out.* file + logical :: tsvar_out = .false. ! Produces netCDF outputs; be careful to not exceed file number limits set in namelist + + ! --- Clock ids for moving_nest performance metering + integer :: id_movnest1, id_movnest1_9, id_movnest2, id_movnest3, id_movnest4, id_movnest5 + integer :: id_movnest5_1, id_movnest5_2, id_movnest5_3, id_movnest5_4 + integer :: id_movnest6, id_movnest7_0, id_movnest7_1, id_movnest7_2, id_movnest7_3, id_movnest8, id_movnest9 + integer :: id_movnestTot + integer, save :: output_step = 0 + + contains + + !> The subroutine 'update_moving_nest' decides whether the nest + !> should be moved, and if so, performs the move. + !> + !> This subroutine evaluates the automatic storm tracker (or + !> prescribed motion configuration), then decides if the nest should + !> be moved. If it should be moved, it calls fv_moving_nest_exec() + !> to perform the nest move. + !> + !> @param[in] Atm_block Physics block layout. + !> @param[in] IPD_control Physics metadata. + !> @param[inout] IPD_data Physics variable data. + !> @param[in] time_step Current timestep. + !> + !> @author W. Ramstrom, AOML/HRD (William.Ramstrom@noaa.gov) @date 05/27/2021 + subroutine update_moving_nest(Atm_block, IPD_control, IPD_data, time_step) + type(block_control_type), intent(in) :: Atm_block !< Physics block layout + type(IPD_control_type), intent(in) :: IPD_control !< Physics metadata + type(IPD_data_type), intent(inout) :: IPD_data(:) !< Physics variable data + type(time_type), intent(in) :: time_step !< Current timestep + + logical :: do_move + integer :: delta_i_c, delta_j_c + integer :: parent_grid_num, child_grid_num, nest_num + integer, allocatable :: global_pelist(:) + integer :: n + integer :: this_pe + + this_pe = mpp_pe() + do_move = .false. - delta_i_c = 0 - delta_j_c = 0 - else if ( Moving_nest(n)%mn_flag%vortex_tracker .eq. 1 ) then - ! Prescribed move according to ntrack, move_cd_x and move_cd_y - ! Move every ntrack of dt_atmos time step - if ( mod(a_step,Moving_nest(n)%mn_flag%ntrack) .eq. 0) then - do_move = .true. - delta_i_c = Moving_nest(n)%mn_flag%move_cd_x - delta_j_c = Moving_nest(n)%mn_flag%move_cd_y + + ! dt_atmos was initialized in atmosphere.F90::atmosphere_init() + + n = mygrid ! Public variable from atmosphere.F90 + + ! Hard-coded for now - these will need to be looked up on each PE when multiple and telescoped nests are enabled. + parent_grid_num = 1 + child_grid_num = 2 + nest_num = 1 + + call eval_move_nest(Atm, a_step, parent_grid_num, child_grid_num, do_move, delta_i_c, delta_j_c, dt_atmos) + + allocate(global_pelist(Atm(parent_grid_num)%npes_this_grid+Atm(child_grid_num)%npes_this_grid)) + global_pelist=(/Atm(parent_grid_num)%pelist, Atm(child_grid_num)%pelist/) + + call mpp_set_current_pelist(global_pelist) + call mpp_broadcast( delta_i_c, Atm(child_grid_num)%pelist(1), global_pelist ) + call mpp_broadcast( delta_j_c, Atm(child_grid_num)%pelist(1), global_pelist ) + call mpp_broadcast( do_move, Atm(child_grid_num)%pelist(1), global_pelist ) + call mpp_set_current_pelist(Atm(n)%pelist) + + if (do_move) then + call fv_moving_nest_exec(Atm, Atm_block, IPD_control, IPD_data, delta_i_c, delta_j_c, n, nest_num, parent_grid_num, child_grid_num, dt_atmos) endif - else if ( Moving_nest(n)%mn_flag%vortex_tracker .eq. 2 .or. & - Moving_nest(n)%mn_flag%vortex_tracker .eq. 6 .or. & - Moving_nest(n)%mn_flag%vortex_tracker .eq. 7 ) then - ! Automatic moving following the internal storm tracker - if ( mod(a_step,Moving_nest(n)%mn_flag%ntrack) .eq. 0) then - if(Tracker(n)%tracker_gave_up) then - call mpp_error(NOTE,'Not moving: tracker decided the storm dissapated') - return - endif - if(.not.Tracker(n)%tracker_havefix) then - call mpp_error(NOTE,'Not moving: tracker did not find a storm') - return - endif - ! Calcuate domain center indexes - cx=(Atm(n)%npx-1)/2+1 - cy=(Atm(n)%npy-1)/2+1 - ! Calculate distance in parent grid index space between storm - ! center and domain center - ! Consider using xydiff as integers in the future? - xdiff=(Tracker(n)%tracker_ifix-real(cx))/Atm(n)%neststruct%refinement - ydiff=(Tracker(n)%tracker_jfix-real(cy))/Atm(n)%neststruct%refinement - if(xdiff .ge. 1.0) then - Moving_nest(n)%mn_flag%move_cd_x=1 - else if(xdiff .le. -1.0) then - Moving_nest(n)%mn_flag%move_cd_x=-1 - else - Moving_nest(n)%mn_flag%move_cd_x=0 - endif - if(ydiff .ge. 1.0) then - Moving_nest(n)%mn_flag%move_cd_y=1 - else if(ydiff .le. -1.0) then - Moving_nest(n)%mn_flag%move_cd_y=-1 - else - Moving_nest(n)%mn_flag%move_cd_y=0 - endif - if(abs(Moving_nest(n)%mn_flag%move_cd_x)>0 .or. abs(Moving_nest(n)%mn_flag%move_cd_y)>0) then - call mpp_error(NOTE,'Moving: tracker center shifted from nest center') - do_move = .true. - delta_i_c = Moving_nest(n)%mn_flag%move_cd_x - delta_j_c = Moving_nest(n)%mn_flag%move_cd_y - else - call mpp_error(NOTE,'Not moving: tracker center is near nest center') - do_move = .false. - delta_i_c = 0 - delta_j_c = 0 - endif + + end subroutine update_moving_nest + + + + !> ??? + !> + !> @author W. Ramstrom, AOML/HRD (William.Ramstrom@noaa.gov) @date 05/27/2021 + subroutine moving_nest_end() + integer :: n + + call deallocate_fv_moving_nests(ngrids) + + ! From fv_grid_utils.F90 + n = mygrid + + deallocate ( Atm(n)%gridstruct%area_c_64 ) + deallocate ( Atm(n)%gridstruct%dxa_64 ) + deallocate ( Atm(n)%gridstruct%dya_64 ) + deallocate ( Atm(n)%gridstruct%dxc_64 ) + deallocate ( Atm(n)%gridstruct%dyc_64 ) + deallocate ( Atm(n)%gridstruct%cosa_64 ) + deallocate ( Atm(n)%gridstruct%sina_64 ) + + end subroutine moving_nest_end + + + !> This subroutine sits in this file to have access to Atm structure. + !> + !> @author W. Ramstrom, AOML/HRD (William.Ramstrom@noaa.gov) @date 05/27/2021 + subroutine nest_tracker_init() + call fv_tracker_init(size(Atm)) + + if (mygrid .eq. 2) call allocate_tracker(mygrid, Atm(mygrid)%bd%isc, Atm(mygrid)%bd%iec, Atm(mygrid)%bd%jsc, Atm(mygrid)%bd%jec) + end subroutine nest_tracker_init + + !> ??? + !> + !> @author W. Ramstrom, AOML/HRD (William.Ramstrom@noaa.gov) @date 05/27/2021 + subroutine nest_tracker_end() + call deallocate_tracker(ngrids) + end subroutine nest_tracker_end + + + + !> The subroutine 'dump_moving_nest' outputs native grid format data + !> to netCDF files. + !> + !> This subroutine exports model variables using FMS IO to netCDF + !> files if tsvar_out is set to .True. + !> + !> @param[in] Atm_block Physics block layout. + !> @param[in] IPD_control Physics metadata. + !> @param[in] IPD_data Physics variable data. + !> @param[in] time_step Current timestep. + !> + !> @author W. Ramstrom, AOML/HRD (William.Ramstrom@noaa.gov) @date 05/27/2021 + subroutine dump_moving_nest(Atm_block, IPD_control, IPD_data, time_step) + type(block_control_type), intent(in) :: Atm_block !< Physics block layout + type(IPD_control_type), intent(in) :: IPD_control !< Physics metadata + type(IPD_data_type), intent(in) :: IPD_data(:) !< Physics variable data + type(time_type), intent(in) :: time_step !< Current timestep + + type(domain2d), pointer :: domain_coarse, domain_fine + logical :: is_fine_pe + integer :: parent_grid_num, child_grid_num, nz, this_pe, n + + this_pe = mpp_pe() + n = mygrid + + parent_grid_num = 1 + child_grid_num = 2 + + domain_fine => Atm(child_grid_num)%domain + domain_coarse => Atm(parent_grid_num)%domain + is_fine_pe = Atm(n)%neststruct%nested .and. ANY(Atm(n)%pelist(:) == this_pe) + nz = Atm(n)%npz + + ! Enable this to dump debug netCDF files. Files are automatically closed when dumped. + !if (mod(a_step, 80) .eq. 0 ) then + ! if (tsvar_out) call mn_prog_dump_to_netcdf(Atm(n), a_step, "tsavar", is_fine_pe, domain_coarse, domain_fine, nz) + ! if (tsvar_out) call mn_phys_dump_to_netcdf(Atm(n), Atm_block, IPD_control, IPD_data, a_step, "tsavar", is_fine_pe, domain_coarse, domain_fine, nz) + !endif + + end subroutine dump_moving_nest + + !> The subroutine fv_moving_nest_init_clocks() intializes + !> performance profiling timers of sections of the moving nest code. + !> + !> Starts timers for subcomponents of moving nest code to determine + !> performance. mpp routines group them into separate sections for + !> parent and nest PEs. + !> + !> @param[in] use_timers ??? + !> + !> @author W. Ramstrom, AOML/HRD (William.Ramstrom@noaa.gov) @date 05/27/2021 + subroutine fv_moving_nest_init_clocks(use_timers) + logical, intent(in) :: use_timers + + ! --- initialize clocks for moving_nest + if (use_timers) then + id_movnest1 = mpp_clock_id ('MN Part 1 Init', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) + id_movnest1_9 = mpp_clock_id ('MN Part 1.9 Copy delz', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) + id_movnest2 = mpp_clock_id ('MN Part 2 Fill Halos from Parent', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) + id_movnest3 = mpp_clock_id ('MN Part 3 Meta Move Nest', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) + id_movnest4 = mpp_clock_id ('MN Part 4 Fill Intern Nest Halos', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) + id_movnest5 = mpp_clock_id ('MN Part 5 Recalc Weights', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) + id_movnest5_1 = mpp_clock_id ('MN Part 5.1 read_parent', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) + id_movnest5_2 = mpp_clock_id ('MN Part 5.2 reset latlon', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) + id_movnest5_3 = mpp_clock_id ('MN Part 5.3 meta recalc', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) + id_movnest5_4 = mpp_clock_id ('MN Part 5.4 shift indx', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) + + id_movnest6 = mpp_clock_id ('MN Part 6 EOSHIFT', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) + + id_movnest7_0 = mpp_clock_id ('MN Part 7.0 Recalc gridstruct', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) + id_movnest7_1 = mpp_clock_id ('MN Part 7.1 Refill halos from Parent', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) + id_movnest7_2 = mpp_clock_id ('MN Part 7.2 Refill Intern Nest Halos', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) + id_movnest7_3 = mpp_clock_id ('MN Part 7.3 Fill delz', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) + + id_movnest8 = mpp_clock_id ('MN Part 8 Dump to netCDF', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) + id_movnest9 = mpp_clock_id ('MN Part 9 Aux Pressure', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) endif - else - write(message,*) 'Wrong vortex_tracker option: ', Moving_nest(n)%mn_flag%vortex_tracker - call mpp_error(FATAL,message) - endif - - ! Override to prevent move on first timestep - if (a_step .eq. 0) then + + id_movnestTot = mpp_clock_id ('Moving Nest Total', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) + end subroutine fv_moving_nest_init_clocks + + !> The subroutine 'eval_move_nest' determines whether the nest + !> should be moved and in which direction. + !> + !> This subroutine can execute prescribed motion or automated storm + !> tracking based on namelist options. + !> + !> @param[inout] Atm Input atmospheric data. + !> @param[in] a_step Timestep. + !> @param[in] parent_grid_num Grid numbers of parent. + !> @param[in] child_grid_num Grid numbers of child. + !> @param[out] do_move Logical for whether to move nest. + !> @param[out] delta_i_c Can be -1, 0, or +1. + !> @param[out] delta_j_c Can be -1, 0, or +1. + !> @param[in] dt_atmos only needed for the simple version of this subroutine. + !> + !> @author W. Ramstrom, AOML/HRD (William.Ramstrom@noaa.gov) @date 05/27/2021 + subroutine eval_move_nest(Atm, a_step, parent_grid_num, child_grid_num, do_move, delta_i_c, delta_j_c, dt_atmos) + type(fv_atmos_type), intent(inout) :: Atm(:) !< Input atmospheric data + integer, intent(in) :: a_step !< Timestep + integer, intent(in) :: parent_grid_num, child_grid_num !< Grid numbers of parent and child + logical, intent(out) :: do_move !< Logical for whether to move nest + integer, intent(out) :: delta_i_c, delta_j_c !< Each can be -1, 0, or +1 + real, intent(in) :: dt_atmos !< only needed for the simple version of this subroutine + + integer :: n + integer :: cx, cy + real :: xdiff, ydiff + integer :: nest_i_c, nest_j_c + integer :: nis, nie, njs, nje + integer :: this_pe + character*255 :: message + + ! On the tropical channel configuration, tile 6 numbering starts at 0,0 off the coast of Spain + ! delta_i_c = +1 is westward + ! delta_i_c = -1 is eastward + ! + ! delta_j_c = +1 is southward + ! delta_j_c = -1 is northward + + this_pe = mpp_pe() + n = mygrid ! Public variable from atmosphere.F90 do_move = .false. delta_i_c = 0 delta_j_c = 0 - endif - - ! Check whether or not the nest move is permitted - if (n==child_grid_num) then - ! Figure out the bounds of the cube face - - ! x parent bounds: 1 to Atm(parent_grid_num)%flagstruct%npx - ! y parent bounds: 1 to Atm(parent_grid_num)%flagstruct%npy - - ! Figure out the bounds of the nest - - ! x nest bounds: 1 to Atm(child_grid_num)%flagstruct%npx - ! y nest bounds: 1 to Atm(child_grid_num)%flagstruct%npy - - ! Nest refinement: Atm(child_grid_num)%neststruct%refinement - ! Nest starting cell in x direction: Atm(child_grid_num)%neststruct%ioffset - ! Nest starting cell in y direction: Atm(child_grid_num)%neststruct%joffset - - nest_i_c = ( Atm(child_grid_num)%flagstruct%npx - 1 ) / Atm(child_grid_num)%neststruct%refinement - nest_j_c = ( Atm(child_grid_num)%flagstruct%npy - 1 ) / Atm(child_grid_num)%neststruct%refinement - - nis = Atm(child_grid_num)%neststruct%ioffset + delta_i_c - nie = Atm(child_grid_num)%neststruct%ioffset + nest_i_c + delta_i_c - - njs = Atm(child_grid_num)%neststruct%joffset + delta_j_c - nje = Atm(child_grid_num)%neststruct%joffset + nest_j_c + delta_j_c - - ! Will the nest motion push the nest over one of the edges? - ! Handle each direction individually, so that nest could slide along edge - - ! Causes a crash if we use .le. 1 - if (nis .le. Moving_nest(child_grid_num)%mn_flag%corral_x) then + + if ( Moving_nest(n)%mn_flag%vortex_tracker .eq. 0 .or. Atm(n)%grid_number .eq. 1) then + ! No need to move + do_move = .false. delta_i_c = 0 - ! block_moves = .true. - write(message,*) 'eval_move_nest motion in x direction blocked. small nis: ', nis - call mpp_error(WARNING,message) - endif - if (njs .le. Moving_nest(child_grid_num)%mn_flag%corral_y) then delta_j_c = 0 - ! block_moves = .true. - write(message,*) 'eval_move_nest motion in y direction blocked. small njs: ', njs - call mpp_error(WARNING,message) + else if ( Moving_nest(n)%mn_flag%vortex_tracker .eq. 1 ) then + ! Prescribed move according to ntrack, move_cd_x and move_cd_y + ! Move every ntrack of dt_atmos time step + if ( mod(a_step,Moving_nest(n)%mn_flag%ntrack) .eq. 0) then + do_move = .true. + delta_i_c = Moving_nest(n)%mn_flag%move_cd_x + delta_j_c = Moving_nest(n)%mn_flag%move_cd_y + endif + else if ( Moving_nest(n)%mn_flag%vortex_tracker .eq. 2 .or. & + Moving_nest(n)%mn_flag%vortex_tracker .eq. 6 .or. & + Moving_nest(n)%mn_flag%vortex_tracker .eq. 7 ) then + ! Automatic moving following the internal storm tracker + if ( mod(a_step,Moving_nest(n)%mn_flag%ntrack) .eq. 0) then + if(Tracker(n)%tracker_gave_up) then + call mpp_error(NOTE,'Not moving: tracker decided the storm dissapated') + return + endif + if(.not.Tracker(n)%tracker_havefix) then + call mpp_error(NOTE,'Not moving: tracker did not find a storm') + return + endif + ! Calcuate domain center indexes + cx=(Atm(n)%npx-1)/2+1 + cy=(Atm(n)%npy-1)/2+1 + ! Calculate distance in parent grid index space between storm + ! center and domain center + ! Consider using xydiff as integers in the future? + xdiff=(Tracker(n)%tracker_ifix-real(cx))/Atm(n)%neststruct%refinement + ydiff=(Tracker(n)%tracker_jfix-real(cy))/Atm(n)%neststruct%refinement + if(xdiff .ge. 1.0) then + Moving_nest(n)%mn_flag%move_cd_x=1 + else if(xdiff .le. -1.0) then + Moving_nest(n)%mn_flag%move_cd_x=-1 + else + Moving_nest(n)%mn_flag%move_cd_x=0 + endif + if(ydiff .ge. 1.0) then + Moving_nest(n)%mn_flag%move_cd_y=1 + else if(ydiff .le. -1.0) then + Moving_nest(n)%mn_flag%move_cd_y=-1 + else + Moving_nest(n)%mn_flag%move_cd_y=0 + endif + if(abs(Moving_nest(n)%mn_flag%move_cd_x)>0 .or. abs(Moving_nest(n)%mn_flag%move_cd_y)>0) then + call mpp_error(NOTE,'Moving: tracker center shifted from nest center') + do_move = .true. + delta_i_c = Moving_nest(n)%mn_flag%move_cd_x + delta_j_c = Moving_nest(n)%mn_flag%move_cd_y + else + call mpp_error(NOTE,'Not moving: tracker center is near nest center') + do_move = .false. + delta_i_c = 0 + delta_j_c = 0 + endif + endif + else + write(message,*) 'Wrong vortex_tracker option: ', Moving_nest(n)%mn_flag%vortex_tracker + call mpp_error(FATAL,message) endif - - if (nie .ge. Atm(parent_grid_num)%flagstruct%npx - Moving_nest(child_grid_num)%mn_flag%corral_x) then + + ! Override to prevent move on first timestep + if (a_step .eq. 0) then + do_move = .false. delta_i_c = 0 - ! block_moves = .true. - write(message,*) 'eval_move_nest motion in x direction blocked. large nie: ', nie - call mpp_error(WARNING,message) - endif - if (nje .ge. Atm(parent_grid_num)%flagstruct%npy - Moving_nest(child_grid_num)%mn_flag%corral_y) then delta_j_c = 0 - ! block_moves = .true. - write(message,*) 'eval_move_nest motion in y direction blocked. large nje: ', nje - call mpp_error(WARNING,message) endif - - if (delta_i_c .eq. 0 .and. delta_j_c .eq. 0) then - do_move = .false. + + ! Check whether or not the nest move is permitted + if (n==child_grid_num) then + ! Figure out the bounds of the cube face + + ! x parent bounds: 1 to Atm(parent_grid_num)%flagstruct%npx + ! y parent bounds: 1 to Atm(parent_grid_num)%flagstruct%npy + + ! Figure out the bounds of the nest + + ! x nest bounds: 1 to Atm(child_grid_num)%flagstruct%npx + ! y nest bounds: 1 to Atm(child_grid_num)%flagstruct%npy + + ! Nest refinement: Atm(child_grid_num)%neststruct%refinement + ! Nest starting cell in x direction: Atm(child_grid_num)%neststruct%ioffset + ! Nest starting cell in y direction: Atm(child_grid_num)%neststruct%joffset + + nest_i_c = ( Atm(child_grid_num)%flagstruct%npx - 1 ) / Atm(child_grid_num)%neststruct%refinement + nest_j_c = ( Atm(child_grid_num)%flagstruct%npy - 1 ) / Atm(child_grid_num)%neststruct%refinement + + nis = Atm(child_grid_num)%neststruct%ioffset + delta_i_c + nie = Atm(child_grid_num)%neststruct%ioffset + nest_i_c + delta_i_c + + njs = Atm(child_grid_num)%neststruct%joffset + delta_j_c + nje = Atm(child_grid_num)%neststruct%joffset + nest_j_c + delta_j_c + + ! Will the nest motion push the nest over one of the edges? + ! Handle each direction individually, so that nest could slide along edge + + ! Causes a crash if we use .le. 1 + if (nis .le. Moving_nest(child_grid_num)%mn_flag%corral_x) then + delta_i_c = 0 + ! block_moves = .true. + write(message,*) 'eval_move_nest motion in x direction blocked. small nis: ', nis + call mpp_error(WARNING,message) + endif + if (njs .le. Moving_nest(child_grid_num)%mn_flag%corral_y) then + delta_j_c = 0 + ! block_moves = .true. + write(message,*) 'eval_move_nest motion in y direction blocked. small njs: ', njs + call mpp_error(WARNING,message) + endif + + if (nie .ge. Atm(parent_grid_num)%flagstruct%npx - Moving_nest(child_grid_num)%mn_flag%corral_x) then + delta_i_c = 0 + ! block_moves = .true. + write(message,*) 'eval_move_nest motion in x direction blocked. large nie: ', nie + call mpp_error(WARNING,message) + endif + if (nje .ge. Atm(parent_grid_num)%flagstruct%npy - Moving_nest(child_grid_num)%mn_flag%corral_y) then + delta_j_c = 0 + ! block_moves = .true. + write(message,*) 'eval_move_nest motion in y direction blocked. large nje: ', nje + call mpp_error(WARNING,message) + endif + + if (delta_i_c .eq. 0 .and. delta_j_c .eq. 0) then + do_move = .false. + endif + endif - - endif - - write(message, *) 'eval_move_nest: move_cd_x=', delta_i_c, 'move_cd_y=', delta_j_c, 'do_move=', do_move - call mpp_error(NOTE,message) - - end subroutine eval_move_nest - - !>@brief The subroutine 'fv_moving_nest_exec' performs the nest move - most work occurs on nest PEs but some on parent PEs. - !>@details This subroutine shifts the prognostic and physics/surface variables. - !! It also updates metadata and interpolation weights. - subroutine fv_moving_nest_exec(Atm, Atm_block, IPD_control, IPD_data, delta_i_c, delta_j_c, n, nest_num, parent_grid_num, child_grid_num, dt_atmos) - implicit none - type(fv_atmos_type), allocatable, target, intent(inout) :: Atm(:) !< Atmospheric variables - type(block_control_type), intent(in) :: Atm_block !< Physics block - type(IPD_control_type), intent(in) :: IPD_control !< Physics metadata - type(IPD_data_type), intent(inout) :: IPD_data(:) !< Physics variable data - integer, intent(in) :: delta_i_c, delta_j_c !< Nest motion increments - integer, intent(in) :: n, nest_num !< Nest indices - integer, intent(in) :: parent_grid_num, child_grid_num !< Grid numbers - real, intent(in) :: dt_atmos !< Timestep in seconds - - !---- Moving Nest local variables ----- - integer :: this_pe - integer, pointer :: ioffset, joffset - real, pointer, dimension(:,:,:) :: grid, agrid - type(domain2d), pointer :: domain_coarse, domain_fine - real(kind=R_GRID), pointer, dimension(:,:,:,:) :: grid_global - - ! Constants for mpp calls - integer :: position = CENTER - integer :: position_u = NORTH - integer :: position_v = EAST - logical :: do_move = .True. - integer :: x_refine, y_refine ! Currently equal, but allows for future flexibility - logical :: is_fine_pe - - ! TODO read halo size from the namelist instead to allow nest refinement > 3 - integer :: ehalo = 3 - integer :: whalo = 3 - integer :: nhalo = 3 - integer :: shalo = 3 - integer :: extra_halo = 0 ! Extra halo for moving nest routines - - integer :: istart_fine, iend_fine, jstart_fine, jend_fine - integer :: istart_coarse, iend_coarse, jstart_coarse, jend_coarse - integer :: nx, ny, nz, nx_cubic, ny_cubic - integer :: p_istart_fine, p_iend_fine, p_jstart_fine, p_jend_fine - - ! Parent tile data, saved between timesteps - logical, save :: first_nest_move = .true. - type(grid_geometry), save :: parent_geo - type(grid_geometry), save :: fp_super_tile_geo - type(mn_surface_grids), save :: mn_static - real(kind=R_GRID), allocatable, save :: p_grid(:,:,:) - real(kind=R_GRID), allocatable, save :: p_grid_u(:,:,:) - real(kind=R_GRID), allocatable, save :: p_grid_v(:,:,:) - - type(grid_geometry) :: tile_geo, tile_geo_u, tile_geo_v - real(kind=R_GRID), allocatable :: n_grid(:,:,:) - real(kind=R_GRID), allocatable :: n_grid_u(:,:,:) - real(kind=R_GRID), allocatable :: n_grid_v(:,:,:) - real, allocatable :: wt_h(:,:,:) ! TODO verify that these are deallocated - real, allocatable :: wt_u(:,:,:) - real, allocatable :: wt_v(:,:,:) - !real :: ua(isd:ied,jsd:jed) - !real :: va(isd:ied,jsd:jed) - - logical :: filtered_terrain = .True. ! TODO set this from namelist - integer :: i, j, x, y, z, p, nn, n_moist - integer :: parent_tile - logical :: found_nest_domain = .false. - - ! Variables to enable debugging use of mpp_sync - logical :: debug_sync = .false. - integer, allocatable :: full_pelist(:) - integer :: pp, p1, p2 - - ! Variables for parent side of setup_aligned_nest() - integer :: isg, ieg, jsg, jeg, gid - integer :: isc_p, iec_p, jsc_p, jec_p - integer :: upoff, jind - integer :: ng, refinement - integer :: npx, npy, npz, ncnst, pnats - integer :: isc, iec, jsc, jec - integer :: isd, ied, jsd, jed - integer :: nq ! number of transported tracers - integer :: is, ie, js, je, k ! For recalculation of omga - integer, save :: output_step = 0 - integer, allocatable :: pelist(:) - character(len=16) :: errstring - logical :: is_moving_nest !! TODO Refine this per Atm(n) structure to allow some static and some moving nests in same run - integer :: year, month, day, hour, minute, second - real(kind=R_GRID) :: pi = 4 * atan(1.0d0) - real :: rad2deg - logical :: use_timers - - rad2deg = 180.0 / pi - - gid = mpp_pe() - this_pe = mpp_pe() - - use_timers = Atm(n)%flagstruct%fv_timers - - allocate(pelist(mpp_npes())) - call mpp_get_current_pelist(pelist) - - ! Get month to use for reading static datasets - call get_date(Atm(n)%Time_init, year, month, day, hour, minute, second) - - ! mygrid and n are the same in atmosphere.F90 - npx = Atm(n)%npx - npy = Atm(n)%npy - npz = Atm(n)%npz - ncnst = Atm(n)%ncnst - pnats = Atm(n)%flagstruct%pnats - - isc = Atm(n)%bd%isc - iec = Atm(n)%bd%iec - jsc = Atm(n)%bd%jsc - jec = Atm(n)%bd%jec - - isd = isc - Atm(n)%bd%ng - ied = iec + Atm(n)%bd%ng - jsd = jsc - Atm(n)%bd%ng - jed = jec + Atm(n)%bd%ng - - is = Atm(n)%bd%is - ie = Atm(n)%bd%ie - js = Atm(n)%bd%js - je = Atm(n)%bd%je - - nq = ncnst-pnats - - is_fine_pe = Atm(n)%neststruct%nested .and. ANY(Atm(n)%pelist(:) == this_pe) - - - if (first_nest_move) then - - call fv_moving_nest_init_clocks(Atm(n)%flagstruct%fv_timers) - - ! If NSST is turned off, do not move the NSST variables. - ! Namelist switches are confusing; this should be the correct way to distinguish, not using nst_anl - if (IPD_Control%nstf_name(1) == 0) then - move_nsst=.false. - else - move_nsst=.true. + + write(message, *) 'eval_move_nest: move_cd_x=', delta_i_c, 'move_cd_y=', delta_j_c, 'do_move=', do_move + call mpp_error(NOTE,message) + + end subroutine eval_move_nest + + !> The subroutine 'fv_moving_nest_exec' performs the nest move - + !> most work occurs on nest PEs but some on parent PEs. + !> + !> This subroutine shifts the prognostic and physics/surface + !> variables. It also updates metadata and interpolation weights. + !> + !> @param[inout] Atm Atmospheric variables. + !> @param[in] Atm_block Physics block. + !> @param[in] IPD_control Physics metadata. + !> @param[inout] IPD_data Physics variable data. + !> @param[in] delta_i_c Nest motion increment. + !> @param[in] delta_j_c Nest motion increment. + !> @param[in] n Nest index. + !> @param[in] nest_num Nest index. + !> @param[in] parent_grid_num Grid numbers of parent. + !> @param[in] child_grid_num Grid numbers of child. + !> @param[in] dt_atmos Timestep in seconds. + !> + !> @author W. Ramstrom, AOML/HRD (William.Ramstrom@noaa.gov) @date 05/27/2021 + subroutine fv_moving_nest_exec(Atm, Atm_block, IPD_control, IPD_data, delta_i_c, delta_j_c, n, nest_num, parent_grid_num, child_grid_num, dt_atmos) + implicit none + type(fv_atmos_type), allocatable, target, intent(inout) :: Atm(:) !< Atmospheric variables + type(block_control_type), intent(in) :: Atm_block !< Physics block + type(IPD_control_type), intent(in) :: IPD_control !< Physics metadata + type(IPD_data_type), intent(inout) :: IPD_data(:) !< Physics variable data + integer, intent(in) :: delta_i_c, delta_j_c !< Nest motion increments + integer, intent(in) :: n, nest_num !< Nest indices + integer, intent(in) :: parent_grid_num, child_grid_num !< Grid numbers + real, intent(in) :: dt_atmos !< Timestep in seconds + + !---- Moving Nest local variables ----- + integer :: this_pe + integer, pointer :: ioffset, joffset + real, pointer, dimension(:,:,:) :: grid, agrid + type(domain2d), pointer :: domain_coarse, domain_fine + real(kind=R_GRID), pointer, dimension(:,:,:,:) :: grid_global + + ! Constants for mpp calls + integer :: position = CENTER + integer :: position_u = NORTH + integer :: position_v = EAST + logical :: do_move = .True. + integer :: x_refine, y_refine ! Currently equal, but allows for future flexibility + logical :: is_fine_pe + + ! TODO read halo size from the namelist instead to allow nest refinement > 3 + integer :: ehalo = 3 + integer :: whalo = 3 + integer :: nhalo = 3 + integer :: shalo = 3 + integer :: extra_halo = 0 ! Extra halo for moving nest routines + + integer :: istart_fine, iend_fine, jstart_fine, jend_fine + integer :: istart_coarse, iend_coarse, jstart_coarse, jend_coarse + integer :: nx, ny, nz, nx_cubic, ny_cubic + integer :: p_istart_fine, p_iend_fine, p_jstart_fine, p_jend_fine + + ! Parent tile data, saved between timesteps + logical, save :: first_nest_move = .true. + type(grid_geometry), save :: parent_geo + type(grid_geometry), save :: fp_super_tile_geo + type(mn_surface_grids), save :: mn_static + real(kind=R_GRID), allocatable, save :: p_grid(:,:,:) + real(kind=R_GRID), allocatable, save :: p_grid_u(:,:,:) + real(kind=R_GRID), allocatable, save :: p_grid_v(:,:,:) + + type(grid_geometry) :: tile_geo, tile_geo_u, tile_geo_v + real(kind=R_GRID), allocatable :: n_grid(:,:,:) + real(kind=R_GRID), allocatable :: n_grid_u(:,:,:) + real(kind=R_GRID), allocatable :: n_grid_v(:,:,:) + real, allocatable :: wt_h(:,:,:) ! TODO verify that these are deallocated + real, allocatable :: wt_u(:,:,:) + real, allocatable :: wt_v(:,:,:) + !real :: ua(isd:ied,jsd:jed) + !real :: va(isd:ied,jsd:jed) + + logical :: filtered_terrain = .True. ! TODO set this from namelist + integer :: i, j, x, y, z, p, nn, n_moist + integer :: parent_tile + logical :: found_nest_domain = .false. + + ! Variables to enable debugging use of mpp_sync + logical :: debug_sync = .false. + integer, allocatable :: full_pelist(:) + integer :: pp, p1, p2 + + ! Variables for parent side of setup_aligned_nest() + integer :: isg, ieg, jsg, jeg, gid + integer :: isc_p, iec_p, jsc_p, jec_p + integer :: upoff, jind + integer :: ng, refinement + integer :: npx, npy, npz, ncnst, pnats + integer :: isc, iec, jsc, jec + integer :: isd, ied, jsd, jed + integer :: nq ! number of transported tracers + integer :: is, ie, js, je, k ! For recalculation of omga + integer, save :: output_step = 0 + integer, allocatable :: pelist(:) + character(len=16) :: errstring + logical :: is_moving_nest !! TODO Refine this per Atm(n) structure to allow some static and some moving nests in same run + integer :: year, month, day, hour, minute, second + real(kind=R_GRID) :: pi = 4 * atan(1.0d0) + real :: rad2deg + logical :: use_timers + + rad2deg = 180.0 / pi + + gid = mpp_pe() + this_pe = mpp_pe() + + use_timers = Atm(n)%flagstruct%fv_timers + + allocate(pelist(mpp_npes())) + call mpp_get_current_pelist(pelist) + + ! Get month to use for reading static datasets + call get_date(Atm(n)%Time_init, year, month, day, hour, minute, second) + + ! mygrid and n are the same in atmosphere.F90 + npx = Atm(n)%npx + npy = Atm(n)%npy + npz = Atm(n)%npz + ncnst = Atm(n)%ncnst + pnats = Atm(n)%flagstruct%pnats + + isc = Atm(n)%bd%isc + iec = Atm(n)%bd%iec + jsc = Atm(n)%bd%jsc + jec = Atm(n)%bd%jec + + isd = isc - Atm(n)%bd%ng + ied = iec + Atm(n)%bd%ng + jsd = jsc - Atm(n)%bd%ng + jed = jec + Atm(n)%bd%ng + + is = Atm(n)%bd%is + ie = Atm(n)%bd%ie + js = Atm(n)%bd%js + je = Atm(n)%bd%je + + nq = ncnst-pnats + + is_fine_pe = Atm(n)%neststruct%nested .and. ANY(Atm(n)%pelist(:) == this_pe) + + + if (first_nest_move) then + + call fv_moving_nest_init_clocks(Atm(n)%flagstruct%fv_timers) + + ! If NSST is turned off, do not move the NSST variables. + ! Namelist switches are confusing; this should be the correct way to distinguish, not using nst_anl + if (IPD_Control%nstf_name(1) == 0) then + move_nsst=.false. + else + move_nsst=.true. + endif + + ! This will only allocate the mn_prog and mn_phys for the active Atm(n), not all of them + ! The others can safely remain unallocated. + + call allocate_fv_moving_nest_prog_type(isd, ied, jsd, jed, npz, Moving_nest(n)%mn_prog) + call allocate_fv_moving_nest_physics_type(isd, ied, jsd, jed, npz, move_physics, move_nsst, & + IPD_Control%lsoil, IPD_Control%nmtvr, IPD_Control%levs, IPD_Control%ntot2d, IPD_Control%ntot3d, & + Moving_nest(n)%mn_phys) + endif - - ! This will only allocate the mn_prog and mn_phys for the active Atm(n), not all of them - ! The others can safely remain unallocated. - - call allocate_fv_moving_nest_prog_type(isd, ied, jsd, jed, npz, Moving_nest(n)%mn_prog) - call allocate_fv_moving_nest_physics_type(isd, ied, jsd, jed, npz, move_physics, move_nsst, & - IPD_Control%lsoil, IPD_Control%nmtvr, IPD_Control%levs, IPD_Control%ntot2d, IPD_Control%ntot3d, & - Moving_nest(n)%mn_phys) - - endif - - !================================================================================================== - ! - ! Begin moving nest code - ! W. Ramstrom - AOML/HRD/CIMAS 01/15/2021 - ! - !================================================================================================== - - !!================================================================ - !! Step 1 -- Initialization - !!================================================================ - - domain_fine => Atm(child_grid_num)%domain - parent_tile = Atm(child_grid_num)%neststruct%parent_tile - domain_coarse => Atm(parent_grid_num)%domain - is_moving_nest = Moving_nest(child_grid_num)%mn_flag%is_moving_nest - nz = Atm(n)%npz - - if (is_moving_nest .and. do_move) then - call mpp_clock_begin (id_movnestTot) - if (use_timers) call mpp_clock_begin (id_movnest1) - + + !================================================================================================== + ! + ! Begin moving nest code + ! W. Ramstrom - AOML/HRD/CIMAS 01/15/2021 + ! + !================================================================================================== + !!================================================================ - !! Step 1.1 -- Show the nest grids - (now removed) - !!================================================================ - - + !! Step 1 -- Initialization !!================================================================ - !! Step 1.2 -- Configure local variables - !!================================================================ - - x_refine = Atm(child_grid_num)%neststruct%refinement - y_refine = x_refine - ioffset => Atm(child_grid_num)%neststruct%ioffset - joffset => Atm(child_grid_num)%neststruct%joffset - - istart_fine = global_nest_domain%istart_fine(nest_num) - iend_fine = global_nest_domain%iend_fine(nest_num) - jstart_fine = global_nest_domain%jstart_fine(nest_num) - jend_fine = global_nest_domain%jend_fine(nest_num) - - istart_coarse = global_nest_domain%istart_coarse(nest_num) - iend_coarse = global_nest_domain%iend_coarse(nest_num) - jstart_coarse = global_nest_domain%jstart_coarse(nest_num) - jend_coarse = global_nest_domain%jend_coarse(nest_num) - - ! Allocate the local weight arrays. TODO OPTIMIZE change to use the ones from the gridstruct - if (is_fine_pe) then - allocate(wt_h(Atm(child_grid_num)%bd%isd:Atm(child_grid_num)%bd%ied, Atm(child_grid_num)%bd%jsd:Atm(child_grid_num)%bd%jed, 4)) - wt_h = real_snan - - allocate(wt_u(Atm(child_grid_num)%bd%isd:Atm(child_grid_num)%bd%ied, Atm(child_grid_num)%bd%jsd:Atm(child_grid_num)%bd%jed+1, 4)) - wt_u = real_snan - - allocate(wt_v(Atm(child_grid_num)%bd%isd:Atm(child_grid_num)%bd%ied+1, Atm(child_grid_num)%bd%jsd:Atm(child_grid_num)%bd%jed, 4)) - wt_v = real_snan - - ! Fill in the local weights with the ones from Atm just to be safe - call fill_weight_grid(wt_h, Atm(n)%neststruct%wt_h) - call fill_weight_grid(wt_u, Atm(n)%neststruct%wt_u) - call fill_weight_grid(wt_v, Atm(n)%neststruct%wt_v) - - else - allocate(wt_h(1,1,4)) - wt_h = 0.0 - - allocate(wt_u(1,1,4)) - wt_u = 0.0 - - allocate(wt_v(1,1,4)) - wt_v = 0.0 - endif - - ! This full list of PEs is used for the mpp_sync for debugging. Can later be removed. - p1 = size(Atm(1)%pelist) ! Parent PEs - p2 = size(Atm(2)%pelist) ! Nest PEs - - allocate(full_pelist(p1 + p2)) - do pp=1,p1 - full_pelist(pp) = Atm(1)%pelist(pp) - enddo - do pp=1,p2 - full_pelist(p1+pp) = Atm(2)%pelist(pp) - enddo - - !!============================================================================ - !! Step 1.3 -- Dump the prognostic variables before we do the nest motion. - !!============================================================================ - - output_step = output_step + 1 - - !!============================================================================ - !! Step 1.4 -- Read in the full panel grid definition - !!============================================================================ - - if (is_fine_pe) then - - nx_cubic = Atm(1)%npx - 1 - ny_cubic = Atm(1)%npy - 1 - - nx = Atm(n)%npx - 1 - ny = Atm(n)%npy - 1 - - grid => Atm(n)%gridstruct%grid - agrid => Atm(n)%gridstruct%agrid - - ! Read in static lat/lon data for parent at nest resolution; returns fp_ full panel variables - ! Also read in other static variables from the orography and surface files - - if (first_nest_move) then - - ! TODO set pelist for the correct nest instead of hard-coded Atm(2)%pelist to allow multiple moving nests - - call mn_latlon_read_hires_parent(Atm(1)%npx, Atm(1)%npy, x_refine, Atm(2)%pelist, fp_super_tile_geo, & - Moving_nest(child_grid_num)%mn_flag%surface_dir, parent_tile) - - call mn_orog_read_hires_parent(Atm(1)%npx, Atm(1)%npy, x_refine, Atm(2)%pelist, & - Moving_nest(child_grid_num)%mn_flag%surface_dir, filtered_terrain, & - mn_static%orog_grid, mn_static%orog_std_grid, mn_static%ls_mask_grid, mn_static%land_frac_grid, parent_tile) - - ! If terrain_smoother method 1 is chosen, we need the parent coarse terrain - if (Moving_nest(n)%mn_flag%terrain_smoother .eq. 1) then - if (filtered_terrain) then - call mn_static_read_hires(Atm(1)%npx, Atm(1)%npy, 1, Atm(2)%pelist, Moving_nest(child_grid_num)%mn_flag%surface_dir, "oro_data", "orog_filt", mn_static%parent_orog_grid, parent_tile) - else - call mn_static_read_hires(Atm(1)%npx, Atm(1)%npy, 1, Atm(2)%pelist, Moving_nest(child_grid_num)%mn_flag%surface_dir, "oro_data", "orog_raw", mn_static%parent_orog_grid, parent_tile) - endif - endif - - call mn_static_read_hires(Atm(1)%npx, Atm(1)%npy, x_refine, Atm(2)%pelist, trim(Moving_nest(child_grid_num)%mn_flag%surface_dir), "substrate_temperature", "substrate_temperature", mn_static%deep_soil_temp_grid, parent_tile) - ! set any -999s to +4C - call mn_replace_low_values(mn_static%deep_soil_temp_grid, -100.0, 277.0) - - call mn_static_read_hires(Atm(1)%npx, Atm(1)%npy, x_refine, Atm(2)%pelist, trim(Moving_nest(child_grid_num)%mn_flag%surface_dir), "soil_type", "soil_type", mn_static%soil_type_grid, parent_tile) - ! To match initialization behavior, set any -999s to 0 in soil_type - call mn_replace_low_values(mn_static%soil_type_grid, -100.0, 0.0) - - - !! TODO investigate reading high-resolution veg_frac and veg_greenness - !call mn_static_read_hires(Atm(1)%npx, Atm(1)%npy, x_refine, trim(Moving_nest(child_grid_num)%mn_flag%surface_dir), "", mn_static%veg_frac_grid) - - call mn_static_read_hires(Atm(1)%npx, Atm(1)%npy, x_refine, Atm(2)%pelist, trim(Moving_nest(child_grid_num)%mn_flag%surface_dir), "vegetation_type", "vegetation_type", mn_static%veg_type_grid, parent_tile) - ! To match initialization behavior, set any -999s to 0 in veg_type - call mn_replace_low_values(mn_static%veg_type_grid, -100.0, 0.0) - - - call mn_static_read_hires(Atm(1)%npx, Atm(1)%npy, x_refine, Atm(2)%pelist, trim(Moving_nest(child_grid_num)%mn_flag%surface_dir), "slope_type", "slope_type", mn_static%slope_type_grid, parent_tile) - ! To match initialization behavior, set any -999s to 0 in slope_type - call mn_replace_low_values(mn_static%slope_type_grid, -100.0, 0.0) - - - call mn_static_read_hires(Atm(1)%npx, Atm(1)%npy, x_refine, Atm(2)%pelist, trim(Moving_nest(child_grid_num)%mn_flag%surface_dir), "maximum_snow_albedo", "maximum_snow_albedo", mn_static%max_snow_alb_grid, parent_tile) - ! Set any -999s to 0.5 - call mn_replace_low_values(mn_static%max_snow_alb_grid, -100.0, 0.5) - - ! Albedo fraction -- read and calculate - call mn_static_read_hires(Atm(1)%npx, Atm(1)%npy, x_refine, Atm(2)%pelist, trim(Moving_nest(child_grid_num)%mn_flag%surface_dir), "facsf", "facsf", mn_static%facsf_grid, parent_tile) - - allocate(mn_static%facwf_grid(lbound(mn_static%facsf_grid,1):ubound(mn_static%facsf_grid,1),lbound(mn_static%facsf_grid,2):ubound(mn_static%facsf_grid,2))) - - ! For land points, set facwf = 1.0 - facsf - ! To match initialization behavior, set any -999s to 0 - do i=lbound(mn_static%facsf_grid,1),ubound(mn_static%facsf_grid,1) - do j=lbound(mn_static%facsf_grid,2),ubound(mn_static%facsf_grid,2) - if (mn_static%facsf_grid(i,j) .lt. -100) then - mn_static%facsf_grid(i,j) = 0 - mn_static%facwf_grid(i,j) = 0 + + domain_fine => Atm(child_grid_num)%domain + parent_tile = Atm(child_grid_num)%neststruct%parent_tile + domain_coarse => Atm(parent_grid_num)%domain + is_moving_nest = Moving_nest(child_grid_num)%mn_flag%is_moving_nest + nz = Atm(n)%npz + + if (is_moving_nest .and. do_move) then + call mpp_clock_begin (id_movnestTot) + if (use_timers) call mpp_clock_begin (id_movnest1) + + !!================================================================ + !! Step 1.1 -- Show the nest grids - (now removed) + !!================================================================ + + + !!================================================================ + !! Step 1.2 -- Configure local variables + !!================================================================ + + x_refine = Atm(child_grid_num)%neststruct%refinement + y_refine = x_refine + ioffset => Atm(child_grid_num)%neststruct%ioffset + joffset => Atm(child_grid_num)%neststruct%joffset + + istart_fine = global_nest_domain%istart_fine(nest_num) + iend_fine = global_nest_domain%iend_fine(nest_num) + jstart_fine = global_nest_domain%jstart_fine(nest_num) + jend_fine = global_nest_domain%jend_fine(nest_num) + + istart_coarse = global_nest_domain%istart_coarse(nest_num) + iend_coarse = global_nest_domain%iend_coarse(nest_num) + jstart_coarse = global_nest_domain%jstart_coarse(nest_num) + jend_coarse = global_nest_domain%jend_coarse(nest_num) + + ! Allocate the local weight arrays. TODO OPTIMIZE change to use the ones from the gridstruct + if (is_fine_pe) then + allocate(wt_h(Atm(child_grid_num)%bd%isd:Atm(child_grid_num)%bd%ied, Atm(child_grid_num)%bd%jsd:Atm(child_grid_num)%bd%jed, 4)) + wt_h = real_snan + + allocate(wt_u(Atm(child_grid_num)%bd%isd:Atm(child_grid_num)%bd%ied, Atm(child_grid_num)%bd%jsd:Atm(child_grid_num)%bd%jed+1, 4)) + wt_u = real_snan + + allocate(wt_v(Atm(child_grid_num)%bd%isd:Atm(child_grid_num)%bd%ied+1, Atm(child_grid_num)%bd%jsd:Atm(child_grid_num)%bd%jed, 4)) + wt_v = real_snan + + ! Fill in the local weights with the ones from Atm just to be safe + call fill_weight_grid(wt_h, Atm(n)%neststruct%wt_h) + call fill_weight_grid(wt_u, Atm(n)%neststruct%wt_u) + call fill_weight_grid(wt_v, Atm(n)%neststruct%wt_v) + + else + allocate(wt_h(1,1,4)) + wt_h = 0.0 + + allocate(wt_u(1,1,4)) + wt_u = 0.0 + + allocate(wt_v(1,1,4)) + wt_v = 0.0 + endif + + ! This full list of PEs is used for the mpp_sync for debugging. Can later be removed. + p1 = size(Atm(1)%pelist) ! Parent PEs + p2 = size(Atm(2)%pelist) ! Nest PEs + + allocate(full_pelist(p1 + p2)) + do pp=1,p1 + full_pelist(pp) = Atm(1)%pelist(pp) + enddo + do pp=1,p2 + full_pelist(p1+pp) = Atm(2)%pelist(pp) + enddo + + !!============================================================================ + !! Step 1.3 -- Dump the prognostic variables before we do the nest motion. + !!============================================================================ + + output_step = output_step + 1 + + !!============================================================================ + !! Step 1.4 -- Read in the full panel grid definition + !!============================================================================ + + if (is_fine_pe) then + + nx_cubic = Atm(1)%npx - 1 + ny_cubic = Atm(1)%npy - 1 + + nx = Atm(n)%npx - 1 + ny = Atm(n)%npy - 1 + + grid => Atm(n)%gridstruct%grid + agrid => Atm(n)%gridstruct%agrid + + ! Read in static lat/lon data for parent at nest resolution; returns fp_ full panel variables + ! Also read in other static variables from the orography and surface files + + if (first_nest_move) then + + ! TODO set pelist for the correct nest instead of hard-coded Atm(2)%pelist to allow multiple moving nests + + call mn_latlon_read_hires_parent(Atm(1)%npx, Atm(1)%npy, x_refine, Atm(2)%pelist, fp_super_tile_geo, & + Moving_nest(child_grid_num)%mn_flag%surface_dir, parent_tile) + + call mn_orog_read_hires_parent(Atm(1)%npx, Atm(1)%npy, x_refine, Atm(2)%pelist, & + Moving_nest(child_grid_num)%mn_flag%surface_dir, filtered_terrain, & + mn_static%orog_grid, mn_static%orog_std_grid, mn_static%ls_mask_grid, mn_static%land_frac_grid, parent_tile) + + ! If terrain_smoother method 1 is chosen, we need the parent coarse terrain + if (Moving_nest(n)%mn_flag%terrain_smoother .eq. 1) then + if (filtered_terrain) then + call mn_static_read_hires(Atm(1)%npx, Atm(1)%npy, 1, Atm(2)%pelist, Moving_nest(child_grid_num)%mn_flag%surface_dir, "oro_data", "orog_filt", mn_static%parent_orog_grid, parent_tile) else - mn_static%facwf_grid(i,j) = 1.0 - mn_static%facsf_grid(i,j) + call mn_static_read_hires(Atm(1)%npx, Atm(1)%npy, 1, Atm(2)%pelist, Moving_nest(child_grid_num)%mn_flag%surface_dir, "oro_data", "orog_raw", mn_static%parent_orog_grid, parent_tile) endif + endif + + call mn_static_read_hires(Atm(1)%npx, Atm(1)%npy, x_refine, Atm(2)%pelist, trim(Moving_nest(child_grid_num)%mn_flag%surface_dir), "substrate_temperature", "substrate_temperature", mn_static%deep_soil_temp_grid, parent_tile) + ! set any -999s to +4C + call mn_replace_low_values(mn_static%deep_soil_temp_grid, -100.0, 277.0) + + call mn_static_read_hires(Atm(1)%npx, Atm(1)%npy, x_refine, Atm(2)%pelist, trim(Moving_nest(child_grid_num)%mn_flag%surface_dir), "soil_type", "soil_type", mn_static%soil_type_grid, parent_tile) + ! To match initialization behavior, set any -999s to 0 in soil_type + call mn_replace_low_values(mn_static%soil_type_grid, -100.0, 0.0) + + + !! TODO investigate reading high-resolution veg_frac and veg_greenness + !call mn_static_read_hires(Atm(1)%npx, Atm(1)%npy, x_refine, trim(Moving_nest(child_grid_num)%mn_flag%surface_dir), "", mn_static%veg_frac_grid) + + call mn_static_read_hires(Atm(1)%npx, Atm(1)%npy, x_refine, Atm(2)%pelist, trim(Moving_nest(child_grid_num)%mn_flag%surface_dir), "vegetation_type", "vegetation_type", mn_static%veg_type_grid, parent_tile) + ! To match initialization behavior, set any -999s to 0 in veg_type + call mn_replace_low_values(mn_static%veg_type_grid, -100.0, 0.0) + + + call mn_static_read_hires(Atm(1)%npx, Atm(1)%npy, x_refine, Atm(2)%pelist, trim(Moving_nest(child_grid_num)%mn_flag%surface_dir), "slope_type", "slope_type", mn_static%slope_type_grid, parent_tile) + ! To match initialization behavior, set any -999s to 0 in slope_type + call mn_replace_low_values(mn_static%slope_type_grid, -100.0, 0.0) + + + call mn_static_read_hires(Atm(1)%npx, Atm(1)%npy, x_refine, Atm(2)%pelist, trim(Moving_nest(child_grid_num)%mn_flag%surface_dir), "maximum_snow_albedo", "maximum_snow_albedo", mn_static%max_snow_alb_grid, parent_tile) + ! Set any -999s to 0.5 + call mn_replace_low_values(mn_static%max_snow_alb_grid, -100.0, 0.5) + + ! Albedo fraction -- read and calculate + call mn_static_read_hires(Atm(1)%npx, Atm(1)%npy, x_refine, Atm(2)%pelist, trim(Moving_nest(child_grid_num)%mn_flag%surface_dir), "facsf", "facsf", mn_static%facsf_grid, parent_tile) + + allocate(mn_static%facwf_grid(lbound(mn_static%facsf_grid,1):ubound(mn_static%facsf_grid,1),lbound(mn_static%facsf_grid,2):ubound(mn_static%facsf_grid,2))) + + ! For land points, set facwf = 1.0 - facsf + ! To match initialization behavior, set any -999s to 0 + do i=lbound(mn_static%facsf_grid,1),ubound(mn_static%facsf_grid,1) + do j=lbound(mn_static%facsf_grid,2),ubound(mn_static%facsf_grid,2) + if (mn_static%facsf_grid(i,j) .lt. -100) then + mn_static%facsf_grid(i,j) = 0 + mn_static%facwf_grid(i,j) = 0 + else + mn_static%facwf_grid(i,j) = 1.0 - mn_static%facsf_grid(i,j) + endif + enddo enddo - enddo - - ! Additional albedo variables - ! black sky = strong cosz -- direct sunlight - ! white sky = weak cosz -- diffuse light - - ! alvsf = visible strong cosz = visible_black_sky_albedo - ! alvwf = visible weak cosz = visible_white_sky_albedo - ! alnsf = near IR strong cosz = near_IR_black_sky_albedo - ! alnwf = near IR weak cosz = near_IR_white_sky_albedo - - call mn_static_read_hires(Atm(1)%npx, Atm(1)%npy, x_refine, Atm(2)%pelist, trim(Moving_nest(child_grid_num)%mn_flag%surface_dir), "snowfree_albedo", "visible_black_sky_albedo", mn_static%alvsf_grid, parent_tile, time=month) - call mn_static_read_hires(Atm(1)%npx, Atm(1)%npy, x_refine, Atm(2)%pelist, trim(Moving_nest(child_grid_num)%mn_flag%surface_dir), "snowfree_albedo", "visible_white_sky_albedo", mn_static%alvwf_grid, parent_tile, time=month) - - call mn_static_read_hires(Atm(1)%npx, Atm(1)%npy, x_refine, Atm(2)%pelist, trim(Moving_nest(child_grid_num)%mn_flag%surface_dir), "snowfree_albedo", "near_IR_black_sky_albedo", mn_static%alnsf_grid, parent_tile, time=month) - call mn_static_read_hires(Atm(1)%npx, Atm(1)%npy, x_refine, Atm(2)%pelist, trim(Moving_nest(child_grid_num)%mn_flag%surface_dir), "snowfree_albedo", "near_IR_white_sky_albedo", mn_static%alnwf_grid, parent_tile, time=month) - - ! Set the -999s to small value of 0.06, matching initialization code in chgres - - call mn_replace_low_values(mn_static%alvsf_grid, -100.0, 0.06) - call mn_replace_low_values(mn_static%alvwf_grid, -100.0, 0.06) - call mn_replace_low_values(mn_static%alnsf_grid, -100.0, 0.06) - call mn_replace_low_values(mn_static%alnwf_grid, -100.0, 0.06) - + + ! Additional albedo variables + ! black sky = strong cosz -- direct sunlight + ! white sky = weak cosz -- diffuse light + + ! alvsf = visible strong cosz = visible_black_sky_albedo + ! alvwf = visible weak cosz = visible_white_sky_albedo + ! alnsf = near IR strong cosz = near_IR_black_sky_albedo + ! alnwf = near IR weak cosz = near_IR_white_sky_albedo + + call mn_static_read_hires(Atm(1)%npx, Atm(1)%npy, x_refine, Atm(2)%pelist, trim(Moving_nest(child_grid_num)%mn_flag%surface_dir), "snowfree_albedo", "visible_black_sky_albedo", mn_static%alvsf_grid, parent_tile, time=month) + call mn_static_read_hires(Atm(1)%npx, Atm(1)%npy, x_refine, Atm(2)%pelist, trim(Moving_nest(child_grid_num)%mn_flag%surface_dir), "snowfree_albedo", "visible_white_sky_albedo", mn_static%alvwf_grid, parent_tile, time=month) + + call mn_static_read_hires(Atm(1)%npx, Atm(1)%npy, x_refine, Atm(2)%pelist, trim(Moving_nest(child_grid_num)%mn_flag%surface_dir), "snowfree_albedo", "near_IR_black_sky_albedo", mn_static%alnsf_grid, parent_tile, time=month) + call mn_static_read_hires(Atm(1)%npx, Atm(1)%npy, x_refine, Atm(2)%pelist, trim(Moving_nest(child_grid_num)%mn_flag%surface_dir), "snowfree_albedo", "near_IR_white_sky_albedo", mn_static%alnwf_grid, parent_tile, time=month) + + ! Set the -999s to small value of 0.06, matching initialization code in chgres + + call mn_replace_low_values(mn_static%alvsf_grid, -100.0, 0.06) + call mn_replace_low_values(mn_static%alvwf_grid, -100.0, 0.06) + call mn_replace_low_values(mn_static%alnsf_grid, -100.0, 0.06) + call mn_replace_low_values(mn_static%alnwf_grid, -100.0, 0.06) + + endif + endif - - endif - - if (first_nest_move) first_nest_move = .false. - - if (use_timers) call mpp_clock_end (id_movnest1) - if (use_timers) call mpp_clock_begin (id_movnest1_9) - - !!===================================================================================== - !! Step 1.9 -- Allocate and fill the temporary variable(s) - !!===================================================================================== - - call mn_prog_fill_temp_variables(Atm, n, child_grid_num, is_fine_pe, npz) - call mn_phys_fill_temp_variables(Atm, Atm_block, IPD_control, IPD_data, n, child_grid_num, is_fine_pe, npz) - - if (use_timers) call mpp_clock_end (id_movnest1_9) - if (use_timers) call mpp_clock_begin (id_movnest2) - - !!============================================================================ - !! Step 2 -- Fill in the halos from the coarse grids - !!============================================================================ - - ! The halos seem to be empty at least on the first model timestep. - ! These calls need to be executed by the parent and nest PEs in order to do the communication - ! This is before any nest motion has occurred - - call mn_prog_fill_nest_halos_from_parent(Atm, n, child_grid_num, is_fine_pe, global_nest_domain, nz) - call mn_phys_fill_nest_halos_from_parent(Atm, IPD_control, IPD_data, mn_static, n, child_grid_num, is_fine_pe, global_nest_domain, nz) - - if (use_timers) call mpp_clock_end (id_movnest2) - if (use_timers) call mpp_clock_begin (id_movnest3) - - !!============================================================================ - !! Step 3 -- Redefine the nest domain to new location - !! This calls mpp_define_nest_domains. Following the code in fv_control.F90, only should - !! be executed on the nest PEs. Operates only on indices. - !! -- Similar to med_nest_configure() from HWRF - !!============================================================================ - - call mn_meta_move_nest(delta_i_c, delta_j_c, pelist, is_fine_pe, extra_halo, & - global_nest_domain, domain_fine, domain_coarse, & - istart_coarse, iend_coarse, jstart_coarse, jend_coarse, & - istart_fine, iend_fine, jstart_fine, jend_fine) - - ! This code updates the values in neststruct; ioffset/joffset are pointers: ioffset => Atm(child_grid_num)%neststruct%ioffset - ioffset = ioffset + delta_i_c - joffset = joffset + delta_j_c - - if (debug_sync) call mpp_sync(full_pelist) ! Used to make debugging easier. Can be removed. - - if (use_timers) call mpp_clock_end (id_movnest3) - if (use_timers) call mpp_clock_begin (id_movnest4) - - !!============================================================================ - !! Step 4 -- Fill the internal nest halos for the prognostic variables, - !! then physics variables - !! Only acts on the nest PEs - !! -- similar to med_nest_initial - !!============================================================================ - - ! TODO should/can this run before the mn_meta_move_nest? - if (is_fine_pe) then - call mn_prog_fill_intern_nest_halos(Atm(n), domain_fine, is_fine_pe) - call mn_phys_fill_intern_nest_halos(Moving_nest(n), IPD_control, IPD_data, domain_fine, is_fine_pe) - endif - - if (debug_sync) call mpp_sync(full_pelist) ! Used to make debugging easier. Can be removed. - - if (use_timers) call mpp_clock_end (id_movnest4) - if (use_timers) call mpp_clock_begin (id_movnest5) - - !!============================================================================ - !! Step 5 -- Recalculate nest halo weights (for fine PEs only) and indices - !! -- Similiar to med_nest_weights - !!============================================================================ - - if (is_fine_pe) then + + if (first_nest_move) first_nest_move = .false. + + if (use_timers) call mpp_clock_end (id_movnest1) + if (use_timers) call mpp_clock_begin (id_movnest1_9) + + !!===================================================================================== + !! Step 1.9 -- Allocate and fill the temporary variable(s) + !!===================================================================================== + + call mn_prog_fill_temp_variables(Atm, n, child_grid_num, is_fine_pe, npz) + call mn_phys_fill_temp_variables(Atm, Atm_block, IPD_control, IPD_data, n, child_grid_num, is_fine_pe, npz) + + if (use_timers) call mpp_clock_end (id_movnest1_9) + if (use_timers) call mpp_clock_begin (id_movnest2) + !!============================================================================ - !! Step 5.1 -- Fill the p_grid* and n_grid* variables + !! Step 2 -- Fill in the halos from the coarse grids !!============================================================================ - if (use_timers) call mpp_clock_begin (id_movnest5_1) - - ! parent_geo, p_grid, p_grid_u, and p_grid_v are only loaded first time; afterwards they are reused. - ! Because they are the coarse resolution grids (supergrid, a-grid, u stagger, v stagger) for the parent - call mn_latlon_load_parent(Moving_nest(child_grid_num)%mn_flag%surface_dir, Atm, n, parent_tile, & - delta_i_c, delta_j_c, Atm(2)%pelist, child_grid_num, & - parent_geo, tile_geo, tile_geo_u, tile_geo_v, fp_super_tile_geo, & - p_grid, n_grid, p_grid_u, n_grid_u, p_grid_v, n_grid_v) - - if (use_timers) call mpp_clock_end (id_movnest5_1) - if (use_timers) call mpp_clock_begin (id_movnest5_2) - - ! tile_geo holds the center lat/lons for the entire nest (all PEs). - call mn_reset_phys_latlon(Atm, n, tile_geo, fp_super_tile_geo, Atm_block, IPD_control, IPD_data) - - if (use_timers) call mpp_clock_end (id_movnest5_2) - endif - + + ! The halos seem to be empty at least on the first model timestep. + ! These calls need to be executed by the parent and nest PEs in order to do the communication + ! This is before any nest motion has occurred + + call mn_prog_fill_nest_halos_from_parent(Atm, n, child_grid_num, is_fine_pe, global_nest_domain, nz) + call mn_phys_fill_nest_halos_from_parent(Atm, IPD_control, IPD_data, mn_static, n, child_grid_num, is_fine_pe, global_nest_domain, nz) + + if (use_timers) call mpp_clock_end (id_movnest2) + if (use_timers) call mpp_clock_begin (id_movnest3) + !!============================================================================ - !! Step 5.2 -- Fill the wt* variables for each stagger + !! Step 3 -- Redefine the nest domain to new location + !! This calls mpp_define_nest_domains. Following the code in fv_control.F90, only should + !! be executed on the nest PEs. Operates only on indices. + !! -- Similar to med_nest_configure() from HWRF !!============================================================================ - - call mn_shift_index(delta_i_c, delta_j_c, Atm(child_grid_num)%neststruct%ind_h) - call mn_shift_index(delta_i_c, delta_j_c, Atm(child_grid_num)%neststruct%ind_u) - call mn_shift_index(delta_i_c, delta_j_c, Atm(child_grid_num)%neststruct%ind_v) - call mn_shift_index(delta_i_c, delta_j_c, Atm(child_grid_num)%neststruct%ind_b) - - if (is_fine_pe) then - if (use_timers) call mpp_clock_begin (id_movnest5_3) - - call mn_meta_recalc( delta_i_c, delta_j_c, x_refine, y_refine, tile_geo, parent_geo, fp_super_tile_geo, & - is_fine_pe, global_nest_domain, position, p_grid, n_grid, wt_h, istart_coarse, jstart_coarse, Atm(child_grid_num)%neststruct%ind_h) - - call mn_meta_recalc( delta_i_c, delta_j_c, x_refine, y_refine, tile_geo_u, parent_geo, fp_super_tile_geo, & - is_fine_pe, global_nest_domain, position_u, p_grid_u, n_grid_u, wt_u, istart_coarse, jstart_coarse, Atm(child_grid_num)%neststruct%ind_u) - - call mn_meta_recalc( delta_i_c, delta_j_c, x_refine, y_refine, tile_geo_v, parent_geo, fp_super_tile_geo, & - is_fine_pe, global_nest_domain, position_v, p_grid_v, n_grid_v, wt_v, istart_coarse, jstart_coarse, Atm(child_grid_num)%neststruct%ind_v) - - if (use_timers) call mpp_clock_end (id_movnest5_3) - endif - - if (use_timers) call mpp_clock_begin (id_movnest5_4) - - !!============================================================================ - !! Step 5.3 -- Adjust the indices by the values of delta_i_c, delta_j_c - !!============================================================================ - - !call mn_shift_index(delta_i_c, delta_j_c, Atm(child_grid_num)%neststruct%ind_h) - !call mn_shift_index(delta_i_c, delta_j_c, Atm(child_grid_num)%neststruct%ind_u) - !call mn_shift_index(delta_i_c, delta_j_c, Atm(child_grid_num)%neststruct%ind_v) - !call mn_shift_index(delta_i_c, delta_j_c, Atm(child_grid_num)%neststruct%ind_b) - - if (debug_sync) call mpp_sync(full_pelist) ! Used to make debugging easier. Can be removed. - - if (use_timers) call mpp_clock_end (id_movnest5_4) - - if (use_timers) call mpp_clock_end (id_movnest5) - if (use_timers) call mpp_clock_begin (id_movnest6) - - !!============================================================================ - !! Step 6 Shift the data on each nest PE - !! -- similar to med_nest_move in HWRF - !!============================================================================ - - call mn_prog_shift_data(Atm, n, child_grid_num, wt_h, wt_u, wt_v, & - delta_i_c, delta_j_c, x_refine, y_refine, & - is_fine_pe, global_nest_domain, nz) - - call mn_phys_shift_data(Atm, IPD_control, IPD_data, n, child_grid_num, wt_h, wt_u, wt_v, & - delta_i_c, delta_j_c, x_refine, y_refine, & - is_fine_pe, global_nest_domain, nz) - - if (debug_sync) call mpp_sync(full_pelist) ! Used to make debugging easier. Can be removed. - - if (use_timers) call mpp_clock_end (id_movnest6) - if (use_timers) call mpp_clock_begin (id_movnest7_0) - - !!===================================================================================== - !! Step 7 -- Reset the grid definition data and buffer sizes and weights after the nest motion - !! Mostly needed when dynamics is executed - !!===================================================================================== - - call mn_meta_reset_gridstruct(Atm, n, child_grid_num, global_nest_domain, fp_super_tile_geo, x_refine, y_refine, is_fine_pe, wt_h, wt_u, wt_v, a_step, dt_atmos) - - if (use_timers) call mpp_clock_end (id_movnest7_0) - if (use_timers) call mpp_clock_begin (id_movnest7_1) - - !!===================================================================================== - !! Step 7.01 -- Reset the orography data that was read from the hires static file - !! - !!===================================================================================== - - if (is_fine_pe) then - ! phis is allocated in fv_arrays.F90 as: allocate ( Atm%phis(isd:ied ,jsd:jed ) ) - ! 0 -- all high-resolution data, 1 - static nest smoothing algorithm, 5 - 5 point smoother, 9 - 9 point smoother - ! Defaults to 1 - static nest smoothing algorithm; this seems to produce the most stable solutions - - select case(Moving_nest(n)%mn_flag%terrain_smoother) - case (0) - ! High-resolution terrain for entire nest - Atm(n)%phis(isd:ied, jsd:jed) = mn_static%orog_grid((ioffset-1)*x_refine+isd:(ioffset-1)*x_refine+ied, (joffset-1)*y_refine+jsd:(joffset-1)*y_refine+jed) * grav - case (1) - ! Static nest smoothing algorithm - interpolation of coarse terrain in halo zone and 5 point blending zone of coarse and fine data - call set_blended_terrain(Atm(n), mn_static%parent_orog_grid, mn_static%orog_grid, x_refine, Atm(n)%bd%ng, 5, a_step) - case (2) - ! Static nest smoothing algorithm - interpolation of coarse terrain in halo zone and 5 point blending zone of coarse and fine data - call set_blended_terrain(Atm(n), mn_static%parent_orog_grid, mn_static%orog_grid, x_refine, Atm(n)%bd%ng, 10, a_step) - case (4) ! Use coarse terrain; no-op here. - ; - case (5) - ! 5 pt smoother. blend zone of 5 to match static nest - call set_smooth_nest_terrain(Atm(n), mn_static%orog_grid, x_refine, 5, Atm(n)%bd%ng, 5) - case (9) - ! 9 pt smoother. blend zone of 5 to match static nest - call set_smooth_nest_terrain(Atm(n), mn_static%orog_grid, x_refine, 9, Atm(n)%bd%ng, 5) - case default - write (errstring, "(I0)") Moving_nest(n)%mn_flag%terrain_smoother - call mpp_error(FATAL,'Invalid terrain_smoother in fv_moving_nest_main '//errstring) - end select - - ! Reinitialize diagnostics -- zsurf which is g * Atm%phis - call fv_diag_reinit(Atm(n:n)) - - ! sgh and oro were only fully allocated if fv_land is True - ! if false, oro is (1,1), and sgh is not allocated - if ( Atm(n)%flagstruct%fv_land ) then - ! oro and sgh are allocated only for the compute domain -- they do not have halos - - !fv_arrays.F90 oro() !< land fraction (1: all land; 0: all water) - !real, _ALLOCATABLE :: oro(:,:) _NULL !< land fraction (1: all land; 0: all water) - !real, _ALLOCATABLE :: sgh(:,:) _NULL !< Terrain standard deviation - - Atm(n)%oro(isc:iec, jsc:jec) = mn_static%land_frac_grid((ioffset-1)*x_refine+isc:(ioffset-1)*x_refine+iec, (joffset-1)*y_refine+jsc:(joffset-1)*y_refine+jec) - Atm(n)%sgh(isc:iec, jsc:jec) = mn_static%orog_std_grid((ioffset-1)*x_refine+isc:(ioffset-1)*x_refine+iec, (joffset-1)*y_refine+jsc:(joffset-1)*y_refine+jec) + + call mn_meta_move_nest(delta_i_c, delta_j_c, pelist, is_fine_pe, extra_halo, & + global_nest_domain, domain_fine, domain_coarse, & + istart_coarse, iend_coarse, jstart_coarse, jend_coarse, & + istart_fine, iend_fine, jstart_fine, jend_fine) + + ! This code updates the values in neststruct; ioffset/joffset are pointers: ioffset => Atm(child_grid_num)%neststruct%ioffset + ioffset = ioffset + delta_i_c + joffset = joffset + delta_j_c + + if (debug_sync) call mpp_sync(full_pelist) ! Used to make debugging easier. Can be removed. + + if (use_timers) call mpp_clock_end (id_movnest3) + if (use_timers) call mpp_clock_begin (id_movnest4) + + !!============================================================================ + !! Step 4 -- Fill the internal nest halos for the prognostic variables, + !! then physics variables + !! Only acts on the nest PEs + !! -- similar to med_nest_initial + !!============================================================================ + + ! TODO should/can this run before the mn_meta_move_nest? + if (is_fine_pe) then + call mn_prog_fill_intern_nest_halos(Atm(n), domain_fine, is_fine_pe) + call mn_phys_fill_intern_nest_halos(Moving_nest(n), IPD_control, IPD_data, domain_fine, is_fine_pe) endif - - call mn_phys_reset_sfc_props(Atm, n, mn_static, Atm_block, IPD_data, ioffset, joffset, x_refine) - endif - - !!===================================================================================== - !! Step 7.1 Refill the nest edge halos from parent grid after nest motion - !! Parent and nest PEs need to execute these subroutines - !!===================================================================================== - - ! Refill the halos around the edge of the nest from the parent - call mn_prog_fill_nest_halos_from_parent(Atm, n, child_grid_num, is_fine_pe, global_nest_domain, nz) - call mn_phys_fill_nest_halos_from_parent(Atm, IPD_control, IPD_data, mn_static, n, child_grid_num, is_fine_pe, global_nest_domain, nz) - - if (use_timers) call mpp_clock_end (id_movnest7_1) - - if (is_fine_pe) then - if (use_timers) call mpp_clock_begin (id_movnest7_2) - - ! Refill the internal halos after nest motion - call mn_prog_fill_intern_nest_halos(Atm(n), domain_fine, is_fine_pe) - call mn_phys_fill_intern_nest_halos(Moving_nest(n), IPD_control, IPD_data, domain_fine, is_fine_pe) - - if (use_timers) call mpp_clock_end (id_movnest7_2) - endif - - if (debug_sync) call mpp_sync(full_pelist) ! Used to make debugging easier. Can be removed. - - !!===================================================================================== - !! Step 7.3 -- Apply the temporary variable to the prognostics and physics structures - !!===================================================================================== - if (use_timers) call mpp_clock_begin (id_movnest7_3) - - call mn_prog_apply_temp_variables(Atm, n, child_grid_num, is_fine_pe, npz) - call mn_phys_apply_temp_variables(Atm, Atm_block, IPD_control, IPD_data, n, child_grid_num, is_fine_pe, npz) - - if (use_timers) call mpp_clock_end (id_movnest7_3) - if (use_timers) call mpp_clock_begin (id_movnest8) - - !!============================================================================ - !! Step 8 -- Dump to netCDF - !!============================================================================ - - - if (is_fine_pe) then - do i=isc,iec - do j=jsc,jec - ! EMIS PATCH - Force to positive at all locations matching the landmask - !if (Moving_nest(n)%mn_phys%slmsk(i,j) .eq. 1 .and. Moving_nest(n)%mn_phys%emis_lnd(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%emis_lnd(i,j) = 0.5 - !if (Moving_nest(n)%mn_phys%slmsk(i,j) .eq. 2 .and. Moving_nest(n)%mn_phys%emis_ice(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%emis_ice(i,j) = 0.5 - !if (Moving_nest(n)%mn_phys%slmsk(i,j) .eq. 0 .and. Moving_nest(n)%mn_phys%emis_wat(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%emis_wat(i,j) = 0.5 - !if (Moving_nest(n)%mn_phys%slmsk(i,j) .eq. 1 .and. Moving_nest(n)%mn_phys%albdirvis_lnd(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%albdirvis_lnd(i,j) = 0.5 - !if (Moving_nest(n)%mn_phys%slmsk(i,j) .eq. 1 .and. Moving_nest(n)%mn_phys%albdirnir_lnd(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%albdirvis_lnd(i,j) = 0.5 - !if (Moving_nest(n)%mn_phys%slmsk(i,j) .eq. 1 .and. Moving_nest(n)%mn_phys%albdifvis_lnd(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%albdifvis_lnd(i,j) = 0.5 - !if (Moving_nest(n)%mn_phys%slmsk(i,j) .eq. 1 .and. Moving_nest(n)%mn_phys%albdifnir_lnd(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%albdifnir_lnd(i,j) = 0.5 - - ! EMIS PATCH - Force to positive at all locations. - if (Moving_nest(n)%mn_phys%emis_lnd(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%emis_lnd(i,j) = 0.5 - if (Moving_nest(n)%mn_phys%emis_ice(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%emis_ice(i,j) = 0.5 - if (Moving_nest(n)%mn_phys%emis_wat(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%emis_wat(i,j) = 0.5 - if (Moving_nest(n)%mn_phys%albdirvis_lnd(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%albdirvis_lnd(i,j) = 0.5 - if (Moving_nest(n)%mn_phys%albdirnir_lnd(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%albdirvis_lnd(i,j) = 0.5 - if (Moving_nest(n)%mn_phys%albdifvis_lnd(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%albdifvis_lnd(i,j) = 0.5 - if (Moving_nest(n)%mn_phys%albdifnir_lnd(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%albdifnir_lnd(i,j) = 0.5 - + + if (debug_sync) call mpp_sync(full_pelist) ! Used to make debugging easier. Can be removed. + + if (use_timers) call mpp_clock_end (id_movnest4) + if (use_timers) call mpp_clock_begin (id_movnest5) + + !!============================================================================ + !! Step 5 -- Recalculate nest halo weights (for fine PEs only) and indices + !! -- Similiar to med_nest_weights + !!============================================================================ + + if (is_fine_pe) then + !!============================================================================ + !! Step 5.1 -- Fill the p_grid* and n_grid* variables + !!============================================================================ + if (use_timers) call mpp_clock_begin (id_movnest5_1) + + ! parent_geo, p_grid, p_grid_u, and p_grid_v are only loaded first time; afterwards they are reused. + ! Because they are the coarse resolution grids (supergrid, a-grid, u stagger, v stagger) for the parent + call mn_latlon_load_parent(Moving_nest(child_grid_num)%mn_flag%surface_dir, Atm, n, parent_tile, & + delta_i_c, delta_j_c, Atm(2)%pelist, child_grid_num, & + parent_geo, tile_geo, tile_geo_u, tile_geo_v, fp_super_tile_geo, & + p_grid, n_grid, p_grid_u, n_grid_u, p_grid_v, n_grid_v) + + if (use_timers) call mpp_clock_end (id_movnest5_1) + if (use_timers) call mpp_clock_begin (id_movnest5_2) + + ! tile_geo holds the center lat/lons for the entire nest (all PEs). + call mn_reset_phys_latlon(Atm, n, tile_geo, fp_super_tile_geo, Atm_block, IPD_control, IPD_data) + + if (use_timers) call mpp_clock_end (id_movnest5_2) + endif + + !!============================================================================ + !! Step 5.2 -- Fill the wt* variables for each stagger + !!============================================================================ + + call mn_shift_index(delta_i_c, delta_j_c, Atm(child_grid_num)%neststruct%ind_h) + call mn_shift_index(delta_i_c, delta_j_c, Atm(child_grid_num)%neststruct%ind_u) + call mn_shift_index(delta_i_c, delta_j_c, Atm(child_grid_num)%neststruct%ind_v) + call mn_shift_index(delta_i_c, delta_j_c, Atm(child_grid_num)%neststruct%ind_b) + + if (is_fine_pe) then + if (use_timers) call mpp_clock_begin (id_movnest5_3) + + call mn_meta_recalc( delta_i_c, delta_j_c, x_refine, y_refine, tile_geo, parent_geo, fp_super_tile_geo, & + is_fine_pe, global_nest_domain, position, p_grid, n_grid, wt_h, istart_coarse, jstart_coarse, Atm(child_grid_num)%neststruct%ind_h) + + call mn_meta_recalc( delta_i_c, delta_j_c, x_refine, y_refine, tile_geo_u, parent_geo, fp_super_tile_geo, & + is_fine_pe, global_nest_domain, position_u, p_grid_u, n_grid_u, wt_u, istart_coarse, jstart_coarse, Atm(child_grid_num)%neststruct%ind_u) + + call mn_meta_recalc( delta_i_c, delta_j_c, x_refine, y_refine, tile_geo_v, parent_geo, fp_super_tile_geo, & + is_fine_pe, global_nest_domain, position_v, p_grid_v, n_grid_v, wt_v, istart_coarse, jstart_coarse, Atm(child_grid_num)%neststruct%ind_v) + + if (use_timers) call mpp_clock_end (id_movnest5_3) + endif + + if (use_timers) call mpp_clock_begin (id_movnest5_4) + + !!============================================================================ + !! Step 5.3 -- Adjust the indices by the values of delta_i_c, delta_j_c + !!============================================================================ + + !call mn_shift_index(delta_i_c, delta_j_c, Atm(child_grid_num)%neststruct%ind_h) + !call mn_shift_index(delta_i_c, delta_j_c, Atm(child_grid_num)%neststruct%ind_u) + !call mn_shift_index(delta_i_c, delta_j_c, Atm(child_grid_num)%neststruct%ind_v) + !call mn_shift_index(delta_i_c, delta_j_c, Atm(child_grid_num)%neststruct%ind_b) + + if (debug_sync) call mpp_sync(full_pelist) ! Used to make debugging easier. Can be removed. + + if (use_timers) call mpp_clock_end (id_movnest5_4) + + if (use_timers) call mpp_clock_end (id_movnest5) + if (use_timers) call mpp_clock_begin (id_movnest6) + + !!============================================================================ + !! Step 6 Shift the data on each nest PE + !! -- similar to med_nest_move in HWRF + !!============================================================================ + + call mn_prog_shift_data(Atm, n, child_grid_num, wt_h, wt_u, wt_v, & + delta_i_c, delta_j_c, x_refine, y_refine, & + is_fine_pe, global_nest_domain, nz) + + call mn_phys_shift_data(Atm, IPD_control, IPD_data, n, child_grid_num, wt_h, wt_u, wt_v, & + delta_i_c, delta_j_c, x_refine, y_refine, & + is_fine_pe, global_nest_domain, nz) + + if (debug_sync) call mpp_sync(full_pelist) ! Used to make debugging easier. Can be removed. + + if (use_timers) call mpp_clock_end (id_movnest6) + if (use_timers) call mpp_clock_begin (id_movnest7_0) + + !!===================================================================================== + !! Step 7 -- Reset the grid definition data and buffer sizes and weights after the nest motion + !! Mostly needed when dynamics is executed + !!===================================================================================== + + call mn_meta_reset_gridstruct(Atm, n, child_grid_num, global_nest_domain, fp_super_tile_geo, x_refine, y_refine, is_fine_pe, wt_h, wt_u, wt_v, a_step, dt_atmos) + + if (use_timers) call mpp_clock_end (id_movnest7_0) + if (use_timers) call mpp_clock_begin (id_movnest7_1) + + !!===================================================================================== + !! Step 7.01 -- Reset the orography data that was read from the hires static file + !! + !!===================================================================================== + + if (is_fine_pe) then + ! phis is allocated in fv_arrays.F90 as: allocate ( Atm%phis(isd:ied ,jsd:jed ) ) + ! 0 -- all high-resolution data, 1 - static nest smoothing algorithm, 5 - 5 point smoother, 9 - 9 point smoother + ! Defaults to 1 - static nest smoothing algorithm; this seems to produce the most stable solutions + + select case(Moving_nest(n)%mn_flag%terrain_smoother) + case (0) + ! High-resolution terrain for entire nest + Atm(n)%phis(isd:ied, jsd:jed) = mn_static%orog_grid((ioffset-1)*x_refine+isd:(ioffset-1)*x_refine+ied, (joffset-1)*y_refine+jsd:(joffset-1)*y_refine+jed) * grav + case (1) + ! Static nest smoothing algorithm - interpolation of coarse terrain in halo zone and 5 point blending zone of coarse and fine data + call set_blended_terrain(Atm(n), mn_static%parent_orog_grid, mn_static%orog_grid, x_refine, Atm(n)%bd%ng, 5, a_step) + case (2) + ! Static nest smoothing algorithm - interpolation of coarse terrain in halo zone and 5 point blending zone of coarse and fine data + call set_blended_terrain(Atm(n), mn_static%parent_orog_grid, mn_static%orog_grid, x_refine, Atm(n)%bd%ng, 10, a_step) + case (4) ! Use coarse terrain; no-op here. + ; + case (5) + ! 5 pt smoother. blend zone of 5 to match static nest + call set_smooth_nest_terrain(Atm(n), mn_static%orog_grid, x_refine, 5, Atm(n)%bd%ng, 5) + case (9) + ! 9 pt smoother. blend zone of 5 to match static nest + call set_smooth_nest_terrain(Atm(n), mn_static%orog_grid, x_refine, 9, Atm(n)%bd%ng, 5) + case default + write (errstring, "(I0)") Moving_nest(n)%mn_flag%terrain_smoother + call mpp_error(FATAL,'Invalid terrain_smoother in fv_moving_nest_main '//errstring) + end select + + ! Reinitialize diagnostics -- zsurf which is g * Atm%phis + call fv_diag_reinit(Atm(n:n)) + + ! sgh and oro were only fully allocated if fv_land is True + ! if false, oro is (1,1), and sgh is not allocated + if ( Atm(n)%flagstruct%fv_land ) then + ! oro and sgh are allocated only for the compute domain -- they do not have halos + + !fv_arrays.F90 oro() !< land fraction (1: all land; 0: all water) + !real, _ALLOCATABLE :: oro(:,:) _NULL !< land fraction (1: all land; 0: all water) + !real, _ALLOCATABLE :: sgh(:,:) _NULL !< Terrain standard deviation + + Atm(n)%oro(isc:iec, jsc:jec) = mn_static%land_frac_grid((ioffset-1)*x_refine+isc:(ioffset-1)*x_refine+iec, (joffset-1)*y_refine+jsc:(joffset-1)*y_refine+jec) + Atm(n)%sgh(isc:iec, jsc:jec) = mn_static%orog_std_grid((ioffset-1)*x_refine+isc:(ioffset-1)*x_refine+iec, (joffset-1)*y_refine+jsc:(joffset-1)*y_refine+jec) + endif + + call mn_phys_reset_sfc_props(Atm, n, mn_static, Atm_block, IPD_data, ioffset, joffset, x_refine) + endif + + !!===================================================================================== + !! Step 7.1 Refill the nest edge halos from parent grid after nest motion + !! Parent and nest PEs need to execute these subroutines + !!===================================================================================== + + ! Refill the halos around the edge of the nest from the parent + call mn_prog_fill_nest_halos_from_parent(Atm, n, child_grid_num, is_fine_pe, global_nest_domain, nz) + call mn_phys_fill_nest_halos_from_parent(Atm, IPD_control, IPD_data, mn_static, n, child_grid_num, is_fine_pe, global_nest_domain, nz) + + if (use_timers) call mpp_clock_end (id_movnest7_1) + + if (is_fine_pe) then + if (use_timers) call mpp_clock_begin (id_movnest7_2) + + ! Refill the internal halos after nest motion + call mn_prog_fill_intern_nest_halos(Atm(n), domain_fine, is_fine_pe) + call mn_phys_fill_intern_nest_halos(Moving_nest(n), IPD_control, IPD_data, domain_fine, is_fine_pe) + + if (use_timers) call mpp_clock_end (id_movnest7_2) + endif + + if (debug_sync) call mpp_sync(full_pelist) ! Used to make debugging easier. Can be removed. + + !!===================================================================================== + !! Step 7.3 -- Apply the temporary variable to the prognostics and physics structures + !!===================================================================================== + if (use_timers) call mpp_clock_begin (id_movnest7_3) + + call mn_prog_apply_temp_variables(Atm, n, child_grid_num, is_fine_pe, npz) + call mn_phys_apply_temp_variables(Atm, Atm_block, IPD_control, IPD_data, n, child_grid_num, is_fine_pe, npz) + + if (use_timers) call mpp_clock_end (id_movnest7_3) + if (use_timers) call mpp_clock_begin (id_movnest8) + + !!============================================================================ + !! Step 8 -- Dump to netCDF + !!============================================================================ + + + if (is_fine_pe) then + do i=isc,iec + do j=jsc,jec + ! EMIS PATCH - Force to positive at all locations matching the landmask + !if (Moving_nest(n)%mn_phys%slmsk(i,j) .eq. 1 .and. Moving_nest(n)%mn_phys%emis_lnd(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%emis_lnd(i,j) = 0.5 + !if (Moving_nest(n)%mn_phys%slmsk(i,j) .eq. 2 .and. Moving_nest(n)%mn_phys%emis_ice(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%emis_ice(i,j) = 0.5 + !if (Moving_nest(n)%mn_phys%slmsk(i,j) .eq. 0 .and. Moving_nest(n)%mn_phys%emis_wat(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%emis_wat(i,j) = 0.5 + !if (Moving_nest(n)%mn_phys%slmsk(i,j) .eq. 1 .and. Moving_nest(n)%mn_phys%albdirvis_lnd(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%albdirvis_lnd(i,j) = 0.5 + !if (Moving_nest(n)%mn_phys%slmsk(i,j) .eq. 1 .and. Moving_nest(n)%mn_phys%albdirnir_lnd(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%albdirvis_lnd(i,j) = 0.5 + !if (Moving_nest(n)%mn_phys%slmsk(i,j) .eq. 1 .and. Moving_nest(n)%mn_phys%albdifvis_lnd(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%albdifvis_lnd(i,j) = 0.5 + !if (Moving_nest(n)%mn_phys%slmsk(i,j) .eq. 1 .and. Moving_nest(n)%mn_phys%albdifnir_lnd(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%albdifnir_lnd(i,j) = 0.5 + + ! EMIS PATCH - Force to positive at all locations. + if (Moving_nest(n)%mn_phys%emis_lnd(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%emis_lnd(i,j) = 0.5 + if (Moving_nest(n)%mn_phys%emis_ice(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%emis_ice(i,j) = 0.5 + if (Moving_nest(n)%mn_phys%emis_wat(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%emis_wat(i,j) = 0.5 + if (Moving_nest(n)%mn_phys%albdirvis_lnd(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%albdirvis_lnd(i,j) = 0.5 + if (Moving_nest(n)%mn_phys%albdirnir_lnd(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%albdirvis_lnd(i,j) = 0.5 + if (Moving_nest(n)%mn_phys%albdifvis_lnd(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%albdifvis_lnd(i,j) = 0.5 + if (Moving_nest(n)%mn_phys%albdifnir_lnd(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%albdifnir_lnd(i,j) = 0.5 + + enddo enddo - enddo + endif + + output_step = output_step + 1 + + if (debug_sync) call mpp_sync(full_pelist) ! Used to make debugging easier. Can be removed. + + if (use_timers) call mpp_clock_end (id_movnest8) + if (use_timers) call mpp_clock_begin (id_movnest9) + + !!========================================================================================= + !! Step 9 -- Recalculate auxiliary pressures + !! Should help stabilize the fields before dynamics runs + !! TODO Consider whether vertical remapping, recalculation of omega, interpolation of winds + !! to A or C grids, and/or divergence recalculation are needed here. + !!========================================================================================= + + if (is_fine_pe) then + call recalc_aux_pressures(Atm(n)) + endif + + output_step = output_step + 1 endif - - output_step = output_step + 1 - + + if (use_timers) call mpp_clock_end (id_movnest9) + call mpp_clock_end (id_movnestTot) + if (debug_sync) call mpp_sync(full_pelist) ! Used to make debugging easier. Can be removed. - - if (use_timers) call mpp_clock_end (id_movnest8) - if (use_timers) call mpp_clock_begin (id_movnest9) - - !!========================================================================================= - !! Step 9 -- Recalculate auxiliary pressures - !! Should help stabilize the fields before dynamics runs - !! TODO Consider whether vertical remapping, recalculation of omega, interpolation of winds - !! to A or C grids, and/or divergence recalculation are needed here. - !!========================================================================================= - - if (is_fine_pe) then - call recalc_aux_pressures(Atm(n)) - endif - - output_step = output_step + 1 - endif - - if (use_timers) call mpp_clock_end (id_movnest9) - call mpp_clock_end (id_movnestTot) - - if (debug_sync) call mpp_sync(full_pelist) ! Used to make debugging easier. Can be removed. - - !call compare_terrain("phis", Atm(n)%phis, 1, Atm(n)%neststruct%ind_h, x_refine, y_refine, is_fine_pe, global_nest_domain) - - !deallocate(tile_geo%lats, tile_geo%lons) - !deallocate(tile_geo_u%lats, tile_geo_u%lons) - !deallocate(tile_geo_v%lats, tile_geo_v%lons) - - !deallocate(p_grid, n_grid) - !deallocate(p_grid_u, n_grid_u) - !deallocate(p_grid_v, n_grid_v) - - end subroutine fv_moving_nest_exec - - !>@brief The subroutine 'mn_replace_low_values' replaces low values with a default value. - subroutine mn_replace_low_values(data_grid, low_value, new_value) - real, _ALLOCATABLE, intent(inout) :: data_grid(:,:) !< 2D grid of data - real, intent(in) :: low_value !< Low value to check for; e.g. negative or fill value - real, intent(in) :: new_value !< Value to replace low value with - - integer :: i, j - - do i=lbound(data_grid,1),ubound(data_grid,1) - do j=lbound(data_grid,2),ubound(data_grid,2) - if (data_grid(i,j) .le. low_value) data_grid(i,j) = new_value + + !call compare_terrain("phis", Atm(n)%phis, 1, Atm(n)%neststruct%ind_h, x_refine, y_refine, is_fine_pe, global_nest_domain) + + !deallocate(tile_geo%lats, tile_geo%lons) + !deallocate(tile_geo_u%lats, tile_geo_u%lons) + !deallocate(tile_geo_v%lats, tile_geo_v%lons) + + !deallocate(p_grid, n_grid) + !deallocate(p_grid_u, n_grid_u) + !deallocate(p_grid_v, n_grid_v) + + end subroutine fv_moving_nest_exec + + !> The subroutine 'mn_replace_low_values' replaces low values with a + !> default value. + !> + !> @param[inout] data_grid 2D grid of data. + !> @param[in] low_value Low value to check for; e.g. negative or fill value. + !> @param[in] new_value Value to replace low value with. + !> + !> @author W. Ramstrom, AOML/HRD (William.Ramstrom@noaa.gov) @date 05/27/2021 + subroutine mn_replace_low_values(data_grid, low_value, new_value) + real, _ALLOCATABLE, intent(inout) :: data_grid(:,:) !< 2D grid of data + real, intent(in) :: low_value !< Low value to check for; e.g. negative or fill value + real, intent(in) :: new_value !< Value to replace low value with + + integer :: i, j + + do i=lbound(data_grid,1),ubound(data_grid,1) + do j=lbound(data_grid,2),ubound(data_grid,2) + if (data_grid(i,j) .le. low_value) data_grid(i,j) = new_value + enddo enddo - enddo - end subroutine mn_replace_low_values - -end module fv_moving_nest_main_mod - + end subroutine mn_replace_low_values + + end module fv_moving_nest_main_mod + \ No newline at end of file From f72b87df9d4bdbb297f5c7e8519b81e5c89005a5 Mon Sep 17 00:00:00 2001 From: AlysonStahl-NOAA <166434581+AlysonStahl-NOAA@users.noreply.github.com> Date: Thu, 11 Apr 2024 14:33:20 -0600 Subject: [PATCH 3/5] reverted recent changes in fv_moving_nest_main.F90 --- moving_nest/fv_moving_nest_main.F90 | 117 ++++++---------------------- 1 file changed, 22 insertions(+), 95 deletions(-) diff --git a/moving_nest/fv_moving_nest_main.F90 b/moving_nest/fv_moving_nest_main.F90 index 9e0b647bd..6294815d0 100644 --- a/moving_nest/fv_moving_nest_main.F90 +++ b/moving_nest/fv_moving_nest_main.F90 @@ -1,7 +1,3 @@ -!> @file -!> @brief Provides top-level interface for moving nest functionality. -!> @author W. Ramstrom, AOML/HRD (William.Ramstrom@noaa.gov) @date 05/27/2021 - !*********************************************************************** !* GNU General Public License * !* This file is a part of fvGFS. * @@ -22,9 +18,13 @@ !* or see: http://www.gnu.org/licenses/gpl.html * !*********************************************************************** -!> @brief Provides top-level interface for moving nest functionality. -!> -!> @author W. Ramstrom, AOML/HRD (William.Ramstrom@noaa.gov) @date 05/27/2021 +!*********************************************************************** +!> @file +!! @brief Provides top-level interface for moving nest functionality +!! @author W. Ramstrom, AOML/HRD 05/27/2021 +!! @email William.Ramstrom@noaa.gov +! =======================================================================! + module fv_moving_nest_main_mod #include @@ -167,20 +167,9 @@ module fv_moving_nest_main_mod contains - !> The subroutine 'update_moving_nest' decides whether the nest - !> should be moved, and if so, performs the move. - !> - !> This subroutine evaluates the automatic storm tracker (or - !> prescribed motion configuration), then decides if the nest should - !> be moved. If it should be moved, it calls fv_moving_nest_exec() - !> to perform the nest move. - !> - !> @param[in] Atm_block Physics block layout. - !> @param[in] IPD_control Physics metadata. - !> @param[inout] IPD_data Physics variable data. - !> @param[in] time_step Current timestep. - !> - !> @author W. Ramstrom, AOML/HRD (William.Ramstrom@noaa.gov) @date 05/27/2021 + !>@brief The subroutine 'update_moving_nest' decides whether the nest should be moved, and if so, performs the move. + !>@details This subroutine evaluates the automatic storm tracker (or prescribed motion configuration), then decides + !! if the nest should be moved. If it should be moved, it calls fv_moving_nest_exec() to perform the nest move. subroutine update_moving_nest(Atm_block, IPD_control, IPD_data, time_step) type(block_control_type), intent(in) :: Atm_block !< Physics block layout type(IPD_control_type), intent(in) :: IPD_control !< Physics metadata @@ -226,9 +215,6 @@ end subroutine update_moving_nest - !> ??? - !> - !> @author W. Ramstrom, AOML/HRD (William.Ramstrom@noaa.gov) @date 05/27/2021 subroutine moving_nest_end() integer :: n @@ -248,36 +234,21 @@ subroutine moving_nest_end() end subroutine moving_nest_end - !> This subroutine sits in this file to have access to Atm structure. - !> - !> @author W. Ramstrom, AOML/HRD (William.Ramstrom@noaa.gov) @date 05/27/2021 + ! This subroutine sits in this file to have access to Atm structure subroutine nest_tracker_init() call fv_tracker_init(size(Atm)) if (mygrid .eq. 2) call allocate_tracker(mygrid, Atm(mygrid)%bd%isc, Atm(mygrid)%bd%iec, Atm(mygrid)%bd%jsc, Atm(mygrid)%bd%jec) end subroutine nest_tracker_init - !> ??? - !> - !> @author W. Ramstrom, AOML/HRD (William.Ramstrom@noaa.gov) @date 05/27/2021 subroutine nest_tracker_end() call deallocate_tracker(ngrids) end subroutine nest_tracker_end - !> The subroutine 'dump_moving_nest' outputs native grid format data - !> to netCDF files. - !> - !> This subroutine exports model variables using FMS IO to netCDF - !> files if tsvar_out is set to .True. - !> - !> @param[in] Atm_block Physics block layout. - !> @param[in] IPD_control Physics metadata. - !> @param[in] IPD_data Physics variable data. - !> @param[in] time_step Current timestep. - !> - !> @author W. Ramstrom, AOML/HRD (William.Ramstrom@noaa.gov) @date 05/27/2021 + !>@brief The subroutine 'dump_moving_nest' outputs native grid format data to netCDF files + !>@details This subroutine exports model variables using FMS IO to netCDF files if tsvar_out is set to .True. subroutine dump_moving_nest(Atm_block, IPD_control, IPD_data, time_step) type(block_control_type), intent(in) :: Atm_block !< Physics block layout type(IPD_control_type), intent(in) :: IPD_control !< Physics metadata @@ -307,16 +278,9 @@ subroutine dump_moving_nest(Atm_block, IPD_control, IPD_data, time_step) end subroutine dump_moving_nest - !> The subroutine fv_moving_nest_init_clocks() intializes - !> performance profiling timers of sections of the moving nest code. - !> - !> Starts timers for subcomponents of moving nest code to determine - !> performance. mpp routines group them into separate sections for - !> parent and nest PEs. - !> - !> @param[in] use_timers ??? - !> - !> @author W. Ramstrom, AOML/HRD (William.Ramstrom@noaa.gov) @date 05/27/2021 + !>@brief The subroutine 'fv_moving_nest_init_clocks' intializes performance profiling timers of sections of the moving nest code. + !>@details Starts timers for subcomponents of moving nest code to determine performance. mpp routines group them into separate + !! sections for parent and nest PEs. subroutine fv_moving_nest_init_clocks(use_timers) logical, intent(in) :: use_timers @@ -347,22 +311,8 @@ subroutine fv_moving_nest_init_clocks(use_timers) id_movnestTot = mpp_clock_id ('Moving Nest Total', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) end subroutine fv_moving_nest_init_clocks - !> The subroutine 'eval_move_nest' determines whether the nest - !> should be moved and in which direction. - !> - !> This subroutine can execute prescribed motion or automated storm - !> tracking based on namelist options. - !> - !> @param[inout] Atm Input atmospheric data. - !> @param[in] a_step Timestep. - !> @param[in] parent_grid_num Grid numbers of parent. - !> @param[in] child_grid_num Grid numbers of child. - !> @param[out] do_move Logical for whether to move nest. - !> @param[out] delta_i_c Can be -1, 0, or +1. - !> @param[out] delta_j_c Can be -1, 0, or +1. - !> @param[in] dt_atmos only needed for the simple version of this subroutine. - !> - !> @author W. Ramstrom, AOML/HRD (William.Ramstrom@noaa.gov) @date 05/27/2021 + !>@brief The subroutine 'eval_move_nest' determines whether the nest should be moved and in which direction. + !>@details This subroutine can execute prescribed motion or automated storm tracking based on namelist options. subroutine eval_move_nest(Atm, a_step, parent_grid_num, child_grid_num, do_move, delta_i_c, delta_j_c, dt_atmos) type(fv_atmos_type), intent(inout) :: Atm(:) !< Input atmospheric data integer, intent(in) :: a_step !< Timestep @@ -530,25 +480,9 @@ subroutine eval_move_nest(Atm, a_step, parent_grid_num, child_grid_num, do_move, end subroutine eval_move_nest - !> The subroutine 'fv_moving_nest_exec' performs the nest move - - !> most work occurs on nest PEs but some on parent PEs. - !> - !> This subroutine shifts the prognostic and physics/surface - !> variables. It also updates metadata and interpolation weights. - !> - !> @param[inout] Atm Atmospheric variables. - !> @param[in] Atm_block Physics block. - !> @param[in] IPD_control Physics metadata. - !> @param[inout] IPD_data Physics variable data. - !> @param[in] delta_i_c Nest motion increment. - !> @param[in] delta_j_c Nest motion increment. - !> @param[in] n Nest index. - !> @param[in] nest_num Nest index. - !> @param[in] parent_grid_num Grid numbers of parent. - !> @param[in] child_grid_num Grid numbers of child. - !> @param[in] dt_atmos Timestep in seconds. - !> - !> @author W. Ramstrom, AOML/HRD (William.Ramstrom@noaa.gov) @date 05/27/2021 + !>@brief The subroutine 'fv_moving_nest_exec' performs the nest move - most work occurs on nest PEs but some on parent PEs. + !>@details This subroutine shifts the prognostic and physics/surface variables. + !! It also updates metadata and interpolation weights. subroutine fv_moving_nest_exec(Atm, Atm_block, IPD_control, IPD_data, delta_i_c, delta_j_c, n, nest_num, parent_grid_num, child_grid_num, dt_atmos) implicit none type(fv_atmos_type), allocatable, target, intent(inout) :: Atm(:) !< Atmospheric variables @@ -1214,14 +1148,7 @@ subroutine fv_moving_nest_exec(Atm, Atm_block, IPD_control, IPD_data, delta_i_c, end subroutine fv_moving_nest_exec - !> The subroutine 'mn_replace_low_values' replaces low values with a - !> default value. - !> - !> @param[inout] data_grid 2D grid of data. - !> @param[in] low_value Low value to check for; e.g. negative or fill value. - !> @param[in] new_value Value to replace low value with. - !> - !> @author W. Ramstrom, AOML/HRD (William.Ramstrom@noaa.gov) @date 05/27/2021 + !>@brief The subroutine 'mn_replace_low_values' replaces low values with a default value. subroutine mn_replace_low_values(data_grid, low_value, new_value) real, _ALLOCATABLE, intent(inout) :: data_grid(:,:) !< 2D grid of data real, intent(in) :: low_value !< Low value to check for; e.g. negative or fill value From 88d1c2f8ee87348bdfa1dc840374ce4efa872671 Mon Sep 17 00:00:00 2001 From: Alyson Stahl Date: Thu, 11 Apr 2024 14:57:09 -0600 Subject: [PATCH 4/5] second attempt at reverting changes to resolve file comparison issue --- moving_nest/fv_moving_nest_main.F90 | 2218 +++++++++++++-------------- 1 file changed, 1109 insertions(+), 1109 deletions(-) diff --git a/moving_nest/fv_moving_nest_main.F90 b/moving_nest/fv_moving_nest_main.F90 index 6294815d0..34af608c2 100644 --- a/moving_nest/fv_moving_nest_main.F90 +++ b/moving_nest/fv_moving_nest_main.F90 @@ -27,1141 +27,1141 @@ module fv_moving_nest_main_mod - #include - - !----------------- - ! FMS modules: - !----------------- - use block_control_mod, only: block_control_type - #ifdef OVERLOAD_R4 - use constantsR4_mod, only: cp_air, rdgas, grav, rvgas, kappa, pstd_mks - #else - use constants_mod, only: cp_air, rdgas, grav, rvgas, kappa, pstd_mks - #endif - use time_manager_mod, only: time_type, get_time, get_date, set_time, operator(+), & - operator(-), operator(/), time_type_to_real - use fms_mod, only: file_exist, open_namelist_file, & - close_file, error_mesg, FATAL, & - check_nml_error, stdlog, & - write_version_number, & - mpp_clock_id, mpp_clock_begin, & - mpp_clock_end, CLOCK_SUBCOMPONENT, & - clock_flag_default - use mpp_mod, only: mpp_error, stdout, FATAL, WARNING, NOTE, & - input_nml_file, mpp_root_pe, & - mpp_npes, mpp_pe, mpp_chksum, & - mpp_get_current_pelist, & - mpp_set_current_pelist, mpp_sync - use mpp_parameter_mod, only: EUPDATE, WUPDATE, SUPDATE, NUPDATE - use mpp_domains_mod, only: domain2d, mpp_update_domains - use xgrid_mod, only: grid_box_type - use field_manager_mod, only: MODEL_ATMOS - use tracer_manager_mod, only: get_tracer_index, get_number_tracers, & - NO_TRACER, get_tracer_names - use DYCORE_typedefs, only: DYCORE_data_type - #ifdef GFS_TYPES - use GFS_typedefs, only: IPD_data_type => GFS_data_type, & - IPD_control_type => GFS_control_type, kind_phys - #else - use IPD_typedefs, only: IPD_data_type, IPD_control_type, kind_phys => IPD_kind_phys - #endif - - use fv_iau_mod, only: IAU_external_data_type - #ifdef MULTI_GASES - use multi_gases_mod, only: virq, virq_max, num_gas, ri, cpi - #endif - - !----------------- - ! FV core modules: - !----------------- - use atmosphere_mod, only: Atm, mygrid, p_split, dt_atmos - use fv_arrays_mod, only: fv_atmos_type, R_GRID, fv_grid_bounds_type, phys_diag_type - use fv_control_mod, only: ngrids - use fv_diagnostics_mod, only: fv_diag_init, fv_diag_reinit, fv_diag, fv_time, prt_maxmin, prt_height - use fv_restart_mod, only: fv_restart, fv_write_restart - use fv_timing_mod, only: timing_on, timing_off - use fv_mp_mod, only: is_master - use fv_regional_mod, only: start_regional_restart, read_new_bc_data, a_step, p_step, current_time_in_seconds - - !----------------------------------------- - ! External routines - !----------------------------------------- - use mpp_domains_mod, only: NORTH, NORTH_EAST, EAST, SOUTH_EAST, CORNER, CENTER - use mpp_domains_mod, only: nest_domain_type - use mpp_mod, only: mpp_sync, mpp_exit - use mpp_domains_mod, only: mpp_get_global_domain - use mpp_mod, only: mpp_send, mpp_sync_self, mpp_broadcast - - use fv_mp_mod, only: global_nest_domain - - use tracer_manager_mod, only: get_tracer_names - use field_manager_mod, only: MODEL_ATMOS - use fv_io_mod, only: fv_io_exit - !!use fv_restart_mod, only: d2c_setup - - !------------------------------------ - ! Moving Nest Routines - !------------------------------------ - - use fv_moving_nest_types_mod, only: allocate_fv_moving_nest_prog_type, allocate_fv_moving_nest_physics_type - use fv_moving_nest_types_mod, only: deallocate_fv_moving_nests - use fv_moving_nest_types_mod, only: Moving_nest - - ! Prognostic variable routines - use fv_moving_nest_mod, only: mn_prog_fill_intern_nest_halos, mn_prog_fill_nest_halos_from_parent, & - mn_prog_dump_to_netcdf, mn_prog_shift_data - ! Physics variable routines - use fv_moving_nest_physics_mod, only: mn_phys_fill_intern_nest_halos, mn_phys_fill_nest_halos_from_parent, & - mn_phys_dump_to_netcdf, mn_phys_shift_data, mn_phys_reset_sfc_props, move_nsst - - ! Metadata routines - use fv_moving_nest_mod, only: mn_meta_move_nest, mn_meta_recalc, mn_meta_reset_gridstruct, mn_shift_index - - ! Temporary variable routines (delz) - use fv_moving_nest_mod, only: mn_prog_fill_temp_variables, mn_prog_apply_temp_variables - use fv_moving_nest_physics_mod, only: mn_phys_fill_temp_variables, mn_phys_apply_temp_variables - - ! Load static datasets - use fv_moving_nest_mod, only: mn_latlon_read_hires_parent, mn_latlon_load_parent - use fv_moving_nest_mod, only: mn_orog_read_hires_parent, mn_static_read_hires - use fv_moving_nest_utils_mod, only: set_smooth_nest_terrain, set_blended_terrain - - use fv_moving_nest_physics_mod, only: mn_reset_phys_latlon, mn_surface_grids - - ! Grid reset routines - use fv_moving_nest_mod, only: grid_geometry - use fv_moving_nest_utils_mod, only: fill_grid_from_supergrid, fill_weight_grid - - ! Physics moving logical variables - use fv_moving_nest_physics_mod, only: move_physics, move_nsst - - ! Recalculation routines - use fv_moving_nest_mod, only: reallocate_BC_buffers, recalc_aux_pressures - - use fv_tracker_mod, only: Tracker, allocate_tracker, fv_tracker_init, deallocate_tracker - - implicit none - - !----------------------------------------------------------------------- - ! version number of this module - ! Include variable "version" to be written to log file. - #include - character(len=20) :: mod_name = 'fvGFS/fv_moving_nest_main_mod' - - #ifdef OVERLOAD_R4 - real, parameter:: real_snan=x'FFBFFFFF' - #else - real, parameter:: real_snan=x'FFF7FFFFFFFFFFFF' - #endif - - ! Enable these for more debugging outputs - logical :: debug_log = .false. ! Produces logging to out.* file - logical :: tsvar_out = .false. ! Produces netCDF outputs; be careful to not exceed file number limits set in namelist - - ! --- Clock ids for moving_nest performance metering - integer :: id_movnest1, id_movnest1_9, id_movnest2, id_movnest3, id_movnest4, id_movnest5 - integer :: id_movnest5_1, id_movnest5_2, id_movnest5_3, id_movnest5_4 - integer :: id_movnest6, id_movnest7_0, id_movnest7_1, id_movnest7_2, id_movnest7_3, id_movnest8, id_movnest9 - integer :: id_movnestTot - integer, save :: output_step = 0 - - contains - - !>@brief The subroutine 'update_moving_nest' decides whether the nest should be moved, and if so, performs the move. - !>@details This subroutine evaluates the automatic storm tracker (or prescribed motion configuration), then decides - !! if the nest should be moved. If it should be moved, it calls fv_moving_nest_exec() to perform the nest move. - subroutine update_moving_nest(Atm_block, IPD_control, IPD_data, time_step) - type(block_control_type), intent(in) :: Atm_block !< Physics block layout - type(IPD_control_type), intent(in) :: IPD_control !< Physics metadata - type(IPD_data_type), intent(inout) :: IPD_data(:) !< Physics variable data - type(time_type), intent(in) :: time_step !< Current timestep - - logical :: do_move - integer :: delta_i_c, delta_j_c - integer :: parent_grid_num, child_grid_num, nest_num - integer, allocatable :: global_pelist(:) - integer :: n - integer :: this_pe - - this_pe = mpp_pe() - +#include + + !----------------- + ! FMS modules: + !----------------- + use block_control_mod, only: block_control_type +#ifdef OVERLOAD_R4 + use constantsR4_mod, only: cp_air, rdgas, grav, rvgas, kappa, pstd_mks +#else + use constants_mod, only: cp_air, rdgas, grav, rvgas, kappa, pstd_mks +#endif + use time_manager_mod, only: time_type, get_time, get_date, set_time, operator(+), & + operator(-), operator(/), time_type_to_real + use fms_mod, only: file_exist, open_namelist_file, & + close_file, error_mesg, FATAL, & + check_nml_error, stdlog, & + write_version_number, & + mpp_clock_id, mpp_clock_begin, & + mpp_clock_end, CLOCK_SUBCOMPONENT, & + clock_flag_default + use mpp_mod, only: mpp_error, stdout, FATAL, WARNING, NOTE, & + input_nml_file, mpp_root_pe, & + mpp_npes, mpp_pe, mpp_chksum, & + mpp_get_current_pelist, & + mpp_set_current_pelist, mpp_sync + use mpp_parameter_mod, only: EUPDATE, WUPDATE, SUPDATE, NUPDATE + use mpp_domains_mod, only: domain2d, mpp_update_domains + use xgrid_mod, only: grid_box_type + use field_manager_mod, only: MODEL_ATMOS + use tracer_manager_mod, only: get_tracer_index, get_number_tracers, & + NO_TRACER, get_tracer_names + use DYCORE_typedefs, only: DYCORE_data_type +#ifdef GFS_TYPES + use GFS_typedefs, only: IPD_data_type => GFS_data_type, & + IPD_control_type => GFS_control_type, kind_phys +#else + use IPD_typedefs, only: IPD_data_type, IPD_control_type, kind_phys => IPD_kind_phys +#endif + + use fv_iau_mod, only: IAU_external_data_type +#ifdef MULTI_GASES + use multi_gases_mod, only: virq, virq_max, num_gas, ri, cpi +#endif + + !----------------- + ! FV core modules: + !----------------- + use atmosphere_mod, only: Atm, mygrid, p_split, dt_atmos + use fv_arrays_mod, only: fv_atmos_type, R_GRID, fv_grid_bounds_type, phys_diag_type + use fv_control_mod, only: ngrids + use fv_diagnostics_mod, only: fv_diag_init, fv_diag_reinit, fv_diag, fv_time, prt_maxmin, prt_height + use fv_restart_mod, only: fv_restart, fv_write_restart + use fv_timing_mod, only: timing_on, timing_off + use fv_mp_mod, only: is_master + use fv_regional_mod, only: start_regional_restart, read_new_bc_data, a_step, p_step, current_time_in_seconds + + !----------------------------------------- + ! External routines + !----------------------------------------- + use mpp_domains_mod, only: NORTH, NORTH_EAST, EAST, SOUTH_EAST, CORNER, CENTER + use mpp_domains_mod, only: nest_domain_type + use mpp_mod, only: mpp_sync, mpp_exit + use mpp_domains_mod, only: mpp_get_global_domain + use mpp_mod, only: mpp_send, mpp_sync_self, mpp_broadcast + + use fv_mp_mod, only: global_nest_domain + + use tracer_manager_mod, only: get_tracer_names + use field_manager_mod, only: MODEL_ATMOS + use fv_io_mod, only: fv_io_exit + !!use fv_restart_mod, only: d2c_setup + + !------------------------------------ + ! Moving Nest Routines + !------------------------------------ + + use fv_moving_nest_types_mod, only: allocate_fv_moving_nest_prog_type, allocate_fv_moving_nest_physics_type + use fv_moving_nest_types_mod, only: deallocate_fv_moving_nests + use fv_moving_nest_types_mod, only: Moving_nest + + ! Prognostic variable routines + use fv_moving_nest_mod, only: mn_prog_fill_intern_nest_halos, mn_prog_fill_nest_halos_from_parent, & + mn_prog_dump_to_netcdf, mn_prog_shift_data + ! Physics variable routines + use fv_moving_nest_physics_mod, only: mn_phys_fill_intern_nest_halos, mn_phys_fill_nest_halos_from_parent, & + mn_phys_dump_to_netcdf, mn_phys_shift_data, mn_phys_reset_sfc_props, move_nsst + + ! Metadata routines + use fv_moving_nest_mod, only: mn_meta_move_nest, mn_meta_recalc, mn_meta_reset_gridstruct, mn_shift_index + + ! Temporary variable routines (delz) + use fv_moving_nest_mod, only: mn_prog_fill_temp_variables, mn_prog_apply_temp_variables + use fv_moving_nest_physics_mod, only: mn_phys_fill_temp_variables, mn_phys_apply_temp_variables + + ! Load static datasets + use fv_moving_nest_mod, only: mn_latlon_read_hires_parent, mn_latlon_load_parent + use fv_moving_nest_mod, only: mn_orog_read_hires_parent, mn_static_read_hires + use fv_moving_nest_utils_mod, only: set_smooth_nest_terrain, set_blended_terrain + + use fv_moving_nest_physics_mod, only: mn_reset_phys_latlon, mn_surface_grids + + ! Grid reset routines + use fv_moving_nest_mod, only: grid_geometry + use fv_moving_nest_utils_mod, only: fill_grid_from_supergrid, fill_weight_grid + + ! Physics moving logical variables + use fv_moving_nest_physics_mod, only: move_physics, move_nsst + + ! Recalculation routines + use fv_moving_nest_mod, only: reallocate_BC_buffers, recalc_aux_pressures + + use fv_tracker_mod, only: Tracker, allocate_tracker, fv_tracker_init, deallocate_tracker + + implicit none + + !----------------------------------------------------------------------- + ! version number of this module + ! Include variable "version" to be written to log file. +#include + character(len=20) :: mod_name = 'fvGFS/fv_moving_nest_main_mod' + +#ifdef OVERLOAD_R4 + real, parameter:: real_snan=x'FFBFFFFF' +#else + real, parameter:: real_snan=x'FFF7FFFFFFFFFFFF' +#endif + + ! Enable these for more debugging outputs + logical :: debug_log = .false. ! Produces logging to out.* file + logical :: tsvar_out = .false. ! Produces netCDF outputs; be careful to not exceed file number limits set in namelist + + ! --- Clock ids for moving_nest performance metering + integer :: id_movnest1, id_movnest1_9, id_movnest2, id_movnest3, id_movnest4, id_movnest5 + integer :: id_movnest5_1, id_movnest5_2, id_movnest5_3, id_movnest5_4 + integer :: id_movnest6, id_movnest7_0, id_movnest7_1, id_movnest7_2, id_movnest7_3, id_movnest8, id_movnest9 + integer :: id_movnestTot + integer, save :: output_step = 0 + +contains + + !>@brief The subroutine 'update_moving_nest' decides whether the nest should be moved, and if so, performs the move. + !>@details This subroutine evaluates the automatic storm tracker (or prescribed motion configuration), then decides + !! if the nest should be moved. If it should be moved, it calls fv_moving_nest_exec() to perform the nest move. + subroutine update_moving_nest(Atm_block, IPD_control, IPD_data, time_step) + type(block_control_type), intent(in) :: Atm_block !< Physics block layout + type(IPD_control_type), intent(in) :: IPD_control !< Physics metadata + type(IPD_data_type), intent(inout) :: IPD_data(:) !< Physics variable data + type(time_type), intent(in) :: time_step !< Current timestep + + logical :: do_move + integer :: delta_i_c, delta_j_c + integer :: parent_grid_num, child_grid_num, nest_num + integer, allocatable :: global_pelist(:) + integer :: n + integer :: this_pe + + this_pe = mpp_pe() + + do_move = .false. + + ! dt_atmos was initialized in atmosphere.F90::atmosphere_init() + + n = mygrid ! Public variable from atmosphere.F90 + + ! Hard-coded for now - these will need to be looked up on each PE when multiple and telescoped nests are enabled. + parent_grid_num = 1 + child_grid_num = 2 + nest_num = 1 + + call eval_move_nest(Atm, a_step, parent_grid_num, child_grid_num, do_move, delta_i_c, delta_j_c, dt_atmos) + + allocate(global_pelist(Atm(parent_grid_num)%npes_this_grid+Atm(child_grid_num)%npes_this_grid)) + global_pelist=(/Atm(parent_grid_num)%pelist, Atm(child_grid_num)%pelist/) + + call mpp_set_current_pelist(global_pelist) + call mpp_broadcast( delta_i_c, Atm(child_grid_num)%pelist(1), global_pelist ) + call mpp_broadcast( delta_j_c, Atm(child_grid_num)%pelist(1), global_pelist ) + call mpp_broadcast( do_move, Atm(child_grid_num)%pelist(1), global_pelist ) + call mpp_set_current_pelist(Atm(n)%pelist) + + if (do_move) then + call fv_moving_nest_exec(Atm, Atm_block, IPD_control, IPD_data, delta_i_c, delta_j_c, n, nest_num, parent_grid_num, child_grid_num, dt_atmos) + endif + + end subroutine update_moving_nest + + + + subroutine moving_nest_end() + integer :: n + + call deallocate_fv_moving_nests(ngrids) + + ! From fv_grid_utils.F90 + n = mygrid + + deallocate ( Atm(n)%gridstruct%area_c_64 ) + deallocate ( Atm(n)%gridstruct%dxa_64 ) + deallocate ( Atm(n)%gridstruct%dya_64 ) + deallocate ( Atm(n)%gridstruct%dxc_64 ) + deallocate ( Atm(n)%gridstruct%dyc_64 ) + deallocate ( Atm(n)%gridstruct%cosa_64 ) + deallocate ( Atm(n)%gridstruct%sina_64 ) + + end subroutine moving_nest_end + + + ! This subroutine sits in this file to have access to Atm structure + subroutine nest_tracker_init() + call fv_tracker_init(size(Atm)) + + if (mygrid .eq. 2) call allocate_tracker(mygrid, Atm(mygrid)%bd%isc, Atm(mygrid)%bd%iec, Atm(mygrid)%bd%jsc, Atm(mygrid)%bd%jec) + end subroutine nest_tracker_init + + subroutine nest_tracker_end() + call deallocate_tracker(ngrids) + end subroutine nest_tracker_end + + + + !>@brief The subroutine 'dump_moving_nest' outputs native grid format data to netCDF files + !>@details This subroutine exports model variables using FMS IO to netCDF files if tsvar_out is set to .True. + subroutine dump_moving_nest(Atm_block, IPD_control, IPD_data, time_step) + type(block_control_type), intent(in) :: Atm_block !< Physics block layout + type(IPD_control_type), intent(in) :: IPD_control !< Physics metadata + type(IPD_data_type), intent(in) :: IPD_data(:) !< Physics variable data + type(time_type), intent(in) :: time_step !< Current timestep + + type(domain2d), pointer :: domain_coarse, domain_fine + logical :: is_fine_pe + integer :: parent_grid_num, child_grid_num, nz, this_pe, n + + this_pe = mpp_pe() + n = mygrid + + parent_grid_num = 1 + child_grid_num = 2 + + domain_fine => Atm(child_grid_num)%domain + domain_coarse => Atm(parent_grid_num)%domain + is_fine_pe = Atm(n)%neststruct%nested .and. ANY(Atm(n)%pelist(:) == this_pe) + nz = Atm(n)%npz + + ! Enable this to dump debug netCDF files. Files are automatically closed when dumped. + !if (mod(a_step, 80) .eq. 0 ) then + ! if (tsvar_out) call mn_prog_dump_to_netcdf(Atm(n), a_step, "tsavar", is_fine_pe, domain_coarse, domain_fine, nz) + ! if (tsvar_out) call mn_phys_dump_to_netcdf(Atm(n), Atm_block, IPD_control, IPD_data, a_step, "tsavar", is_fine_pe, domain_coarse, domain_fine, nz) + !endif + + end subroutine dump_moving_nest + + !>@brief The subroutine 'fv_moving_nest_init_clocks' intializes performance profiling timers of sections of the moving nest code. + !>@details Starts timers for subcomponents of moving nest code to determine performance. mpp routines group them into separate + !! sections for parent and nest PEs. + subroutine fv_moving_nest_init_clocks(use_timers) + logical, intent(in) :: use_timers + + ! --- initialize clocks for moving_nest + if (use_timers) then + id_movnest1 = mpp_clock_id ('MN Part 1 Init', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) + id_movnest1_9 = mpp_clock_id ('MN Part 1.9 Copy delz', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) + id_movnest2 = mpp_clock_id ('MN Part 2 Fill Halos from Parent', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) + id_movnest3 = mpp_clock_id ('MN Part 3 Meta Move Nest', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) + id_movnest4 = mpp_clock_id ('MN Part 4 Fill Intern Nest Halos', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) + id_movnest5 = mpp_clock_id ('MN Part 5 Recalc Weights', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) + id_movnest5_1 = mpp_clock_id ('MN Part 5.1 read_parent', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) + id_movnest5_2 = mpp_clock_id ('MN Part 5.2 reset latlon', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) + id_movnest5_3 = mpp_clock_id ('MN Part 5.3 meta recalc', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) + id_movnest5_4 = mpp_clock_id ('MN Part 5.4 shift indx', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) + + id_movnest6 = mpp_clock_id ('MN Part 6 EOSHIFT', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) + + id_movnest7_0 = mpp_clock_id ('MN Part 7.0 Recalc gridstruct', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) + id_movnest7_1 = mpp_clock_id ('MN Part 7.1 Refill halos from Parent', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) + id_movnest7_2 = mpp_clock_id ('MN Part 7.2 Refill Intern Nest Halos', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) + id_movnest7_3 = mpp_clock_id ('MN Part 7.3 Fill delz', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) + + id_movnest8 = mpp_clock_id ('MN Part 8 Dump to netCDF', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) + id_movnest9 = mpp_clock_id ('MN Part 9 Aux Pressure', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) + endif + + id_movnestTot = mpp_clock_id ('Moving Nest Total', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) + end subroutine fv_moving_nest_init_clocks + + !>@brief The subroutine 'eval_move_nest' determines whether the nest should be moved and in which direction. + !>@details This subroutine can execute prescribed motion or automated storm tracking based on namelist options. + subroutine eval_move_nest(Atm, a_step, parent_grid_num, child_grid_num, do_move, delta_i_c, delta_j_c, dt_atmos) + type(fv_atmos_type), intent(inout) :: Atm(:) !< Input atmospheric data + integer, intent(in) :: a_step !< Timestep + integer, intent(in) :: parent_grid_num, child_grid_num !< Grid numbers of parent and child + logical, intent(out) :: do_move !< Logical for whether to move nest + integer, intent(out) :: delta_i_c, delta_j_c !< Each can be -1, 0, or +1 + real, intent(in) :: dt_atmos !< only needed for the simple version of this subroutine + + integer :: n + integer :: cx, cy + real :: xdiff, ydiff + integer :: nest_i_c, nest_j_c + integer :: nis, nie, njs, nje + integer :: this_pe + character*255 :: message + + ! On the tropical channel configuration, tile 6 numbering starts at 0,0 off the coast of Spain + ! delta_i_c = +1 is westward + ! delta_i_c = -1 is eastward + ! + ! delta_j_c = +1 is southward + ! delta_j_c = -1 is northward + + this_pe = mpp_pe() + n = mygrid ! Public variable from atmosphere.F90 + do_move = .false. + delta_i_c = 0 + delta_j_c = 0 + + if ( Moving_nest(n)%mn_flag%vortex_tracker .eq. 0 .or. Atm(n)%grid_number .eq. 1) then + ! No need to move do_move = .false. - - ! dt_atmos was initialized in atmosphere.F90::atmosphere_init() - - n = mygrid ! Public variable from atmosphere.F90 - - ! Hard-coded for now - these will need to be looked up on each PE when multiple and telescoped nests are enabled. - parent_grid_num = 1 - child_grid_num = 2 - nest_num = 1 - - call eval_move_nest(Atm, a_step, parent_grid_num, child_grid_num, do_move, delta_i_c, delta_j_c, dt_atmos) - - allocate(global_pelist(Atm(parent_grid_num)%npes_this_grid+Atm(child_grid_num)%npes_this_grid)) - global_pelist=(/Atm(parent_grid_num)%pelist, Atm(child_grid_num)%pelist/) - - call mpp_set_current_pelist(global_pelist) - call mpp_broadcast( delta_i_c, Atm(child_grid_num)%pelist(1), global_pelist ) - call mpp_broadcast( delta_j_c, Atm(child_grid_num)%pelist(1), global_pelist ) - call mpp_broadcast( do_move, Atm(child_grid_num)%pelist(1), global_pelist ) - call mpp_set_current_pelist(Atm(n)%pelist) - - if (do_move) then - call fv_moving_nest_exec(Atm, Atm_block, IPD_control, IPD_data, delta_i_c, delta_j_c, n, nest_num, parent_grid_num, child_grid_num, dt_atmos) + delta_i_c = 0 + delta_j_c = 0 + else if ( Moving_nest(n)%mn_flag%vortex_tracker .eq. 1 ) then + ! Prescribed move according to ntrack, move_cd_x and move_cd_y + ! Move every ntrack of dt_atmos time step + if ( mod(a_step,Moving_nest(n)%mn_flag%ntrack) .eq. 0) then + do_move = .true. + delta_i_c = Moving_nest(n)%mn_flag%move_cd_x + delta_j_c = Moving_nest(n)%mn_flag%move_cd_y endif - - end subroutine update_moving_nest - - - - subroutine moving_nest_end() - integer :: n - - call deallocate_fv_moving_nests(ngrids) - - ! From fv_grid_utils.F90 - n = mygrid - - deallocate ( Atm(n)%gridstruct%area_c_64 ) - deallocate ( Atm(n)%gridstruct%dxa_64 ) - deallocate ( Atm(n)%gridstruct%dya_64 ) - deallocate ( Atm(n)%gridstruct%dxc_64 ) - deallocate ( Atm(n)%gridstruct%dyc_64 ) - deallocate ( Atm(n)%gridstruct%cosa_64 ) - deallocate ( Atm(n)%gridstruct%sina_64 ) - - end subroutine moving_nest_end - - - ! This subroutine sits in this file to have access to Atm structure - subroutine nest_tracker_init() - call fv_tracker_init(size(Atm)) - - if (mygrid .eq. 2) call allocate_tracker(mygrid, Atm(mygrid)%bd%isc, Atm(mygrid)%bd%iec, Atm(mygrid)%bd%jsc, Atm(mygrid)%bd%jec) - end subroutine nest_tracker_init - - subroutine nest_tracker_end() - call deallocate_tracker(ngrids) - end subroutine nest_tracker_end - - - - !>@brief The subroutine 'dump_moving_nest' outputs native grid format data to netCDF files - !>@details This subroutine exports model variables using FMS IO to netCDF files if tsvar_out is set to .True. - subroutine dump_moving_nest(Atm_block, IPD_control, IPD_data, time_step) - type(block_control_type), intent(in) :: Atm_block !< Physics block layout - type(IPD_control_type), intent(in) :: IPD_control !< Physics metadata - type(IPD_data_type), intent(in) :: IPD_data(:) !< Physics variable data - type(time_type), intent(in) :: time_step !< Current timestep - - type(domain2d), pointer :: domain_coarse, domain_fine - logical :: is_fine_pe - integer :: parent_grid_num, child_grid_num, nz, this_pe, n - - this_pe = mpp_pe() - n = mygrid - - parent_grid_num = 1 - child_grid_num = 2 - - domain_fine => Atm(child_grid_num)%domain - domain_coarse => Atm(parent_grid_num)%domain - is_fine_pe = Atm(n)%neststruct%nested .and. ANY(Atm(n)%pelist(:) == this_pe) - nz = Atm(n)%npz - - ! Enable this to dump debug netCDF files. Files are automatically closed when dumped. - !if (mod(a_step, 80) .eq. 0 ) then - ! if (tsvar_out) call mn_prog_dump_to_netcdf(Atm(n), a_step, "tsavar", is_fine_pe, domain_coarse, domain_fine, nz) - ! if (tsvar_out) call mn_phys_dump_to_netcdf(Atm(n), Atm_block, IPD_control, IPD_data, a_step, "tsavar", is_fine_pe, domain_coarse, domain_fine, nz) - !endif - - end subroutine dump_moving_nest - - !>@brief The subroutine 'fv_moving_nest_init_clocks' intializes performance profiling timers of sections of the moving nest code. - !>@details Starts timers for subcomponents of moving nest code to determine performance. mpp routines group them into separate - !! sections for parent and nest PEs. - subroutine fv_moving_nest_init_clocks(use_timers) - logical, intent(in) :: use_timers - - ! --- initialize clocks for moving_nest - if (use_timers) then - id_movnest1 = mpp_clock_id ('MN Part 1 Init', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) - id_movnest1_9 = mpp_clock_id ('MN Part 1.9 Copy delz', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) - id_movnest2 = mpp_clock_id ('MN Part 2 Fill Halos from Parent', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) - id_movnest3 = mpp_clock_id ('MN Part 3 Meta Move Nest', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) - id_movnest4 = mpp_clock_id ('MN Part 4 Fill Intern Nest Halos', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) - id_movnest5 = mpp_clock_id ('MN Part 5 Recalc Weights', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) - id_movnest5_1 = mpp_clock_id ('MN Part 5.1 read_parent', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) - id_movnest5_2 = mpp_clock_id ('MN Part 5.2 reset latlon', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) - id_movnest5_3 = mpp_clock_id ('MN Part 5.3 meta recalc', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) - id_movnest5_4 = mpp_clock_id ('MN Part 5.4 shift indx', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) - - id_movnest6 = mpp_clock_id ('MN Part 6 EOSHIFT', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) - - id_movnest7_0 = mpp_clock_id ('MN Part 7.0 Recalc gridstruct', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) - id_movnest7_1 = mpp_clock_id ('MN Part 7.1 Refill halos from Parent', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) - id_movnest7_2 = mpp_clock_id ('MN Part 7.2 Refill Intern Nest Halos', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) - id_movnest7_3 = mpp_clock_id ('MN Part 7.3 Fill delz', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) - - id_movnest8 = mpp_clock_id ('MN Part 8 Dump to netCDF', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) - id_movnest9 = mpp_clock_id ('MN Part 9 Aux Pressure', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) + else if ( Moving_nest(n)%mn_flag%vortex_tracker .eq. 2 .or. & + Moving_nest(n)%mn_flag%vortex_tracker .eq. 6 .or. & + Moving_nest(n)%mn_flag%vortex_tracker .eq. 7 ) then + ! Automatic moving following the internal storm tracker + if ( mod(a_step,Moving_nest(n)%mn_flag%ntrack) .eq. 0) then + if(Tracker(n)%tracker_gave_up) then + call mpp_error(NOTE,'Not moving: tracker decided the storm dissapated') + return + endif + if(.not.Tracker(n)%tracker_havefix) then + call mpp_error(NOTE,'Not moving: tracker did not find a storm') + return + endif + ! Calcuate domain center indexes + cx=(Atm(n)%npx-1)/2+1 + cy=(Atm(n)%npy-1)/2+1 + ! Calculate distance in parent grid index space between storm + ! center and domain center + ! Consider using xydiff as integers in the future? + xdiff=(Tracker(n)%tracker_ifix-real(cx))/Atm(n)%neststruct%refinement + ydiff=(Tracker(n)%tracker_jfix-real(cy))/Atm(n)%neststruct%refinement + if(xdiff .ge. 1.0) then + Moving_nest(n)%mn_flag%move_cd_x=1 + else if(xdiff .le. -1.0) then + Moving_nest(n)%mn_flag%move_cd_x=-1 + else + Moving_nest(n)%mn_flag%move_cd_x=0 + endif + if(ydiff .ge. 1.0) then + Moving_nest(n)%mn_flag%move_cd_y=1 + else if(ydiff .le. -1.0) then + Moving_nest(n)%mn_flag%move_cd_y=-1 + else + Moving_nest(n)%mn_flag%move_cd_y=0 + endif + if(abs(Moving_nest(n)%mn_flag%move_cd_x)>0 .or. abs(Moving_nest(n)%mn_flag%move_cd_y)>0) then + call mpp_error(NOTE,'Moving: tracker center shifted from nest center') + do_move = .true. + delta_i_c = Moving_nest(n)%mn_flag%move_cd_x + delta_j_c = Moving_nest(n)%mn_flag%move_cd_y + else + call mpp_error(NOTE,'Not moving: tracker center is near nest center') + do_move = .false. + delta_i_c = 0 + delta_j_c = 0 + endif endif - - id_movnestTot = mpp_clock_id ('Moving Nest Total', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) - end subroutine fv_moving_nest_init_clocks - - !>@brief The subroutine 'eval_move_nest' determines whether the nest should be moved and in which direction. - !>@details This subroutine can execute prescribed motion or automated storm tracking based on namelist options. - subroutine eval_move_nest(Atm, a_step, parent_grid_num, child_grid_num, do_move, delta_i_c, delta_j_c, dt_atmos) - type(fv_atmos_type), intent(inout) :: Atm(:) !< Input atmospheric data - integer, intent(in) :: a_step !< Timestep - integer, intent(in) :: parent_grid_num, child_grid_num !< Grid numbers of parent and child - logical, intent(out) :: do_move !< Logical for whether to move nest - integer, intent(out) :: delta_i_c, delta_j_c !< Each can be -1, 0, or +1 - real, intent(in) :: dt_atmos !< only needed for the simple version of this subroutine - - integer :: n - integer :: cx, cy - real :: xdiff, ydiff - integer :: nest_i_c, nest_j_c - integer :: nis, nie, njs, nje - integer :: this_pe - character*255 :: message - - ! On the tropical channel configuration, tile 6 numbering starts at 0,0 off the coast of Spain - ! delta_i_c = +1 is westward - ! delta_i_c = -1 is eastward - ! - ! delta_j_c = +1 is southward - ! delta_j_c = -1 is northward - - this_pe = mpp_pe() - n = mygrid ! Public variable from atmosphere.F90 + else + write(message,*) 'Wrong vortex_tracker option: ', Moving_nest(n)%mn_flag%vortex_tracker + call mpp_error(FATAL,message) + endif + + ! Override to prevent move on first timestep + if (a_step .eq. 0) then do_move = .false. delta_i_c = 0 delta_j_c = 0 - - if ( Moving_nest(n)%mn_flag%vortex_tracker .eq. 0 .or. Atm(n)%grid_number .eq. 1) then - ! No need to move - do_move = .false. + endif + + ! Check whether or not the nest move is permitted + if (n==child_grid_num) then + ! Figure out the bounds of the cube face + + ! x parent bounds: 1 to Atm(parent_grid_num)%flagstruct%npx + ! y parent bounds: 1 to Atm(parent_grid_num)%flagstruct%npy + + ! Figure out the bounds of the nest + + ! x nest bounds: 1 to Atm(child_grid_num)%flagstruct%npx + ! y nest bounds: 1 to Atm(child_grid_num)%flagstruct%npy + + ! Nest refinement: Atm(child_grid_num)%neststruct%refinement + ! Nest starting cell in x direction: Atm(child_grid_num)%neststruct%ioffset + ! Nest starting cell in y direction: Atm(child_grid_num)%neststruct%joffset + + nest_i_c = ( Atm(child_grid_num)%flagstruct%npx - 1 ) / Atm(child_grid_num)%neststruct%refinement + nest_j_c = ( Atm(child_grid_num)%flagstruct%npy - 1 ) / Atm(child_grid_num)%neststruct%refinement + + nis = Atm(child_grid_num)%neststruct%ioffset + delta_i_c + nie = Atm(child_grid_num)%neststruct%ioffset + nest_i_c + delta_i_c + + njs = Atm(child_grid_num)%neststruct%joffset + delta_j_c + nje = Atm(child_grid_num)%neststruct%joffset + nest_j_c + delta_j_c + + ! Will the nest motion push the nest over one of the edges? + ! Handle each direction individually, so that nest could slide along edge + + ! Causes a crash if we use .le. 1 + if (nis .le. Moving_nest(child_grid_num)%mn_flag%corral_x) then delta_i_c = 0 + ! block_moves = .true. + write(message,*) 'eval_move_nest motion in x direction blocked. small nis: ', nis + call mpp_error(WARNING,message) + endif + if (njs .le. Moving_nest(child_grid_num)%mn_flag%corral_y) then delta_j_c = 0 - else if ( Moving_nest(n)%mn_flag%vortex_tracker .eq. 1 ) then - ! Prescribed move according to ntrack, move_cd_x and move_cd_y - ! Move every ntrack of dt_atmos time step - if ( mod(a_step,Moving_nest(n)%mn_flag%ntrack) .eq. 0) then - do_move = .true. - delta_i_c = Moving_nest(n)%mn_flag%move_cd_x - delta_j_c = Moving_nest(n)%mn_flag%move_cd_y - endif - else if ( Moving_nest(n)%mn_flag%vortex_tracker .eq. 2 .or. & - Moving_nest(n)%mn_flag%vortex_tracker .eq. 6 .or. & - Moving_nest(n)%mn_flag%vortex_tracker .eq. 7 ) then - ! Automatic moving following the internal storm tracker - if ( mod(a_step,Moving_nest(n)%mn_flag%ntrack) .eq. 0) then - if(Tracker(n)%tracker_gave_up) then - call mpp_error(NOTE,'Not moving: tracker decided the storm dissapated') - return - endif - if(.not.Tracker(n)%tracker_havefix) then - call mpp_error(NOTE,'Not moving: tracker did not find a storm') - return - endif - ! Calcuate domain center indexes - cx=(Atm(n)%npx-1)/2+1 - cy=(Atm(n)%npy-1)/2+1 - ! Calculate distance in parent grid index space between storm - ! center and domain center - ! Consider using xydiff as integers in the future? - xdiff=(Tracker(n)%tracker_ifix-real(cx))/Atm(n)%neststruct%refinement - ydiff=(Tracker(n)%tracker_jfix-real(cy))/Atm(n)%neststruct%refinement - if(xdiff .ge. 1.0) then - Moving_nest(n)%mn_flag%move_cd_x=1 - else if(xdiff .le. -1.0) then - Moving_nest(n)%mn_flag%move_cd_x=-1 - else - Moving_nest(n)%mn_flag%move_cd_x=0 - endif - if(ydiff .ge. 1.0) then - Moving_nest(n)%mn_flag%move_cd_y=1 - else if(ydiff .le. -1.0) then - Moving_nest(n)%mn_flag%move_cd_y=-1 - else - Moving_nest(n)%mn_flag%move_cd_y=0 - endif - if(abs(Moving_nest(n)%mn_flag%move_cd_x)>0 .or. abs(Moving_nest(n)%mn_flag%move_cd_y)>0) then - call mpp_error(NOTE,'Moving: tracker center shifted from nest center') - do_move = .true. - delta_i_c = Moving_nest(n)%mn_flag%move_cd_x - delta_j_c = Moving_nest(n)%mn_flag%move_cd_y - else - call mpp_error(NOTE,'Not moving: tracker center is near nest center') - do_move = .false. - delta_i_c = 0 - delta_j_c = 0 - endif - endif - else - write(message,*) 'Wrong vortex_tracker option: ', Moving_nest(n)%mn_flag%vortex_tracker - call mpp_error(FATAL,message) + ! block_moves = .true. + write(message,*) 'eval_move_nest motion in y direction blocked. small njs: ', njs + call mpp_error(WARNING,message) endif - - ! Override to prevent move on first timestep - if (a_step .eq. 0) then - do_move = .false. + + if (nie .ge. Atm(parent_grid_num)%flagstruct%npx - Moving_nest(child_grid_num)%mn_flag%corral_x) then delta_i_c = 0 + ! block_moves = .true. + write(message,*) 'eval_move_nest motion in x direction blocked. large nie: ', nie + call mpp_error(WARNING,message) + endif + if (nje .ge. Atm(parent_grid_num)%flagstruct%npy - Moving_nest(child_grid_num)%mn_flag%corral_y) then delta_j_c = 0 + ! block_moves = .true. + write(message,*) 'eval_move_nest motion in y direction blocked. large nje: ', nje + call mpp_error(WARNING,message) endif - - ! Check whether or not the nest move is permitted - if (n==child_grid_num) then - ! Figure out the bounds of the cube face - - ! x parent bounds: 1 to Atm(parent_grid_num)%flagstruct%npx - ! y parent bounds: 1 to Atm(parent_grid_num)%flagstruct%npy - - ! Figure out the bounds of the nest - - ! x nest bounds: 1 to Atm(child_grid_num)%flagstruct%npx - ! y nest bounds: 1 to Atm(child_grid_num)%flagstruct%npy - - ! Nest refinement: Atm(child_grid_num)%neststruct%refinement - ! Nest starting cell in x direction: Atm(child_grid_num)%neststruct%ioffset - ! Nest starting cell in y direction: Atm(child_grid_num)%neststruct%joffset - - nest_i_c = ( Atm(child_grid_num)%flagstruct%npx - 1 ) / Atm(child_grid_num)%neststruct%refinement - nest_j_c = ( Atm(child_grid_num)%flagstruct%npy - 1 ) / Atm(child_grid_num)%neststruct%refinement - - nis = Atm(child_grid_num)%neststruct%ioffset + delta_i_c - nie = Atm(child_grid_num)%neststruct%ioffset + nest_i_c + delta_i_c - - njs = Atm(child_grid_num)%neststruct%joffset + delta_j_c - nje = Atm(child_grid_num)%neststruct%joffset + nest_j_c + delta_j_c - - ! Will the nest motion push the nest over one of the edges? - ! Handle each direction individually, so that nest could slide along edge - - ! Causes a crash if we use .le. 1 - if (nis .le. Moving_nest(child_grid_num)%mn_flag%corral_x) then - delta_i_c = 0 - ! block_moves = .true. - write(message,*) 'eval_move_nest motion in x direction blocked. small nis: ', nis - call mpp_error(WARNING,message) - endif - if (njs .le. Moving_nest(child_grid_num)%mn_flag%corral_y) then - delta_j_c = 0 - ! block_moves = .true. - write(message,*) 'eval_move_nest motion in y direction blocked. small njs: ', njs - call mpp_error(WARNING,message) - endif - - if (nie .ge. Atm(parent_grid_num)%flagstruct%npx - Moving_nest(child_grid_num)%mn_flag%corral_x) then - delta_i_c = 0 - ! block_moves = .true. - write(message,*) 'eval_move_nest motion in x direction blocked. large nie: ', nie - call mpp_error(WARNING,message) - endif - if (nje .ge. Atm(parent_grid_num)%flagstruct%npy - Moving_nest(child_grid_num)%mn_flag%corral_y) then - delta_j_c = 0 - ! block_moves = .true. - write(message,*) 'eval_move_nest motion in y direction blocked. large nje: ', nje - call mpp_error(WARNING,message) - endif - - if (delta_i_c .eq. 0 .and. delta_j_c .eq. 0) then - do_move = .false. - endif - + + if (delta_i_c .eq. 0 .and. delta_j_c .eq. 0) then + do_move = .false. endif - - write(message, *) 'eval_move_nest: move_cd_x=', delta_i_c, 'move_cd_y=', delta_j_c, 'do_move=', do_move - call mpp_error(NOTE,message) - - end subroutine eval_move_nest - - !>@brief The subroutine 'fv_moving_nest_exec' performs the nest move - most work occurs on nest PEs but some on parent PEs. - !>@details This subroutine shifts the prognostic and physics/surface variables. - !! It also updates metadata and interpolation weights. - subroutine fv_moving_nest_exec(Atm, Atm_block, IPD_control, IPD_data, delta_i_c, delta_j_c, n, nest_num, parent_grid_num, child_grid_num, dt_atmos) - implicit none - type(fv_atmos_type), allocatable, target, intent(inout) :: Atm(:) !< Atmospheric variables - type(block_control_type), intent(in) :: Atm_block !< Physics block - type(IPD_control_type), intent(in) :: IPD_control !< Physics metadata - type(IPD_data_type), intent(inout) :: IPD_data(:) !< Physics variable data - integer, intent(in) :: delta_i_c, delta_j_c !< Nest motion increments - integer, intent(in) :: n, nest_num !< Nest indices - integer, intent(in) :: parent_grid_num, child_grid_num !< Grid numbers - real, intent(in) :: dt_atmos !< Timestep in seconds - - !---- Moving Nest local variables ----- - integer :: this_pe - integer, pointer :: ioffset, joffset - real, pointer, dimension(:,:,:) :: grid, agrid - type(domain2d), pointer :: domain_coarse, domain_fine - real(kind=R_GRID), pointer, dimension(:,:,:,:) :: grid_global - - ! Constants for mpp calls - integer :: position = CENTER - integer :: position_u = NORTH - integer :: position_v = EAST - logical :: do_move = .True. - integer :: x_refine, y_refine ! Currently equal, but allows for future flexibility - logical :: is_fine_pe - - ! TODO read halo size from the namelist instead to allow nest refinement > 3 - integer :: ehalo = 3 - integer :: whalo = 3 - integer :: nhalo = 3 - integer :: shalo = 3 - integer :: extra_halo = 0 ! Extra halo for moving nest routines - - integer :: istart_fine, iend_fine, jstart_fine, jend_fine - integer :: istart_coarse, iend_coarse, jstart_coarse, jend_coarse - integer :: nx, ny, nz, nx_cubic, ny_cubic - integer :: p_istart_fine, p_iend_fine, p_jstart_fine, p_jend_fine - - ! Parent tile data, saved between timesteps - logical, save :: first_nest_move = .true. - type(grid_geometry), save :: parent_geo - type(grid_geometry), save :: fp_super_tile_geo - type(mn_surface_grids), save :: mn_static - real(kind=R_GRID), allocatable, save :: p_grid(:,:,:) - real(kind=R_GRID), allocatable, save :: p_grid_u(:,:,:) - real(kind=R_GRID), allocatable, save :: p_grid_v(:,:,:) - - type(grid_geometry) :: tile_geo, tile_geo_u, tile_geo_v - real(kind=R_GRID), allocatable :: n_grid(:,:,:) - real(kind=R_GRID), allocatable :: n_grid_u(:,:,:) - real(kind=R_GRID), allocatable :: n_grid_v(:,:,:) - real, allocatable :: wt_h(:,:,:) ! TODO verify that these are deallocated - real, allocatable :: wt_u(:,:,:) - real, allocatable :: wt_v(:,:,:) - !real :: ua(isd:ied,jsd:jed) - !real :: va(isd:ied,jsd:jed) - - logical :: filtered_terrain = .True. ! TODO set this from namelist - integer :: i, j, x, y, z, p, nn, n_moist - integer :: parent_tile - logical :: found_nest_domain = .false. - - ! Variables to enable debugging use of mpp_sync - logical :: debug_sync = .false. - integer, allocatable :: full_pelist(:) - integer :: pp, p1, p2 - - ! Variables for parent side of setup_aligned_nest() - integer :: isg, ieg, jsg, jeg, gid - integer :: isc_p, iec_p, jsc_p, jec_p - integer :: upoff, jind - integer :: ng, refinement - integer :: npx, npy, npz, ncnst, pnats - integer :: isc, iec, jsc, jec - integer :: isd, ied, jsd, jed - integer :: nq ! number of transported tracers - integer :: is, ie, js, je, k ! For recalculation of omga - integer, save :: output_step = 0 - integer, allocatable :: pelist(:) - character(len=16) :: errstring - logical :: is_moving_nest !! TODO Refine this per Atm(n) structure to allow some static and some moving nests in same run - integer :: year, month, day, hour, minute, second - real(kind=R_GRID) :: pi = 4 * atan(1.0d0) - real :: rad2deg - logical :: use_timers - - rad2deg = 180.0 / pi - - gid = mpp_pe() - this_pe = mpp_pe() - - use_timers = Atm(n)%flagstruct%fv_timers - - allocate(pelist(mpp_npes())) - call mpp_get_current_pelist(pelist) - - ! Get month to use for reading static datasets - call get_date(Atm(n)%Time_init, year, month, day, hour, minute, second) - - ! mygrid and n are the same in atmosphere.F90 - npx = Atm(n)%npx - npy = Atm(n)%npy - npz = Atm(n)%npz - ncnst = Atm(n)%ncnst - pnats = Atm(n)%flagstruct%pnats - - isc = Atm(n)%bd%isc - iec = Atm(n)%bd%iec - jsc = Atm(n)%bd%jsc - jec = Atm(n)%bd%jec - - isd = isc - Atm(n)%bd%ng - ied = iec + Atm(n)%bd%ng - jsd = jsc - Atm(n)%bd%ng - jed = jec + Atm(n)%bd%ng - - is = Atm(n)%bd%is - ie = Atm(n)%bd%ie - js = Atm(n)%bd%js - je = Atm(n)%bd%je - - nq = ncnst-pnats - - is_fine_pe = Atm(n)%neststruct%nested .and. ANY(Atm(n)%pelist(:) == this_pe) - - - if (first_nest_move) then - - call fv_moving_nest_init_clocks(Atm(n)%flagstruct%fv_timers) - - ! If NSST is turned off, do not move the NSST variables. - ! Namelist switches are confusing; this should be the correct way to distinguish, not using nst_anl - if (IPD_Control%nstf_name(1) == 0) then - move_nsst=.false. - else - move_nsst=.true. - endif - - ! This will only allocate the mn_prog and mn_phys for the active Atm(n), not all of them - ! The others can safely remain unallocated. - - call allocate_fv_moving_nest_prog_type(isd, ied, jsd, jed, npz, Moving_nest(n)%mn_prog) - call allocate_fv_moving_nest_physics_type(isd, ied, jsd, jed, npz, move_physics, move_nsst, & - IPD_Control%lsoil, IPD_Control%nmtvr, IPD_Control%levs, IPD_Control%ntot2d, IPD_Control%ntot3d, & - Moving_nest(n)%mn_phys) - + + endif + + write(message, *) 'eval_move_nest: move_cd_x=', delta_i_c, 'move_cd_y=', delta_j_c, 'do_move=', do_move + call mpp_error(NOTE,message) + + end subroutine eval_move_nest + + !>@brief The subroutine 'fv_moving_nest_exec' performs the nest move - most work occurs on nest PEs but some on parent PEs. + !>@details This subroutine shifts the prognostic and physics/surface variables. + !! It also updates metadata and interpolation weights. + subroutine fv_moving_nest_exec(Atm, Atm_block, IPD_control, IPD_data, delta_i_c, delta_j_c, n, nest_num, parent_grid_num, child_grid_num, dt_atmos) + implicit none + type(fv_atmos_type), allocatable, target, intent(inout) :: Atm(:) !< Atmospheric variables + type(block_control_type), intent(in) :: Atm_block !< Physics block + type(IPD_control_type), intent(in) :: IPD_control !< Physics metadata + type(IPD_data_type), intent(inout) :: IPD_data(:) !< Physics variable data + integer, intent(in) :: delta_i_c, delta_j_c !< Nest motion increments + integer, intent(in) :: n, nest_num !< Nest indices + integer, intent(in) :: parent_grid_num, child_grid_num !< Grid numbers + real, intent(in) :: dt_atmos !< Timestep in seconds + + !---- Moving Nest local variables ----- + integer :: this_pe + integer, pointer :: ioffset, joffset + real, pointer, dimension(:,:,:) :: grid, agrid + type(domain2d), pointer :: domain_coarse, domain_fine + real(kind=R_GRID), pointer, dimension(:,:,:,:) :: grid_global + + ! Constants for mpp calls + integer :: position = CENTER + integer :: position_u = NORTH + integer :: position_v = EAST + logical :: do_move = .True. + integer :: x_refine, y_refine ! Currently equal, but allows for future flexibility + logical :: is_fine_pe + + ! TODO read halo size from the namelist instead to allow nest refinement > 3 + integer :: ehalo = 3 + integer :: whalo = 3 + integer :: nhalo = 3 + integer :: shalo = 3 + integer :: extra_halo = 0 ! Extra halo for moving nest routines + + integer :: istart_fine, iend_fine, jstart_fine, jend_fine + integer :: istart_coarse, iend_coarse, jstart_coarse, jend_coarse + integer :: nx, ny, nz, nx_cubic, ny_cubic + integer :: p_istart_fine, p_iend_fine, p_jstart_fine, p_jend_fine + + ! Parent tile data, saved between timesteps + logical, save :: first_nest_move = .true. + type(grid_geometry), save :: parent_geo + type(grid_geometry), save :: fp_super_tile_geo + type(mn_surface_grids), save :: mn_static + real(kind=R_GRID), allocatable, save :: p_grid(:,:,:) + real(kind=R_GRID), allocatable, save :: p_grid_u(:,:,:) + real(kind=R_GRID), allocatable, save :: p_grid_v(:,:,:) + + type(grid_geometry) :: tile_geo, tile_geo_u, tile_geo_v + real(kind=R_GRID), allocatable :: n_grid(:,:,:) + real(kind=R_GRID), allocatable :: n_grid_u(:,:,:) + real(kind=R_GRID), allocatable :: n_grid_v(:,:,:) + real, allocatable :: wt_h(:,:,:) ! TODO verify that these are deallocated + real, allocatable :: wt_u(:,:,:) + real, allocatable :: wt_v(:,:,:) + !real :: ua(isd:ied,jsd:jed) + !real :: va(isd:ied,jsd:jed) + + logical :: filtered_terrain = .True. ! TODO set this from namelist + integer :: i, j, x, y, z, p, nn, n_moist + integer :: parent_tile + logical :: found_nest_domain = .false. + + ! Variables to enable debugging use of mpp_sync + logical :: debug_sync = .false. + integer, allocatable :: full_pelist(:) + integer :: pp, p1, p2 + + ! Variables for parent side of setup_aligned_nest() + integer :: isg, ieg, jsg, jeg, gid + integer :: isc_p, iec_p, jsc_p, jec_p + integer :: upoff, jind + integer :: ng, refinement + integer :: npx, npy, npz, ncnst, pnats + integer :: isc, iec, jsc, jec + integer :: isd, ied, jsd, jed + integer :: nq ! number of transported tracers + integer :: is, ie, js, je, k ! For recalculation of omga + integer, save :: output_step = 0 + integer, allocatable :: pelist(:) + character(len=16) :: errstring + logical :: is_moving_nest !! TODO Refine this per Atm(n) structure to allow some static and some moving nests in same run + integer :: year, month, day, hour, minute, second + real(kind=R_GRID) :: pi = 4 * atan(1.0d0) + real :: rad2deg + logical :: use_timers + + rad2deg = 180.0 / pi + + gid = mpp_pe() + this_pe = mpp_pe() + + use_timers = Atm(n)%flagstruct%fv_timers + + allocate(pelist(mpp_npes())) + call mpp_get_current_pelist(pelist) + + ! Get month to use for reading static datasets + call get_date(Atm(n)%Time_init, year, month, day, hour, minute, second) + + ! mygrid and n are the same in atmosphere.F90 + npx = Atm(n)%npx + npy = Atm(n)%npy + npz = Atm(n)%npz + ncnst = Atm(n)%ncnst + pnats = Atm(n)%flagstruct%pnats + + isc = Atm(n)%bd%isc + iec = Atm(n)%bd%iec + jsc = Atm(n)%bd%jsc + jec = Atm(n)%bd%jec + + isd = isc - Atm(n)%bd%ng + ied = iec + Atm(n)%bd%ng + jsd = jsc - Atm(n)%bd%ng + jed = jec + Atm(n)%bd%ng + + is = Atm(n)%bd%is + ie = Atm(n)%bd%ie + js = Atm(n)%bd%js + je = Atm(n)%bd%je + + nq = ncnst-pnats + + is_fine_pe = Atm(n)%neststruct%nested .and. ANY(Atm(n)%pelist(:) == this_pe) + + + if (first_nest_move) then + + call fv_moving_nest_init_clocks(Atm(n)%flagstruct%fv_timers) + + ! If NSST is turned off, do not move the NSST variables. + ! Namelist switches are confusing; this should be the correct way to distinguish, not using nst_anl + if (IPD_Control%nstf_name(1) == 0) then + move_nsst=.false. + else + move_nsst=.true. endif - - !================================================================================================== - ! - ! Begin moving nest code - ! W. Ramstrom - AOML/HRD/CIMAS 01/15/2021 - ! - !================================================================================================== - + + ! This will only allocate the mn_prog and mn_phys for the active Atm(n), not all of them + ! The others can safely remain unallocated. + + call allocate_fv_moving_nest_prog_type(isd, ied, jsd, jed, npz, Moving_nest(n)%mn_prog) + call allocate_fv_moving_nest_physics_type(isd, ied, jsd, jed, npz, move_physics, move_nsst, & + IPD_Control%lsoil, IPD_Control%nmtvr, IPD_Control%levs, IPD_Control%ntot2d, IPD_Control%ntot3d, & + Moving_nest(n)%mn_phys) + + endif + + !================================================================================================== + ! + ! Begin moving nest code + ! W. Ramstrom - AOML/HRD/CIMAS 01/15/2021 + ! + !================================================================================================== + + !!================================================================ + !! Step 1 -- Initialization + !!================================================================ + + domain_fine => Atm(child_grid_num)%domain + parent_tile = Atm(child_grid_num)%neststruct%parent_tile + domain_coarse => Atm(parent_grid_num)%domain + is_moving_nest = Moving_nest(child_grid_num)%mn_flag%is_moving_nest + nz = Atm(n)%npz + + if (is_moving_nest .and. do_move) then + call mpp_clock_begin (id_movnestTot) + if (use_timers) call mpp_clock_begin (id_movnest1) + !!================================================================ - !! Step 1 -- Initialization + !! Step 1.1 -- Show the nest grids - (now removed) !!================================================================ - - domain_fine => Atm(child_grid_num)%domain - parent_tile = Atm(child_grid_num)%neststruct%parent_tile - domain_coarse => Atm(parent_grid_num)%domain - is_moving_nest = Moving_nest(child_grid_num)%mn_flag%is_moving_nest - nz = Atm(n)%npz - - if (is_moving_nest .and. do_move) then - call mpp_clock_begin (id_movnestTot) - if (use_timers) call mpp_clock_begin (id_movnest1) - - !!================================================================ - !! Step 1.1 -- Show the nest grids - (now removed) - !!================================================================ - - - !!================================================================ - !! Step 1.2 -- Configure local variables - !!================================================================ - - x_refine = Atm(child_grid_num)%neststruct%refinement - y_refine = x_refine - ioffset => Atm(child_grid_num)%neststruct%ioffset - joffset => Atm(child_grid_num)%neststruct%joffset - - istart_fine = global_nest_domain%istart_fine(nest_num) - iend_fine = global_nest_domain%iend_fine(nest_num) - jstart_fine = global_nest_domain%jstart_fine(nest_num) - jend_fine = global_nest_domain%jend_fine(nest_num) - - istart_coarse = global_nest_domain%istart_coarse(nest_num) - iend_coarse = global_nest_domain%iend_coarse(nest_num) - jstart_coarse = global_nest_domain%jstart_coarse(nest_num) - jend_coarse = global_nest_domain%jend_coarse(nest_num) - - ! Allocate the local weight arrays. TODO OPTIMIZE change to use the ones from the gridstruct - if (is_fine_pe) then - allocate(wt_h(Atm(child_grid_num)%bd%isd:Atm(child_grid_num)%bd%ied, Atm(child_grid_num)%bd%jsd:Atm(child_grid_num)%bd%jed, 4)) - wt_h = real_snan - - allocate(wt_u(Atm(child_grid_num)%bd%isd:Atm(child_grid_num)%bd%ied, Atm(child_grid_num)%bd%jsd:Atm(child_grid_num)%bd%jed+1, 4)) - wt_u = real_snan - - allocate(wt_v(Atm(child_grid_num)%bd%isd:Atm(child_grid_num)%bd%ied+1, Atm(child_grid_num)%bd%jsd:Atm(child_grid_num)%bd%jed, 4)) - wt_v = real_snan - - ! Fill in the local weights with the ones from Atm just to be safe - call fill_weight_grid(wt_h, Atm(n)%neststruct%wt_h) - call fill_weight_grid(wt_u, Atm(n)%neststruct%wt_u) - call fill_weight_grid(wt_v, Atm(n)%neststruct%wt_v) - - else - allocate(wt_h(1,1,4)) - wt_h = 0.0 - - allocate(wt_u(1,1,4)) - wt_u = 0.0 - - allocate(wt_v(1,1,4)) - wt_v = 0.0 - endif - - ! This full list of PEs is used for the mpp_sync for debugging. Can later be removed. - p1 = size(Atm(1)%pelist) ! Parent PEs - p2 = size(Atm(2)%pelist) ! Nest PEs - - allocate(full_pelist(p1 + p2)) - do pp=1,p1 - full_pelist(pp) = Atm(1)%pelist(pp) - enddo - do pp=1,p2 - full_pelist(p1+pp) = Atm(2)%pelist(pp) - enddo - - !!============================================================================ - !! Step 1.3 -- Dump the prognostic variables before we do the nest motion. - !!============================================================================ - - output_step = output_step + 1 - - !!============================================================================ - !! Step 1.4 -- Read in the full panel grid definition - !!============================================================================ - - if (is_fine_pe) then - - nx_cubic = Atm(1)%npx - 1 - ny_cubic = Atm(1)%npy - 1 - - nx = Atm(n)%npx - 1 - ny = Atm(n)%npy - 1 - - grid => Atm(n)%gridstruct%grid - agrid => Atm(n)%gridstruct%agrid - - ! Read in static lat/lon data for parent at nest resolution; returns fp_ full panel variables - ! Also read in other static variables from the orography and surface files - - if (first_nest_move) then - - ! TODO set pelist for the correct nest instead of hard-coded Atm(2)%pelist to allow multiple moving nests - - call mn_latlon_read_hires_parent(Atm(1)%npx, Atm(1)%npy, x_refine, Atm(2)%pelist, fp_super_tile_geo, & - Moving_nest(child_grid_num)%mn_flag%surface_dir, parent_tile) - - call mn_orog_read_hires_parent(Atm(1)%npx, Atm(1)%npy, x_refine, Atm(2)%pelist, & - Moving_nest(child_grid_num)%mn_flag%surface_dir, filtered_terrain, & - mn_static%orog_grid, mn_static%orog_std_grid, mn_static%ls_mask_grid, mn_static%land_frac_grid, parent_tile) - - ! If terrain_smoother method 1 is chosen, we need the parent coarse terrain - if (Moving_nest(n)%mn_flag%terrain_smoother .eq. 1) then - if (filtered_terrain) then - call mn_static_read_hires(Atm(1)%npx, Atm(1)%npy, 1, Atm(2)%pelist, Moving_nest(child_grid_num)%mn_flag%surface_dir, "oro_data", "orog_filt", mn_static%parent_orog_grid, parent_tile) + + + !!================================================================ + !! Step 1.2 -- Configure local variables + !!================================================================ + + x_refine = Atm(child_grid_num)%neststruct%refinement + y_refine = x_refine + ioffset => Atm(child_grid_num)%neststruct%ioffset + joffset => Atm(child_grid_num)%neststruct%joffset + + istart_fine = global_nest_domain%istart_fine(nest_num) + iend_fine = global_nest_domain%iend_fine(nest_num) + jstart_fine = global_nest_domain%jstart_fine(nest_num) + jend_fine = global_nest_domain%jend_fine(nest_num) + + istart_coarse = global_nest_domain%istart_coarse(nest_num) + iend_coarse = global_nest_domain%iend_coarse(nest_num) + jstart_coarse = global_nest_domain%jstart_coarse(nest_num) + jend_coarse = global_nest_domain%jend_coarse(nest_num) + + ! Allocate the local weight arrays. TODO OPTIMIZE change to use the ones from the gridstruct + if (is_fine_pe) then + allocate(wt_h(Atm(child_grid_num)%bd%isd:Atm(child_grid_num)%bd%ied, Atm(child_grid_num)%bd%jsd:Atm(child_grid_num)%bd%jed, 4)) + wt_h = real_snan + + allocate(wt_u(Atm(child_grid_num)%bd%isd:Atm(child_grid_num)%bd%ied, Atm(child_grid_num)%bd%jsd:Atm(child_grid_num)%bd%jed+1, 4)) + wt_u = real_snan + + allocate(wt_v(Atm(child_grid_num)%bd%isd:Atm(child_grid_num)%bd%ied+1, Atm(child_grid_num)%bd%jsd:Atm(child_grid_num)%bd%jed, 4)) + wt_v = real_snan + + ! Fill in the local weights with the ones from Atm just to be safe + call fill_weight_grid(wt_h, Atm(n)%neststruct%wt_h) + call fill_weight_grid(wt_u, Atm(n)%neststruct%wt_u) + call fill_weight_grid(wt_v, Atm(n)%neststruct%wt_v) + + else + allocate(wt_h(1,1,4)) + wt_h = 0.0 + + allocate(wt_u(1,1,4)) + wt_u = 0.0 + + allocate(wt_v(1,1,4)) + wt_v = 0.0 + endif + + ! This full list of PEs is used for the mpp_sync for debugging. Can later be removed. + p1 = size(Atm(1)%pelist) ! Parent PEs + p2 = size(Atm(2)%pelist) ! Nest PEs + + allocate(full_pelist(p1 + p2)) + do pp=1,p1 + full_pelist(pp) = Atm(1)%pelist(pp) + enddo + do pp=1,p2 + full_pelist(p1+pp) = Atm(2)%pelist(pp) + enddo + + !!============================================================================ + !! Step 1.3 -- Dump the prognostic variables before we do the nest motion. + !!============================================================================ + + output_step = output_step + 1 + + !!============================================================================ + !! Step 1.4 -- Read in the full panel grid definition + !!============================================================================ + + if (is_fine_pe) then + + nx_cubic = Atm(1)%npx - 1 + ny_cubic = Atm(1)%npy - 1 + + nx = Atm(n)%npx - 1 + ny = Atm(n)%npy - 1 + + grid => Atm(n)%gridstruct%grid + agrid => Atm(n)%gridstruct%agrid + + ! Read in static lat/lon data for parent at nest resolution; returns fp_ full panel variables + ! Also read in other static variables from the orography and surface files + + if (first_nest_move) then + + ! TODO set pelist for the correct nest instead of hard-coded Atm(2)%pelist to allow multiple moving nests + + call mn_latlon_read_hires_parent(Atm(1)%npx, Atm(1)%npy, x_refine, Atm(2)%pelist, fp_super_tile_geo, & + Moving_nest(child_grid_num)%mn_flag%surface_dir, parent_tile) + + call mn_orog_read_hires_parent(Atm(1)%npx, Atm(1)%npy, x_refine, Atm(2)%pelist, & + Moving_nest(child_grid_num)%mn_flag%surface_dir, filtered_terrain, & + mn_static%orog_grid, mn_static%orog_std_grid, mn_static%ls_mask_grid, mn_static%land_frac_grid, parent_tile) + + ! If terrain_smoother method 1 is chosen, we need the parent coarse terrain + if (Moving_nest(n)%mn_flag%terrain_smoother .eq. 1) then + if (filtered_terrain) then + call mn_static_read_hires(Atm(1)%npx, Atm(1)%npy, 1, Atm(2)%pelist, Moving_nest(child_grid_num)%mn_flag%surface_dir, "oro_data", "orog_filt", mn_static%parent_orog_grid, parent_tile) + else + call mn_static_read_hires(Atm(1)%npx, Atm(1)%npy, 1, Atm(2)%pelist, Moving_nest(child_grid_num)%mn_flag%surface_dir, "oro_data", "orog_raw", mn_static%parent_orog_grid, parent_tile) + endif + endif + + call mn_static_read_hires(Atm(1)%npx, Atm(1)%npy, x_refine, Atm(2)%pelist, trim(Moving_nest(child_grid_num)%mn_flag%surface_dir), "substrate_temperature", "substrate_temperature", mn_static%deep_soil_temp_grid, parent_tile) + ! set any -999s to +4C + call mn_replace_low_values(mn_static%deep_soil_temp_grid, -100.0, 277.0) + + call mn_static_read_hires(Atm(1)%npx, Atm(1)%npy, x_refine, Atm(2)%pelist, trim(Moving_nest(child_grid_num)%mn_flag%surface_dir), "soil_type", "soil_type", mn_static%soil_type_grid, parent_tile) + ! To match initialization behavior, set any -999s to 0 in soil_type + call mn_replace_low_values(mn_static%soil_type_grid, -100.0, 0.0) + + + !! TODO investigate reading high-resolution veg_frac and veg_greenness + !call mn_static_read_hires(Atm(1)%npx, Atm(1)%npy, x_refine, trim(Moving_nest(child_grid_num)%mn_flag%surface_dir), "", mn_static%veg_frac_grid) + + call mn_static_read_hires(Atm(1)%npx, Atm(1)%npy, x_refine, Atm(2)%pelist, trim(Moving_nest(child_grid_num)%mn_flag%surface_dir), "vegetation_type", "vegetation_type", mn_static%veg_type_grid, parent_tile) + ! To match initialization behavior, set any -999s to 0 in veg_type + call mn_replace_low_values(mn_static%veg_type_grid, -100.0, 0.0) + + + call mn_static_read_hires(Atm(1)%npx, Atm(1)%npy, x_refine, Atm(2)%pelist, trim(Moving_nest(child_grid_num)%mn_flag%surface_dir), "slope_type", "slope_type", mn_static%slope_type_grid, parent_tile) + ! To match initialization behavior, set any -999s to 0 in slope_type + call mn_replace_low_values(mn_static%slope_type_grid, -100.0, 0.0) + + + call mn_static_read_hires(Atm(1)%npx, Atm(1)%npy, x_refine, Atm(2)%pelist, trim(Moving_nest(child_grid_num)%mn_flag%surface_dir), "maximum_snow_albedo", "maximum_snow_albedo", mn_static%max_snow_alb_grid, parent_tile) + ! Set any -999s to 0.5 + call mn_replace_low_values(mn_static%max_snow_alb_grid, -100.0, 0.5) + + ! Albedo fraction -- read and calculate + call mn_static_read_hires(Atm(1)%npx, Atm(1)%npy, x_refine, Atm(2)%pelist, trim(Moving_nest(child_grid_num)%mn_flag%surface_dir), "facsf", "facsf", mn_static%facsf_grid, parent_tile) + + allocate(mn_static%facwf_grid(lbound(mn_static%facsf_grid,1):ubound(mn_static%facsf_grid,1),lbound(mn_static%facsf_grid,2):ubound(mn_static%facsf_grid,2))) + + ! For land points, set facwf = 1.0 - facsf + ! To match initialization behavior, set any -999s to 0 + do i=lbound(mn_static%facsf_grid,1),ubound(mn_static%facsf_grid,1) + do j=lbound(mn_static%facsf_grid,2),ubound(mn_static%facsf_grid,2) + if (mn_static%facsf_grid(i,j) .lt. -100) then + mn_static%facsf_grid(i,j) = 0 + mn_static%facwf_grid(i,j) = 0 else - call mn_static_read_hires(Atm(1)%npx, Atm(1)%npy, 1, Atm(2)%pelist, Moving_nest(child_grid_num)%mn_flag%surface_dir, "oro_data", "orog_raw", mn_static%parent_orog_grid, parent_tile) + mn_static%facwf_grid(i,j) = 1.0 - mn_static%facsf_grid(i,j) endif - endif - - call mn_static_read_hires(Atm(1)%npx, Atm(1)%npy, x_refine, Atm(2)%pelist, trim(Moving_nest(child_grid_num)%mn_flag%surface_dir), "substrate_temperature", "substrate_temperature", mn_static%deep_soil_temp_grid, parent_tile) - ! set any -999s to +4C - call mn_replace_low_values(mn_static%deep_soil_temp_grid, -100.0, 277.0) - - call mn_static_read_hires(Atm(1)%npx, Atm(1)%npy, x_refine, Atm(2)%pelist, trim(Moving_nest(child_grid_num)%mn_flag%surface_dir), "soil_type", "soil_type", mn_static%soil_type_grid, parent_tile) - ! To match initialization behavior, set any -999s to 0 in soil_type - call mn_replace_low_values(mn_static%soil_type_grid, -100.0, 0.0) - - - !! TODO investigate reading high-resolution veg_frac and veg_greenness - !call mn_static_read_hires(Atm(1)%npx, Atm(1)%npy, x_refine, trim(Moving_nest(child_grid_num)%mn_flag%surface_dir), "", mn_static%veg_frac_grid) - - call mn_static_read_hires(Atm(1)%npx, Atm(1)%npy, x_refine, Atm(2)%pelist, trim(Moving_nest(child_grid_num)%mn_flag%surface_dir), "vegetation_type", "vegetation_type", mn_static%veg_type_grid, parent_tile) - ! To match initialization behavior, set any -999s to 0 in veg_type - call mn_replace_low_values(mn_static%veg_type_grid, -100.0, 0.0) - - - call mn_static_read_hires(Atm(1)%npx, Atm(1)%npy, x_refine, Atm(2)%pelist, trim(Moving_nest(child_grid_num)%mn_flag%surface_dir), "slope_type", "slope_type", mn_static%slope_type_grid, parent_tile) - ! To match initialization behavior, set any -999s to 0 in slope_type - call mn_replace_low_values(mn_static%slope_type_grid, -100.0, 0.0) - - - call mn_static_read_hires(Atm(1)%npx, Atm(1)%npy, x_refine, Atm(2)%pelist, trim(Moving_nest(child_grid_num)%mn_flag%surface_dir), "maximum_snow_albedo", "maximum_snow_albedo", mn_static%max_snow_alb_grid, parent_tile) - ! Set any -999s to 0.5 - call mn_replace_low_values(mn_static%max_snow_alb_grid, -100.0, 0.5) - - ! Albedo fraction -- read and calculate - call mn_static_read_hires(Atm(1)%npx, Atm(1)%npy, x_refine, Atm(2)%pelist, trim(Moving_nest(child_grid_num)%mn_flag%surface_dir), "facsf", "facsf", mn_static%facsf_grid, parent_tile) - - allocate(mn_static%facwf_grid(lbound(mn_static%facsf_grid,1):ubound(mn_static%facsf_grid,1),lbound(mn_static%facsf_grid,2):ubound(mn_static%facsf_grid,2))) - - ! For land points, set facwf = 1.0 - facsf - ! To match initialization behavior, set any -999s to 0 - do i=lbound(mn_static%facsf_grid,1),ubound(mn_static%facsf_grid,1) - do j=lbound(mn_static%facsf_grid,2),ubound(mn_static%facsf_grid,2) - if (mn_static%facsf_grid(i,j) .lt. -100) then - mn_static%facsf_grid(i,j) = 0 - mn_static%facwf_grid(i,j) = 0 - else - mn_static%facwf_grid(i,j) = 1.0 - mn_static%facsf_grid(i,j) - endif - enddo enddo - - ! Additional albedo variables - ! black sky = strong cosz -- direct sunlight - ! white sky = weak cosz -- diffuse light - - ! alvsf = visible strong cosz = visible_black_sky_albedo - ! alvwf = visible weak cosz = visible_white_sky_albedo - ! alnsf = near IR strong cosz = near_IR_black_sky_albedo - ! alnwf = near IR weak cosz = near_IR_white_sky_albedo - - call mn_static_read_hires(Atm(1)%npx, Atm(1)%npy, x_refine, Atm(2)%pelist, trim(Moving_nest(child_grid_num)%mn_flag%surface_dir), "snowfree_albedo", "visible_black_sky_albedo", mn_static%alvsf_grid, parent_tile, time=month) - call mn_static_read_hires(Atm(1)%npx, Atm(1)%npy, x_refine, Atm(2)%pelist, trim(Moving_nest(child_grid_num)%mn_flag%surface_dir), "snowfree_albedo", "visible_white_sky_albedo", mn_static%alvwf_grid, parent_tile, time=month) - - call mn_static_read_hires(Atm(1)%npx, Atm(1)%npy, x_refine, Atm(2)%pelist, trim(Moving_nest(child_grid_num)%mn_flag%surface_dir), "snowfree_albedo", "near_IR_black_sky_albedo", mn_static%alnsf_grid, parent_tile, time=month) - call mn_static_read_hires(Atm(1)%npx, Atm(1)%npy, x_refine, Atm(2)%pelist, trim(Moving_nest(child_grid_num)%mn_flag%surface_dir), "snowfree_albedo", "near_IR_white_sky_albedo", mn_static%alnwf_grid, parent_tile, time=month) - - ! Set the -999s to small value of 0.06, matching initialization code in chgres - - call mn_replace_low_values(mn_static%alvsf_grid, -100.0, 0.06) - call mn_replace_low_values(mn_static%alvwf_grid, -100.0, 0.06) - call mn_replace_low_values(mn_static%alnsf_grid, -100.0, 0.06) - call mn_replace_low_values(mn_static%alnwf_grid, -100.0, 0.06) - - endif - - endif - - if (first_nest_move) first_nest_move = .false. - - if (use_timers) call mpp_clock_end (id_movnest1) - if (use_timers) call mpp_clock_begin (id_movnest1_9) - - !!===================================================================================== - !! Step 1.9 -- Allocate and fill the temporary variable(s) - !!===================================================================================== - - call mn_prog_fill_temp_variables(Atm, n, child_grid_num, is_fine_pe, npz) - call mn_phys_fill_temp_variables(Atm, Atm_block, IPD_control, IPD_data, n, child_grid_num, is_fine_pe, npz) - - if (use_timers) call mpp_clock_end (id_movnest1_9) - if (use_timers) call mpp_clock_begin (id_movnest2) - - !!============================================================================ - !! Step 2 -- Fill in the halos from the coarse grids - !!============================================================================ - - ! The halos seem to be empty at least on the first model timestep. - ! These calls need to be executed by the parent and nest PEs in order to do the communication - ! This is before any nest motion has occurred - - call mn_prog_fill_nest_halos_from_parent(Atm, n, child_grid_num, is_fine_pe, global_nest_domain, nz) - call mn_phys_fill_nest_halos_from_parent(Atm, IPD_control, IPD_data, mn_static, n, child_grid_num, is_fine_pe, global_nest_domain, nz) - - if (use_timers) call mpp_clock_end (id_movnest2) - if (use_timers) call mpp_clock_begin (id_movnest3) - - !!============================================================================ - !! Step 3 -- Redefine the nest domain to new location - !! This calls mpp_define_nest_domains. Following the code in fv_control.F90, only should - !! be executed on the nest PEs. Operates only on indices. - !! -- Similar to med_nest_configure() from HWRF - !!============================================================================ - - call mn_meta_move_nest(delta_i_c, delta_j_c, pelist, is_fine_pe, extra_halo, & - global_nest_domain, domain_fine, domain_coarse, & - istart_coarse, iend_coarse, jstart_coarse, jend_coarse, & - istart_fine, iend_fine, jstart_fine, jend_fine) - - ! This code updates the values in neststruct; ioffset/joffset are pointers: ioffset => Atm(child_grid_num)%neststruct%ioffset - ioffset = ioffset + delta_i_c - joffset = joffset + delta_j_c - - if (debug_sync) call mpp_sync(full_pelist) ! Used to make debugging easier. Can be removed. - - if (use_timers) call mpp_clock_end (id_movnest3) - if (use_timers) call mpp_clock_begin (id_movnest4) - - !!============================================================================ - !! Step 4 -- Fill the internal nest halos for the prognostic variables, - !! then physics variables - !! Only acts on the nest PEs - !! -- similar to med_nest_initial - !!============================================================================ - - ! TODO should/can this run before the mn_meta_move_nest? - if (is_fine_pe) then - call mn_prog_fill_intern_nest_halos(Atm(n), domain_fine, is_fine_pe) - call mn_phys_fill_intern_nest_halos(Moving_nest(n), IPD_control, IPD_data, domain_fine, is_fine_pe) - endif - - if (debug_sync) call mpp_sync(full_pelist) ! Used to make debugging easier. Can be removed. - - if (use_timers) call mpp_clock_end (id_movnest4) - if (use_timers) call mpp_clock_begin (id_movnest5) - - !!============================================================================ - !! Step 5 -- Recalculate nest halo weights (for fine PEs only) and indices - !! -- Similiar to med_nest_weights - !!============================================================================ - - if (is_fine_pe) then - !!============================================================================ - !! Step 5.1 -- Fill the p_grid* and n_grid* variables - !!============================================================================ - if (use_timers) call mpp_clock_begin (id_movnest5_1) - - ! parent_geo, p_grid, p_grid_u, and p_grid_v are only loaded first time; afterwards they are reused. - ! Because they are the coarse resolution grids (supergrid, a-grid, u stagger, v stagger) for the parent - call mn_latlon_load_parent(Moving_nest(child_grid_num)%mn_flag%surface_dir, Atm, n, parent_tile, & - delta_i_c, delta_j_c, Atm(2)%pelist, child_grid_num, & - parent_geo, tile_geo, tile_geo_u, tile_geo_v, fp_super_tile_geo, & - p_grid, n_grid, p_grid_u, n_grid_u, p_grid_v, n_grid_v) - - if (use_timers) call mpp_clock_end (id_movnest5_1) - if (use_timers) call mpp_clock_begin (id_movnest5_2) - - ! tile_geo holds the center lat/lons for the entire nest (all PEs). - call mn_reset_phys_latlon(Atm, n, tile_geo, fp_super_tile_geo, Atm_block, IPD_control, IPD_data) - - if (use_timers) call mpp_clock_end (id_movnest5_2) - endif - - !!============================================================================ - !! Step 5.2 -- Fill the wt* variables for each stagger - !!============================================================================ - - call mn_shift_index(delta_i_c, delta_j_c, Atm(child_grid_num)%neststruct%ind_h) - call mn_shift_index(delta_i_c, delta_j_c, Atm(child_grid_num)%neststruct%ind_u) - call mn_shift_index(delta_i_c, delta_j_c, Atm(child_grid_num)%neststruct%ind_v) - call mn_shift_index(delta_i_c, delta_j_c, Atm(child_grid_num)%neststruct%ind_b) - - if (is_fine_pe) then - if (use_timers) call mpp_clock_begin (id_movnest5_3) - - call mn_meta_recalc( delta_i_c, delta_j_c, x_refine, y_refine, tile_geo, parent_geo, fp_super_tile_geo, & - is_fine_pe, global_nest_domain, position, p_grid, n_grid, wt_h, istart_coarse, jstart_coarse, Atm(child_grid_num)%neststruct%ind_h) - - call mn_meta_recalc( delta_i_c, delta_j_c, x_refine, y_refine, tile_geo_u, parent_geo, fp_super_tile_geo, & - is_fine_pe, global_nest_domain, position_u, p_grid_u, n_grid_u, wt_u, istart_coarse, jstart_coarse, Atm(child_grid_num)%neststruct%ind_u) - - call mn_meta_recalc( delta_i_c, delta_j_c, x_refine, y_refine, tile_geo_v, parent_geo, fp_super_tile_geo, & - is_fine_pe, global_nest_domain, position_v, p_grid_v, n_grid_v, wt_v, istart_coarse, jstart_coarse, Atm(child_grid_num)%neststruct%ind_v) - - if (use_timers) call mpp_clock_end (id_movnest5_3) + enddo + + ! Additional albedo variables + ! black sky = strong cosz -- direct sunlight + ! white sky = weak cosz -- diffuse light + + ! alvsf = visible strong cosz = visible_black_sky_albedo + ! alvwf = visible weak cosz = visible_white_sky_albedo + ! alnsf = near IR strong cosz = near_IR_black_sky_albedo + ! alnwf = near IR weak cosz = near_IR_white_sky_albedo + + call mn_static_read_hires(Atm(1)%npx, Atm(1)%npy, x_refine, Atm(2)%pelist, trim(Moving_nest(child_grid_num)%mn_flag%surface_dir), "snowfree_albedo", "visible_black_sky_albedo", mn_static%alvsf_grid, parent_tile, time=month) + call mn_static_read_hires(Atm(1)%npx, Atm(1)%npy, x_refine, Atm(2)%pelist, trim(Moving_nest(child_grid_num)%mn_flag%surface_dir), "snowfree_albedo", "visible_white_sky_albedo", mn_static%alvwf_grid, parent_tile, time=month) + + call mn_static_read_hires(Atm(1)%npx, Atm(1)%npy, x_refine, Atm(2)%pelist, trim(Moving_nest(child_grid_num)%mn_flag%surface_dir), "snowfree_albedo", "near_IR_black_sky_albedo", mn_static%alnsf_grid, parent_tile, time=month) + call mn_static_read_hires(Atm(1)%npx, Atm(1)%npy, x_refine, Atm(2)%pelist, trim(Moving_nest(child_grid_num)%mn_flag%surface_dir), "snowfree_albedo", "near_IR_white_sky_albedo", mn_static%alnwf_grid, parent_tile, time=month) + + ! Set the -999s to small value of 0.06, matching initialization code in chgres + + call mn_replace_low_values(mn_static%alvsf_grid, -100.0, 0.06) + call mn_replace_low_values(mn_static%alvwf_grid, -100.0, 0.06) + call mn_replace_low_values(mn_static%alnsf_grid, -100.0, 0.06) + call mn_replace_low_values(mn_static%alnwf_grid, -100.0, 0.06) + endif - - if (use_timers) call mpp_clock_begin (id_movnest5_4) - - !!============================================================================ - !! Step 5.3 -- Adjust the indices by the values of delta_i_c, delta_j_c - !!============================================================================ - - !call mn_shift_index(delta_i_c, delta_j_c, Atm(child_grid_num)%neststruct%ind_h) - !call mn_shift_index(delta_i_c, delta_j_c, Atm(child_grid_num)%neststruct%ind_u) - !call mn_shift_index(delta_i_c, delta_j_c, Atm(child_grid_num)%neststruct%ind_v) - !call mn_shift_index(delta_i_c, delta_j_c, Atm(child_grid_num)%neststruct%ind_b) - - if (debug_sync) call mpp_sync(full_pelist) ! Used to make debugging easier. Can be removed. - - if (use_timers) call mpp_clock_end (id_movnest5_4) - - if (use_timers) call mpp_clock_end (id_movnest5) - if (use_timers) call mpp_clock_begin (id_movnest6) - + + endif + + if (first_nest_move) first_nest_move = .false. + + if (use_timers) call mpp_clock_end (id_movnest1) + if (use_timers) call mpp_clock_begin (id_movnest1_9) + + !!===================================================================================== + !! Step 1.9 -- Allocate and fill the temporary variable(s) + !!===================================================================================== + + call mn_prog_fill_temp_variables(Atm, n, child_grid_num, is_fine_pe, npz) + call mn_phys_fill_temp_variables(Atm, Atm_block, IPD_control, IPD_data, n, child_grid_num, is_fine_pe, npz) + + if (use_timers) call mpp_clock_end (id_movnest1_9) + if (use_timers) call mpp_clock_begin (id_movnest2) + + !!============================================================================ + !! Step 2 -- Fill in the halos from the coarse grids + !!============================================================================ + + ! The halos seem to be empty at least on the first model timestep. + ! These calls need to be executed by the parent and nest PEs in order to do the communication + ! This is before any nest motion has occurred + + call mn_prog_fill_nest_halos_from_parent(Atm, n, child_grid_num, is_fine_pe, global_nest_domain, nz) + call mn_phys_fill_nest_halos_from_parent(Atm, IPD_control, IPD_data, mn_static, n, child_grid_num, is_fine_pe, global_nest_domain, nz) + + if (use_timers) call mpp_clock_end (id_movnest2) + if (use_timers) call mpp_clock_begin (id_movnest3) + + !!============================================================================ + !! Step 3 -- Redefine the nest domain to new location + !! This calls mpp_define_nest_domains. Following the code in fv_control.F90, only should + !! be executed on the nest PEs. Operates only on indices. + !! -- Similar to med_nest_configure() from HWRF + !!============================================================================ + + call mn_meta_move_nest(delta_i_c, delta_j_c, pelist, is_fine_pe, extra_halo, & + global_nest_domain, domain_fine, domain_coarse, & + istart_coarse, iend_coarse, jstart_coarse, jend_coarse, & + istart_fine, iend_fine, jstart_fine, jend_fine) + + ! This code updates the values in neststruct; ioffset/joffset are pointers: ioffset => Atm(child_grid_num)%neststruct%ioffset + ioffset = ioffset + delta_i_c + joffset = joffset + delta_j_c + + if (debug_sync) call mpp_sync(full_pelist) ! Used to make debugging easier. Can be removed. + + if (use_timers) call mpp_clock_end (id_movnest3) + if (use_timers) call mpp_clock_begin (id_movnest4) + + !!============================================================================ + !! Step 4 -- Fill the internal nest halos for the prognostic variables, + !! then physics variables + !! Only acts on the nest PEs + !! -- similar to med_nest_initial + !!============================================================================ + + ! TODO should/can this run before the mn_meta_move_nest? + if (is_fine_pe) then + call mn_prog_fill_intern_nest_halos(Atm(n), domain_fine, is_fine_pe) + call mn_phys_fill_intern_nest_halos(Moving_nest(n), IPD_control, IPD_data, domain_fine, is_fine_pe) + endif + + if (debug_sync) call mpp_sync(full_pelist) ! Used to make debugging easier. Can be removed. + + if (use_timers) call mpp_clock_end (id_movnest4) + if (use_timers) call mpp_clock_begin (id_movnest5) + + !!============================================================================ + !! Step 5 -- Recalculate nest halo weights (for fine PEs only) and indices + !! -- Similiar to med_nest_weights + !!============================================================================ + + if (is_fine_pe) then !!============================================================================ - !! Step 6 Shift the data on each nest PE - !! -- similar to med_nest_move in HWRF + !! Step 5.1 -- Fill the p_grid* and n_grid* variables !!============================================================================ - - call mn_prog_shift_data(Atm, n, child_grid_num, wt_h, wt_u, wt_v, & - delta_i_c, delta_j_c, x_refine, y_refine, & - is_fine_pe, global_nest_domain, nz) - - call mn_phys_shift_data(Atm, IPD_control, IPD_data, n, child_grid_num, wt_h, wt_u, wt_v, & - delta_i_c, delta_j_c, x_refine, y_refine, & - is_fine_pe, global_nest_domain, nz) - - if (debug_sync) call mpp_sync(full_pelist) ! Used to make debugging easier. Can be removed. - - if (use_timers) call mpp_clock_end (id_movnest6) - if (use_timers) call mpp_clock_begin (id_movnest7_0) - - !!===================================================================================== - !! Step 7 -- Reset the grid definition data and buffer sizes and weights after the nest motion - !! Mostly needed when dynamics is executed - !!===================================================================================== - - call mn_meta_reset_gridstruct(Atm, n, child_grid_num, global_nest_domain, fp_super_tile_geo, x_refine, y_refine, is_fine_pe, wt_h, wt_u, wt_v, a_step, dt_atmos) - - if (use_timers) call mpp_clock_end (id_movnest7_0) - if (use_timers) call mpp_clock_begin (id_movnest7_1) - - !!===================================================================================== - !! Step 7.01 -- Reset the orography data that was read from the hires static file - !! - !!===================================================================================== - - if (is_fine_pe) then - ! phis is allocated in fv_arrays.F90 as: allocate ( Atm%phis(isd:ied ,jsd:jed ) ) - ! 0 -- all high-resolution data, 1 - static nest smoothing algorithm, 5 - 5 point smoother, 9 - 9 point smoother - ! Defaults to 1 - static nest smoothing algorithm; this seems to produce the most stable solutions - - select case(Moving_nest(n)%mn_flag%terrain_smoother) - case (0) - ! High-resolution terrain for entire nest - Atm(n)%phis(isd:ied, jsd:jed) = mn_static%orog_grid((ioffset-1)*x_refine+isd:(ioffset-1)*x_refine+ied, (joffset-1)*y_refine+jsd:(joffset-1)*y_refine+jed) * grav - case (1) - ! Static nest smoothing algorithm - interpolation of coarse terrain in halo zone and 5 point blending zone of coarse and fine data - call set_blended_terrain(Atm(n), mn_static%parent_orog_grid, mn_static%orog_grid, x_refine, Atm(n)%bd%ng, 5, a_step) - case (2) - ! Static nest smoothing algorithm - interpolation of coarse terrain in halo zone and 5 point blending zone of coarse and fine data - call set_blended_terrain(Atm(n), mn_static%parent_orog_grid, mn_static%orog_grid, x_refine, Atm(n)%bd%ng, 10, a_step) - case (4) ! Use coarse terrain; no-op here. - ; - case (5) - ! 5 pt smoother. blend zone of 5 to match static nest - call set_smooth_nest_terrain(Atm(n), mn_static%orog_grid, x_refine, 5, Atm(n)%bd%ng, 5) - case (9) - ! 9 pt smoother. blend zone of 5 to match static nest - call set_smooth_nest_terrain(Atm(n), mn_static%orog_grid, x_refine, 9, Atm(n)%bd%ng, 5) - case default - write (errstring, "(I0)") Moving_nest(n)%mn_flag%terrain_smoother - call mpp_error(FATAL,'Invalid terrain_smoother in fv_moving_nest_main '//errstring) - end select - - ! Reinitialize diagnostics -- zsurf which is g * Atm%phis - call fv_diag_reinit(Atm(n:n)) - - ! sgh and oro were only fully allocated if fv_land is True - ! if false, oro is (1,1), and sgh is not allocated - if ( Atm(n)%flagstruct%fv_land ) then - ! oro and sgh are allocated only for the compute domain -- they do not have halos - - !fv_arrays.F90 oro() !< land fraction (1: all land; 0: all water) - !real, _ALLOCATABLE :: oro(:,:) _NULL !< land fraction (1: all land; 0: all water) - !real, _ALLOCATABLE :: sgh(:,:) _NULL !< Terrain standard deviation - - Atm(n)%oro(isc:iec, jsc:jec) = mn_static%land_frac_grid((ioffset-1)*x_refine+isc:(ioffset-1)*x_refine+iec, (joffset-1)*y_refine+jsc:(joffset-1)*y_refine+jec) - Atm(n)%sgh(isc:iec, jsc:jec) = mn_static%orog_std_grid((ioffset-1)*x_refine+isc:(ioffset-1)*x_refine+iec, (joffset-1)*y_refine+jsc:(joffset-1)*y_refine+jec) - endif - - call mn_phys_reset_sfc_props(Atm, n, mn_static, Atm_block, IPD_data, ioffset, joffset, x_refine) - endif - - !!===================================================================================== - !! Step 7.1 Refill the nest edge halos from parent grid after nest motion - !! Parent and nest PEs need to execute these subroutines - !!===================================================================================== - - ! Refill the halos around the edge of the nest from the parent - call mn_prog_fill_nest_halos_from_parent(Atm, n, child_grid_num, is_fine_pe, global_nest_domain, nz) - call mn_phys_fill_nest_halos_from_parent(Atm, IPD_control, IPD_data, mn_static, n, child_grid_num, is_fine_pe, global_nest_domain, nz) - - if (use_timers) call mpp_clock_end (id_movnest7_1) - - if (is_fine_pe) then - if (use_timers) call mpp_clock_begin (id_movnest7_2) - - ! Refill the internal halos after nest motion - call mn_prog_fill_intern_nest_halos(Atm(n), domain_fine, is_fine_pe) - call mn_phys_fill_intern_nest_halos(Moving_nest(n), IPD_control, IPD_data, domain_fine, is_fine_pe) - - if (use_timers) call mpp_clock_end (id_movnest7_2) - endif - - if (debug_sync) call mpp_sync(full_pelist) ! Used to make debugging easier. Can be removed. - - !!===================================================================================== - !! Step 7.3 -- Apply the temporary variable to the prognostics and physics structures - !!===================================================================================== - if (use_timers) call mpp_clock_begin (id_movnest7_3) - - call mn_prog_apply_temp_variables(Atm, n, child_grid_num, is_fine_pe, npz) - call mn_phys_apply_temp_variables(Atm, Atm_block, IPD_control, IPD_data, n, child_grid_num, is_fine_pe, npz) - - if (use_timers) call mpp_clock_end (id_movnest7_3) - if (use_timers) call mpp_clock_begin (id_movnest8) - + if (use_timers) call mpp_clock_begin (id_movnest5_1) + + ! parent_geo, p_grid, p_grid_u, and p_grid_v are only loaded first time; afterwards they are reused. + ! Because they are the coarse resolution grids (supergrid, a-grid, u stagger, v stagger) for the parent + call mn_latlon_load_parent(Moving_nest(child_grid_num)%mn_flag%surface_dir, Atm, n, parent_tile, & + delta_i_c, delta_j_c, Atm(2)%pelist, child_grid_num, & + parent_geo, tile_geo, tile_geo_u, tile_geo_v, fp_super_tile_geo, & + p_grid, n_grid, p_grid_u, n_grid_u, p_grid_v, n_grid_v) + + if (use_timers) call mpp_clock_end (id_movnest5_1) + if (use_timers) call mpp_clock_begin (id_movnest5_2) + + ! tile_geo holds the center lat/lons for the entire nest (all PEs). + call mn_reset_phys_latlon(Atm, n, tile_geo, fp_super_tile_geo, Atm_block, IPD_control, IPD_data) + + if (use_timers) call mpp_clock_end (id_movnest5_2) + endif + !!============================================================================ - !! Step 8 -- Dump to netCDF + !! Step 5.2 -- Fill the wt* variables for each stagger !!============================================================================ - - - if (is_fine_pe) then - do i=isc,iec - do j=jsc,jec - ! EMIS PATCH - Force to positive at all locations matching the landmask - !if (Moving_nest(n)%mn_phys%slmsk(i,j) .eq. 1 .and. Moving_nest(n)%mn_phys%emis_lnd(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%emis_lnd(i,j) = 0.5 - !if (Moving_nest(n)%mn_phys%slmsk(i,j) .eq. 2 .and. Moving_nest(n)%mn_phys%emis_ice(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%emis_ice(i,j) = 0.5 - !if (Moving_nest(n)%mn_phys%slmsk(i,j) .eq. 0 .and. Moving_nest(n)%mn_phys%emis_wat(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%emis_wat(i,j) = 0.5 - !if (Moving_nest(n)%mn_phys%slmsk(i,j) .eq. 1 .and. Moving_nest(n)%mn_phys%albdirvis_lnd(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%albdirvis_lnd(i,j) = 0.5 - !if (Moving_nest(n)%mn_phys%slmsk(i,j) .eq. 1 .and. Moving_nest(n)%mn_phys%albdirnir_lnd(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%albdirvis_lnd(i,j) = 0.5 - !if (Moving_nest(n)%mn_phys%slmsk(i,j) .eq. 1 .and. Moving_nest(n)%mn_phys%albdifvis_lnd(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%albdifvis_lnd(i,j) = 0.5 - !if (Moving_nest(n)%mn_phys%slmsk(i,j) .eq. 1 .and. Moving_nest(n)%mn_phys%albdifnir_lnd(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%albdifnir_lnd(i,j) = 0.5 - - ! EMIS PATCH - Force to positive at all locations. - if (Moving_nest(n)%mn_phys%emis_lnd(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%emis_lnd(i,j) = 0.5 - if (Moving_nest(n)%mn_phys%emis_ice(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%emis_ice(i,j) = 0.5 - if (Moving_nest(n)%mn_phys%emis_wat(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%emis_wat(i,j) = 0.5 - if (Moving_nest(n)%mn_phys%albdirvis_lnd(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%albdirvis_lnd(i,j) = 0.5 - if (Moving_nest(n)%mn_phys%albdirnir_lnd(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%albdirvis_lnd(i,j) = 0.5 - if (Moving_nest(n)%mn_phys%albdifvis_lnd(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%albdifvis_lnd(i,j) = 0.5 - if (Moving_nest(n)%mn_phys%albdifnir_lnd(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%albdifnir_lnd(i,j) = 0.5 - - enddo - enddo - endif - - output_step = output_step + 1 - - if (debug_sync) call mpp_sync(full_pelist) ! Used to make debugging easier. Can be removed. - - if (use_timers) call mpp_clock_end (id_movnest8) - if (use_timers) call mpp_clock_begin (id_movnest9) - - !!========================================================================================= - !! Step 9 -- Recalculate auxiliary pressures - !! Should help stabilize the fields before dynamics runs - !! TODO Consider whether vertical remapping, recalculation of omega, interpolation of winds - !! to A or C grids, and/or divergence recalculation are needed here. - !!========================================================================================= - - if (is_fine_pe) then - call recalc_aux_pressures(Atm(n)) + + call mn_shift_index(delta_i_c, delta_j_c, Atm(child_grid_num)%neststruct%ind_h) + call mn_shift_index(delta_i_c, delta_j_c, Atm(child_grid_num)%neststruct%ind_u) + call mn_shift_index(delta_i_c, delta_j_c, Atm(child_grid_num)%neststruct%ind_v) + call mn_shift_index(delta_i_c, delta_j_c, Atm(child_grid_num)%neststruct%ind_b) + + if (is_fine_pe) then + if (use_timers) call mpp_clock_begin (id_movnest5_3) + + call mn_meta_recalc( delta_i_c, delta_j_c, x_refine, y_refine, tile_geo, parent_geo, fp_super_tile_geo, & + is_fine_pe, global_nest_domain, position, p_grid, n_grid, wt_h, istart_coarse, jstart_coarse, Atm(child_grid_num)%neststruct%ind_h) + + call mn_meta_recalc( delta_i_c, delta_j_c, x_refine, y_refine, tile_geo_u, parent_geo, fp_super_tile_geo, & + is_fine_pe, global_nest_domain, position_u, p_grid_u, n_grid_u, wt_u, istart_coarse, jstart_coarse, Atm(child_grid_num)%neststruct%ind_u) + + call mn_meta_recalc( delta_i_c, delta_j_c, x_refine, y_refine, tile_geo_v, parent_geo, fp_super_tile_geo, & + is_fine_pe, global_nest_domain, position_v, p_grid_v, n_grid_v, wt_v, istart_coarse, jstart_coarse, Atm(child_grid_num)%neststruct%ind_v) + + if (use_timers) call mpp_clock_end (id_movnest5_3) + endif + + if (use_timers) call mpp_clock_begin (id_movnest5_4) + + !!============================================================================ + !! Step 5.3 -- Adjust the indices by the values of delta_i_c, delta_j_c + !!============================================================================ + + !call mn_shift_index(delta_i_c, delta_j_c, Atm(child_grid_num)%neststruct%ind_h) + !call mn_shift_index(delta_i_c, delta_j_c, Atm(child_grid_num)%neststruct%ind_u) + !call mn_shift_index(delta_i_c, delta_j_c, Atm(child_grid_num)%neststruct%ind_v) + !call mn_shift_index(delta_i_c, delta_j_c, Atm(child_grid_num)%neststruct%ind_b) + + if (debug_sync) call mpp_sync(full_pelist) ! Used to make debugging easier. Can be removed. + + if (use_timers) call mpp_clock_end (id_movnest5_4) + + if (use_timers) call mpp_clock_end (id_movnest5) + if (use_timers) call mpp_clock_begin (id_movnest6) + + !!============================================================================ + !! Step 6 Shift the data on each nest PE + !! -- similar to med_nest_move in HWRF + !!============================================================================ + + call mn_prog_shift_data(Atm, n, child_grid_num, wt_h, wt_u, wt_v, & + delta_i_c, delta_j_c, x_refine, y_refine, & + is_fine_pe, global_nest_domain, nz) + + call mn_phys_shift_data(Atm, IPD_control, IPD_data, n, child_grid_num, wt_h, wt_u, wt_v, & + delta_i_c, delta_j_c, x_refine, y_refine, & + is_fine_pe, global_nest_domain, nz) + + if (debug_sync) call mpp_sync(full_pelist) ! Used to make debugging easier. Can be removed. + + if (use_timers) call mpp_clock_end (id_movnest6) + if (use_timers) call mpp_clock_begin (id_movnest7_0) + + !!===================================================================================== + !! Step 7 -- Reset the grid definition data and buffer sizes and weights after the nest motion + !! Mostly needed when dynamics is executed + !!===================================================================================== + + call mn_meta_reset_gridstruct(Atm, n, child_grid_num, global_nest_domain, fp_super_tile_geo, x_refine, y_refine, is_fine_pe, wt_h, wt_u, wt_v, a_step, dt_atmos) + + if (use_timers) call mpp_clock_end (id_movnest7_0) + if (use_timers) call mpp_clock_begin (id_movnest7_1) + + !!===================================================================================== + !! Step 7.01 -- Reset the orography data that was read from the hires static file + !! + !!===================================================================================== + + if (is_fine_pe) then + ! phis is allocated in fv_arrays.F90 as: allocate ( Atm%phis(isd:ied ,jsd:jed ) ) + ! 0 -- all high-resolution data, 1 - static nest smoothing algorithm, 5 - 5 point smoother, 9 - 9 point smoother + ! Defaults to 1 - static nest smoothing algorithm; this seems to produce the most stable solutions + + select case(Moving_nest(n)%mn_flag%terrain_smoother) + case (0) + ! High-resolution terrain for entire nest + Atm(n)%phis(isd:ied, jsd:jed) = mn_static%orog_grid((ioffset-1)*x_refine+isd:(ioffset-1)*x_refine+ied, (joffset-1)*y_refine+jsd:(joffset-1)*y_refine+jed) * grav + case (1) + ! Static nest smoothing algorithm - interpolation of coarse terrain in halo zone and 5 point blending zone of coarse and fine data + call set_blended_terrain(Atm(n), mn_static%parent_orog_grid, mn_static%orog_grid, x_refine, Atm(n)%bd%ng, 5, a_step) + case (2) + ! Static nest smoothing algorithm - interpolation of coarse terrain in halo zone and 5 point blending zone of coarse and fine data + call set_blended_terrain(Atm(n), mn_static%parent_orog_grid, mn_static%orog_grid, x_refine, Atm(n)%bd%ng, 10, a_step) + case (4) ! Use coarse terrain; no-op here. + ; + case (5) + ! 5 pt smoother. blend zone of 5 to match static nest + call set_smooth_nest_terrain(Atm(n), mn_static%orog_grid, x_refine, 5, Atm(n)%bd%ng, 5) + case (9) + ! 9 pt smoother. blend zone of 5 to match static nest + call set_smooth_nest_terrain(Atm(n), mn_static%orog_grid, x_refine, 9, Atm(n)%bd%ng, 5) + case default + write (errstring, "(I0)") Moving_nest(n)%mn_flag%terrain_smoother + call mpp_error(FATAL,'Invalid terrain_smoother in fv_moving_nest_main '//errstring) + end select + + ! Reinitialize diagnostics -- zsurf which is g * Atm%phis + call fv_diag_reinit(Atm(n:n)) + + ! sgh and oro were only fully allocated if fv_land is True + ! if false, oro is (1,1), and sgh is not allocated + if ( Atm(n)%flagstruct%fv_land ) then + ! oro and sgh are allocated only for the compute domain -- they do not have halos + + !fv_arrays.F90 oro() !< land fraction (1: all land; 0: all water) + !real, _ALLOCATABLE :: oro(:,:) _NULL !< land fraction (1: all land; 0: all water) + !real, _ALLOCATABLE :: sgh(:,:) _NULL !< Terrain standard deviation + + Atm(n)%oro(isc:iec, jsc:jec) = mn_static%land_frac_grid((ioffset-1)*x_refine+isc:(ioffset-1)*x_refine+iec, (joffset-1)*y_refine+jsc:(joffset-1)*y_refine+jec) + Atm(n)%sgh(isc:iec, jsc:jec) = mn_static%orog_std_grid((ioffset-1)*x_refine+isc:(ioffset-1)*x_refine+iec, (joffset-1)*y_refine+jsc:(joffset-1)*y_refine+jec) endif - - output_step = output_step + 1 + + call mn_phys_reset_sfc_props(Atm, n, mn_static, Atm_block, IPD_data, ioffset, joffset, x_refine) + endif + + !!===================================================================================== + !! Step 7.1 Refill the nest edge halos from parent grid after nest motion + !! Parent and nest PEs need to execute these subroutines + !!===================================================================================== + + ! Refill the halos around the edge of the nest from the parent + call mn_prog_fill_nest_halos_from_parent(Atm, n, child_grid_num, is_fine_pe, global_nest_domain, nz) + call mn_phys_fill_nest_halos_from_parent(Atm, IPD_control, IPD_data, mn_static, n, child_grid_num, is_fine_pe, global_nest_domain, nz) + + if (use_timers) call mpp_clock_end (id_movnest7_1) + + if (is_fine_pe) then + if (use_timers) call mpp_clock_begin (id_movnest7_2) + + ! Refill the internal halos after nest motion + call mn_prog_fill_intern_nest_halos(Atm(n), domain_fine, is_fine_pe) + call mn_phys_fill_intern_nest_halos(Moving_nest(n), IPD_control, IPD_data, domain_fine, is_fine_pe) + + if (use_timers) call mpp_clock_end (id_movnest7_2) endif - - if (use_timers) call mpp_clock_end (id_movnest9) - call mpp_clock_end (id_movnestTot) - + if (debug_sync) call mpp_sync(full_pelist) ! Used to make debugging easier. Can be removed. - - !call compare_terrain("phis", Atm(n)%phis, 1, Atm(n)%neststruct%ind_h, x_refine, y_refine, is_fine_pe, global_nest_domain) - - !deallocate(tile_geo%lats, tile_geo%lons) - !deallocate(tile_geo_u%lats, tile_geo_u%lons) - !deallocate(tile_geo_v%lats, tile_geo_v%lons) - - !deallocate(p_grid, n_grid) - !deallocate(p_grid_u, n_grid_u) - !deallocate(p_grid_v, n_grid_v) - - end subroutine fv_moving_nest_exec - - !>@brief The subroutine 'mn_replace_low_values' replaces low values with a default value. - subroutine mn_replace_low_values(data_grid, low_value, new_value) - real, _ALLOCATABLE, intent(inout) :: data_grid(:,:) !< 2D grid of data - real, intent(in) :: low_value !< Low value to check for; e.g. negative or fill value - real, intent(in) :: new_value !< Value to replace low value with - - integer :: i, j - - do i=lbound(data_grid,1),ubound(data_grid,1) - do j=lbound(data_grid,2),ubound(data_grid,2) - if (data_grid(i,j) .le. low_value) data_grid(i,j) = new_value + + !!===================================================================================== + !! Step 7.3 -- Apply the temporary variable to the prognostics and physics structures + !!===================================================================================== + if (use_timers) call mpp_clock_begin (id_movnest7_3) + + call mn_prog_apply_temp_variables(Atm, n, child_grid_num, is_fine_pe, npz) + call mn_phys_apply_temp_variables(Atm, Atm_block, IPD_control, IPD_data, n, child_grid_num, is_fine_pe, npz) + + if (use_timers) call mpp_clock_end (id_movnest7_3) + if (use_timers) call mpp_clock_begin (id_movnest8) + + !!============================================================================ + !! Step 8 -- Dump to netCDF + !!============================================================================ + + + if (is_fine_pe) then + do i=isc,iec + do j=jsc,jec + ! EMIS PATCH - Force to positive at all locations matching the landmask + !if (Moving_nest(n)%mn_phys%slmsk(i,j) .eq. 1 .and. Moving_nest(n)%mn_phys%emis_lnd(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%emis_lnd(i,j) = 0.5 + !if (Moving_nest(n)%mn_phys%slmsk(i,j) .eq. 2 .and. Moving_nest(n)%mn_phys%emis_ice(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%emis_ice(i,j) = 0.5 + !if (Moving_nest(n)%mn_phys%slmsk(i,j) .eq. 0 .and. Moving_nest(n)%mn_phys%emis_wat(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%emis_wat(i,j) = 0.5 + !if (Moving_nest(n)%mn_phys%slmsk(i,j) .eq. 1 .and. Moving_nest(n)%mn_phys%albdirvis_lnd(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%albdirvis_lnd(i,j) = 0.5 + !if (Moving_nest(n)%mn_phys%slmsk(i,j) .eq. 1 .and. Moving_nest(n)%mn_phys%albdirnir_lnd(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%albdirvis_lnd(i,j) = 0.5 + !if (Moving_nest(n)%mn_phys%slmsk(i,j) .eq. 1 .and. Moving_nest(n)%mn_phys%albdifvis_lnd(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%albdifvis_lnd(i,j) = 0.5 + !if (Moving_nest(n)%mn_phys%slmsk(i,j) .eq. 1 .and. Moving_nest(n)%mn_phys%albdifnir_lnd(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%albdifnir_lnd(i,j) = 0.5 + + ! EMIS PATCH - Force to positive at all locations. + if (Moving_nest(n)%mn_phys%emis_lnd(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%emis_lnd(i,j) = 0.5 + if (Moving_nest(n)%mn_phys%emis_ice(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%emis_ice(i,j) = 0.5 + if (Moving_nest(n)%mn_phys%emis_wat(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%emis_wat(i,j) = 0.5 + if (Moving_nest(n)%mn_phys%albdirvis_lnd(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%albdirvis_lnd(i,j) = 0.5 + if (Moving_nest(n)%mn_phys%albdirnir_lnd(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%albdirvis_lnd(i,j) = 0.5 + if (Moving_nest(n)%mn_phys%albdifvis_lnd(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%albdifvis_lnd(i,j) = 0.5 + if (Moving_nest(n)%mn_phys%albdifnir_lnd(i,j) .lt. 0.0) Moving_nest(n)%mn_phys%albdifnir_lnd(i,j) = 0.5 + + enddo enddo + endif + + output_step = output_step + 1 + + if (debug_sync) call mpp_sync(full_pelist) ! Used to make debugging easier. Can be removed. + + if (use_timers) call mpp_clock_end (id_movnest8) + if (use_timers) call mpp_clock_begin (id_movnest9) + + !!========================================================================================= + !! Step 9 -- Recalculate auxiliary pressures + !! Should help stabilize the fields before dynamics runs + !! TODO Consider whether vertical remapping, recalculation of omega, interpolation of winds + !! to A or C grids, and/or divergence recalculation are needed here. + !!========================================================================================= + + if (is_fine_pe) then + call recalc_aux_pressures(Atm(n)) + endif + + output_step = output_step + 1 + endif + + if (use_timers) call mpp_clock_end (id_movnest9) + call mpp_clock_end (id_movnestTot) + + if (debug_sync) call mpp_sync(full_pelist) ! Used to make debugging easier. Can be removed. + + !call compare_terrain("phis", Atm(n)%phis, 1, Atm(n)%neststruct%ind_h, x_refine, y_refine, is_fine_pe, global_nest_domain) + + !deallocate(tile_geo%lats, tile_geo%lons) + !deallocate(tile_geo_u%lats, tile_geo_u%lons) + !deallocate(tile_geo_v%lats, tile_geo_v%lons) + + !deallocate(p_grid, n_grid) + !deallocate(p_grid_u, n_grid_u) + !deallocate(p_grid_v, n_grid_v) + + end subroutine fv_moving_nest_exec + + !>@brief The subroutine 'mn_replace_low_values' replaces low values with a default value. + subroutine mn_replace_low_values(data_grid, low_value, new_value) + real, _ALLOCATABLE, intent(inout) :: data_grid(:,:) !< 2D grid of data + real, intent(in) :: low_value !< Low value to check for; e.g. negative or fill value + real, intent(in) :: new_value !< Value to replace low value with + + integer :: i, j + + do i=lbound(data_grid,1),ubound(data_grid,1) + do j=lbound(data_grid,2),ubound(data_grid,2) + if (data_grid(i,j) .le. low_value) data_grid(i,j) = new_value enddo - end subroutine mn_replace_low_values - - end module fv_moving_nest_main_mod - \ No newline at end of file + enddo + end subroutine mn_replace_low_values + +end module fv_moving_nest_main_mod + From cc884cc83d8095aa1ac1977224c93a80e1cd90ee Mon Sep 17 00:00:00 2001 From: AlysonStahl-NOAA <166434581+AlysonStahl-NOAA@users.noreply.github.com> Date: Thu, 11 Apr 2024 15:17:32 -0600 Subject: [PATCH 5/5] doxygen update in fv_moving_nest_main.F90 --- moving_nest/fv_moving_nest_main.F90 | 113 ++++++++++++++++++++++++---- 1 file changed, 97 insertions(+), 16 deletions(-) diff --git a/moving_nest/fv_moving_nest_main.F90 b/moving_nest/fv_moving_nest_main.F90 index 34af608c2..f6cad5450 100644 --- a/moving_nest/fv_moving_nest_main.F90 +++ b/moving_nest/fv_moving_nest_main.F90 @@ -1,3 +1,7 @@ +!> @file +!> @brief Provides top-level interface for moving nest functionality. +!> @author W. Ramstrom, AOML/HRD (William.Ramstrom@noaa.gov) @date 05/27/2021 + !*********************************************************************** !* GNU General Public License * !* This file is a part of fvGFS. * @@ -25,6 +29,10 @@ !! @email William.Ramstrom@noaa.gov ! =======================================================================! +!> @brief Provides top-level interface for moving nest functionality. +!> +!> @author W. Ramstrom, AOML/HRD (William.Ramstrom@noaa.gov) @date 05/27/2021 + module fv_moving_nest_main_mod #include @@ -167,9 +175,20 @@ module fv_moving_nest_main_mod contains - !>@brief The subroutine 'update_moving_nest' decides whether the nest should be moved, and if so, performs the move. - !>@details This subroutine evaluates the automatic storm tracker (or prescribed motion configuration), then decides - !! if the nest should be moved. If it should be moved, it calls fv_moving_nest_exec() to perform the nest move. + !> The subroutine 'update_moving_nest' decides whether the nest + !> should be moved, and if so, performs the move. + !> + !> This subroutine evaluates the automatic storm tracker (or + !> prescribed motion configuration), then decides if the nest should + !> be moved. If it should be moved, it calls fv_moving_nest_exec() + !> to perform the nest move. + !> + !> @param[in] Atm_block Physics block layout. + !> @param[in] IPD_control Physics metadata. + !> @param[inout] IPD_data Physics variable data. + !> @param[in] time_step Current timestep. + !> + !> @author W. Ramstrom, AOML/HRD (William.Ramstrom@noaa.gov) @date 05/27/2021 subroutine update_moving_nest(Atm_block, IPD_control, IPD_data, time_step) type(block_control_type), intent(in) :: Atm_block !< Physics block layout type(IPD_control_type), intent(in) :: IPD_control !< Physics metadata @@ -214,7 +233,9 @@ subroutine update_moving_nest(Atm_block, IPD_control, IPD_data, time_step) end subroutine update_moving_nest - + !> ??? + !> + !> @author W. Ramstrom, AOML/HRD (William.Ramstrom@noaa.gov) @date 05/27/2021 subroutine moving_nest_end() integer :: n @@ -234,21 +255,36 @@ subroutine moving_nest_end() end subroutine moving_nest_end - ! This subroutine sits in this file to have access to Atm structure + !> This subroutine sits in this file to have access to Atm structure. + !> + !> @author W. Ramstrom, AOML/HRD (William.Ramstrom@noaa.gov) @date 05/27/2021 subroutine nest_tracker_init() call fv_tracker_init(size(Atm)) if (mygrid .eq. 2) call allocate_tracker(mygrid, Atm(mygrid)%bd%isc, Atm(mygrid)%bd%iec, Atm(mygrid)%bd%jsc, Atm(mygrid)%bd%jec) end subroutine nest_tracker_init + !> ??? + !> + !> @author W. Ramstrom, AOML/HRD (William.Ramstrom@noaa.gov) @date 05/27/2021 subroutine nest_tracker_end() call deallocate_tracker(ngrids) end subroutine nest_tracker_end - !>@brief The subroutine 'dump_moving_nest' outputs native grid format data to netCDF files - !>@details This subroutine exports model variables using FMS IO to netCDF files if tsvar_out is set to .True. + !> The subroutine 'dump_moving_nest' outputs native grid format data + !> to netCDF files. + !> + !> This subroutine exports model variables using FMS IO to netCDF + !> files if tsvar_out is set to .True. + !> + !> @param[in] Atm_block Physics block layout. + !> @param[in] IPD_control Physics metadata. + !> @param[in] IPD_data Physics variable data. + !> @param[in] time_step Current timestep. + !> + !> @author W. Ramstrom, AOML/HRD (William.Ramstrom@noaa.gov) @date 05/27/2021 subroutine dump_moving_nest(Atm_block, IPD_control, IPD_data, time_step) type(block_control_type), intent(in) :: Atm_block !< Physics block layout type(IPD_control_type), intent(in) :: IPD_control !< Physics metadata @@ -278,9 +314,16 @@ subroutine dump_moving_nest(Atm_block, IPD_control, IPD_data, time_step) end subroutine dump_moving_nest - !>@brief The subroutine 'fv_moving_nest_init_clocks' intializes performance profiling timers of sections of the moving nest code. - !>@details Starts timers for subcomponents of moving nest code to determine performance. mpp routines group them into separate - !! sections for parent and nest PEs. + !> The subroutine fv_moving_nest_init_clocks() intializes + !> performance profiling timers of sections of the moving nest code. + !> + !> Starts timers for subcomponents of moving nest code to determine + !> performance. mpp routines group them into separate sections for + !> parent and nest PEs. + !> + !> @param[in] use_timers ??? + !> + !> @author W. Ramstrom, AOML/HRD (William.Ramstrom@noaa.gov) @date 05/27/2021 subroutine fv_moving_nest_init_clocks(use_timers) logical, intent(in) :: use_timers @@ -311,8 +354,22 @@ subroutine fv_moving_nest_init_clocks(use_timers) id_movnestTot = mpp_clock_id ('Moving Nest Total', flags = clock_flag_default, grain=CLOCK_SUBCOMPONENT ) end subroutine fv_moving_nest_init_clocks - !>@brief The subroutine 'eval_move_nest' determines whether the nest should be moved and in which direction. - !>@details This subroutine can execute prescribed motion or automated storm tracking based on namelist options. + !> The subroutine 'eval_move_nest' determines whether the nest + !> should be moved and in which direction. + !> + !> This subroutine can execute prescribed motion or automated storm + !> tracking based on namelist options. + !> + !> @param[inout] Atm Input atmospheric data. + !> @param[in] a_step Timestep. + !> @param[in] parent_grid_num Grid numbers of parent. + !> @param[in] child_grid_num Grid numbers of child. + !> @param[out] do_move Logical for whether to move nest. + !> @param[out] delta_i_c Can be -1, 0, or +1. + !> @param[out] delta_j_c Can be -1, 0, or +1. + !> @param[in] dt_atmos only needed for the simple version of this subroutine. + !> + !> @author W. Ramstrom, AOML/HRD (William.Ramstrom@noaa.gov) @date 05/27/2021 subroutine eval_move_nest(Atm, a_step, parent_grid_num, child_grid_num, do_move, delta_i_c, delta_j_c, dt_atmos) type(fv_atmos_type), intent(inout) :: Atm(:) !< Input atmospheric data integer, intent(in) :: a_step !< Timestep @@ -480,9 +537,25 @@ subroutine eval_move_nest(Atm, a_step, parent_grid_num, child_grid_num, do_move, end subroutine eval_move_nest - !>@brief The subroutine 'fv_moving_nest_exec' performs the nest move - most work occurs on nest PEs but some on parent PEs. - !>@details This subroutine shifts the prognostic and physics/surface variables. - !! It also updates metadata and interpolation weights. + !> The subroutine 'fv_moving_nest_exec' performs the nest move - + !> most work occurs on nest PEs but some on parent PEs. + !> + !> This subroutine shifts the prognostic and physics/surface + !> variables. It also updates metadata and interpolation weights. + !> + !> @param[inout] Atm Atmospheric variables. + !> @param[in] Atm_block Physics block. + !> @param[in] IPD_control Physics metadata. + !> @param[inout] IPD_data Physics variable data. + !> @param[in] delta_i_c Nest motion increment. + !> @param[in] delta_j_c Nest motion increment. + !> @param[in] n Nest index. + !> @param[in] nest_num Nest index. + !> @param[in] parent_grid_num Grid numbers of parent. + !> @param[in] child_grid_num Grid numbers of child. + !> @param[in] dt_atmos Timestep in seconds. + !> + !> @author W. Ramstrom, AOML/HRD (William.Ramstrom@noaa.gov) @date 05/27/2021 subroutine fv_moving_nest_exec(Atm, Atm_block, IPD_control, IPD_data, delta_i_c, delta_j_c, n, nest_num, parent_grid_num, child_grid_num, dt_atmos) implicit none type(fv_atmos_type), allocatable, target, intent(inout) :: Atm(:) !< Atmospheric variables @@ -1148,7 +1221,15 @@ subroutine fv_moving_nest_exec(Atm, Atm_block, IPD_control, IPD_data, delta_i_c, end subroutine fv_moving_nest_exec - !>@brief The subroutine 'mn_replace_low_values' replaces low values with a default value. + + !> The subroutine 'mn_replace_low_values' replaces low values with a + !> default value. + !> + !> @param[inout] data_grid 2D grid of data. + !> @param[in] low_value Low value to check for; e.g. negative or fill value. + !> @param[in] new_value Value to replace low value with. + !> + !> @author W. Ramstrom, AOML/HRD (William.Ramstrom@noaa.gov) @date 05/27/2021 subroutine mn_replace_low_values(data_grid, low_value, new_value) real, _ALLOCATABLE, intent(inout) :: data_grid(:,:) !< 2D grid of data real, intent(in) :: low_value !< Low value to check for; e.g. negative or fill value