diff --git a/applications/adjoint_tests/example/configuration.nml b/applications/adjoint_tests/example/configuration.nml index 582deb87b..e007973f6 100644 --- a/applications/adjoint_tests/example/configuration.nml +++ b/applications/adjoint_tests/example/configuration.nml @@ -277,6 +277,8 @@ n_coarsesmooth=4, n_postsmooth=2, n_presmooth=2, smooth_relaxation=0.8, +coarsen_multigrid_tiles=.false. +max_tiled_multigrid_level=1 / &esm_couple l_esm_couple_test=.false., @@ -290,6 +292,9 @@ panel_decomposition='auto', panel_xproc=1, panel_yproc=1, partitioner='cubedsphere', +inner_halo_tiles=.false. +tile_size_x=1 +tile_size_y=1 / &physics bl_segment=0, diff --git a/applications/adjoint_tests/source/adjoint_tests.f90 b/applications/adjoint_tests/source/adjoint_tests.f90 index 75de561c6..9531bc8e4 100644 --- a/applications/adjoint_tests/source/adjoint_tests.f90 +++ b/applications/adjoint_tests/source/adjoint_tests.f90 @@ -76,7 +76,9 @@ program adjoint_tests call init_config( filename, gungho_required_namelists, & config=modeldb%config ) - call init_logger( modeldb%mpi%get_comm(), application_name ) + call init_logger( modeldb%config, & + modeldb%mpi%get_comm(), & + application_name ) subroutine_timers = modeldb%config%io%subroutine_timers() timer_output_path = modeldb%config%io%timer_output_path() diff --git a/applications/gravity_wave/example/configuration.nml b/applications/gravity_wave/example/configuration.nml index 4786292e1..a52682485 100644 --- a/applications/gravity_wave/example/configuration.nml +++ b/applications/gravity_wave/example/configuration.nml @@ -180,6 +180,8 @@ smooth_relaxation = 0.8 n_presmooth = 2 n_postsmooth = 2 n_coarsesmooth = 4 +coarsen_multigrid_tiles = .false. +max_tiled_multigrid_level = 1 / ×tepping @@ -200,6 +202,9 @@ partitioner = 'cubedsphere' panel_decomposition = 'auto' panel_xproc = 1 panel_yproc = 1 +tile_size_x = 1 +tile_size_y = 1 +inner_halo_tiles = .false. / &boundaries diff --git a/applications/gravity_wave/source/algorithm/gw_pressure_operator_alg_mod.x90 b/applications/gravity_wave/source/algorithm/gw_pressure_operator_alg_mod.x90 index b9c8bf521..edde569c0 100644 --- a/applications/gravity_wave/source/algorithm/gw_pressure_operator_alg_mod.x90 +++ b/applications/gravity_wave/source/algorithm/gw_pressure_operator_alg_mod.x90 @@ -44,7 +44,7 @@ module gw_pressure_operator_alg_mod b_space_w0, & b_space_w3, & b_space_wtheta - use function_space_chain_mod, only: multigrid_function_space_chain + use multigrid_mod, only: multigrid_function_space_chain implicit none diff --git a/applications/gravity_wave/source/driver/gravity_wave_infrastructure_mod.f90 b/applications/gravity_wave/source/driver/gravity_wave_infrastructure_mod.f90 index 362641c57..343029ea7 100644 --- a/applications/gravity_wave/source/driver/gravity_wave_infrastructure_mod.f90 +++ b/applications/gravity_wave/source/driver/gravity_wave_infrastructure_mod.f90 @@ -10,7 +10,7 @@ module gravity_wave_infrastructure_mod use add_mesh_map_mod, only : assign_mesh_maps use driver_modeldb_mod, only : modeldb_type - use constants_mod, only : i_def, & + use constants_mod, only : i_def, imdi, & PRECISION_REAL, & r_def, r_second, & l_def, str_def @@ -20,6 +20,8 @@ module gravity_wave_infrastructure_mod use extrusion_mod, only : extrusion_type, & uniform_extrusion_type, & TWOD, PRIME_EXTRUSION + use multigrid_mod, only : get_multigrid_tile_size, & + init_multigrid_fs_chain use sci_geometric_constants_mod, & only : get_chi_inventory, & get_panel_id_inventory @@ -30,7 +32,7 @@ module gravity_wave_infrastructure_mod LOG_LEVEL_ERROR use mesh_collection_mod, only : mesh_collection use field_mod, only : field_type - use driver_fem_mod, only : init_fem, init_function_space_chains + use driver_fem_mod, only : init_fem use driver_io_mod, only : init_io, final_io use driver_mesh_mod, only : init_mesh use runtime_constants_mod, only : create_runtime_constants @@ -77,17 +79,23 @@ subroutine initialise_infrastructure( program_name, & logical(l_def) :: l_multigrid logical(l_def) :: prepartitioned - logical :: apply_partition_check - + logical(l_def) :: check_partitions + logical(l_def) :: inner_halo_tiles integer(i_def) :: stencil_depth(1) - integer(i_def) :: geometry + integer(i_def) :: topology integer(i_def) :: method integer(i_def) :: number_of_layers + integer(i_def) :: tile_size_x + integer(i_def) :: tile_size_y + real(r_def) :: domain_bottom real(r_def) :: domain_height real(r_def) :: scaled_radius + integer(i_def), allocatable :: tile_size(:,:) + integer(i_def), allocatable :: multigrid_tile_size(:,:) + integer(i_def) :: i integer(i_def), parameter :: one_layer = 1_i_def @@ -101,12 +109,23 @@ subroutine initialise_infrastructure( program_name, & prime_mesh_name = modeldb%config%base_mesh%prime_mesh_name() geometry = modeldb%config%base_mesh%geometry() + topology = modeldb%config%base_mesh%topology() prepartitioned = modeldb%config%base_mesh%prepartitioned() method = modeldb%config%extrusion%method() domain_height = modeldb%config%extrusion%domain_height() number_of_layers = modeldb%config%extrusion%number_of_layers() scaled_radius = modeldb%config%planet%scaled_radius() + if (prepartitioned) then + inner_halo_tiles = .false. + tile_size_x = 1 + tile_size_y = 1 + else + inner_halo_tiles = modeldb%config%partitioning%inner_halo_tiles() + tile_size_x = maxval([1,modeldb%config%partitioning%tile_size_x()]) + tile_size_y = maxval([1,modeldb%config%partitioning%tile_size_y()]) + end if + !------------------------------------------------------------------------- ! Initialise infrastructure !------------------------------------------------------------------------- @@ -158,12 +177,12 @@ subroutine initialise_infrastructure( program_name, & call log_event("Invalid geometry for mesh initialisation", LOG_LEVEL_ERROR) end select allocate( extrusion, source=create_extrusion( method, & - domain_height, & + domain_height, & domain_bottom, & number_of_layers, & PRIME_EXTRUSION ) ) - extrusion_2d = uniform_extrusion_type( domain_height, & + extrusion_2d = uniform_extrusion_type( domain_height, & domain_bottom, & one_layer, TWOD ) @@ -172,23 +191,46 @@ subroutine initialise_infrastructure( program_name, & ! 1.3 Initialise mesh objects and assign InterGrid maps !======================================================================= stencil_depth = 2 - apply_partition_check = .false. + check_partitions = .false. if ( .not. prepartitioned .and. l_multigrid ) then - apply_partition_check = .true. + check_partitions = .true. + end if + + if (allocated(tile_size)) deallocate(tile_size) + allocate(tile_size(2, size(base_mesh_names))) + tile_size(1,:) = tile_size_x + tile_size(2,:) = tile_size_y + if (l_multigrid) then + multigrid_tile_size = get_multigrid_tile_size( modeldb%config, & + base_mesh_names, & + extrusion ) + where (multigrid_tile_size /= imdi) tile_size = multigrid_tile_size end if call init_mesh( modeldb%config, & modeldb%mpi%get_comm_rank(), & modeldb%mpi%get_comm_size(), & - base_mesh_names, & - extrusion, stencil_depth, & - apply_partition_check ) + base_mesh_names, extrusion, & + inner_halo_tiles, tile_size, & + stencil_depth, check_partitions ) allocate( twod_names, source=base_mesh_names ) do i=1, size(twod_names) twod_names(i) = trim(twod_names(i))//'_2d' end do + + if (allocated(tile_size)) deallocate(tile_size) + allocate(tile_size(2, size(base_mesh_names))) + tile_size(1,:) = tile_size_x + tile_size(2,:) = tile_size_y + if (l_multigrid) then + multigrid_tile_size = get_multigrid_tile_size( modeldb%config, & + base_mesh_names, & + extrusion_2d ) + where (multigrid_tile_size /= imdi) tile_size = multigrid_tile_size + end if call create_mesh( base_mesh_names, extrusion_2d, & + inner_halo_tiles, tile_size, & alt_name=twod_names ) call assign_mesh_maps(twod_names) @@ -197,16 +239,17 @@ subroutine initialise_infrastructure( program_name, & !======================================================================= chi_inventory => get_chi_inventory() panel_id_inventory => get_panel_id_inventory() - call init_fem( mesh_collection, chi_inventory, panel_id_inventory ) + call init_fem( modeldb%config, chi_inventory, panel_id_inventory ) if ( l_multigrid ) then - call init_function_space_chains( mesh_collection, chain_mesh_tags ) + call init_multigrid_fs_chain(chain_mesh_tags) end if !------------------------------------------------------------------------- ! Initialise aspects of output !------------------------------------------------------------------------- - call init_io( program_name, prime_mesh_name, & - modeldb, chi_inventory, panel_id_inventory) + call init_io( program_name, prime_mesh_name, modeldb, & + chi_inventory, panel_id_inventory, & + geometry, topology ) !------------------------------------------------------------------------- ! Setup constants diff --git a/applications/gravity_wave/source/gravity_wave.f90 b/applications/gravity_wave/source/gravity_wave.f90 index 7c3928fea..e7651a672 100644 --- a/applications/gravity_wave/source/gravity_wave.f90 +++ b/applications/gravity_wave/source/gravity_wave.f90 @@ -49,7 +49,9 @@ program gravity_wave deallocate( filename ) - call init_logger( modeldb%mpi%get_comm(), program_name ) + call init_logger( modeldb%config, & + modeldb%mpi%get_comm(), & + program_name ) subroutine_timers = modeldb%config%io%subroutine_timers() timer_output_path = modeldb%config%io%timer_output_path() diff --git a/applications/gravity_wave/source/kernel/initial_buoyancy_kernel_mod.F90 b/applications/gravity_wave/source/kernel/initial_buoyancy_kernel_mod.F90 index 76171aac8..a33156592 100644 --- a/applications/gravity_wave/source/kernel/initial_buoyancy_kernel_mod.F90 +++ b/applications/gravity_wave/source/kernel/initial_buoyancy_kernel_mod.F90 @@ -12,115 +12,123 @@ !! analytic expression module initial_buoyancy_kernel_mod - use argument_mod, only: arg_type, func_type, & - GH_FIELD, GH_REAL, GH_INC, GH_READ, & - ANY_SPACE_9, ANY_SPACE_1, GH_BASIS, & - CELL_COLUMN, GH_EVALUATOR, & - ANY_DISCONTINUOUS_SPACE_3 - use constants_mod, only: r_def, i_def - use kernel_mod, only: kernel_type - - implicit none - + use argument_mod, only: arg_type, func_type, & + GH_FIELD, GH_REAL, GH_INC, GH_READ, & + ANY_SPACE_9, ANY_SPACE_1, GH_BASIS, & + CELL_COLUMN, GH_EVALUATOR, & + ANY_DISCONTINUOUS_SPACE_3 + use constants_mod, only: r_def, i_def + use kernel_mod, only: kernel_type + + ! Configuration modules + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + + implicit none + + private + + !------------------------------------------------------------------------------- + ! Public types + !------------------------------------------------------------------------------- + !> The type declaration for the kernel. Contains the metadata needed by the Psy layer + type, public, extends(kernel_type) :: initial_buoyancy_kernel_type private + type(arg_type) :: meta_args(3) = (/ & + arg_type(GH_FIELD, GH_REAL, GH_INC, ANY_SPACE_1), & + arg_type(GH_FIELD*3, GH_REAL, GH_READ, ANY_SPACE_9), & + arg_type(GH_FIELD, GH_REAL, GH_READ, ANY_DISCONTINUOUS_SPACE_3) & + /) + type(func_type) :: meta_funcs(1) = (/ & + func_type(ANY_SPACE_9, GH_BASIS) & + /) + integer :: operates_on = CELL_COLUMN + integer :: gh_shape = GH_EVALUATOR + contains + procedure, nopass :: initial_buoyancy_code + end type + + !------------------------------------------------------------------------------- + ! Contained functions/subroutines + !------------------------------------------------------------------------------- + public :: initial_buoyancy_code - !------------------------------------------------------------------------------- - ! Public types - !------------------------------------------------------------------------------- - !> The type declaration for the kernel. Contains the metadata needed by the Psy layer - type, public, extends(kernel_type) :: initial_buoyancy_kernel_type - private - type(arg_type) :: meta_args(3) = (/ & - arg_type(GH_FIELD, GH_REAL, GH_INC, ANY_SPACE_1), & - arg_type(GH_FIELD*3, GH_REAL, GH_READ, ANY_SPACE_9), & - arg_type(GH_FIELD, GH_REAL, GH_READ, ANY_DISCONTINUOUS_SPACE_3) & - /) - type(func_type) :: meta_funcs(1) = (/ & - func_type(ANY_SPACE_9, GH_BASIS) & - /) - integer :: operates_on = CELL_COLUMN - integer :: gh_shape = GH_EVALUATOR - contains - procedure, nopass :: initial_buoyancy_code - end type - - !------------------------------------------------------------------------------- - ! Contained functions/subroutines - !------------------------------------------------------------------------------- - public :: initial_buoyancy_code contains - !> @brief Compute the initial buoyancy field - !! @param[in] nlayers The number of model layers - !! @param[in,out] buoyancy The field to compute - !! @param[in] chi_1 Real array, the x component of the coordinate field - !! @param[in] chi_2 Real array, the y component of the coordinate field - !! @param[in] chi_3 Real array, the z component of the coordinate field - !! @param[in] panel_id Field with IDs of mesh panels - !! @param[in] ndf_wt The number of degrees of freedom per cell for wt - !! @param[in] undf_wt The number of total degrees of freedom for wt - !! @param[in] map_wt Integer array holding the dofmap for the cell at the base of the column - !! @param[in] ndf_wx The number of degrees of freedom per cell - !! @param[in] undf_wx The total number of degrees of freedom - !! @param[in] map_wx Integer array holding the dofmap for the cell at the base of the column - !! @param[in] wx_basis Real 5-dim array holding basis functions evaluated at quadrature points, - !! @param[in] ndf_pid The number of degrees of freedom per cell for panel id - !! @param[in] ndf_pid The total number of degrees of freedom for panel id - !! @param[in] map_pid Integer array with the dofmap for panel_id - subroutine initial_buoyancy_code(nlayers, & - buoyancy, & - chi_1, chi_2, chi_3, & - panel_id, & - ndf_wt, undf_wt, map_wt, & - ndf_wx, undf_wx, map_wx, wx_basis, & - ndf_pid, undf_pid, map_pid ) - - use analytic_buoyancy_profiles_mod, only : analytic_buoyancy - use sci_chi_transform_mod, only : chi2xyz - - implicit none - - ! Arguments - integer(kind=i_def), intent(in) :: nlayers, ndf_wt, ndf_wx, ndf_pid - integer(kind=i_def), intent(in) :: undf_wt, undf_wx, undf_pid - integer(kind=i_def), dimension(ndf_wt), intent(in) :: map_wt - integer(kind=i_def), dimension(ndf_wx), intent(in) :: map_wx - integer(kind=i_def), dimension(ndf_pid), intent(in) :: map_pid - real(kind=r_def), dimension(undf_wt), intent(inout) :: buoyancy - real(kind=r_def), dimension(undf_wx), intent(in) :: chi_1, chi_2, chi_3 - real(kind=r_def), dimension(undf_pid), intent(in) :: panel_id - real(kind=r_def), dimension(1,ndf_wx,ndf_wt), intent(in) :: wx_basis - - ! Internal variables - integer(kind=i_def) :: df, df0, k, ipanel - real(kind=r_def), dimension(ndf_wx) :: chi_1_e, chi_2_e, chi_3_e - real(kind=r_def) :: chi_wt(3), xyz(3) - - ipanel = int(panel_id(map_pid(1)), i_def) - - ! compute the pointwise buoyancy profile - do k = 0, nlayers-1 - do df0 = 1, ndf_wx - chi_1_e(df0) = chi_1( map_wx(df0) + k ) - chi_2_e(df0) = chi_2( map_wx(df0) + k ) - chi_3_e(df0) = chi_3( map_wx(df0) + k ) - end do - - do df = 1, ndf_wt - chi_wt(:) = 0.0_r_def - do df0 = 1, ndf_wx - chi_wt(1) = chi_wt(1) + chi_1_e(df0)*wx_basis(1,df0,df) - chi_wt(2) = chi_wt(2) + chi_2_e(df0)*wx_basis(1,df0,df) - chi_wt(3) = chi_wt(3) + chi_3_e(df0)*wx_basis(1,df0,df) - end do - - call chi2xyz(chi_wt(1), chi_wt(2), chi_wt(3), & - ipanel, xyz(1), xyz(2), xyz(3)) - - buoyancy(map_wt(df) + k) = analytic_buoyancy(xyz) - end do - end do - - end subroutine initial_buoyancy_code +!> @brief Compute the initial buoyancy field +!! @param[in] nlayers The number of model layers +!! @param[in,out] buoyancy The field to compute +!! @param[in] chi_1 Real array, the x component of the coordinate field +!! @param[in] chi_2 Real array, the y component of the coordinate field +!! @param[in] chi_3 Real array, the z component of the coordinate field +!! @param[in] panel_id Field with IDs of mesh panels +!! @param[in] ndf_wt The number of degrees of freedom per cell for wt +!! @param[in] undf_wt The number of total degrees of freedom for wt +!! @param[in] map_wt Integer array holding the dofmap for the cell at the base of the column +!! @param[in] ndf_wx The number of degrees of freedom per cell +!! @param[in] undf_wx The total number of degrees of freedom +!! @param[in] map_wx Integer array holding the dofmap for the cell at the base of the column +!! @param[in] wx_basis Real 5-dim array holding basis functions evaluated at quadrature points, +!! @param[in] ndf_pid The number of degrees of freedom per cell for panel id +!! @param[in] ndf_pid The total number of degrees of freedom for panel id +!! @param[in] map_pid Integer array with the dofmap for panel_id +subroutine initial_buoyancy_code(nlayers, & + buoyancy, & + chi_1, chi_2, chi_3, & + panel_id, & + ndf_wt, undf_wt, map_wt, & + ndf_wx, undf_wx, map_wx, wx_basis, & + ndf_pid, undf_pid, map_pid ) + + use analytic_buoyancy_profiles_mod, only : analytic_buoyancy + use sci_chi_transform_mod, only : chi2xyz + + implicit none + + ! Arguments + integer(kind=i_def), intent(in) :: nlayers, ndf_wt, ndf_wx, ndf_pid + integer(kind=i_def), intent(in) :: undf_wt, undf_wx, undf_pid + integer(kind=i_def), dimension(ndf_wt), intent(in) :: map_wt + integer(kind=i_def), dimension(ndf_wx), intent(in) :: map_wx + integer(kind=i_def), dimension(ndf_pid), intent(in) :: map_pid + real(kind=r_def), dimension(undf_wt), intent(inout) :: buoyancy + real(kind=r_def), dimension(undf_wx), intent(in) :: chi_1, chi_2, chi_3 + real(kind=r_def), dimension(undf_pid), intent(in) :: panel_id + real(kind=r_def), dimension(1,ndf_wx,ndf_wt), intent(in) :: wx_basis + + ! Internal variables + integer(kind=i_def) :: df, df0, k, ipanel + real(kind=r_def), dimension(ndf_wx) :: chi_1_e, chi_2_e, chi_3_e + real(kind=r_def) :: chi_wt(3), xyz(3) + + ipanel = int(panel_id(map_pid(1)), i_def) + + ! compute the pointwise buoyancy profile + do k = 0, nlayers-1 + do df0 = 1, ndf_wx + chi_1_e(df0) = chi_1( map_wx(df0) + k ) + chi_2_e(df0) = chi_2( map_wx(df0) + k ) + chi_3_e(df0) = chi_3( map_wx(df0) + k ) + end do + + do df = 1, ndf_wt + chi_wt(:) = 0.0_r_def + do df0 = 1, ndf_wx + chi_wt(1) = chi_wt(1) + chi_1_e(df0)*wx_basis(1,df0,df) + chi_wt(2) = chi_wt(2) + chi_2_e(df0)*wx_basis(1,df0,df) + chi_wt(3) = chi_wt(3) + chi_3_e(df0)*wx_basis(1,df0,df) + end do + + call chi2xyz( chi_wt(1), chi_wt(2), chi_wt(3), & + ipanel, geometry, topology, & + coord_system, scaled_radius, & + xyz(1), xyz(2), xyz(3) ) + + buoyancy(map_wt(df) + k) = analytic_buoyancy(xyz) + end do + end do + +end subroutine initial_buoyancy_code end module initial_buoyancy_kernel_mod diff --git a/applications/gungho_model/example/configuration.nml b/applications/gungho_model/example/configuration.nml index 525f2ffb2..5a1beaf39 100644 --- a/applications/gungho_model/example/configuration.nml +++ b/applications/gungho_model/example/configuration.nml @@ -207,6 +207,8 @@ n_coarsesmooth=4, n_postsmooth=2, n_presmooth=2, smooth_relaxation=0.8, +coarsen_multigrid_tiles = .false. +max_tiled_multigrid_level = 1 / &esm_couple l_esm_couple_test=.false., @@ -219,6 +221,9 @@ panel_decomposition='auto', panel_xproc=6, panel_yproc=1, partitioner='cubedsphere', +tile_size_x = 1 +tile_size_y = 1 +inner_halo_tiles = .false. / &physics / diff --git a/applications/gungho_model/source/gungho_model.f90 b/applications/gungho_model/source/gungho_model.f90 index aacdb0d21..b7050543b 100644 --- a/applications/gungho_model/source/gungho_model.f90 +++ b/applications/gungho_model/source/gungho_model.f90 @@ -75,7 +75,9 @@ program gungho_model call init_config( filename, gungho_required_namelists, & config=modeldb%config ) - call init_logger( modeldb%mpi%get_comm(), application_name ) + call init_logger( modeldb%config, & + modeldb%mpi%get_comm(), & + application_name ) subroutine_timers = modeldb%config%io%subroutine_timers() timer_output_path = modeldb%config%io%timer_output_path() @@ -85,7 +87,7 @@ program gungho_model call init_collections() call init_time( modeldb ) - call init_counters( application_name ) + call init_counters( modeldb%config, application_name ) deallocate( filename ) write( log_scratch_space, '("Initialise ", A, " ...")' ) application_name @@ -108,7 +110,7 @@ program gungho_model call log_event( 'Finalising '//application_name//' ...', log_level_trace ) call finalise( application_name, modeldb ) - call final_counters( application_name ) + call final_counters(modeldb%config, application_name) call final_time( modeldb ) call final_collections() call final_timing( application_name ) diff --git a/applications/jedi_lfric_tests/integration-test/algorithm/algorithm_test.f90 b/applications/jedi_lfric_tests/integration-test/algorithm/algorithm_test.f90 index 278a94ff0..af704fa3b 100644 --- a/applications/jedi_lfric_tests/integration-test/algorithm/algorithm_test.f90 +++ b/applications/jedi_lfric_tests/integration-test/algorithm/algorithm_test.f90 @@ -65,16 +65,22 @@ program algorithm_test character(str_def) :: prime_mesh_name - logical(l_def) :: apply_partition_check + logical(l_def) :: check_partitions + logical(l_def) :: inner_halo_tiles integer(i_def) :: geometry integer(i_def) :: stencil_depth(1) integer(i_def) :: method integer(i_def) :: number_of_layers + integer(i_def) :: tile_size_x + integer(i_def) :: tile_size_y + real(r_def) :: domain_bottom real(r_def) :: domain_height real(r_def) :: scaled_radius + integer(i_def), allocatable :: tile_size(:,:) + integer(i_def) :: i integer(i_def), parameter :: one_layer = 1_i_def @@ -153,6 +159,10 @@ program algorithm_test number_of_layers = config%extrusion%number_of_layers() scaled_radius = config%planet%scaled_radius() + tile_size_x = 1 + tile_size_y = 1 + inner_halo_tiles = .false. + !-------------------------------------- ! 1.0 Create the meshes !-------------------------------------- @@ -183,16 +193,22 @@ program algorithm_test !------------------------------------------------------------------------- ! 1.2 Create the required meshes !------------------------------------------------------------------------- + if (allocated(tile_size)) deallocate(tile_size) + allocate(tile_size(2, size(base_mesh_names))) + tile_size(1,:) = tile_size_x + tile_size(2,:) = tile_size_y stencil_depth = 1 - apply_partition_check = .false. - call init_mesh( config, local_rank, total_ranks, & - base_mesh_names, extrusion, stencil_depth, & - apply_partition_check ) + check_partitions = .false. + call init_mesh( config, local_rank, total_ranks, & + base_mesh_names, extrusion, & + inner_halo_tiles, tile_size, & + stencil_depth, check_partitions ) do i=1, size(twod_names) twod_names(i) = trim(twod_names(i))//'_2d' end do call create_mesh( base_mesh_names, extrusion_2d, & + inner_halo_tiles, tile_size, & alt_name=twod_names ) call assign_mesh_maps(twod_names) @@ -200,7 +216,7 @@ program algorithm_test !------------------------------------------------------------------------- ! Tests !------------------------------------------------------------------------- - call test_algorithm_initialise(prime_mesh_name) ! fem + call test_algorithm_initialise(config, prime_mesh_name) ! fem if ( do_test_jedi_lfric_increment_alg_mod ) then call test_jedi_lfric_increment_alg(tolerance) diff --git a/applications/jedi_lfric_tests/integration-test/algorithm/test_algorithm_mod.x90 b/applications/jedi_lfric_tests/integration-test/algorithm/test_algorithm_mod.x90 index dac52dea5..f4ede9aa9 100644 --- a/applications/jedi_lfric_tests/integration-test/algorithm/test_algorithm_mod.x90 +++ b/applications/jedi_lfric_tests/integration-test/algorithm/test_algorithm_mod.x90 @@ -7,6 +7,7 @@ !>@brief Drives the execution of the da dev algorithms tests module test_algorithm_mod + use config_mod, only : config_type use constants_mod, only : i_def, r_def, str_def use driver_fem_mod, only : init_fem, final_fem use field_mod, only : field_type, field_proxy_type @@ -40,14 +41,15 @@ contains !> @brief Initialise module. !> @details Initialises the fem & function space wtheta_fs !> @param[in] mesh Mesh to be used - subroutine test_algorithm_initialise( mesh_name ) + subroutine test_algorithm_initialise( config, mesh_name ) implicit none + type(config_type), intent(in) :: config character(str_def), intent(in) :: mesh_name type(mesh_type), pointer :: mesh => null() - call init_fem( mesh_collection, chi_inventory, panel_id_inventory ) + call init_fem( config, chi_inventory, panel_id_inventory ) mesh => mesh_collection%get_mesh(mesh_name) wtheta_fs => function_space_collection%get_fs( mesh, & element_order_h, & @@ -101,4 +103,4 @@ contains end subroutine test_jedi_lfric_increment_alg -end module test_algorithm_mod \ No newline at end of file +end module test_algorithm_mod diff --git a/applications/jedi_lfric_tests/source/jedi-interface/jedi_geometry_mod.f90 b/applications/jedi_lfric_tests/source/jedi-interface/jedi_geometry_mod.f90 index 7c441b791..96e7bb642 100644 --- a/applications/jedi_lfric_tests/source/jedi-interface/jedi_geometry_mod.f90 +++ b/applications/jedi_lfric_tests/source/jedi-interface/jedi_geometry_mod.f90 @@ -404,7 +404,8 @@ subroutine setup_io(self, config) ! Setup XIOS with the files defined by file_meta_data context_name = "jedi_context" - call initialise_io( context_name, & + call initialise_io( config, & + context_name, & self%get_mpi_comm(), & file_meta_data, & self%get_mesh_name(), & diff --git a/applications/jedi_lfric_tests/source/jedi-interface/jedi_run_mod.f90 b/applications/jedi_lfric_tests/source/jedi-interface/jedi_run_mod.f90 index bda63a7a4..e1c06fe33 100644 --- a/applications/jedi_lfric_tests/source/jedi-interface/jedi_run_mod.f90 +++ b/applications/jedi_lfric_tests/source/jedi-interface/jedi_run_mod.f90 @@ -120,7 +120,7 @@ subroutine initialise_infrastructure( self, filename, model_communicator ) ! Initialise the logger call lfric_comm%set_comm_mpi_val(model_communicator) - call init_logger( lfric_comm, self%jedi_run_name ) + call init_logger( self%config, lfric_comm, self%jedi_run_name ) ! Initialise timing wrapper subroutine_timers = self%config%io%subroutine_timers() diff --git a/applications/jedi_lfric_tests/source/jedi_lfric_tests.f90 b/applications/jedi_lfric_tests/source/jedi_lfric_tests.f90 index 7c7b8ae1f..765f0ce12 100644 --- a/applications/jedi_lfric_tests/source/jedi_lfric_tests.f90 +++ b/applications/jedi_lfric_tests/source/jedi_lfric_tests.f90 @@ -69,7 +69,9 @@ program jedi_lfric_tests call init_config( filename, gungho_required_namelists, & config=modeldb%config ) - call init_logger( modeldb%mpi%get_comm(), application_name ) + call init_logger( modeldb%config, & + modeldb%mpi%get_comm(), & + application_name ) subroutine_timers = modeldb%config%io%subroutine_timers() timer_output_path = modeldb%config%io%timer_output_path() diff --git a/applications/jules/example/configuration.nml b/applications/jules/example/configuration.nml index 1321dfef8..d87dbfae8 100644 --- a/applications/jules/example/configuration.nml +++ b/applications/jules/example/configuration.nml @@ -378,6 +378,9 @@ panel_decomposition='auto', panel_xproc=1, panel_yproc=1, partitioner='planar', +tile_size_x = 1 +tile_size_y = 1 +inner_halo_tiles = .false. / &physics blayer_placement='fast', diff --git a/applications/jules/source/jules.f90 b/applications/jules/source/jules.f90 index 867c2c424..c63fdc674 100644 --- a/applications/jules/source/jules.f90 +++ b/applications/jules/source/jules.f90 @@ -71,7 +71,9 @@ program jules call init_config( filename, gungho_required_namelists, & config=modeldb%config ) - call init_logger( modeldb%mpi%get_comm(), application_name ) + call init_logger( modeldb%config, & + modeldb%mpi%get_comm(), & + application_name ) subroutine_timers = modeldb%config%io%subroutine_timers() timer_output_path = modeldb%config%io%timer_output_path() @@ -81,7 +83,7 @@ program jules call init_collections() call init_time( modeldb ) - call init_counters( application_name ) + call init_counters( modeldb%config, application_name ) deallocate( filename ) call initialise( application_name, modeldb ) @@ -92,7 +94,7 @@ program jules end do call finalise( application_name, modeldb ) - call final_counters( application_name ) + call final_counters(modeldb%config, application_name) call final_time( modeldb ) call final_collections() call final_timing( application_name ) diff --git a/applications/lfric2lfric/example/configuration.nml b/applications/lfric2lfric/example/configuration.nml index 24a76588b..24bcc89ed 100644 --- a/applications/lfric2lfric/example/configuration.nml +++ b/applications/lfric2lfric/example/configuration.nml @@ -16,6 +16,8 @@ source_topology = 'fully_periodic', target_domain = 'global', / !============================================================================== +&base_mesh +/ &extrusion domain_height = 80000.0, @@ -78,12 +80,18 @@ coord_space = 'Wchi', mesh_target = 'destination', partitioner = 'cubedsphere', panel_decomposition = 'auto', + tile_size_x = 1 + tile_size_y = 1 + inner_halo_tiles = .false. / &partitioning mesh_target = 'source', partitioner = 'cubedsphere', panel_decomposition = 'auto', + tile_size_x = 1 + tile_size_y = 1 + inner_halo_tiles = .false. / &planet diff --git a/applications/lfric2lfric/rose-meta/lfric-lfric2lfric/HEAD/rose-meta.conf b/applications/lfric2lfric/rose-meta/lfric-lfric2lfric/HEAD/rose-meta.conf index a055110c4..3f4be5dbf 100644 --- a/applications/lfric2lfric/rose-meta/lfric-lfric2lfric/HEAD/rose-meta.conf +++ b/applications/lfric2lfric/rose-meta/lfric-lfric2lfric/HEAD/rose-meta.conf @@ -292,3 +292,6 @@ help=The designation of the mesh to which this ns=namelist/lfric2lfric/configuration !string_length=default type=character + +[namelist:partitioning=inner_halo_tiles] +trigger= diff --git a/applications/lfric2lfric/rose-meta/lfric-lfric2lfric/versions.py b/applications/lfric2lfric/rose-meta/lfric-lfric2lfric/versions.py index 493965c38..c25523c28 100644 --- a/applications/lfric2lfric/rose-meta/lfric-lfric2lfric/versions.py +++ b/applications/lfric2lfric/rose-meta/lfric-lfric2lfric/versions.py @@ -173,3 +173,44 @@ def upgrade(self, config, meta_config=None): ) return config, self.reports + + +class vn31_t324(MacroUpgrade): + """Upgrade macro for ticket #324 by Ricky Wong.""" + + BEFORE_TAG = "vn3.1_t464" + AFTER_TAG = "vn3.1_t324" + + def upgrade(self, config, meta_config=None): + + if config.get(["namelist:partitioning(source)"]) is not None: + self.add_setting( + config, + ["namelist:partitioning(source)", "inner_halo_tiles"], + ".false.", + ) + self.add_setting( + config, ["namelist:partitioning(source)", "tile_size_x"], "1" + ) + self.add_setting( + config, ["namelist:partitioning(source)", "tile_size_y"], "1" + ) + + if config.get(["namelist:partitioning(destination)"]) is not None: + self.add_setting( + config, + ["namelist:partitioning(destination)", "inner_halo_tiles"], + ".false.", + ) + self.add_setting( + config, + ["namelist:partitioning(destination)", "tile_size_x"], + "1", + ) + self.add_setting( + config, + ["namelist:partitioning(destination)", "tile_size_y"], + "1", + ) + + return config, self.reports diff --git a/applications/lfric2lfric/source/initialisation/lfric2lfric_infrastructure_mod.X90 b/applications/lfric2lfric/source/initialisation/lfric2lfric_infrastructure_mod.X90 index aed2ca7f1..79336588a 100644 --- a/applications/lfric2lfric/source/initialisation/lfric2lfric_infrastructure_mod.X90 +++ b/applications/lfric2lfric/source/initialisation/lfric2lfric_infrastructure_mod.X90 @@ -81,6 +81,10 @@ module lfric2lfric_infrastructure_mod !------------------------------------ ! Configuration modules !------------------------------------ + use base_mesh_config_mod, only: geometry_planar, & + geometry_spherical, & + topology_fully_periodic, & + topology_non_periodic use extrusion_config_mod, only: key_from_method, & method_uniform, & method_geometric, & @@ -96,6 +100,8 @@ module lfric2lfric_infrastructure_mod regrid_method_lfric2lfric, & regrid_method_map, & regrid_method_oasis, & + source_topology_fully_periodic, & + source_topology_non_periodic, & source_geometry_planar, & source_geometry_spherical @@ -167,10 +173,10 @@ contains ! lfric2lfric namelist parameters integer(kind=i_def) :: stencil_depth(1) integer(kind=i_def) :: source_geometry + integer(kind=i_def) :: source_topology integer(i_def) :: mode integer(i_def) :: regrid_method real(kind=r_def) :: domain_bottom - real(kind=r_def) :: scaled_radius integer(kind=i_def) :: element_order_h integer(kind=i_def) :: element_order_v @@ -178,6 +184,11 @@ contains integer(kind=i_def) :: number_of_layers real(kind=r_def) :: domain_height + integer(i_def) :: tile_size_x + integer(i_def) :: tile_size_y + logical(l_def) :: inner_halo_tiles + + integer(i_def), allocatable :: tile_size(:,:) integer(kind=i_def) :: i integer(kind=i_def), parameter :: one_layer = 1_i_def @@ -205,6 +216,10 @@ contains type(lfric_xios_context_type), pointer :: io_context_dst type(linked_list_type), pointer :: file_list + integer(i_def) :: geometry + integer(i_def) :: topology + integer(i_def) :: coord_system + real(r_def) :: scaled_radius ! ------------------------------- ! Extract namelist variables @@ -225,10 +240,16 @@ contains mesh_names(src) = modeldb%config%lfric2lfric%source_mesh_name() source_file_lbc = modeldb%config%lfric2lfric%source_file_lbc() source_geometry = modeldb%config%lfric2lfric%source_geometry() + source_topology = modeldb%config%lfric2lfric%source_topology() start_dump_filename = modeldb%config%files%start_dump_filename() - element_order_h = modeldb%config%finite_element%element_order_h() - element_order_v = modeldb%config%finite_element%element_order_v() + coord_system = modeldb%config%finite_element%coord_system() + element_order_h = modeldb%config%finite_element%element_order_h() + element_order_v = modeldb%config%finite_element%element_order_v() + + tile_size_x = 1 + tile_size_y = 1 + inner_halo_tiles = .false. !======================================================================= ! Mesh @@ -237,11 +258,27 @@ contains ! Create the required extrusions !----------------------------------------------------------------------- select case (source_geometry) + case (source_geometry_planar) domain_bottom = 0.0_r_def + geometry = geometry_planar case (source_geometry_spherical) domain_bottom = scaled_radius + geometry = geometry_spherical + + case default + call log_event("Invalid geometry for mesh initialisation", & + log_level_error) + end select + + select case (source_topology) + + case (source_topology_fully_periodic) + topology = topology_fully_periodic + + case (source_topology_non_periodic) + topology = topology_non_periodic case default call log_event("Invalid geometry for mesh initialisation", & @@ -307,17 +344,23 @@ contains ! Create the required meshes !----------------------------------------------------------------------- stencil_depth = 2 + if (allocated(tile_size)) deallocate(tile_size) + allocate(tile_size(2, size(mesh_names))) + tile_size(1,:) = tile_size_x + tile_size(2,:) = tile_size_y call init_mesh( modeldb%config, & modeldb%mpi%get_comm_rank(), & modeldb%mpi%get_comm_size(), & mesh_names, extrusion, & + inner_halo_tiles, tile_size, & stencil_depth, regrid_method ) allocate( twod_names, source=mesh_names ) do i=1, size(twod_names) twod_names(i) = trim(twod_names(i))//'_2d' end do - call create_mesh( mesh_names, extrusion_2d, & + call create_mesh( mesh_names, extrusion_2d, & + inner_halo_tiles, tile_size, & alt_name=twod_names ) !======================================================================= @@ -329,7 +372,7 @@ contains ! Create FEM specifics (function spaces and chi field) chi_inventory => get_chi_inventory() panel_id_inventory => get_panel_id_inventory() - call init_fem( mesh_collection, chi_inventory, panel_id_inventory ) + call init_fem( modeldb%config, chi_inventory, panel_id_inventory ) !----------------------------------------------------------------------- ! Assign pointers to the correct meshes @@ -360,11 +403,12 @@ contains files_init_ptr => init_lfric2lfric_dst_files ! Initialise the IO context with all the required info - call init_io( context_dst, & - mesh_names(dst), & - modeldb, & - chi_inventory, & - panel_id_inventory, & + call init_io( context_dst, & + mesh_names(dst), & + modeldb, & + chi_inventory, & + panel_id_inventory, & + geometry, topology, & populate_filelist=files_init_ptr ) call modeldb%io_contexts%get_io_context(context_dst, io_context_dst) @@ -428,11 +472,12 @@ contains ! Using correct chi and panel_id, initialise xios context for source mesh nullify( before_close ) call io_context_src%initialise_xios_context( modeldb%mpi%get_comm(), & - chi, & - panel_id, & + chi, panel_id, & modeldb%clock, & modeldb%calendar, & - before_close ) + before_close, & + geometry, topology, & + coord_system, scaled_radius ) !======================================================================= ! Initialise source orography diff --git a/applications/lfric2lfric/source/initialisation/lfric2lfric_init_mesh.f90 b/applications/lfric2lfric/source/initialisation/lfric2lfric_init_mesh.f90 index 43e0f0036..734ca96d1 100644 --- a/applications/lfric2lfric/source/initialisation/lfric2lfric_init_mesh.f90 +++ b/applications/lfric2lfric/source/initialisation/lfric2lfric_init_mesh.f90 @@ -74,6 +74,8 @@ module lfric2lfric_init_mesh_mod !> @param[in] total_ranks Total number of MPI ranks in this job. !> @param[in] mesh_names Mesh names to load from the mesh input file(s). !> @param[in] extrusion Extrusion object to be applied to meshes. +!> @param[in] inner_halo_tiles Flag to apply tiling to inner halos +!> @param[in] tile_size Inner halo tile sizes in x/y direction for each mesh. !> @param[in] stencil_depths_in Required stencil depth for the application !! for each mesh. !> @param[in] regrid_method Apply check for even partitions with the @@ -85,6 +87,8 @@ subroutine init_mesh( config, & local_rank, total_ranks, & mesh_names, & extrusion, & + inner_halo_tiles, & + tile_size, & stencil_depths_in, & regrid_method ) @@ -100,6 +104,8 @@ subroutine init_mesh( config, & integer(kind=i_def), intent(in) :: total_ranks character(len=*), intent(in) :: mesh_names(2) class(extrusion_type), intent(in) :: extrusion + logical(l_def), intent(in) :: inner_halo_tiles + integer(i_def), intent(in) :: tile_size(:,:) integer(kind=i_def), intent(in) :: stencil_depths_in(:) integer(kind=i_def), intent(in) :: regrid_method @@ -367,7 +373,8 @@ subroutine init_mesh( config, & ! Alternative names are needed in case the source and destination ! mesh files use the same mesh name. !============================================================================ - call create_mesh( mesh_names, extrusion ) + call create_mesh( mesh_names, extrusion, & + inner_halo_tiles, tile_size ) !============================================================================ ! Generate intergrid LiD-LiD maps and assign them to mesh objects. diff --git a/applications/lfric2lfric/source/lfric2lfric.F90 b/applications/lfric2lfric/source/lfric2lfric.F90 index 676f7e2b4..6a260e03c 100644 --- a/applications/lfric2lfric/source/lfric2lfric.F90 +++ b/applications/lfric2lfric/source/lfric2lfric.F90 @@ -73,7 +73,9 @@ program lfric2lfric call init_config( filename, lfric2lfric_required_namelists, & config=modeldb%config ) - call init_logger( modeldb%mpi%get_comm(), program_name ) + call init_logger( modeldb%config, & + modeldb%mpi%get_comm(), & + program_name ) call init_collections() call init_time( modeldb ) deallocate( filename ) diff --git a/applications/lfric_atm/example/configuration.nml b/applications/lfric_atm/example/configuration.nml index a51239294..9ca96d4b0 100644 --- a/applications/lfric_atm/example/configuration.nml +++ b/applications/lfric_atm/example/configuration.nml @@ -521,7 +521,11 @@ panel_decomposition='auto', panel_xproc=1, panel_yproc=1, partitioner='planar', +tile_size_x = 1 +tile_size_y = 1 +inner_halo_tiles = .false. / + &physics blayer_placement='fast', configure_segments=.false., diff --git a/applications/lfric_atm/source/lfric_atm.f90 b/applications/lfric_atm/source/lfric_atm.f90 index ec60fa9d7..cc54568ac 100644 --- a/applications/lfric_atm/source/lfric_atm.f90 +++ b/applications/lfric_atm/source/lfric_atm.f90 @@ -74,7 +74,9 @@ program lfric_atm call init_config( filename, gungho_required_namelists, & config=modeldb%config ) - call init_logger( modeldb%mpi%get_comm(), application_name ) + call init_logger( modeldb%config, & + modeldb%mpi%get_comm(), & + application_name ) subroutine_timers = modeldb%config%io%subroutine_timers() timer_output_path = modeldb%config%io%timer_output_path() @@ -86,7 +88,7 @@ program lfric_atm call init_collections() call init_time( modeldb ) - call init_counters( application_name ) + call init_counters( modeldb%config, application_name ) call initialise( application_name, modeldb ) deallocate( filename ) @@ -99,7 +101,7 @@ program lfric_atm call finalise( application_name, modeldb ) - call final_counters( application_name ) + call final_counters(modeldb%config, application_name) call final_time( modeldb ) call final_collections() call final_timing( application_name ) diff --git a/applications/lfric_coupled/source/lfric_coupled.f90 b/applications/lfric_coupled/source/lfric_coupled.f90 index 0a89fba83..3ae856ad3 100644 --- a/applications/lfric_coupled/source/lfric_coupled.f90 +++ b/applications/lfric_coupled/source/lfric_coupled.f90 @@ -72,7 +72,9 @@ program lfric_coupled call init_config( filename, gungho_required_namelists, & config=modeldb%config ) - call init_logger( modeldb%mpi%get_comm(), application_name ) + call init_logger( modeldb%config, & + modeldb%mpi%get_comm(), & + application_name ) subroutine_timers = modeldb%config%io%subroutine_timers() timer_output_path = modeldb%config%io%timer_output_path() diff --git a/applications/lfricinputs/source/common/lfricinp_lfric_driver_mod.f90 b/applications/lfricinputs/source/common/lfricinp_lfric_driver_mod.f90 index 9aac28527..b71f26066 100644 --- a/applications/lfricinputs/source/common/lfricinp_lfric_driver_mod.f90 +++ b/applications/lfricinputs/source/common/lfricinp_lfric_driver_mod.f90 @@ -114,7 +114,7 @@ subroutine lfricinp_initialise_lfric(program_name_arg, & class(event_actor_type), pointer :: event_actor_ptr procedure(event_action), pointer :: context_advance -type(config_type), save :: config +type(config_type), save :: config class(extrusion_type), allocatable :: extrusion type(uniform_extrusion_type), allocatable :: extrusion_2d @@ -128,13 +128,20 @@ subroutine lfricinp_initialise_lfric(program_name_arg, & integer(i_def) :: stencil_depth(1) integer(i_def) :: geometry +integer(i_def) :: topology +integer(i_def) :: coord_system real(r_def) :: domain_bottom real(r_def) :: scaled_radius logical(l_def) :: check_partitions -integer :: extrusion_method +logical(l_def) :: inner_halo_tiles +integer(i_def) :: extrusion_method integer(i_def) :: number_of_layers real(r_def) :: domain_height +integer(i_def) :: tile_size_x +integer(i_def) :: tile_size_y + +integer(i_def), allocatable :: tile_size(:,:) !===================================================================== ! Set module variables @@ -162,7 +169,7 @@ subroutine lfricinp_initialise_lfric(program_name_arg, & call load_configuration( lfric_nl_fname, required_lfric_namelists, config ) ! Initialise logging system -call init_logger( comm, program_name ) +call init_logger( config, comm, program_name ) call init_collections() @@ -180,10 +187,16 @@ subroutine lfricinp_initialise_lfric(program_name_arg, & ! ------------------------------- prime_mesh_name = config%base_mesh%prime_mesh_name() geometry = config%base_mesh%geometry() +topology = config%base_mesh%topology() scaled_radius = config%planet%scaled_radius() extrusion_method = config%extrusion%method() number_of_layers = config%extrusion%number_of_layers() domain_height = config%extrusion%domain_height() +coord_system = config%finite_element%coord_system() + +tile_size_x = 1 +tile_size_y = 1 +inner_halo_tiles = .false. !------------------------------------------------------------------------- ! 1.0 Create the meshes @@ -225,12 +238,18 @@ subroutine lfricinp_initialise_lfric(program_name_arg, & stencil_depth = 2_i_def check_partitions = .false. -call init_mesh( config, & - local_rank, total_ranks, & - base_mesh_names, extrusion, & +if (allocated(tile_size)) deallocate(tile_size) +allocate(tile_size(2, size(base_mesh_names))) +tile_size(1,:) = tile_size_x +tile_size(2,:) = tile_size_y +call init_mesh( config, & + local_rank, total_ranks, & + base_mesh_names, extrusion, & + inner_halo_tiles, tile_size, & stencil_depth, check_partitions ) call create_mesh( base_mesh_names, extrusion_2d, & + inner_halo_tiles, tile_size, & alt_name=twod_names ) call assign_mesh_maps( twod_names ) @@ -240,7 +259,7 @@ subroutine lfricinp_initialise_lfric(program_name_arg, & call log_event('Creating function spaces and chi', LOG_LEVEL_INFO) chi_inventory => get_chi_inventory() panel_id_inventory => get_panel_id_inventory() -call init_fem(mesh_collection, chi_inventory, panel_id_inventory) +call init_fem(config, chi_inventory, panel_id_inventory) ! XIOS domain initialisation mesh => mesh_collection%get_mesh(prime_mesh_name) @@ -255,7 +274,11 @@ subroutine lfricinp_initialise_lfric(program_name_arg, & call io_config%init_lfricinp_files(file_list) call io_context%initialise( xios_ctx ) call io_context%initialise_xios_context( comm, chi, panel_id, & - model_clock, model_calendar, before_close ) + model_clock, model_calendar, & + before_close, & + geometry, topology, & + coord_system, scaled_radius ) + ! Attach context advancement to the model's clock context_advance => advance event_actor_ptr => io_context diff --git a/applications/linear_model/example/configuration.nml b/applications/linear_model/example/configuration.nml index 4e2c8d190..1b1e3d477 100644 --- a/applications/linear_model/example/configuration.nml +++ b/applications/linear_model/example/configuration.nml @@ -191,6 +191,9 @@ orog_init_option='none', panel_decomposition='auto', panel_xproc=1, panel_yproc=1, +tile_size_x = 1 +tile_size_y = 1 +inner_halo_tiles = .false. / &physics / diff --git a/applications/linear_model/source/linear_model.f90 b/applications/linear_model/source/linear_model.f90 index 8462b66d8..8faee1c0b 100644 --- a/applications/linear_model/source/linear_model.f90 +++ b/applications/linear_model/source/linear_model.f90 @@ -68,7 +68,9 @@ program linear_model call init_config( filename, gungho_required_namelists, & config=modeldb%config ) - call init_logger( modeldb%mpi%get_comm(), application_name ) + call init_logger( modeldb%config, & + modeldb%mpi%get_comm(), & + application_name ) subroutine_timers = modeldb%config%io%subroutine_timers() timer_output_path = modeldb%config%io%timer_output_path() diff --git a/applications/name_transport/example/configuration.nml b/applications/name_transport/example/configuration.nml index a3d1d828e..6dc876892 100644 --- a/applications/name_transport/example/configuration.nml +++ b/applications/name_transport/example/configuration.nml @@ -94,6 +94,9 @@ transport_density=.true. &partitioning partitioner='cubedsphere', panel_decomposition='auto', +tile_size_x = 1 +tile_size_y = 1 +inner_halo_tiles = .false. / &planet cp=1005.0 diff --git a/applications/name_transport/source/driver/name_transport_driver_mod.f90 b/applications/name_transport/source/driver/name_transport_driver_mod.f90 index a524fcfd6..c4b3b0bfe 100644 --- a/applications/name_transport/source/driver/name_transport_driver_mod.f90 +++ b/applications/name_transport/source/driver/name_transport_driver_mod.f90 @@ -55,9 +55,12 @@ module name_transport_driver_mod name_transport_final ! Configuration modules - use base_mesh_config_mod, only: GEOMETRY_PLANAR, & - GEOMETRY_SPHERICAL - use name_options_config_mod, only: transport_density + use base_mesh_config_mod, only: geometry_planar, & + geometry_spherical + use finite_element_config_mod, only: coord_system, & + element_order_h, & + element_order_v + use name_options_config_mod, only: transport_density implicit none @@ -110,10 +113,13 @@ subroutine initialise_name_transport( program_name, modeldb ) character(len=str_def) :: prime_mesh_name integer(kind=i_def), allocatable :: stencil_depths(:) + integer(i_def), allocatable :: tile_size(:,:) + logical(kind=l_def) :: prepartitioned - logical(kind=l_def) :: apply_partition_check + logical(kind=l_def) :: check_partitions integer(kind=i_def) :: geometry + integer(kind=i_def) :: topology real(kind=r_def) :: domain_bottom real(kind=r_def) :: domain_height real(kind=r_def) :: scaled_radius @@ -123,6 +129,10 @@ subroutine initialise_name_transport( program_name, modeldb ) logical(kind=l_def) :: write_diag logical(kind=l_def) :: use_xios_io + logical(l_def) :: inner_halo_tiles + integer(i_def) :: tile_size_x + integer(i_def) :: tile_size_y + integer(i_def) :: i integer(i_def), parameter :: one_layer = 1_i_def @@ -131,6 +141,7 @@ subroutine initialise_name_transport( program_name, modeldb ) !======================================================================= prime_mesh_name = modeldb%config%base_mesh%prime_mesh_name() geometry = modeldb%config%base_mesh%geometry() + topology = modeldb%config%base_mesh%topology() prepartitioned = modeldb%config%base_mesh%prepartitioned() method = modeldb%config%extrusion%method() domain_height = modeldb%config%extrusion%domain_height() @@ -140,6 +151,16 @@ subroutine initialise_name_transport( program_name, modeldb ) write_diag = modeldb%config%io%write_diag() use_xios_io = modeldb%config%io%use_xios_io() + if (prepartitioned) then + inner_halo_tiles = .false. + tile_size_x = 1 + tile_size_y = 1 + else + inner_halo_tiles = modeldb%config%partitioning%inner_halo_tiles() + tile_size_x = maxval([1,modeldb%config%partitioning%tile_size_x()]) + tile_size_y = maxval([1,modeldb%config%partitioning%tile_size_y()]) + end if + !----------------------------------------------------------------------- ! Initialise infrastructure !----------------------------------------------------------------------- @@ -225,16 +246,21 @@ subroutine initialise_name_transport( program_name, modeldb ) base_mesh_names, & modeldb%config ) - apply_partition_check = .false. + if (allocated(tile_size)) deallocate(tile_size) + allocate(tile_size(2, size(base_mesh_names))) + tile_size(1,:) = tile_size_x + tile_size(2,:) = tile_size_y + check_partitions = .false. call init_mesh( modeldb%config, & modeldb%mpi%get_comm_rank(), & modeldb%mpi%get_comm_size(), & - base_mesh_names, & - extrusion, stencil_depths, & - apply_partition_check ) + base_mesh_names, extrusion, & + inner_halo_tiles, tile_size, & + stencil_depths, check_partitions ) call create_mesh( base_mesh_names, extrusion_2d, & + inner_halo_tiles, tile_size, & alt_name=twod_names ) call assign_mesh_maps(twod_names) @@ -247,8 +273,16 @@ subroutine initialise_name_transport( program_name, modeldb ) do i=1, size(shifted_names) shifted_names(i) = trim(shifted_names(i))//'_shifted' end do + + if (allocated(tile_size)) deallocate(tile_size) + allocate(tile_size(2, size(meshes_to_shift))) + tile_size(1,:) = tile_size_x + tile_size(2,:) = tile_size_y + call create_mesh( meshes_to_shift, & extrusion_shifted, & + inner_halo_tiles, & + tile_size, & alt_name=shifted_names ) call assign_mesh_maps(shifted_names) @@ -264,8 +298,16 @@ subroutine initialise_name_transport( program_name, modeldb ) do i=1, size(double_names) double_names(i) = trim(double_names(i))//'_double' end do + + if (allocated(tile_size)) deallocate(tile_size) + allocate(tile_size(2, size(meshes_to_shift))) + tile_size(1,:) = tile_size_x + tile_size(2,:) = tile_size_y + call create_mesh( meshes_to_double, & extrusion_double, & + inner_halo_tiles, & + tile_size, & alt_name=double_names ) call assign_mesh_maps(double_names) @@ -280,7 +322,7 @@ subroutine initialise_name_transport( program_name, modeldb ) chi_inventory => get_chi_inventory() panel_id_inventory => get_panel_id_inventory() - call init_fem( mesh_collection, chi_inventory, panel_id_inventory ) + call init_fem( modeldb%config, chi_inventory, panel_id_inventory ) call create_runtime_constants() @@ -306,7 +348,8 @@ subroutine initialise_name_transport( program_name, modeldb ) prime_mesh_name, & modeldb, & chi_inventory, & - panel_id_inventory ) + panel_id_inventory, & + geometry, topology ) ! Call clock initial step before initial conditions output ! This ensures that lfric_initial.nc will be written out @@ -329,8 +372,13 @@ subroutine initialise_name_transport( program_name, modeldb ) call write_scalar_diagnostic( 'tracer_con', tracer_con, modeldb%clock, & mesh, nodal_output_on_w3 ) - height_w3 => get_height_fe(W3, mesh%get_id()) - height_wth => get_height_fe(Wtheta, mesh%get_id()) + height_w3 => get_height_fe( W3, mesh%get_id(), & + geometry, element_order_h, element_order_v, & + coord_system, scaled_radius ) + height_wth => get_height_fe( Wtheta, mesh%get_id(), & + geometry, element_order_h, element_order_v, & + coord_system, scaled_radius ) + call write_scalar_diagnostic( 'height_w3', height_w3, modeldb%clock, & mesh, nodal_output_on_w3 ) call write_scalar_diagnostic( 'height_wth', height_wth, modeldb%clock, & diff --git a/applications/name_transport/source/kernel/set_name_field_kernel_mod.F90 b/applications/name_transport/source/kernel/set_name_field_kernel_mod.F90 index 453a1cc18..2a314c9d6 100644 --- a/applications/name_transport/source/kernel/set_name_field_kernel_mod.F90 +++ b/applications/name_transport/source/kernel/set_name_field_kernel_mod.F90 @@ -167,8 +167,10 @@ subroutine set_name_field_code(nlayers, tracer, & end do ! Need (X,Y,Z) coordinate - call chi2xyz(coords(1), coords(2), coords(3), & - ipanel, xyz(1), xyz(2), xyz(3)) + call chi2xyz( coords(1), coords(2), coords(3), & + ipanel, geometry, topology, & + coord_system, scaled_radius, & + xyz(1), xyz(2), xyz(3) ) ! Set tracer field based on namelist tracer_ref = analytic_name_field(xyz, test, domain_max_x) diff --git a/applications/name_transport/source/name_transport.f90 b/applications/name_transport/source/name_transport.f90 index 21bc1fa0a..981844b05 100644 --- a/applications/name_transport/source/name_transport.f90 +++ b/applications/name_transport/source/name_transport.f90 @@ -48,7 +48,9 @@ program name_transport call init_config( filename, name_transport_required_namelists, & config=modeldb%config ) - call init_logger( modeldb%mpi%get_comm(), program_name ) + call init_logger( modeldb%config, & + modeldb%mpi%get_comm(), & + program_name ) call log_event( 'Miniapp will run with default precision set as:', & log_level_info ) diff --git a/applications/ngarch/source/ngarch.f90 b/applications/ngarch/source/ngarch.f90 index ab6e11299..80e4bf776 100644 --- a/applications/ngarch/source/ngarch.f90 +++ b/applications/ngarch/source/ngarch.f90 @@ -68,7 +68,9 @@ program ngarch deallocate( filename ) - call init_logger( modeldb%mpi%get_comm(), application_name ) + call init_logger( modeldb%config, & + modeldb%mpi%get_comm(), & + application_name ) subroutine_timers = modeldb%config%io%subroutine_timers() timer_output_path = modeldb%config%io%timer_output_path() diff --git a/applications/shallow_water/source/driver/shallow_water_model_mod.F90 b/applications/shallow_water/source/driver/shallow_water_model_mod.F90 index 1180262d5..2c3ff4559 100644 --- a/applications/shallow_water/source/driver/shallow_water_model_mod.F90 +++ b/applications/shallow_water/source/driver/shallow_water_model_mod.F90 @@ -12,7 +12,7 @@ module shallow_water_model_mod use check_configuration_mod, only: get_required_stencil_depth use sci_checksum_alg_mod, only: checksum_alg use conservation_algorithm_mod, only: conservation_algorithm - use constants_mod, only: i_def, str_def, r_def, & + use constants_mod, only: i_def, str_def, r_def, imdi, & PRECISION_REAL, l_def use convert_to_upper_mod, only: convert_to_upper use create_mesh_mod, only: create_mesh, create_extrusion @@ -25,6 +25,7 @@ module shallow_water_model_mod use extrusion_mod, only: extrusion_type, & uniform_extrusion_type, & PRIME_EXTRUSION, TWOD + use multigrid_mod, only: get_multigrid_tile_size use field_mod, only: field_type use field_parent_mod, only: write_interface use field_collection_mod, only: field_collection_type @@ -80,6 +81,7 @@ subroutine initialise_infrastructure( program_name, modeldb) character(len=*), parameter :: io_context_name = "shallow_water" character(str_def), allocatable :: base_mesh_names(:) + character(str_def), allocatable :: chain_mesh_tags(:) character(str_def), allocatable :: twod_names(:) integer(i_def), allocatable :: stencil_depths(:) @@ -89,12 +91,22 @@ subroutine initialise_infrastructure( program_name, modeldb) character(str_def) :: prime_mesh_name integer(i_def) :: geometry + integer(i_def) :: topology integer(i_def) :: method integer(i_def) :: number_of_layers real(r_def) :: domain_bottom real(r_def) :: domain_height real(r_def) :: scaled_radius - logical :: check_partitions + logical(l_def) :: check_partitions + logical(l_def) :: prepartitioned + logical(l_def) :: inner_halo_tiles + integer(i_def) :: tile_size_x + integer(i_def) :: tile_size_y + + logical(l_def) :: l_multigrid + + integer(i_def), allocatable :: tile_size(:,:) + integer(i_def), allocatable :: multigrid_tile_size(:,:) integer(i_def), parameter :: one_layer = 1_i_def integer(i_def) :: i @@ -102,13 +114,30 @@ subroutine initialise_infrastructure( program_name, modeldb) !======================================================================= ! 0.0 Extract configuration variables !======================================================================= + l_multigrid = modeldb%config%formulation%l_multigrid() + if (l_multigrid) then + chain_mesh_tags = modeldb%config%multigrid%chain_mesh_tags() + end if + prime_mesh_name = modeldb%config%base_mesh%prime_mesh_name() geometry = modeldb%config%base_mesh%geometry() + topology = modeldb%config%base_mesh%topology() + prepartitioned = modeldb%config%base_mesh%prepartitioned() method = modeldb%config%extrusion%method() domain_height = modeldb%config%extrusion%domain_height() number_of_layers = modeldb%config%extrusion%number_of_layers() scaled_radius = modeldb%config%planet%scaled_radius() + if (prepartitioned) then + inner_halo_tiles = .false. + tile_size_x = 1 + tile_size_y = 1 + else + inner_halo_tiles = modeldb%config%partitioning%inner_halo_tiles() + tile_size_x = maxval([1,modeldb%config%partitioning%tile_size_x()]) + tile_size_y = maxval([1,modeldb%config%partitioning%tile_size_y()]) + end if + !------------------------------------------------------------------------- ! Initialise aspects of the infrastructure !------------------------------------------------------------------------- @@ -171,10 +200,22 @@ subroutine initialise_infrastructure( program_name, modeldb) base_mesh_names, & modeldb%config ) + if (allocated(tile_size)) deallocate(tile_size) + allocate(tile_size(2, size(base_mesh_names))) + tile_size(1,:) = tile_size_x + tile_size(2,:) = tile_size_y + if (l_multigrid) then + multigrid_tile_size = get_multigrid_tile_size( modeldb%config, & + base_mesh_names, & + extrusion ) + where (multigrid_tile_size /= imdi) tile_size = multigrid_tile_size + end if + call init_mesh( modeldb%config, & modeldb%mpi%get_comm_rank(), & modeldb%mpi%get_comm_size(), & base_mesh_names, extrusion, & + inner_halo_tiles, tile_size, & stencil_depths, check_partitions ) @@ -182,7 +223,19 @@ subroutine initialise_infrastructure( program_name, modeldb) do i=1, size(twod_names) twod_names(i) = trim(twod_names(i))//'_2d' end do + + if (allocated(tile_size)) deallocate(tile_size) + allocate(tile_size(2, size(base_mesh_names))) + tile_size(1,:) = tile_size_x + tile_size(2,:) = tile_size_y + if (l_multigrid) then + multigrid_tile_size = get_multigrid_tile_size( modeldb%config, & + base_mesh_names, & + extrusion_2d ) + where (multigrid_tile_size /= imdi) tile_size = multigrid_tile_size + end if call create_mesh( base_mesh_names, extrusion_2d, & + inner_halo_tiles, tile_size, & alt_name=twod_names ) call assign_mesh_maps(twod_names) @@ -191,7 +244,7 @@ subroutine initialise_infrastructure( program_name, modeldb) !------------------------------------------------------------------------- chi_inventory => get_chi_inventory() panel_id_inventory => get_panel_id_inventory() - call init_fem(mesh_collection, chi_inventory, panel_id_inventory) + call init_fem(modeldb%config, chi_inventory, panel_id_inventory) !------------------------------------------------------------------------- ! Initialise aspects of output @@ -203,6 +256,7 @@ subroutine initialise_infrastructure( program_name, modeldb) files_init_ptr => init_shallow_water_files call init_io( io_context_name, prime_mesh_name, modeldb, & chi_inventory, panel_id_inventory, & + geometry, topology, & populate_filelist=files_init_ptr ) !------------------------------------------------------------------------- diff --git a/applications/shallow_water/source/kernel/initial_geopot_kernel_mod.F90 b/applications/shallow_water/source/kernel/initial_geopot_kernel_mod.F90 index 641d42faa..753944ff0 100644 --- a/applications/shallow_water/source/kernel/initial_geopot_kernel_mod.F90 +++ b/applications/shallow_water/source/kernel/initial_geopot_kernel_mod.F90 @@ -21,6 +21,11 @@ module initial_geopot_kernel_mod use shallow_water_settings_config_mod, & only: swe_test + ! Configuration modules + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none !------------------------------------------------------------------------------- @@ -115,7 +120,11 @@ subroutine initial_geopot_code(nlayers, geopot, & coord(3) = coord(3) + chi_3_e(df0)*wx_basis(1,df0,df) end do - call chi2xyz(coord(1), coord(2), coord(3), ipanel, xyz(1), xyz(2), xyz(3)) + call chi2xyz( coord(1), coord(2), coord(3), & + ipanel, geometry, topology, & + coord_system, scaled_radius, & + xyz(1), xyz(2), xyz(3) ) + geopot(map_w3(df)) = analytic_geopot(xyz, swe_test, domain_x) end do diff --git a/applications/shallow_water/source/kernel/initial_surface_geopot_kernel_mod.F90 b/applications/shallow_water/source/kernel/initial_surface_geopot_kernel_mod.F90 index 3a16acdf1..dd2968c8d 100644 --- a/applications/shallow_water/source/kernel/initial_surface_geopot_kernel_mod.F90 +++ b/applications/shallow_water/source/kernel/initial_surface_geopot_kernel_mod.F90 @@ -21,6 +21,11 @@ module initial_surface_geopot_kernel_mod use shallow_water_settings_config_mod, & only: swe_test + ! Configuration modules + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none !------------------------------------------------------------------------------- @@ -111,7 +116,11 @@ subroutine initial_surface_geopot_code(nlayers, geopot, & coord(3) = coord(3) + chi_3_e(df0)*wx_basis(1,df0,df) end do - call chi2xyz(coord(1), coord(2), coord(3), ipanel, xyz(1), xyz(2), xyz(3)) + call chi2xyz( coord(1), coord(2), coord(3), & + ipanel, geometry, topology, & + coord_system, scaled_radius, & + xyz(1), xyz(2), xyz(3) ) + geopot(map_w3(df)) = analytic_surface_geopot(xyz, swe_test) end do diff --git a/applications/shallow_water/source/kernel/initial_swe_buoyancy_kernel_mod.F90 b/applications/shallow_water/source/kernel/initial_swe_buoyancy_kernel_mod.F90 index c0a961d46..ba82a71e1 100644 --- a/applications/shallow_water/source/kernel/initial_swe_buoyancy_kernel_mod.F90 +++ b/applications/shallow_water/source/kernel/initial_swe_buoyancy_kernel_mod.F90 @@ -21,6 +21,11 @@ module initial_swe_buoyancy_kernel_mod use shallow_water_settings_config_mod, & only: swe_test + ! Configuration modules + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none !------------------------------------------------------------------------------- @@ -120,7 +125,11 @@ subroutine initial_swe_buoyancy_code(nlayers, & coord(3) = coord(3) + chi_3_e(df0)*wx_basis(1,df0,df) end do - call chi2xyz(coord(1), coord(2), coord(3), ipanel, xyz(1), xyz(2), xyz(3)) + call chi2xyz( coord(1), coord(2), coord(3), & + ipanel, geometry, topology, & + coord_system, scaled_radius, & + xyz(1), xyz(2), xyz(3) ) + buoyancy(map_wb(df)) = analytic_swe_buoyancy(xyz, swe_test, domain_x) end do diff --git a/applications/shallow_water/source/kernel/initial_swe_streamfunc_kernel_mod.F90 b/applications/shallow_water/source/kernel/initial_swe_streamfunc_kernel_mod.F90 index b9221ca88..82d598615 100644 --- a/applications/shallow_water/source/kernel/initial_swe_streamfunc_kernel_mod.F90 +++ b/applications/shallow_water/source/kernel/initial_swe_streamfunc_kernel_mod.F90 @@ -19,12 +19,13 @@ module initial_swe_streamfunc_kernel_mod use fs_continuity_mod, only : W1 use kernel_mod, only : kernel_type + use shallow_water_settings_config_mod, only: swe_test + + ! Configuration modules use base_mesh_config_mod, only: geometry, topology, & geometry_spherical use finite_element_config_mod, only: coord_system use planet_config_mod, only: scaled_radius - use shallow_water_settings_config_mod, & - only: swe_test implicit none @@ -166,12 +167,22 @@ subroutine initial_swe_streamfunc_code(nlayers, rhs, chi_1, chi_2, chi_3, panel_ coord(3) = coord(3) + chi_3_cell(df)*chi_basis(1,df,qp1,qp2) end do if ( geometry == geometry_spherical ) then - call chi2llr(coord(1), coord(2), coord(3), ipanel, llr(1), llr(2), llr(3)) + + call chi2llr( coord(1), coord(2), coord(3), & + ipanel, geometry, topology, & + coord_system, scaled_radius, & + llr(1), llr(2), llr(3) ) psi_spherical = analytic_swe_streamfunction(llr, swe_test) psi_physical = sphere2cart_vector(psi_spherical,llr) + else - call chi2xyz(coord(1), coord(2), coord(3), ipanel, xyz(1), xyz(2), xyz(3)) + + call chi2xyz( coord(1), coord(2), coord(3), & + ipanel, geometry, topology, & + coord_system, scaled_radius, & + xyz(1), xyz(2), xyz(3) ) psi_physical = analytic_swe_streamfunction(xyz, swe_test) + end if do df = 1, ndf integrand = dot_product(matmul(transpose(jac_inv(:,:,qp1,qp2)), & diff --git a/applications/shallow_water/source/kernel/initial_swe_tracer_kernel_mod.F90 b/applications/shallow_water/source/kernel/initial_swe_tracer_kernel_mod.F90 index c8eb44e35..214fd72c3 100644 --- a/applications/shallow_water/source/kernel/initial_swe_tracer_kernel_mod.F90 +++ b/applications/shallow_water/source/kernel/initial_swe_tracer_kernel_mod.F90 @@ -18,6 +18,11 @@ module initial_swe_tracer_kernel_mod use constants_mod, only: r_def, i_def use kernel_mod, only: kernel_type + ! Configuration modules + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none !------------------------------------------------------------------------------- @@ -112,7 +117,11 @@ subroutine initial_swe_tracer_code(nlayers, tracer, & coord(3) = coord(3) + chi_3_e(df0)*wx_basis(1,df0,df) end do - call chi2xyz(coord(1), coord(2), coord(3), ipanel, xyz(1), xyz(2), xyz(3)) + call chi2xyz( coord(1), coord(2), coord(3), & + ipanel, geometry, topology, & + coord_system, scaled_radius, & + xyz(1), xyz(2), xyz(3) ) + tracer(map_w3(df)) = analytic_tracer(xyz, domain_x) end do diff --git a/applications/shallow_water/source/kernel/initial_swe_u_kernel_mod.F90 b/applications/shallow_water/source/kernel/initial_swe_u_kernel_mod.F90 index 6d93ab3d9..0c8cdfc2e 100644 --- a/applications/shallow_water/source/kernel/initial_swe_u_kernel_mod.F90 +++ b/applications/shallow_water/source/kernel/initial_swe_u_kernel_mod.F90 @@ -21,6 +21,9 @@ module initial_swe_u_kernel_mod use fs_continuity_mod, only : W2 use kernel_mod, only : kernel_type + use shallow_water_settings_config_mod, only: swe_test + + ! Configuration modules use base_mesh_config_mod, only: geometry, topology, & geometry_spherical use finite_element_config_mod, only: coord_system @@ -28,8 +31,6 @@ module initial_swe_u_kernel_mod profile, sbr_angle_lat, sbr_angle_lon, & u0, v0, shear, wavelength use planet_config_mod, only: scaled_radius - use shallow_water_settings_config_mod, & - only: swe_test implicit none @@ -169,12 +170,22 @@ subroutine initial_swe_u_code( nlayers, rhs, & coord(3) = coord(3) + chi_3_cell(df)*chi_basis(1,df,qp1,qp2) end do if ( geometry == geometry_spherical ) then - call chi2llr(coord(1), coord(2), coord(3), ipanel, llr(1), llr(2), llr(3)) + + call chi2llr( coord(1), coord(2), coord(3), & + ipanel, geometry, topology, & + coord_system, scaled_radius, & + llr(1), llr(2), llr(3) ) u_spherical = analytic_swe_wind(llr, swe_test, domain_x) u_physical = sphere2cart_vector(u_spherical,llr) + else - call chi2xyz(coord(1), coord(2), coord(3), ipanel, xyz(1), xyz(2), xyz(3)) + + call chi2xyz( coord(1), coord(2), coord(3), & + ipanel, geometry, topology, & + coord_system, scaled_radius, & + xyz(1), xyz(2), xyz(3) ) u_physical = analytic_swe_wind(xyz, swe_test, domain_x) + end if do df = 1, ndf integrand = dot_product(matmul(jacobian(:,:,qp1,qp2),& diff --git a/applications/shallow_water/source/shallow_water.f90 b/applications/shallow_water/source/shallow_water.f90 index 7dffed65f..0e1f776fb 100644 --- a/applications/shallow_water/source/shallow_water.f90 +++ b/applications/shallow_water/source/shallow_water.f90 @@ -65,7 +65,9 @@ program shallow_water call init_config( filename, shallow_water_required_namelists, & config=modeldb%config ) - call init_logger( global_mpi%get_comm(), program_name ) + call init_logger( modeldb%config, & + global_mpi%get_comm(), & + program_name ) subroutine_timers = modeldb%config%io%subroutine_timers() timer_output_path = modeldb%config%io%timer_output_path() @@ -73,7 +75,7 @@ program shallow_water call init_timing( modeldb%mpi%get_comm(), subroutine_timers, & program_name, timer_output_path ) - call init_counters( program_name ) + call init_counters( modeldb%config, program_name ) call init_collections() call init_time( modeldb ) deallocate( filename ) @@ -91,7 +93,7 @@ program shallow_water call final_time( modeldb ) call final_collections() - call final_counters( program_name ) + call final_counters(modeldb%config, program_name) call final_timing( program_name ) call final_logger( program_name ) call final_config() diff --git a/applications/solver/example/configuration.nml b/applications/solver/example/configuration.nml index 68d9f61b3..f376b7619 100644 --- a/applications/solver/example/configuration.nml +++ b/applications/solver/example/configuration.nml @@ -86,6 +86,9 @@ scaling_factor=125.0, &partitioning partitioner='cubedsphere', panel_decomposition='auto' +tile_size_x = 1 +tile_size_y = 1 +inner_halo_tiles = .false. / &solver diff --git a/applications/solver/source/solver.F90 b/applications/solver/source/solver.F90 index d21e212a6..94eef989f 100644 --- a/applications/solver/source/solver.F90 +++ b/applications/solver/source/solver.F90 @@ -14,7 +14,8 @@ program solver use add_mesh_map_mod, only: assign_mesh_maps use config_mod, only: config_type use config_loader_mod, only: final_configuration - use constants_mod, only: i_def, r_def, PRECISION_REAL, str_def + use constants_mod, only: i_def, r_def, l_def, str_def, & + PRECISION_REAL use convert_to_upper_mod, only: convert_to_upper use cli_mod, only: parse_command_line use create_mesh_mod, only: create_mesh, create_extrusion @@ -84,11 +85,16 @@ program solver integer(i_def) :: geometry integer(i_def) :: method integer(i_def) :: number_of_layers + integer(i_def) :: tile_size_x + integer(i_def) :: tile_size_y real(r_def) :: domain_bottom real(r_def) :: domain_height real(r_def) :: scaled_radius - logical :: check_partitions + logical(l_def) :: check_partitions + logical(l_def) :: inner_halo_tiles + + integer(i_def), allocatable :: tile_size(:,:) integer(i_def) :: i integer(i_def), parameter :: one_layer = 1_i_def @@ -115,7 +121,7 @@ program solver call init_config( filename, solver_required_namelists, & config=config ) - call init_logger( comm, program_name ) + call init_logger( config, comm, program_name ) call init_collections() @@ -136,6 +142,10 @@ program solver number_of_layers = config%extrusion%number_of_layers() scaled_radius = config%planet%scaled_radius() + inner_halo_tiles = .false. + tile_size_x = 1 + tile_size_y = 1 + call log_event( 'Initialising '//program_name//' ...', LOG_LEVEL_ALWAYS ) !======================================================================= @@ -173,8 +183,15 @@ program solver !----------------------------------------------------------------------- stencil_depth = 1 check_partitions = .false. + + if (allocated(tile_size)) deallocate(tile_size) + allocate(tile_size(2, size(base_mesh_names))) + tile_size(1,:) = tile_size_x + tile_size(2,:) = tile_size_y + call init_mesh( config, local_rank, total_ranks, & base_mesh_names, extrusion, & + inner_halo_tiles, tile_size, & stencil_depth, check_partitions ) allocate( twod_names, source=base_mesh_names ) @@ -182,6 +199,7 @@ program solver twod_names(i) = trim(twod_names(i))//'_2d' end do call create_mesh( base_mesh_names, extrusion_2d, & + inner_halo_tiles, tile_size, & alt_name=twod_names ) call assign_mesh_maps(twod_names) @@ -190,7 +208,7 @@ program solver ! 2.0 Build the FEM function spaces and coordinate fields !======================================================================= ! Create FEM specifics (function spaces and chi field) - call init_fem( mesh_collection, chi_inventory, panel_id_inventory ) + call init_fem( config, chi_inventory, panel_id_inventory ) ! Create and initialise prognostic fields mesh => mesh_collection%get_mesh(prime_mesh_name) diff --git a/applications/transport/example/configuration.nml b/applications/transport/example/configuration.nml index 4853be668..f92d201ad 100644 --- a/applications/transport/example/configuration.nml +++ b/applications/transport/example/configuration.nml @@ -169,6 +169,7 @@ test='cosine_hill', horizontal_physics_predictor=.false. horizontal_transport_predictor=.false. use_multires_coupling=.false. +l_multigrid=.false. / &departure_points horizontal_limit='cap', @@ -197,9 +198,14 @@ outer_iterations=2, runge_kutta_method='forward_euler', / &partitioning +generate_inner_halos=.false. partitioner='cubedsphere', panel_decomposition='auto', +tile_size_x = 1 +tile_size_y = 1 +inner_halo_tiles = .false. / + §ion_choice aerosol='none', boundary_layer='none', diff --git a/applications/transport/source/driver/transport_driver_mod.f90 b/applications/transport/source/driver/transport_driver_mod.f90 index 743d6ca6f..0f3bc9e3e 100644 --- a/applications/transport/source/driver/transport_driver_mod.f90 +++ b/applications/transport/source/driver/transport_driver_mod.f90 @@ -12,8 +12,8 @@ module transport_driver_mod use sci_checksum_alg_mod, only: checksum_alg use check_configuration_mod, only: get_required_stencil_depth use config_loader_mod, only: final_configuration - use constants_mod, only: i_def, l_def, & - r_def, r_second, str_def + use constants_mod, only: i_def, l_def, r_def, r_second, & + str_def, imdi use create_mesh_mod, only: create_mesh, create_extrusion use driver_fem_mod, only: init_fem use driver_io_mod, only: init_io, final_io @@ -29,6 +29,7 @@ module transport_driver_mod double_level_extrusion_type, & PRIME_EXTRUSION, TWOD, & SHIFTED, DOUBLE_LEVEL + use multigrid_mod, only: get_multigrid_tile_size use field_mod, only: field_type use fs_continuity_mod, only: W3, Wtheta use sci_geometric_constants_mod, only: get_chi_inventory, & @@ -61,8 +62,13 @@ module transport_driver_mod !------------------------------------------- ! Configuration modules !------------------------------------------- - use base_mesh_config_mod, only: GEOMETRY_PLANAR, & - GEOMETRY_SPHERICAL + use base_mesh_config_mod, only: geometry, & + geometry_planar, & + geometry_spherical + use finite_element_config_mod, only: coord_system, & + element_order_h, & + element_order_v + use planet_config_mod, only: scaled_radius implicit none @@ -130,18 +136,26 @@ subroutine initialise_transport( program_name, modeldb ) logical(kind=l_def) :: use_multires_coupling logical(kind=l_def) :: l_multigrid logical(kind=l_def) :: prepartitioned - logical(kind=l_def) :: apply_partition_check + logical(kind=l_def) :: inner_halo_tiles + logical(kind=l_def) :: check_partitions integer(kind=i_def) :: geometry + integer(kind=i_def) :: topology real(kind=r_def) :: domain_bottom real(kind=r_def) :: domain_height real(kind=r_def) :: scaled_radius integer(kind=i_def) :: method integer(kind=i_def) :: number_of_layers + integer(i_def) :: tile_size_x + integer(i_def) :: tile_size_y + logical(kind=l_def) :: nodal_output_on_w3 logical(kind=l_def) :: write_diag logical(kind=l_def) :: use_xios_io + integer(i_def), allocatable :: tile_size(:,:) + integer(i_def), allocatable :: multigrid_tile_size(:,:) + integer(i_def) :: i integer(i_def), parameter :: one_layer = 1_i_def @@ -161,6 +175,7 @@ subroutine initialise_transport( program_name, modeldb ) prime_mesh_name = modeldb%config%base_mesh%prime_mesh_name() geometry = modeldb%config%base_mesh%geometry() + topology = modeldb%config%base_mesh%topology() prepartitioned = modeldb%config%base_mesh%prepartitioned() method = modeldb%config%extrusion%method() domain_height = modeldb%config%extrusion%domain_height() @@ -170,6 +185,16 @@ subroutine initialise_transport( program_name, modeldb ) write_diag = modeldb%config%io%write_diag() use_xios_io = modeldb%config%io%use_xios_io() + if (prepartitioned) then + tile_size_x = 1 + tile_size_y = 1 + inner_halo_tiles = .false. + else + tile_size_x = maxval([1,modeldb%config%partitioning%tile_size_x()]) + tile_size_y = maxval([1,modeldb%config%partitioning%tile_size_y()]) + inner_halo_tiles = modeldb%config%partitioning%inner_halo_tiles() + end if + !----------------------------------------------------------------------- ! Initialise infrastructure !----------------------------------------------------------------------- @@ -263,20 +288,43 @@ subroutine initialise_transport( program_name, modeldb ) base_mesh_names, & modeldb%config ) - apply_partition_check = .false. + check_partitions = .false. if ( .not. prepartitioned .and. & ( l_multigrid .or. use_multires_coupling ) ) then - apply_partition_check = .true. + check_partitions = .true. end if - call init_mesh( modeldb%config, & - modeldb%mpi%get_comm_rank(), & - modeldb%mpi%get_comm_size(), & - base_mesh_names, & - extrusion, stencil_depths, & - apply_partition_check ) + if (allocated(tile_size)) deallocate(tile_size) + allocate(tile_size(2, size(base_mesh_names))) + tile_size(1,:) = tile_size_x + tile_size(2,:) = tile_size_y + if (l_multigrid) then + multigrid_tile_size = get_multigrid_tile_size( modeldb%config, & + base_mesh_names, & + extrusion ) + where (multigrid_tile_size /= imdi) tile_size = multigrid_tile_size + end if + + call init_mesh( modeldb%config, & + modeldb%mpi%get_comm_rank(), & + modeldb%mpi%get_comm_size(), & + base_mesh_names, extrusion, & + inner_halo_tiles, tile_size, & + stencil_depths, check_partitions ) + + if (allocated(tile_size)) deallocate(tile_size) + allocate(tile_size(2, size(base_mesh_names))) + tile_size(1,:) = tile_size_x + tile_size(2,:) = tile_size_y + if (l_multigrid) then + multigrid_tile_size = get_multigrid_tile_size( modeldb%config, & + base_mesh_names, & + extrusion_2d ) + where (multigrid_tile_size /= imdi) tile_size = multigrid_tile_size + end if call create_mesh( base_mesh_names, extrusion_2d, & + inner_halo_tiles, tile_size, & alt_name=twod_names ) call assign_mesh_maps(twod_names) @@ -289,8 +337,22 @@ subroutine initialise_transport( program_name, modeldb ) do i=1, size(shifted_names) shifted_names(i) = trim(shifted_names(i))//'_shifted' end do + + if (allocated(tile_size)) deallocate(tile_size) + allocate(tile_size(2, size(meshes_to_shift))) + tile_size(1,:) = tile_size_x + tile_size(2,:) = tile_size_y + if (l_multigrid) then + multigrid_tile_size = get_multigrid_tile_size( modeldb%config, & + meshes_to_shift, & + extrusion_shifted ) + where (multigrid_tile_size /= imdi) tile_size = multigrid_tile_size + end if + call create_mesh( meshes_to_shift, & extrusion_shifted, & + inner_halo_tiles, & + tile_size, & alt_name=shifted_names ) call assign_mesh_maps(shifted_names) @@ -306,8 +368,22 @@ subroutine initialise_transport( program_name, modeldb ) do i=1, size(double_names) double_names(i) = trim(double_names(i))//'_double' end do + + if (allocated(tile_size)) deallocate(tile_size) + allocate(tile_size(2, size(meshes_to_shift))) + tile_size(1,:) = tile_size_x + tile_size(2,:) = tile_size_y + if (l_multigrid) then + multigrid_tile_size = get_multigrid_tile_size( modeldb%config, & + meshes_to_double, & + extrusion_double ) + where (multigrid_tile_size /= imdi) tile_size = multigrid_tile_size + end if + call create_mesh( meshes_to_double, & extrusion_double, & + inner_halo_tiles, & + tile_size, & alt_name=double_names ) call assign_mesh_maps(double_names) @@ -321,7 +397,7 @@ subroutine initialise_transport( program_name, modeldb ) chi_inventory => get_chi_inventory() panel_id_inventory => get_panel_id_inventory() - call init_fem( mesh_collection, chi_inventory, panel_id_inventory ) + call init_fem( modeldb%config, chi_inventory, panel_id_inventory ) call create_runtime_constants() @@ -361,13 +437,15 @@ subroutine initialise_transport( program_name, modeldb ) modeldb, & chi_inventory, & panel_id_inventory, & + geometry, topology, & alt_mesh_names=extra_io_mesh_names ) else call init_io( xios_ctx, & prime_mesh_name, & modeldb, & chi_inventory, & - panel_id_inventory ) + panel_id_inventory, & + geometry, topology ) end if ! Call clock initial step before initial conditions output @@ -400,9 +478,16 @@ subroutine initialise_transport( program_name, modeldb ) call write_vector_diagnostic( 'w2_vector', w2_vector, modeldb%clock, & mesh, nodal_output_on_w3 ) end if + if (use_aerosols) then - height_w3 => get_height_fe(W3, aerosol_mesh%get_id()) - height_wth => get_height_fe(Wtheta, aerosol_mesh%get_id()) + + height_w3 => get_height_fe( W3, aerosol_mesh%get_id(), & + geometry, element_order_h, element_order_v, & + coord_system, scaled_radius ) + height_wth => get_height_fe( Wtheta, aerosol_mesh%get_id(), & + geometry, element_order_h, element_order_v, & + coord_system, scaled_radius ) + call write_scalar_diagnostic( 'aerosol_height_w3', height_w3, modeldb%clock, & aerosol_mesh, nodal_output_on_w3 ) call write_scalar_diagnostic( 'aerosol_height_wth', height_wth, modeldb%clock, & @@ -416,8 +501,13 @@ subroutine initialise_transport( program_name, modeldb ) aerosol_mesh, nodal_output_on_w3 ) end if - height_w3 => get_height_fe(W3, mesh%get_id()) - height_wth => get_height_fe(Wtheta, mesh%get_id()) + height_w3 => get_height_fe( W3, mesh%get_id(), & + geometry, element_order_h, element_order_v, & + coord_system, scaled_radius ) + height_wth => get_height_fe( Wtheta, mesh%get_id(), & + geometry, element_order_h, element_order_v, & + coord_system, scaled_radius ) + call write_scalar_diagnostic( 'height_w3', height_w3, modeldb%clock, & mesh, nodal_output_on_w3 ) call write_scalar_diagnostic( 'height_wth', height_wth, modeldb%clock, & diff --git a/applications/transport/source/kernel/initial_tracer_field_sample_kernel_mod.F90 b/applications/transport/source/kernel/initial_tracer_field_sample_kernel_mod.F90 index d24c38b65..2b34dc2c9 100644 --- a/applications/transport/source/kernel/initial_tracer_field_sample_kernel_mod.F90 +++ b/applications/transport/source/kernel/initial_tracer_field_sample_kernel_mod.F90 @@ -20,9 +20,14 @@ module initial_tracer_field_sample_kernel_mod GH_INTEGER use fs_continuity_mod, only : Wchi use constants_mod, only : r_def, i_def - use idealised_config_mod, only : test use kernel_mod, only : kernel_type + ! Configuration modules + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system + use idealised_config_mod, only: test + use planet_config_mod, only: scaled_radius + implicit none private @@ -134,8 +139,10 @@ subroutine initial_tracer_field_sample_kernel_code( nlayers, coords(3) = coords(3) + chi_3_e(df1)*chi_basis(1,df1,df) end do - call chi2xyz(coords(1), coords(2), coords(3), & - ipanel, xyz(1), xyz(2), xyz(3)) + call chi2xyz( coords(1), coords(2), coords(3), & + ipanel, geometry, topology, & + coord_system, scaled_radius, & + xyz(1), xyz(2), xyz(3) ) if (const_flag == 1_i_def) then ! Set tracer field to be 1 everywhere diff --git a/applications/transport/source/kernel/set_tracer_field_kernel_mod.F90 b/applications/transport/source/kernel/set_tracer_field_kernel_mod.F90 index e6cd86ab4..85e92d883 100644 --- a/applications/transport/source/kernel/set_tracer_field_kernel_mod.F90 +++ b/applications/transport/source/kernel/set_tracer_field_kernel_mod.F90 @@ -21,6 +21,7 @@ module set_tracer_field_kernel_mod use kernel_mod, only : kernel_type use log_mod, only : log_event, LOG_LEVEL_ERROR + ! Configuration modules use base_mesh_config_mod, only: geometry, topology use finite_element_config_mod, only: coord_system use idealised_config_mod, only: test @@ -172,8 +173,10 @@ subroutine set_tracer_field_code(nlayers, tracer, & end do ! Need (X,Y,Z) coordinate - call chi2xyz(coords(1), coords(2), coords(3), & - ipanel, xyz(1), xyz(2), xyz(3)) + call chi2xyz( coords(1), coords(2), coords(3), & + ipanel, geometry, topology, & + coord_system, scaled_radius, & + xyz(1), xyz(2), xyz(3) ) if (const_flag == 1_i_def) then ! Set tracer field to be 1 everywhere diff --git a/applications/transport/source/transport.f90 b/applications/transport/source/transport.f90 index 6432a4be3..7ae2a7307 100644 --- a/applications/transport/source/transport.f90 +++ b/applications/transport/source/transport.f90 @@ -46,7 +46,9 @@ program transport call init_config( filename, transport_required_namelists, & config=modeldb%config ) - call init_logger( modeldb%mpi%get_comm(), program_name ) + call init_logger( modeldb%config, & + modeldb%mpi%get_comm(), & + program_name ) call log_event( 'Miniapp will run with default precision set as:', & log_level_trace ) diff --git a/dependencies.yaml b/dependencies.yaml index e314999e5..6f4ef8a95 100644 --- a/dependencies.yaml +++ b/dependencies.yaml @@ -30,8 +30,9 @@ lfric_apps: ref: lfric_core: - source: git@github.com:MetOffice/lfric_core.git - ref: 70405b50bda5a86c8711a2cceae0ea69dd04c2bc +# source: cazld000020:/data/users/ricky.wong/GitHub/lfric_core + source: git@github.com:mo-rickywong/lfric_core.git + ref: RmGlobalCfg_CoreDriver moci: source: git@github.com:MetOffice/moci.git diff --git a/interfaces/coupled_interface/source/algorithm/coupler_update_prognostics_mod.X90 b/interfaces/coupled_interface/source/algorithm/coupler_update_prognostics_mod.X90 index 6149953e4..3a08ae1aa 100644 --- a/interfaces/coupled_interface/source/algorithm/coupler_update_prognostics_mod.X90 +++ b/interfaces/coupled_interface/source/algorithm/coupler_update_prognostics_mod.X90 @@ -36,6 +36,13 @@ module coupler_update_prognostics_mod #endif use sci_field_minmax_alg_mod, only: log_field_minmax + ! Configuration modules + use base_mesh_config_mod, only: geometry, topology, f_lat + use finite_element_config_mod, only: element_order_h, element_order_v, & + coord_system + use idealised_config_mod, only: f_lon + use planet_config_mod, only: scaled_radius + implicit none #if !defined(UM_PHYSICS) @@ -89,7 +96,11 @@ module coupler_update_prognostics_mod call depository%get_field('tile_fraction', fld_ptr1) call depository%get_field('sea_ice_thickness', fld_ptr2) twod_mesh => fld_ptr2%get_mesh() - lat => get_latitude_fv( W3, twod_mesh%get_id() ) + lat => get_latitude_fv( W3, twod_mesh%get_id(), & + geometry, topology, & + element_order_h, element_order_v, & + coord_system, f_lat, f_lon, & + scaled_radius ) #if defined(UM_PHYSICS) ! Update tile_fractions with new sea ice fractions call invoke( masked_process_ssi_kernel_type(fld,fld_ptr2,fld_ptr1,lat, & diff --git a/interfaces/coupled_interface/source/algorithm/process_send_fields_0d_mod.X90 b/interfaces/coupled_interface/source/algorithm/process_send_fields_0d_mod.X90 index 2d12e66be..b6a6e3de6 100644 --- a/interfaces/coupled_interface/source/algorithm/process_send_fields_0d_mod.X90 +++ b/interfaces/coupled_interface/source/algorithm/process_send_fields_0d_mod.X90 @@ -24,6 +24,13 @@ module process_send_fields_0d_mod ice_sheet_mass use value_based_mask_kernel_mod, only: value_based_mask_kernel_type + ! Configuration modules + use base_mesh_config_mod, only: geometry, topology, f_lat + use finite_element_config_mod, only: element_order_h, element_order_v, & + coord_system + use idealised_config_mod, only: f_lon + use planet_config_mod, only: scaled_radius + implicit none private @@ -70,20 +77,29 @@ module process_send_fields_0d_mod ! Get the mesh mesh => fld%get_mesh() ! Get the latitude field - latitude => get_latitude_fv(W3, mesh%get_id()) + latitude => get_latitude_fv( W3, mesh%get_id(), & + geometry, topology, & + element_order_h, element_order_v, & + coord_system, f_lat, f_lon, & + scaled_radius ) call invoke(value_based_mask_kernel_type(fld, latitude, & 0.0_r_def, 2.0_r_def) ) - endif + end if + if (fld_name == "lf_antarctic") then !Make a mask of the Southern Hemisphere ! Get the mesh mesh => fld%get_mesh() ! Get the latitude field - latitude => get_latitude_fv(W3, mesh%get_id()) + latitude => get_latitude_fv( W3, mesh%get_id(), & + geometry, topology, & + element_order_h, element_order_v, & + coord_system, f_lat, f_lon, & + scaled_radius ) call invoke(value_based_mask_kernel_type(fld, latitude, & -2.0_r_def, 0.0_r_def) ) - endif - endif + end if + end if ! Calculate the scalar icesheet mass diff --git a/interfaces/coupled_interface/source/algorithm/process_send_fields_2d_mod.X90 b/interfaces/coupled_interface/source/algorithm/process_send_fields_2d_mod.X90 index b9f6eb244..a4bb8d0bb 100644 --- a/interfaces/coupled_interface/source/algorithm/process_send_fields_2d_mod.X90 +++ b/interfaces/coupled_interface/source/algorithm/process_send_fields_2d_mod.X90 @@ -33,6 +33,10 @@ module process_send_fields_2d_mod use convert_to_celsius_kernel_mod, only: convert_to_celsius_kernel_type use convert_to_marine_fraction_mod, only: convert_to_marine_fraction_type + ! Configuration modules + use base_mesh_config_mod, only: geometry + use extrusion_config_mod, only: planet_radius, domain_height + implicit none private @@ -316,7 +320,8 @@ module process_send_fields_2d_mod call tmp_field3%initialise( vector_space=tmp_fs, name="tmp_field3_W3" ) ! Calculate the grid cell areas (dA) - dA => get_dA_msl_proj( mesh%get_id() ) + dA => get_dA_msl_proj( mesh%get_id(), geometry, & + planet_radius, domain_height ) call invoke( & ! Extract snow mass on ice tile into tmp_field1 diff --git a/interfaces/jedi_lfric_interface/source/io/jedi_lfric_io_setup_mod.F90 b/interfaces/jedi_lfric_interface/source/io/jedi_lfric_io_setup_mod.F90 index 44784aa3f..a1b549d05 100644 --- a/interfaces/jedi_lfric_interface/source/io/jedi_lfric_io_setup_mod.F90 +++ b/interfaces/jedi_lfric_interface/source/io/jedi_lfric_io_setup_mod.F90 @@ -8,7 +8,8 @@ module jedi_lfric_io_setup_mod use calendar_mod, only: calendar_type - use constants_mod, only: i_def + use config_mod, only: config_type + use constants_mod, only: i_def, r_def use driver_fem_mod, only: init_fem, final_fem use empty_io_context_mod, only: empty_io_context_type use event_actor_mod, only: event_actor_type @@ -42,18 +43,21 @@ module jedi_lfric_io_setup_mod !> @brief Initialise the XIOS context and IO !> + !> @param [in] config Application configuration object !> @param [in] context_name The name of the context !> @param [in] mpi The mpi communicator !> @param [in] file_meta The file meta data !> @param [in] mesh_name The name of the mesh !> @param [in] calendar The model calendar - !> @param [inout] io_context The LFRic context object + !> @param [inout] io_context The LFRic context object !> @param [inout] model_clock The model clock - subroutine initialise_io( context_name, mpi, file_meta, mesh_name, & - calendar, io_context, model_clock ) + subroutine initialise_io( config, context_name, mpi, file_meta, & + mesh_name, calendar, io_context, model_clock ) implicit none + type(config_type), intent(in) :: config + character(len=*), intent(in) :: context_name class(lfric_mpi_type), intent(in) :: mpi type(jedi_lfric_file_meta_type), intent(in) :: file_meta(:) @@ -73,7 +77,7 @@ subroutine initialise_io( context_name, mpi, file_meta, mesh_name, & nullify(mesh, chi, panel_id) ! Create FEM specifics (function spaces and chi field) - call init_fem( mesh_collection, chi_inventory, panel_id_inventory ) + call init_fem( config, chi_inventory, panel_id_inventory ) ! Get coordinate fields for prime mesh mesh => mesh_collection%get_mesh( mesh_name ) @@ -82,8 +86,9 @@ subroutine initialise_io( context_name, mpi, file_meta, mesh_name, & ! Initialise I/O context and setup file to use lfric_comm = mpi%get_comm() - call init_io( context_name, lfric_comm%get_comm_mpi_val(), file_meta, & - calendar, io_context, chi, panel_id, model_clock ) + call init_io( config, context_name, lfric_comm%get_comm_mpi_val(), & + file_meta, calendar, io_context, chi, panel_id, & + model_clock ) ! Do initial step if ( model_clock%is_initialisation() ) then @@ -103,6 +108,7 @@ end subroutine initialise_io !> @brief Initialises the model I/O and context !> + !> @param[in] config Application configuration object !> @param[in] context_name A string identifier for the context !> @param[in] communicator The ID for the model MPI communicator !> @param[in] file_meta The file meta data @@ -113,7 +119,8 @@ end subroutine initialise_io !> @param[in] model_clock The model clock !> @param[in] before_close Optional routine to be called before !> context closes - subroutine init_io( context_name, & + subroutine init_io( config, & + context_name, & communicator, & file_meta, & calendar, & @@ -125,6 +132,8 @@ subroutine init_io( context_name, & implicit none + type(config_type), intent(in) :: config + character(*), intent(in) :: context_name integer(i_def), intent(in) :: communicator type(jedi_lfric_file_meta_type), intent(in) :: file_meta(:) @@ -144,6 +153,16 @@ subroutine init_io( context_name, & procedure(event_action), pointer :: context_advance type(lfric_comm_type) :: lfric_comm + integer(i_def) :: geometry + integer(i_def) :: topology + integer(i_def) :: coord_system + real(r_def) :: scaled_radius + + geometry = config%base_mesh%geometry() + topology = config%base_mesh%topology() + coord_system = config%finite_element%coord_system() + scaled_radius = config%planet%scaled_radius() + ! Allocate XIOS IO context types if (present(before_close)) then before_close_ptr => before_close @@ -169,7 +188,9 @@ subroutine init_io( context_name, & call io_context%initialise_xios_context( lfric_comm, & chi, panel_id, & model_clock, calendar, & - before_close_ptr ) + before_close_ptr, & + geometry, topology, & + coord_system, scaled_radius ) ! Attach context advancement to the model's clock context_advance => advance event_actor_ptr => io_context diff --git a/interfaces/jedi_lfric_interface/source/mesh/jedi_lfric_mesh_setup_mod.F90 b/interfaces/jedi_lfric_interface/source/mesh/jedi_lfric_mesh_setup_mod.F90 index 9823c30c5..f37a6576f 100644 --- a/interfaces/jedi_lfric_interface/source/mesh/jedi_lfric_mesh_setup_mod.F90 +++ b/interfaces/jedi_lfric_interface/source/mesh/jedi_lfric_mesh_setup_mod.F90 @@ -35,7 +35,7 @@ module jedi_lfric_mesh_setup_mod !> @brief Initialise the mesh and store it in the global mesh collection !> !> @param [out] mesh_name The name of the mesh being setup - !> @param [in] config The geometry configuration + !> @param [in] config Application configuration object !> @param [inout] mpi_obj The mpi communicator !> @param [in] alt_mesh_name The name of an alternative mesh_name to setup subroutine initialise_mesh( mesh_name, config, mpi_obj, alt_mesh_name ) @@ -43,7 +43,7 @@ subroutine initialise_mesh( mesh_name, config, mpi_obj, alt_mesh_name ) implicit none character(len=*), intent(out) :: mesh_name - type(config_type), intent(in) :: config + type(config_type), intent(in) :: config !> @todo: This should be intent in but when calling the method I get !> a compiler failure class(lfric_mpi_type), intent(inout) :: mpi_obj @@ -53,6 +53,10 @@ subroutine initialise_mesh( mesh_name, config, mpi_obj, alt_mesh_name ) class(extrusion_type), allocatable :: extrusion type(uniform_extrusion_type), allocatable :: extrusion_2d + integer(i_def), allocatable :: tile_size(:,:) + integer(i_def) :: tile_size_x + integer(i_def) :: tile_size_y + character(str_def), allocatable :: twod_names(:) character(str_def) :: base_mesh_names(1) character(str_def) :: prime_mesh_name @@ -65,7 +69,9 @@ subroutine initialise_mesh( mesh_name, config, mpi_obj, alt_mesh_name ) real(r_def) :: domain_bottom real(r_def) :: domain_height real(r_def) :: scaled_radius - logical(l_def) :: apply_partition_check + + logical(l_def) :: inner_halo_tiles + logical(l_def) :: check_partitions !-------------------------------------- ! 0.0 Extract namelist variables @@ -77,6 +83,10 @@ subroutine initialise_mesh( mesh_name, config, mpi_obj, alt_mesh_name ) number_of_layers = config%extrusion%number_of_layers() scaled_radius = config%planet%scaled_radius() + tile_size_x = 1 + tile_size_y = 1 + inner_halo_tiles = .false. + !-------------------------------------- ! 1.0 Create the meshes !-------------------------------------- @@ -120,20 +130,26 @@ subroutine initialise_mesh( mesh_name, config, mpi_obj, alt_mesh_name ) base_mesh_names, & config ) - apply_partition_check = .false. - call init_mesh( config, & - mpi_obj%get_comm_rank(), & - mpi_obj%get_comm_size(), & - base_mesh_names, & - extrusion, & - stencil_depths, & - apply_partition_check ) + if (allocated(tile_size)) deallocate(tile_size) + allocate(tile_size(2, size(base_mesh_names))) + tile_size(1,:) = tile_size_x + tile_size(2,:) = tile_size_y + check_partitions = .false. + + call init_mesh( config, & + mpi_obj%get_comm_rank(), & + mpi_obj%get_comm_size(), & + base_mesh_names, extrusion, & + inner_halo_tiles, tile_size, & + stencil_depths, check_partitions ) allocate( twod_names, source=base_mesh_names ) do i=1, size(twod_names) twod_names(i) = trim(twod_names(i))//'_2d' end do + call create_mesh( base_mesh_names, extrusion_2d, & + inner_halo_tiles, tile_size, & alt_name=twod_names ) call assign_mesh_maps(twod_names) diff --git a/interfaces/jules_interface/source/algorithm/jules_exp_alg_mod.x90 b/interfaces/jules_interface/source/algorithm/jules_exp_alg_mod.x90 index 971658188..4fa685679 100644 --- a/interfaces/jules_interface/source/algorithm/jules_exp_alg_mod.x90 +++ b/interfaces/jules_interface/source/algorithm/jules_exp_alg_mod.x90 @@ -37,6 +37,11 @@ module jules_exp_alg_mod use jules_exp_diags_mod, only: initialise_diags_for_jules_exp, & output_diags_for_jules_exp + ! Configuration modules + use base_mesh_config_mod, only: geometry + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -367,8 +372,12 @@ contains mesh => theta%get_mesh() - height_wth => get_height_fv( Wtheta, mesh%get_id() ) - height_w3 => get_height_fv( W3, mesh%get_id() ) + height_wth => get_height_fv( Wtheta, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) + height_w3 => get_height_fv( W3, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) call initialise_diags_for_jules_exp(z0h_eff, gross_prim_prod, & soil_respiration) diff --git a/interfaces/jules_interface/source/algorithm/jules_imp_alg_mod.x90 b/interfaces/jules_interface/source/algorithm/jules_imp_alg_mod.x90 index 355b37f74..c4a5181bb 100644 --- a/interfaces/jules_interface/source/algorithm/jules_imp_alg_mod.x90 +++ b/interfaces/jules_interface/source/algorithm/jules_imp_alg_mod.x90 @@ -27,6 +27,13 @@ module jules_imp_alg_mod use log_mod, only: log_event, LOG_LEVEL_DEBUG use mesh_mod, only: mesh_type + ! Configuration modules + use base_mesh_config_mod, only: geometry, topology, f_lat + use finite_element_config_mod, only: element_order_h, element_order_v, & + coord_system + use idealised_config_mod, only: f_lon + use planet_config_mod, only: scaled_radius + implicit none private @@ -233,10 +240,16 @@ contains call snow_fields%get_field('snow_depth', snow_depth) mesh => exner_in_wth%get_mesh() - height_wth => get_height_fv(Wtheta, mesh%get_id()) + height_wth => get_height_fv( Wtheta, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) mesh => ustar%get_mesh() - latitude => get_latitude_fv(W3, mesh%get_id()) + latitude => get_latitude_fv( W3, mesh%get_id(), & + geometry, topology, & + element_order_h, element_order_v, & + coord_system, f_lat, f_lon, & + scaled_radius ) if ( loop == 1 ) then diff --git a/interfaces/jules_interface/source/algorithm/lake_water_correction_alg_mod.x90 b/interfaces/jules_interface/source/algorithm/lake_water_correction_alg_mod.x90 index cde86502d..0b6cf54e1 100644 --- a/interfaces/jules_interface/source/algorithm/lake_water_correction_alg_mod.x90 +++ b/interfaces/jules_interface/source/algorithm/lake_water_correction_alg_mod.x90 @@ -11,9 +11,13 @@ module lake_water_correction_alg_mod use constants_mod, only: l_def, r_def use field_mod, only: field_type, field_proxy_type use mesh_mod, only: mesh_type - use surface_config_mod, only: check_soilm_negatives use initialise_diagnostics_mod, only: init_diag => init_diagnostic_field + ! Configuration modules + use base_mesh_config_mod, only: geometry + use extrusion_config_mod, only: planet_radius, domain_height + use surface_config_mod, only: check_soilm_negatives + implicit none private @@ -114,7 +118,8 @@ contains mesh => lake_evap%get_mesh() ! Calculate the grid cell areas (cell_area) - cell_area => get_dA_msl_proj( mesh%get_id() ) + cell_area => get_dA_msl_proj( mesh%get_id(), geometry, & + planet_radius, domain_height ) ! Multiply by the grid box areas call invoke(X_times_Y(evap_whole_grid_cell,lake_evap, cell_area), & diff --git a/interfaces/jules_interface/source/algorithm/process_inputs_alg_mod.x90 b/interfaces/jules_interface/source/algorithm/process_inputs_alg_mod.x90 index ba41c70e5..b21a9e578 100644 --- a/interfaces/jules_interface/source/algorithm/process_inputs_alg_mod.x90 +++ b/interfaces/jules_interface/source/algorithm/process_inputs_alg_mod.x90 @@ -45,6 +45,13 @@ module process_inputs_alg_mod use log_mod, only : log_event, log_scratch_space, & LOG_LEVEL_ERROR + ! Configuration modules + use base_mesh_config_mod, only: geometry, topology, f_lat + use finite_element_config_mod, only: element_order_h, element_order_v, & + coord_system + use idealised_config_mod, only: f_lon + use planet_config_mod, only: scaled_radius + implicit none private @@ -226,7 +233,11 @@ contains end if twod_mesh => sea_ice_thickness%get_mesh() - latitude => get_latitude_fv( W3, twod_mesh%get_id() ) + latitude => get_latitude_fv( W3, twod_mesh%get_id(), & + geometry, topology, & + element_order_h, element_order_v, & + coord_system, f_lat, f_lon, & + scaled_radius ) ! Surface fields if (init_option == init_option_fd_start_dump) then @@ -246,14 +257,14 @@ contains call invoke(process_ssi_kernel_type( sea_ice_fraction, & sea_ice_thickness, & tile_fraction, latitude, & - amip_ice_thick, l_couple_sea_ice), & + amip_ice_thick, l_couple_sea_ice), & multi_insert_kernel_type(tile_temperature, tstar_sea, & first_sea_tile, n_sea_tile )) ! In a coupled model with inland lakes we need to initialise the sea-ice ! conductivity. This will be overwritten by values from SI3 except at ! lake points. - if ((sea_ice_source == sea_ice_source_surf ) .and. & + if ((sea_ice_source == sea_ice_source_surf ) .and. & (l_couple_sea_ice)) then call surface_fields%get_field('sea_ice_conductivity', & sea_ice_conductivity) diff --git a/interfaces/jules_interface/source/algorithm/rad_tile_alg_mod.x90 b/interfaces/jules_interface/source/algorithm/rad_tile_alg_mod.x90 index 7e6731b4c..c73930266 100644 --- a/interfaces/jules_interface/source/algorithm/rad_tile_alg_mod.x90 +++ b/interfaces/jules_interface/source/algorithm/rad_tile_alg_mod.x90 @@ -42,6 +42,11 @@ use socrates_init_mod, only: wavelength_short, wavelength_long, & use sw_rad_tile_kernel_mod, only: sw_rad_tile_kernel_type use lw_rad_tile_kernel_mod, only: lw_rad_tile_kernel_type +! Configuration modules +use base_mesh_config_mod, only: geometry +use finite_element_config_mod, only: coord_system +use planet_config_mod, only: scaled_radius + implicit none private @@ -221,7 +226,9 @@ subroutine rad_tile_alg(tile_sw_direct_albedo, tile_sw_diffuse_albedo, & call derived_fields%get_field('u_in_w3', u_in_w3) call derived_fields%get_field('v_in_w3', v_in_w3) - dz_wth => get_dz_at_wtheta(u_in_w3%get_mesh_id()) + dz_wth => get_dz_at_wtheta( u_in_w3%get_mesh_id(), & + geometry, coord_system, & + scaled_radius ) ! SW albedos only required on radiation timesteps if (radiation == radiation_socrates .and. & diff --git a/interfaces/jules_interface/source/algorithm/update_ancils_alg_mod.x90 b/interfaces/jules_interface/source/algorithm/update_ancils_alg_mod.x90 index 3f6a3b7bf..20fce5b65 100644 --- a/interfaces/jules_interface/source/algorithm/update_ancils_alg_mod.x90 +++ b/interfaces/jules_interface/source/algorithm/update_ancils_alg_mod.x90 @@ -25,6 +25,13 @@ module update_ancils_alg_mod use jules_sea_seaice_config_mod, only: amip_ice_thick use derived_config_mod, only: l_couple_sea_ice, l_couple_ocean + ! Configuration modules + use base_mesh_config_mod, only: geometry, topology, f_lat + use finite_element_config_mod, only: element_order_h, element_order_v, & + coord_system + use idealised_config_mod, only: f_lon + use planet_config_mod, only: scaled_radius + implicit none private @@ -77,7 +84,11 @@ contains end if twod_mesh => sea_ice_thickness%get_mesh() - latitude => get_latitude_fv( W3, twod_mesh%get_id() ) + latitude => get_latitude_fv( W3, twod_mesh%get_id(), & + geometry, topology, & + element_order_h, element_order_v, & + coord_system, f_lat, f_lon, & + scaled_radius ) ! Start at the head of the time_axis linked list loop => time_axis_list%get_head() diff --git a/interfaces/physics_schemes_interface/source/algorithm/aerosol_ukca_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/aerosol_ukca_alg_mod.x90 index 4a50a0f80..b87e2b97d 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/aerosol_ukca_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/aerosol_ukca_alg_mod.x90 @@ -10,6 +10,14 @@ module aerosol_ukca_alg_mod use mesh_mod, only: mesh_type use model_clock_mod, only: model_clock_type + ! Configuration modules + use base_mesh_config_mod, only: geometry, topology, f_lat + use extrusion_config_mod, only: planet_radius, domain_height + use finite_element_config_mod, only: element_order_h, element_order_v, & + coord_system + use idealised_config_mod, only: f_lon + use planet_config_mod, only: scaled_radius + implicit none private @@ -117,7 +125,6 @@ contains use um_sizes_init_mod, only: um_sizes_init use um_ukca_init_mod, only: n_phot_spc, ratj_varnames use ukca_photol_param_mod, only: jppj, jrate_fac, jp_names - use pseudo_photol_kernel_mod, only: pseudo_photol_kernel_type use map_pseudophotol_kernel_mod, only: map_pseudophotol_kernel_type use calc_albedo_kernel_mod, only: calc_albedo_kernel_type @@ -970,15 +977,29 @@ contains ! Get location, level heights, cell area and volume data mesh => sin_stellar_declination_rts%get_mesh() ! 2-D mesh - latitude_w3 => get_latitude_fv(W3, mesh%get_id()) - longitude_w3 => get_longitude_fv(W3, mesh%get_id()) - cell_area => get_da_msl_proj(mesh%get_id()) + latitude_w3 => get_latitude_fv( W3, mesh%get_id(), & + geometry, topology, & + element_order_h, element_order_v, & + coord_system, f_lat, f_lon, & + scaled_radius) - mesh => state(igh_t)%get_mesh() ! 3-D mesh - height_wth => get_height_fv( Wtheta, mesh%get_id() ) - height_w3 => get_height_fv( W3, mesh%get_id() ) - rdz_w3 => get_rdz_w3( mesh%get_id() ) + longitude_w3 => get_longitude_fv( W3, mesh%get_id(), & + geometry, topology, & + element_order_h, element_order_v, & + coord_system, f_lat, f_lon, & + scaled_radius ) + cell_area => get_da_msl_proj( mesh%get_id(), geometry, & + planet_radius, domain_height ) + + mesh => state(igh_t)%get_mesh() ! 3-D mesh + height_wth => get_height_fv( Wtheta, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) + height_w3 => get_height_fv( W3, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) + rdz_w3 => get_rdz_w3( mesh%get_id() ) ! Get detj on shifted W3 grid (to use as grid_volume) shifted_mesh => mesh_collection%get_mesh(mesh, SHIFTED) diff --git a/interfaces/physics_schemes_interface/source/algorithm/bl_exp_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/bl_exp_alg_mod.x90 index c1f05d8eb..441550b57 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/bl_exp_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/bl_exp_alg_mod.x90 @@ -39,6 +39,11 @@ module bl_exp_alg_mod use bl_exp_diags_mod, only: initialise_diags_for_bl_exp, & output_diags_for_bl_exp + ! Configuration modules + use base_mesh_config_mod, only: geometry + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -316,8 +321,13 @@ contains mesh => theta%get_mesh() - height_wth => get_height_fv( Wtheta, mesh%get_id() ) - height_w3 => get_height_fv( W3, mesh%get_id() ) + height_wth => get_height_fv( Wtheta, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) + height_w3 => get_height_fv( W3, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) + ! delta is calculated in sci_calc_delta_at_wtheta_kernel_mod.F90 ! in lfric core as the mininum of the cell horizontal edge lengths delta => get_delta_at_wtheta( mesh%get_id() ) @@ -327,7 +337,8 @@ contains rdz_w3 => get_rdz_w3( mesh%get_id() ) dtrdz_wth => get_dtrdz_wth( mesh%get_id(), model_clock ) w2_rmultiplicity => get_rmultiplicity_fv( W2, mesh%get_id() ) - dz_wth => get_dz_at_wtheta( mesh%get_id() ) + dz_wth => get_dz_at_wtheta( mesh%get_id(), geometry, & + coord_system, scaled_radius ) ! Initialise diagnostics call initialise_diags_for_bl_exp(zht, oblen) diff --git a/interfaces/physics_schemes_interface/source/algorithm/bl_imp_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/bl_imp_alg_mod.x90 index 541d574c1..31b2806f9 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/bl_imp_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/bl_imp_alg_mod.x90 @@ -40,6 +40,11 @@ module bl_imp_alg_mod blpert_type_theta_star, & blpert_type_theta_and_moist + ! Configuration modules + use base_mesh_config_mod, only: geometry + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -278,10 +283,20 @@ contains call surface_fields%get_field('tauy_ssi', tauy_ssi) mesh => theta%get_mesh() - height_wth => get_height_fv(Wtheta, mesh%get_id()) - height_w1 => get_height_fv(W1, mesh%get_id()) - height_w2 => get_height_fv(W2, mesh%get_id()) - height_w3 => get_height_fv(W3, mesh%get_id()) + + height_wth => get_height_fv( Wtheta, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) + height_w1 => get_height_fv( W1, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) + height_w2 => get_height_fv( W2, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) + height_w3 => get_height_fv( W3, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) + dA => get_da_at_w2(mesh%get_id()) rdz => get_rdz_fd1(mesh%get_id()) dtrdz => get_dtrdz_fd2(mesh%get_id(), model_clock) diff --git a/interfaces/physics_schemes_interface/source/algorithm/blpert_main_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/blpert_main_alg_mod.x90 index ca8c73bad..562f2cf82 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/blpert_main_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/blpert_main_alg_mod.x90 @@ -15,6 +15,11 @@ module blpert_main_alg_mod use clock_mod, only: clock_type use timing_mod, only: start_timing, stop_timing, tik, LPROF + ! Configuration modules + use base_mesh_config_mod, only: geometry + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -135,7 +140,9 @@ contains mesh => dtheta_blpert % get_mesh() twod_mesh => mesh_collection % get_mesh(mesh, TWOD) vector_space => function_space_collection % get_fs(twod_mesh, 0, 0, W3) - height_wth => get_height_fv(Wtheta, mesh % get_id()) + height_wth => get_height_fv( Wtheta, mesh % get_id(), & + geometry, coord_system, & + scaled_radius ) coarse_mesh => mesh_collection % get_mesh(blpert_mesh_name) coarse_twod_mesh => mesh_collection % get_mesh(coarse_mesh, TWOD) diff --git a/interfaces/physics_schemes_interface/source/algorithm/casim_activate_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/casim_activate_alg_mod.x90 index df825a839..55bac5268 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/casim_activate_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/casim_activate_alg_mod.x90 @@ -22,6 +22,11 @@ module casim_activate_alg_mod use microphysics_config_mod, only: casim_cdnc_opt, & casim_cdnc_opt_fixed + ! Configuration modules + use base_mesh_config_mod, only: geometry + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -80,7 +85,9 @@ contains call microphysics_fields%get_field('nl_mphys', nl_mphys) mesh => cf_liq%get_mesh() - height_wth => get_height_fv(Wtheta, mesh%get_id()) + height_wth => get_height_fv( Wtheta, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) call invoke( casim_activate_kernel_type( mr(imr_cl), & cf_liq, & diff --git a/interfaces/physics_schemes_interface/source/algorithm/casim_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/casim_alg_mod.x90 index 056661535..624df8067 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/casim_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/casim_alg_mod.x90 @@ -17,9 +17,13 @@ module casim_alg_mod use fs_continuity_mod, only: W3, Wtheta use mesh_mod, only: mesh_type - use casim_diagnostics_mod, only: initialise_diags_for_casim, & + use casim_diagnostics_mod, only: initialise_diags_for_casim, & output_diags_for_casim + ! Configuration modules + use base_mesh_config_mod, only: geometry + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius implicit none @@ -167,8 +171,12 @@ contains call turbulence_fields%get_field('wvar', wvar) - height_w3 => get_height_fv(W3, mesh_id) - height_wth => get_height_fv(Wtheta, mesh_id) + height_w3 => get_height_fv( W3, mesh_id, & + geometry, coord_system, & + scaled_radius) + height_wth => get_height_fv( Wtheta, mesh_id, & + geometry, coord_system, & + scaled_radius ) call initialise_diags_for_casim( refl_tot, refl_1km, superc_liq, & superc_rain, ls_graup_3d ) @@ -193,7 +201,9 @@ contains superc_liq, superc_rain ) ) if (turb_gen_mixph) then - dz_in_wth => get_dz_at_wtheta( mesh_id ) + dz_in_wth => get_dz_at_wtheta( mesh_id, geometry, & + coord_system, scaled_radius ) + ! Switch UM to running i-first on whole domain ncells = mesh%get_last_edge_cell() call um_sizes_init(ncells) diff --git a/interfaces/physics_schemes_interface/source/algorithm/cld_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/cld_alg_mod.x90 index 07bb7b030..9994b2808 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/cld_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/cld_alg_mod.x90 @@ -36,6 +36,11 @@ module cld_alg_mod output_diags_for_cld use um_sizes_init_mod, only: um_sizes_init + ! Configuration modules + use base_mesh_config_mod, only: geometry + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -134,7 +139,9 @@ contains call log_event( 'End-of-timestep cloud update', LOG_LEVEL_DEBUG ) mesh => theta%get_mesh() - height_wth => get_height_fv(Wtheta, mesh%get_id()) + height_wth => get_height_fv( Wtheta, mesh%get_id(), & + geometry, coord_system, & + scaled_radius) ! Map updated pressure into wtheta space call derived_fields%get_field('exner_in_wth', exner_wth) diff --git a/interfaces/physics_schemes_interface/source/algorithm/conv_comorph_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/conv_comorph_alg_mod.x90 index d61b1d7d0..2cf7b04fa 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/conv_comorph_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/conv_comorph_alg_mod.x90 @@ -29,6 +29,11 @@ module conv_comorph_alg_mod use map_fd_to_prognostics_alg_mod, only: set_wind use physics_mappings_alg_mod, only: map_physics_winds + ! Configuration modules + use base_mesh_config_mod, only: geometry + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -459,8 +464,12 @@ contains call microphysics_fields%get_field('ls_rain', ls_rain) call microphysics_fields%get_field('ls_snow', ls_snow) - height_wth => get_height_fv(Wtheta, mesh%get_id()) - height_w3 => get_height_fv(W3, mesh%get_id()) + height_wth => get_height_fv( Wtheta, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) + height_w3 => get_height_fv( W3, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) ! Initialise the convection diagnostics call initialise_diags_for_comorph(lowest_cv_base, & diff --git a/interfaces/physics_schemes_interface/source/algorithm/conv_gr_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/conv_gr_alg_mod.x90 index 8692b476a..61ad7a1fd 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/conv_gr_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/conv_gr_alg_mod.x90 @@ -30,6 +30,11 @@ module conv_gr_alg_mod use map_fd_to_prognostics_alg_mod, only: set_wind use physics_mappings_alg_mod, only: map_physics_winds + ! Configuration modules + use base_mesh_config_mod, only: geometry + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -455,8 +460,12 @@ contains call microphysics_fields%get_field('tnuc', tnuc) call microphysics_fields%get_field('tnuc_nlcl', tnuc_nlcl) - height_wth => get_height_fv(Wtheta, mesh%get_id()) - height_w3 => get_height_fv(W3, mesh%get_id()) + height_wth => get_height_fv( Wtheta, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) + height_w3 => get_height_fv( W3, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) delta => get_delta_at_wtheta(mesh%get_id()) ! Initialise the convection diagnostics diff --git a/interfaces/physics_schemes_interface/source/algorithm/electric_main_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/electric_main_alg_mod.x90 index 5a3dac459..c3cd67824 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/electric_main_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/electric_main_alg_mod.x90 @@ -19,6 +19,11 @@ module electric_main_alg_mod use electric_main_diags_mod, only: initialise_main_diags_for_electric, & output_main_diags_for_electric + ! Configuration modules + use base_mesh_config_mod, only: geometry + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -89,7 +94,8 @@ contains call invoke( setval_c(rhodz_dry, 0.0_r_def), & setval_c(t_local, 0.0_r_def)) - dz_in_wth => get_dz_at_wtheta( mesh%get_id() ) + dz_in_wth => get_dz_at_wtheta( mesh%get_id(), geometry, & + coord_system, scaled_radius ) call electric_fields%get_field('flash_potential', flash_potential) call flash_potential%copy_field_properties(num_flashes_2d) diff --git a/interfaces/physics_schemes_interface/source/algorithm/freeze_lev_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/freeze_lev_alg_mod.x90 index a5c03d68e..ac2c98971 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/freeze_lev_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/freeze_lev_alg_mod.x90 @@ -15,6 +15,11 @@ module freeze_lev_alg_mod use sci_geometric_constants_mod, only: get_height_fv use fs_continuity_mod, only: Wtheta + ! Configuration modules + use base_mesh_config_mod, only: geometry + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -46,7 +51,8 @@ contains if (init_diag(freeze_lev, 'processed__freeze_lev') .and. use_xios_io) then - height_wth => get_height_fv(Wtheta, theta%get_mesh_id()) + height_wth => get_height_fv( Wtheta, theta%get_mesh_id(), & + geometry, coord_system, scaled_radius ) call invoke( freeze_lev_kernel_type(theta, mr(imr_v), & moist_dyn(total_mass), exner_wth, & diff --git a/interfaces/physics_schemes_interface/source/algorithm/fsd_condensate_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/fsd_condensate_alg_mod.x90 index 4f2de9e2b..655e85ae2 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/fsd_condensate_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/fsd_condensate_alg_mod.x90 @@ -14,11 +14,16 @@ module fsd_condensate_alg_mod use mesh_mod, only: mesh_type use sci_geometric_constants_mod, only: get_delta_at_wtheta, get_dz_at_wtheta - implicit none + ! Configuration modules + use base_mesh_config_mod, only: geometry + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius - private + implicit none - public fsd_condensate_alg + private + + public fsd_condensate_alg contains !>@brief Calculate fractional standard deviation (FSD) condensate @@ -65,7 +70,8 @@ contains mesh => area_fraction%get_mesh() delta => get_delta_at_wtheta(mesh%get_id()) - dz_wth => get_dz_at_wtheta(mesh%get_id()) + dz_wth => get_dz_at_wtheta( mesh%get_id(), geometry, & + coord_system, scaled_radius ) call invoke ( fsd_condensate_kernel_type ( sigma_ml, & ! fsd of condensate f_arr, & ! fsd parameters diff --git a/interfaces/physics_schemes_interface/source/algorithm/iau/dry_rho_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/iau/dry_rho_alg_mod.x90 index 576a82095..2d4500006 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/iau/dry_rho_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/iau/dry_rho_alg_mod.x90 @@ -10,11 +10,16 @@ module dry_rho_alg_mod use constants_mod, only: r_def, i_def - use extrusion_config_mod, only: planet_radius use field_mod, only: field_type use fs_continuity_mod, only: W3 use sci_geometric_constants_mod, only: get_height_fv + ! Configuration modules + use base_mesh_config_mod, only: geometry + use extrusion_config_mod, only: planet_radius + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none public :: dry_rho @@ -43,7 +48,10 @@ contains integer( kind=i_def ) :: mesh_id mesh_id = rho%get_mesh_id() - height_w3 => get_height_fv( W3, mesh_id ) + height_w3 => get_height_fv( W3, mesh_id, & + geometry, coord_system, & + scaled_radius ) + call rho_r2_tot_inc % copy_field_properties( wetrho_inc ) call rho % copy_field_properties( rho_inc ) call height_w3 % copy_field_properties( radius_w3 ) diff --git a/interfaces/physics_schemes_interface/source/algorithm/locate_tropopause_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/locate_tropopause_alg_mod.x90 index 56b535f63..b31cbdbb9 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/locate_tropopause_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/locate_tropopause_alg_mod.x90 @@ -21,6 +21,11 @@ use sci_geometric_constants_mod, only: get_height_fv use locate_tropopause_kernel_mod, only: locate_tropopause_kernel_type use timing_mod, only: start_timing, stop_timing, tik, LPROF +! Configuration modules +use base_mesh_config_mod, only: geometry +use finite_element_config_mod, only: coord_system +use planet_config_mod, only: scaled_radius + implicit none private public :: locate_tropopause_alg @@ -48,7 +53,9 @@ subroutine locate_tropopause_alg(trop_level, theta, exner_in_wth, twod_mesh) if ( LPROF ) call start_timing( id_alg, 'locate_tropopause' ) - height_wth => get_height_fv(Wtheta, theta%get_mesh_id()) + height_wth => get_height_fv( Wtheta, theta%get_mesh_id(), & + geometry, coord_system, & + scaled_radius ) vector_space=>function_space_collection%get_fs(twod_mesh, 0, 0, W3) call trop_level%initialise(vector_space) diff --git a/interfaces/physics_schemes_interface/source/algorithm/mphys_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/mphys_alg_mod.x90 index af353f280..fe1fea455 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/mphys_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/mphys_alg_mod.x90 @@ -21,6 +21,11 @@ module mphys_alg_mod use sci_geometric_constants_mod, only: get_height_fv, get_dz_at_wtheta use fs_continuity_mod, only: W3, Wtheta + ! Configuration modules + use base_mesh_config_mod, only: geometry + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -146,8 +151,12 @@ contains mesh => theta%get_mesh() - height_wth => get_height_fv( Wtheta, mesh%get_id() ) - height_w3 => get_height_fv( W3, mesh%get_id() ) + height_wth => get_height_fv( Wtheta, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) + height_w3 => get_height_fv( W3, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) call theta%copy_field_properties(dcfl_mphys) call theta%copy_field_properties(dcff_mphys) @@ -241,7 +250,8 @@ contains refl_tot, refl_1km ) ) if (turb_gen_mixph) then - dz_in_wth => get_dz_at_wtheta( mesh%get_id() ) + dz_in_wth => get_dz_at_wtheta( mesh%get_id(), geometry, & + coord_system, scaled_radius ) call invoke( mphys_turb_gen_kernel_type(theta, mr_n(imr_v), mr_n(imr_cl),& mr_n(imr_ci), mr_n(imr_s), & ns_mphys, ni_mphys, & diff --git a/interfaces/physics_schemes_interface/source/algorithm/murk_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/murk_alg_mod.x90 index 9602255cb..9722ec122 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/murk_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/murk_alg_mod.x90 @@ -19,6 +19,11 @@ module murk_alg_mod use mesh_mod, only: mesh_type use um_sizes_init_mod, only: um_sizes_init + ! Configuration modules + use base_mesh_config_mod, only: geometry + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -83,8 +88,12 @@ contains call turbulence_fields%get_field('ent_zrzi_dsc', ent_zrzi_dsc) mesh => murk%get_mesh() - height_wth => get_height_fv( Wtheta, mesh%get_id() ) - height_w3 => get_height_fv( W3, mesh%get_id() ) + height_wth => get_height_fv( Wtheta, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) + height_w3 => get_height_fv( W3, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) rdz_w3 => get_rdz_w3( mesh%get_id() ) ! Call emission routine to add source to murk field diff --git a/interfaces/physics_schemes_interface/source/algorithm/orographic_drag_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/orographic_drag_alg_mod.x90 index ac7b24810..8f7528666 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/orographic_drag_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/orographic_drag_alg_mod.x90 @@ -26,6 +26,11 @@ module orographic_drag_alg_mod use orographic_drag_diags_mod, only: initialise_diags_for_orographic_drag, & output_diags_for_orographic_drag + ! Configuration modules + use base_mesh_config_mod, only: geometry + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -102,8 +107,12 @@ contains mesh => theta%get_mesh() - height_wth => get_height_fv(Wtheta, mesh%get_id()) - height_w3 => get_height_fv(W3, mesh%get_id()) + height_wth => get_height_fv( Wtheta, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) + height_w3 => get_height_fv( W3, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) ! Unpack fields call derived_fields%get_field('u_in_w3', u_in_w3) diff --git a/interfaces/physics_schemes_interface/source/algorithm/pc2_initiation_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/pc2_initiation_alg_mod.x90 index 762245e56..9d21ca8d0 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/pc2_initiation_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/pc2_initiation_alg_mod.x90 @@ -18,6 +18,11 @@ module pc2_initiation_alg_mod use um_sizes_init_mod, only: um_sizes_init use io_config_mod, only: write_diag, use_xios_io + ! Configuration modules + use base_mesh_config_mod, only: geometry + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -145,7 +150,9 @@ contains call turbulence_fields%get_field('bl_type_ind', bl_type_ind) mesh => theta%get_mesh() - height_wth => get_height_fv(Wtheta, mesh%get_id()) + height_wth => get_height_fv( Wtheta, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) call theta%copy_field_properties(dmv_pc2_inc) call theta%copy_field_properties(dmcl_pc2_inc) diff --git a/interfaces/physics_schemes_interface/source/algorithm/pmsl_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/pmsl_alg_mod.x90 index 5a466f4c7..4e05d9069 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/pmsl_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/pmsl_alg_mod.x90 @@ -26,6 +26,11 @@ module pmsl_alg_mod use um_domain_init_mod, only: n_iter_pmsl use physics_config_mod, only: pmsl_halo_calcs + ! Configuration modules + use base_mesh_config_mod, only: geometry + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -98,8 +103,12 @@ contains ! Unpack fields call derived_fields%get_field('exner_in_wth', exner_wth) - height_w3 => get_height_fv(W3, exner_w3%get_mesh_id()) - height_wth => get_height_fv(Wtheta, theta_wth%get_mesh_id()) + height_w3 => get_height_fv( W3, exner_w3%get_mesh_id(), & + geometry, coord_system, & + scaled_radius ) + height_wth => get_height_fv( Wtheta, theta_wth%get_mesh_id(), & + geometry, coord_system, & + scaled_radius ) ! Find level above boundary layer to use in PMSL calculation ! domain_height is the top model height and is the same everywhere diff --git a/interfaces/physics_schemes_interface/source/algorithm/pres_lev_diags_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/pres_lev_diags_alg_mod.x90 index 0907509b0..430eb0a85 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/pres_lev_diags_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/pres_lev_diags_alg_mod.x90 @@ -20,9 +20,14 @@ module pres_lev_diags_alg_mod use fs_continuity_mod, only: W3, WTheta use mr_indices_mod, only: nummr, imr_v use moist_dyn_mod, only: num_moist_factors, total_mass - use planet_config_mod, only: p_zero, kappa, gravity, cp use planet_constants_mod, only: ex_power + ! Configuration modules + use base_mesh_config_mod, only: geometry + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius, p_zero, kappa, & + gravity, cp + implicit none private @@ -90,7 +95,8 @@ contains allocate(plevs(nplev)) plevs = get_axis_values('pressure_levels',nplev) call derived_fields%get_field('exner_in_wth', exner_wth) - height_wth => get_height_fv(WTheta, exner_w3%get_mesh_id()) + height_wth => get_height_fv( WTheta, exner_w3%get_mesh_id(), & + geometry, coord_system, scaled_radius ) ! Heaviside function plev_heaviside_flag = init_diag(plev_heaviside, 'plev__heaviside') @@ -261,7 +267,9 @@ contains plev_geopot_flag = init_diag(plev_geopot, 'plev__geopot', activate=plev_geopot_clim_flag) if ((plev_geopot_flag .or. plev_geopot_clim_flag) .and. use_xios_io) then - height_w3 => get_height_fv(W3, exner_w3%get_mesh_id()) + height_w3 => get_height_fv( W3, exner_w3%get_mesh_id(), & + geometry, coord_system, & + scaled_radius ) call invoke_geo_on_pres_kernel_type(height_w3, exner_w3, theta_wth, & height_wth, exner_wth, & nplev, plevs, plev_geopot, & diff --git a/interfaces/physics_schemes_interface/source/algorithm/radaer_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/radaer_alg_mod.x90 index d53d66ee8..c96ec49e3 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/radaer_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/radaer_alg_mod.x90 @@ -41,6 +41,11 @@ module radaer_alg_mod use ukca_radaer_precalc, only: npd_ukca_aod_wavel + ! Configuration modules + use base_mesh_config_mod, only: geometry + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -212,7 +217,8 @@ contains if ( LPROF ) call start_timing( id_aero, 'aerosol.radaer' ) mesh => theta_in_wth%get_mesh() - dz_in_wth => get_dz_at_wtheta(mesh%get_id()) + dz_in_wth => get_dz_at_wtheta( mesh%get_id(), geometry, & + coord_system, scaled_radius ) ! Unpack fields from aerosol_fields call aerosol_fields%get_field('n_ait_sol', n_ait_sol) diff --git a/interfaces/physics_schemes_interface/source/algorithm/skeb_main_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/skeb_main_alg_mod.x90 index ae0e542ba..bfa888824 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/skeb_main_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/skeb_main_alg_mod.x90 @@ -31,12 +31,18 @@ module skeb_main_alg_mod use initialise_diagnostics_mod, only: init_diag => init_diagnostic_field ! configs use um_domain_init_mod, only: level2km, model_wavenumber_max - use planet_config_mod, only: gravity use sci_geometric_constants_mod, only: get_da_at_w2, get_panel_id, & get_height_fv use sci_set_any_dof_kernel_mod, only: set_any_dof_kernel_type use reference_element_mod, only: T + ! Configuration modules + use base_mesh_config_mod, only: geometry, topology, f_lat + use finite_element_config_mod, only: element_order_h, element_order_v, & + coord_system + use idealised_config_mod, only: f_lon + use planet_config_mod, only: scaled_radius, gravity + implicit none private @@ -59,7 +65,7 @@ module skeb_main_alg_mod public skeb_main_alg, skeb_init_power_law - contains +contains !>@brief Run the Stochastic Kinetic Energy Backscatter (SKEB) !>@details The SKEB scheme creates stochastic perturbations !> for the horizontal wind based on the projection of @@ -364,7 +370,9 @@ module skeb_main_alg_mod !!! 2.b call convective dissipation kernel ! Call kernel to compute the convective dissipation, get dz at W3 points - height_wth => get_height_fv(Wtheta, mesh_id) + height_wth => get_height_fv( Wtheta, mesh_id, & + geometry, coord_system, & + scaled_radius ) call invoke(skeb_conv_disp_kernel_type(cdisp, wetrho_w3, massflux_diff, & cape, height_wth, skeb_level_bottom, & @@ -494,7 +502,9 @@ module skeb_main_alg_mod if (skeb_rot_du == skeb_rot_du_fe) then ! Initialise Operators - project_w3_to_w1 => get_project_r_dot_to_w1(mesh%get_id()) + project_w3_to_w1 => get_project_r_dot_to_w1( mesh%get_id(), & + geometry, topology, & + coord_system, scaled_radius ) ! Project k*psif_hat to W1V and take strong curl call psif_hat_w1%initialise( vector_space = w1_fs) @@ -529,8 +539,12 @@ module skeb_main_alg_mod !! 6) Compute divergence wind increments !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - mesh_2d => mesh_collection%get_mesh( mesh, TWOD ) - latitude => get_latitude_fv(W2, mesh_2d%get_id()) + mesh_2d => mesh_collection%get_mesh( mesh, TWOD ) + latitude => get_latitude_fv( W2, mesh_2d%get_id(), & + geometry, topology, & + element_order_h, element_order_v, & + coord_system, f_lat, f_lon, & + scaled_radius ) if (skeb_div_du == skeb_div_du_fe) then diff --git a/interfaces/physics_schemes_interface/source/algorithm/spectral_gwd_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/spectral_gwd_alg_mod.x90 index 9fa5ed02b..0a586bef0 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/spectral_gwd_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/spectral_gwd_alg_mod.x90 @@ -20,6 +20,13 @@ module spectral_gwd_alg_mod use spectral_gwd_diags_mod, only: initialise_diags_for_spectral_gwd, & output_diags_for_spectral_gwd + ! Configuration modules + use base_mesh_config_mod, only: geometry, topology, f_lat + use finite_element_config_mod, only: element_order_h, element_order_v, & + coord_system + use idealised_config_mod, only: f_lon + use planet_config_mod, only: scaled_radius + implicit none private @@ -107,9 +114,17 @@ contains mesh => theta%get_mesh() twod_mesh => ls_rain%get_mesh() - latitude_w3 => get_latitude_fv(W3, twod_mesh%get_id()) - height_wth => get_height_fv(Wtheta, mesh%get_id()) - height_w3 => get_height_fv(W3, mesh%get_id()) + latitude_w3 => get_latitude_fv( W3, twod_mesh%get_id(), & + geometry, topology, & + element_order_h, element_order_v, & + coord_system, f_lat, f_lon, & + scaled_radius ) + height_wth => get_height_fv( Wtheta, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) + height_w3 => get_height_fv( W3, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) call u_in_w3%copy_field_properties(du_spectral_gwd) call v_in_w3%copy_field_properties(dv_spectral_gwd) diff --git a/interfaces/physics_schemes_interface/source/algorithm/spt_main_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/spt_main_alg_mod.x90 index 99843ab6c..b7a43300a 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/spt_main_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/spt_main_alg_mod.x90 @@ -8,29 +8,36 @@ module spt_main_alg_mod - use constants_mod, only: r_def, i_def, l_def, r_second - use fs_continuity_mod, only: W0, Wtheta - ! define types - use clock_mod, only: clock_type - use field_mod, only: field_type - use field_collection_mod, only: field_collection_type - use mesh_mod, only: mesh_type - ! for IO and timers - use io_config_mod, only: write_diag, use_xios_io - use timing_mod, only: start_timing, stop_timing, tik, LPROF - ! load modules to set up the W0 space for 1-2-1 filtering - ! wtheta -> w0 bottom DoF -> wtheta - use function_space_collection_mod, only: function_space_collection - use function_space_mod, only: function_space_type - use extrusion_config_mod, only: planet_radius - - implicit none - - private - - public spt_main_alg, spt_init_power_law - - contains + use constants_mod, only: r_def, i_def, l_def, r_second + use fs_continuity_mod, only: W0, Wtheta + + ! define types + use clock_mod, only: clock_type + use field_mod, only: field_type + use field_collection_mod, only: field_collection_type + use mesh_mod, only: mesh_type + + ! for IO and timers + use io_config_mod, only: write_diag, use_xios_io + use timing_mod, only: start_timing, stop_timing, tik, LPROF + ! load modules to set up the W0 space for 1-2-1 filtering + ! wtheta -> w0 bottom DoF -> wtheta + use function_space_collection_mod, only: function_space_collection + use function_space_mod, only: function_space_type + use extrusion_config_mod, only: planet_radius + + ! Configuration modules + use base_mesh_config_mod, only: geometry + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + + implicit none + + private + + public spt_main_alg, spt_init_power_law + +contains !>@brief Run the Stochastic Perturbation of Tendencies (SPT) !>@details The SPT scheme creates perturbations in theta and mv prognostics !> from the physical tendencies of radiation, microphysics and convection. @@ -445,7 +452,8 @@ module spt_main_alg_mod ! Apply water conservation to the column if requested if (spt_moisture_conservation) then mesh => theta_latest%get_mesh() - dz_wth => get_dz_at_wtheta(mesh%get_id()) + dz_wth => get_dz_at_wtheta( mesh%get_id(), geometry, & + coord_system, scaled_radius ) call invoke(spt_moisture_conservation_kernel_type(dmv_spt,mv,dz_wth, & rho_in_wth,spt_level_bottom, & spt_level_top)) diff --git a/interfaces/physics_schemes_interface/source/algorithm/stph_fp_main_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/stph_fp_main_alg_mod.x90 index a6abf14be..508375035 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/stph_fp_main_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/stph_fp_main_alg_mod.x90 @@ -8,23 +8,31 @@ module stph_fp_main_alg_mod - use constants_mod, only: r_def, i_def, str_def, pi - use extrusion_mod, only: TWOD - use field_mod, only: field_type - use fs_continuity_mod, only: W3 - use mesh_mod, only: mesh_type - use mesh_collection_mod, only: mesh_collection - use timing_mod, only: start_timing, stop_timing, tik, LPROF - use level_heights_mod, only: eta_theta_levels - use extrusion_config_mod, only: domain_height + use constants_mod, only: r_def, i_def, str_def, pi + use extrusion_mod, only: TWOD + use field_mod, only: field_type + use fs_continuity_mod, only: W3 + use mesh_mod, only: mesh_type + use mesh_collection_mod, only: mesh_collection + use timing_mod, only: start_timing, stop_timing, tik, LPROF + use level_heights_mod, only: eta_theta_levels + use extrusion_config_mod, only: domain_height + + ! Configuration modules + use base_mesh_config_mod, only: geometry, topology, f_lat + use finite_element_config_mod, only: element_order_h, element_order_v, & + coord_system + use idealised_config_mod, only: f_lon + use planet_config_mod, only: scaled_radius - implicit none - private + implicit none + + private - public stph_fp_main_alg + public stph_fp_main_alg - contains +contains !>@brief Run the Stochastic Forcing pattern code !>@details This code creates the forcing pattern for stochastic physics schemes. !> The forcing pattern comes from the spherical harmonic spectral transformation @@ -182,12 +190,16 @@ module stph_fp_main_alg_mod !! 2) Apply the spect_2_cubedsphere transformation !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! Create 2D mesh from the FP field + ! Create 2D mesh from the FP field mesh => fp%get_mesh() twod_mesh => mesh_collection%get_mesh(mesh, TWOD) ! Get longitude - longitude => get_longitude_fv(W3, twod_mesh%get_id()) + longitude => get_longitude_fv( W3, twod_mesh%get_id(), & + geometry, topology, & + element_order_h, element_order_v, & + coord_system, f_lat, f_lon, & + scaled_radius ) ! Get Matrix of Legendre Polynomials (scaled) Pnm_star Pnm_star => get_Pnm_star(twod_mesh%get_id()) diff --git a/interfaces/physics_schemes_interface/source/algorithm/tracer_emission_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/tracer_emission_alg_mod.x90 index 663403d04..4ae0e8e41 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/tracer_emission_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/tracer_emission_alg_mod.x90 @@ -17,6 +17,11 @@ module tracer_emission_alg_mod use sci_calc_dz_face_kernel_mod, only: calc_dz_face_kernel_type use timestepping_config_mod, only: dt + ! Configuration modules + use base_mesh_config_mod, only: geometry + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -69,8 +74,12 @@ contains call derived_fields%get_field('rho_in_wth',rho_in_wth) mesh => rho_in_wth%get_mesh() - height_wth => get_height_fv(WTheta, mesh%get_id() ) - height_w3 => get_height_fv(W3, mesh%get_id() ) + height_wth => get_height_fv( WTheta, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) + height_w3 => get_height_fv( W3, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) call tracer_emissions%copy_field_properties(scaled_emission) call tracer_emissions%copy_field_properties(dz_wth) diff --git a/interfaces/physics_schemes_interface/source/diagnostics/cld_diags_mod.x90 b/interfaces/physics_schemes_interface/source/diagnostics/cld_diags_mod.x90 index 6b6eb9a40..5e902fedc 100644 --- a/interfaces/physics_schemes_interface/source/diagnostics/cld_diags_mod.x90 +++ b/interfaces/physics_schemes_interface/source/diagnostics/cld_diags_mod.x90 @@ -28,6 +28,11 @@ module cld_diags_mod use initialise_diagnostics_mod, only : init_diag => init_diagnostic_field, & samp_diag => diagnostic_to_be_sampled + ! Configuration modules + use base_mesh_config_mod, only: geometry + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -244,8 +249,12 @@ contains cloud_fraction_below_1000feet_asl_flag ) then mesh => combined_cld_amount%get_mesh() - height_w3 => get_height_fv(W3, mesh%get_id()) - height_wth => get_height_fv(Wtheta, mesh%get_id()) + height_w3 => get_height_fv( W3, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) + height_wth => get_height_fv( Wtheta, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) call derived_fields%get_field('rho_in_wth', rho_in_wth) call cloud_fields%get_field('frozen_fraction', cf_frozen) @@ -288,7 +297,9 @@ contains ! Need to know height to remove any spurious icing index in stratosphere mesh => theta%get_mesh() - height_wth => get_height_fv( Wtheta, mesh%get_id() ) + height_wth => get_height_fv( Wtheta, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) end if diff --git a/interfaces/physics_schemes_interface/source/iau/printing_iau_mod.x90 b/interfaces/physics_schemes_interface/source/iau/printing_iau_mod.x90 index ca00ff9d2..f31584454 100644 --- a/interfaces/physics_schemes_interface/source/iau/printing_iau_mod.x90 +++ b/interfaces/physics_schemes_interface/source/iau/printing_iau_mod.x90 @@ -19,6 +19,11 @@ module printing_iau_mod use fs_continuity_mod, only: W3 use sci_geometric_constants_mod, only: get_height_fv + ! Configuration modules + use base_mesh_config_mod, only: geometry + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -234,7 +239,9 @@ module printing_iau_mod call iau_fields % get_field( 'rho_r2_inc', iau_field ) ! Divide by r2 to create wet density mesh_id = iau_field%get_mesh_id() - height_w3 => get_height_fv(W3, mesh_id) + height_w3 => get_height_fv( W3, mesh_id, & + geometry, coord_system, & + scaled_radius ) call iau_field%copy_field_properties(radius_w3) call invoke( a_plus_X( radius_w3, planet_radius, height_w3 ), & inc_X_divideby_Y( iau_field, radius_w3 ), & diff --git a/interfaces/socrates_interface/source/algorithm/cosp_alg_mod.x90 b/interfaces/socrates_interface/source/algorithm/cosp_alg_mod.x90 index adf6728a3..e55aa7679 100644 --- a/interfaces/socrates_interface/source/algorithm/cosp_alg_mod.x90 +++ b/interfaces/socrates_interface/source/algorithm/cosp_alg_mod.x90 @@ -20,7 +20,6 @@ use mphys_inputs_mod, only: x1r, x2r use mphys_psd_mod, only: x1g, x2g, x4g use microphysics_config_mod, only: microphysics_casim use mr_indices_mod, only: nummr, imr_v, imr_cl, imr_s, imr_ci -use planet_config_mod, only: p_zero, kappa use timing_mod, only: start_timing, stop_timing, tik, LPROF use log_mod, only: log_event, LOG_LEVEL_DEBUG @@ -28,6 +27,11 @@ use cosp_config_mod, only: n_subcol_gen use cosp_diags_mod, only: initialise_diags_for_cosp, output_diags_for_cosp use cosp_kernel_mod, only: cosp_kernel_type +! Configuration modules +use base_mesh_config_mod, only: geometry +use finite_element_config_mod, only: coord_system +use planet_config_mod, only: scaled_radius, p_zero, kappa + implicit none private public :: cosp_alg @@ -148,8 +152,12 @@ subroutine cosp_alg(pressure_in_wth, temperature_in_wth, exner, mr, & ! Set height on W3 and Wtheta levels mesh => exner%get_mesh() - height_wth => get_height_fv( Wtheta, mesh%get_id() ) - height_w3 => get_height_fv( W3, mesh%get_id() ) + height_wth => get_height_fv( Wtheta, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) + height_w3 => get_height_fv( W3, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) ! Set pressure on W3 levels call exner%copy_field_properties(pressure_in_w3) diff --git a/interfaces/socrates_interface/source/algorithm/illuminate_alg_mod.x90 b/interfaces/socrates_interface/source/algorithm/illuminate_alg_mod.x90 index 69c02b4d1..3ec96a3de 100644 --- a/interfaces/socrates_interface/source/algorithm/illuminate_alg_mod.x90 +++ b/interfaces/socrates_interface/source/algorithm/illuminate_alg_mod.x90 @@ -17,7 +17,16 @@ use sci_geometric_constants_mod, & only: get_latitude_fv, get_longitude_fv use illuminate_kernel_mod, only: illuminate_kernel_type use timing_mod, only: start_timing, stop_timing, tik, LPROF + +! Confugration modules +use base_mesh_config_mod, only: geometry, topology, f_lat +use finite_element_config_mod, only: element_order_h, element_order_v, & + coord_system +use idealised_config_mod, only: f_lon +use planet_config_mod, only: scaled_radius + implicit none + private !------------------------------------------------------------------------------ @@ -93,8 +102,16 @@ subroutine illuminate_alg(radiation_fields, timestep, dt) mesh => cos_zenith_angle%get_mesh() - latitude => get_latitude_fv( W3, mesh%get_id() ) - longitude => get_longitude_fv( W3, mesh%get_id() ) + latitude => get_latitude_fv( W3, mesh%get_id(), & + geometry, topology, & + element_order_h, element_order_v, & + coord_system, f_lat, f_lon, & + scaled_radius ) + longitude => get_longitude_fv( W3, mesh%get_id(), & + geometry, topology, & + element_order_h, element_order_v, & + coord_system, f_lat, f_lon, & + scaled_radius ) call invoke( illuminate_kernel_type( & cos_zenith_angle, lit_fraction, & diff --git a/interfaces/socrates_interface/source/algorithm/init_radiation_fields_alg_mod.x90 b/interfaces/socrates_interface/source/algorithm/init_radiation_fields_alg_mod.x90 index 2091d2f3b..731f11c78 100644 --- a/interfaces/socrates_interface/source/algorithm/init_radiation_fields_alg_mod.x90 +++ b/interfaces/socrates_interface/source/algorithm/init_radiation_fields_alg_mod.x90 @@ -16,6 +16,11 @@ module init_radiation_fields_alg_mod use fs_continuity_mod, only: Wtheta use sci_geometric_constants_mod, only: get_height_fv + ! Configuration modules + use base_mesh_config_mod, only: geometry + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -32,8 +37,8 @@ contains use radiative_gases_config_mod, only: o3_rad_opt, o3_rad_opt_profile, & o3_profile_size, o3_profile_data,& - o3_profile_heights - + o3_profile_heights + !> @todo Data passed to the kernel via module 'use' statements. !> When PSyclone supports passing of arrays into kernels (issue #1312), !> these data should be passed through the argument list of the invoke. @@ -92,15 +97,17 @@ contains call radiation_fields%get_field('ozone', ozone) if ( o3_rad_opt == o3_rad_opt_profile ) then mesh_id = ozone%get_mesh_id() - height_o3 => get_height_fv(Wtheta, mesh_id) + height_o3 => get_height_fv( Wtheta, mesh_id, & + geometry, coord_system, & + scaled_radius ) profile_size = o3_profile_size profile_data(1:profile_size) = o3_profile_data(1:o3_profile_size) profile_heights(1:profile_size) = o3_profile_heights(1:o3_profile_size) if ( profile_size == 1) then - call invoke( setval_c( ozone, profile_data(1) ) ) + call invoke( setval_c( ozone, profile_data(1) ) ) else profile_extrap = .true. - call invoke( profile_interp_kernel_type( ozone, height_o3, & + call invoke( profile_interp_kernel_type( ozone, height_o3, & profile_extrap ) ) end if end if diff --git a/interfaces/socrates_interface/source/algorithm/rad_cloud_alg_mod.x90 b/interfaces/socrates_interface/source/algorithm/rad_cloud_alg_mod.x90 index 4fad4bcb9..3b4268cd6 100644 --- a/interfaces/socrates_interface/source/algorithm/rad_cloud_alg_mod.x90 +++ b/interfaces/socrates_interface/source/algorithm/rad_cloud_alg_mod.x90 @@ -33,6 +33,13 @@ use casim_ice_act_kernel_mod, only: casim_ice_act_kernel_type use cv_run_mod, only: l_param_conv use microphysics_config_mod, only: microphysics_casim +! Configuration modules +use base_mesh_config_mod, only: geometry, topology, f_lat +use finite_element_config_mod, only: element_order_h, element_order_v, & + coord_system +use idealised_config_mod, only: f_lon +use planet_config_mod, only: scaled_radius + implicit none private public :: rad_cloud_alg @@ -140,8 +147,16 @@ subroutine rad_cloud_alg(rand_seed, n_cloud_layer, & year = int( datetime%year, i_def ) day_of_year = int( xios_date_get_day_of_year(datetime), i_def ) second_of_day = int( xios_date_get_second_of_day(datetime), i_def ) - latitude => get_latitude_fv(W3, twod_mesh%get_id()) - longitude => get_longitude_fv(W3, twod_mesh%get_id()) + latitude => get_latitude_fv( W3, twod_mesh%get_id(), & + geometry, topology, & + element_order_h, element_order_v, & + coord_system, f_lat, f_lon, & + scaled_radius ) + longitude => get_longitude_fv( W3, twod_mesh%get_id(), & + geometry, topology, & + element_order_h, element_order_v, & + coord_system, f_lat, f_lon, & + scaled_radius ) ! Generate a unique seed for each gridpoint (actually for each area of the ! globe with a size defined by per_deg_lat) at the given time in seconds. diff --git a/interfaces/socrates_interface/source/algorithm/radiation_alg_mod.x90 b/interfaces/socrates_interface/source/algorithm/radiation_alg_mod.x90 index 7d990d067..7b8b2d338 100644 --- a/interfaces/socrates_interface/source/algorithm/radiation_alg_mod.x90 +++ b/interfaces/socrates_interface/source/algorithm/radiation_alg_mod.x90 @@ -32,13 +32,17 @@ use lfric_xios_write_mod, only: write_field_generic use mesh_mod, only: mesh_type use field_parent_mod, only: write_interface use empty_data_mod, only: empty_real_data -use planet_config_mod, only: p_zero, kappa, gravity, cp use microphysics_config_mod, only: microphysics_casim use radiation_diags_mod, only: initialise_diags_for_radiation, & output_diags_for_radiation use set_thermodynamic_kernel_mod, only: set_thermodynamic_kernel_type use radiative_gases_config_mod, only: h2o_rad_opt, h2o_rad_opt_ancil +! Configuration modules +use base_mesh_config_mod, only: geometry +use finite_element_config_mod, only: coord_system +use planet_config_mod, only: scaled_radius, p_zero, kappa, gravity, cp + implicit none private @@ -390,7 +394,8 @@ subroutine radiation_alg(dtheta_rad, theta, exner, mr, moist_dyn, & mesh => theta%get_mesh() twod_mesh => cos_zenith_angle%get_mesh() - dz_in_wth => get_dz_at_wtheta(mesh%get_id()) + dz_in_wth => get_dz_at_wtheta( mesh%get_id(), geometry, & + coord_system, scaled_radius ) n_levs = mesh%get_nlayers() + 1 flux_space => function_space_collection%get_fs(twod_mesh, 0, 0, W3, n_levs) diff --git a/science/adjoint/source/algorithm/interpolation/adj_interpolation_alg_mod.x90 b/science/adjoint/source/algorithm/interpolation/adj_interpolation_alg_mod.x90 index 0c57391e7..df8b025d6 100644 --- a/science/adjoint/source/algorithm/interpolation/adj_interpolation_alg_mod.x90 +++ b/science/adjoint/source/algorithm/interpolation/adj_interpolation_alg_mod.x90 @@ -27,6 +27,11 @@ module adj_interpolation_alg_mod use sci_nodal_xyz_coordinates_kernel_mod, only: nodal_xyz_coordinates_kernel_type use sci_compute_sample_u_ops_kernel_mod, only: compute_sample_u_ops_kernel_type + ! Configuration modules + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none public :: adj_interp_w2_to_w3wth_alg @@ -80,8 +85,14 @@ module adj_interpolation_alg_mod end do ! Adjoint of compute vertical wind on Wtheta - call invoke( nodal_xyz_coordinates_kernel_type(physical_chi_w3, chi, panel_id), & - nodal_xyz_coordinates_kernel_type(physical_chi_w2, chi, panel_id), & + call invoke( nodal_xyz_coordinates_kernel_type( physical_chi_w3, chi, & + panel_id, geometry, & + topology, coord_system, & + scaled_radius ), & + nodal_xyz_coordinates_kernel_type( physical_chi_w2, chi, & + panel_id, geometry, & + topology, coord_system, & + scaled_radius ), & setval_c(physical_wind_w2(1), 0.0_r_def), & setval_c(physical_wind_w2(2), 0.0_r_def), & setval_c(physical_wind_w2(3), 0.0_r_def), & @@ -161,7 +172,9 @@ module adj_interpolation_alg_mod ! Adjoint of compute wind on W2 call invoke( setval_c(u_broken, 0.0_r_def), & - compute_sample_u_ops_kernel_type(u_map, v_map, w_map, chi, panel_id), & + compute_sample_u_ops_kernel_type( u_map, v_map, w_map, chi, & + panel_id, geometry, topology, & + coord_system, scaled_radius ), & adj_average_w2b_to_w2_kernel_type(u_in_w2, u_broken, w2_rmultiplicity), & adj_dg_inc_matrix_vector_kernel_type(u_broken, w_in_wth, w_map), & adj_dg_inc_matrix_vector_kernel_type(u_broken, v_in_w3, v_map), & diff --git a/science/adjoint/source/algorithm/linear_physics/atl_bdy_lyr_alg.x90 b/science/adjoint/source/algorithm/linear_physics/atl_bdy_lyr_alg.x90 index 7fddefed1..325bed1fe 100644 --- a/science/adjoint/source/algorithm/linear_physics/atl_bdy_lyr_alg.x90 +++ b/science/adjoint/source/algorithm/linear_physics/atl_bdy_lyr_alg.x90 @@ -32,6 +32,12 @@ module atl_bdy_lyr_alg_mod use tl_compute_aubu_kernel_mod, only: tl_compute_aubu_kernel_type use atl_bl_inc_kernel_mod, only: atl_bl_inc_kernel_type + ! Configuration modules + use base_mesh_config_mod, only: geometry + use finite_element_config_mod, only: element_order_h, element_order_v, & + coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -87,9 +93,15 @@ subroutine atl_bdy_lyr_alg(modeldb, u_bl_inc, u, ls_state, dt) call ls_fields%get_field('ls_land_fraction', ls_land_fraction) mesh => u%get_mesh() - height_w2 => get_height_fe(W2, mesh%get_id()) - height_w3 => get_height_fe(W3, mesh%get_id()) - height_wth => get_height_fe(Wtheta, mesh%get_id()) + height_w2 => get_height_fe( W2, mesh%get_id(), geometry, & + element_order_h, element_order_v, & + coord_system, scaled_radius ) + height_w3 => get_height_fe( W3, mesh%get_id(), geometry, & + element_order_h, element_order_v, & + coord_system, scaled_radius ) + height_wth => get_height_fe( Wtheta, mesh%get_id(), geometry, & + element_order_h, element_order_v, & + coord_system, scaled_radius ) w2_rmultiplicity => get_rmultiplicity_fe(W2, mesh%get_id()) diff --git a/science/adjoint/source/algorithm/lookup/solver/adj_solver_lookup_cache_mod.x90 b/science/adjoint/source/algorithm/lookup/solver/adj_solver_lookup_cache_mod.x90 index e0aa2d9fa..88f7e6a22 100644 --- a/science/adjoint/source/algorithm/lookup/solver/adj_solver_lookup_cache_mod.x90 +++ b/science/adjoint/source/algorithm/lookup/solver/adj_solver_lookup_cache_mod.x90 @@ -53,10 +53,10 @@ module adj_solver_lookup_cache_mod use formulation_config_mod, only: l_multigrid use fs_continuity_mod, only: W3 use function_space_mod, only: function_space_type - use function_space_chain_mod, only: multigrid_function_space_chain use function_space_collection_mod, only: function_space_collection use mesh_mod, only: mesh_type use multigrid_config_mod, only: multigrid_chain_nitems + use multigrid_mod, only: multigrid_function_space_chain use r_solver_field_mod, only: r_solver_field_type diff --git a/science/gungho/integration-test/cma_test/cma_test.f90 b/science/gungho/integration-test/cma_test/cma_test.f90 index a12a7f67f..6765f2648 100644 --- a/science/gungho/integration-test/cma_test/cma_test.f90 +++ b/science/gungho/integration-test/cma_test/cma_test.f90 @@ -130,11 +130,16 @@ program cma_test character(str_def) :: prime_mesh_name real(r_def) :: radius real(r_def) :: scaled_radius - integer :: geometry - integer :: extrusion_method + integer(i_def) :: geometry + integer(i_def) :: extrusion_method + integer(i_def) :: tile_size_x + integer(i_def) :: tile_size_y integer(i_def) :: number_of_layers logical(l_def) :: prepartitioned - logical :: check_partitions = .false. + logical(l_def) :: check_partitions = .false. + logical(l_def) :: inner_halo_tiles + + integer(i_def), allocatable :: tile_size(:,:) ! Error tolerance for tests ! Note: tolerance is for r_solver = real64 @@ -267,6 +272,16 @@ program cma_test prime_mesh_name = config%base_mesh%prime_mesh_name() scaled_radius = config%planet%scaled_radius() + if (prepartitioned) then + inner_halo_tiles = .false. + tile_size_x = 1 + tile_size_y = 1 + else + inner_halo_tiles = config%partitioning%inner_halo_tiles() + tile_size_x = config%partitioning%tile_size_x() + tile_size_y = config%partitioning%tile_size_y() + end if + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Initialise @@ -283,9 +298,15 @@ program cma_test stencil_depth = 2 check_partitions = .false. - call init_mesh( config, & - local_rank, total_ranks, & - base_mesh_names, extrusion, & + if (allocated(tile_size)) deallocate(tile_size) + allocate(tile_size(2, size(base_mesh_names))) + tile_size(1,:) = tile_size_x + tile_size(2,:) = tile_size_y + + call init_mesh( config, & + local_rank, total_ranks, & + base_mesh_names, extrusion, & + inner_halo_tiles, tile_size, & stencil_depth, check_partitions ) allocate( twod_names, source=base_mesh_names ) @@ -296,6 +317,7 @@ program cma_test 0.0_r_def, & 1_i_def, TWOD ) call create_mesh( base_mesh_names, extrusion_2d, & + inner_halo_tiles, tile_size, & alt_name=twod_names ) call assign_mesh_maps(twod_names) diff --git a/science/gungho/integration-test/cma_test/cma_test_algorithm_mod.x90 b/science/gungho/integration-test/cma_test/cma_test_algorithm_mod.x90 index 7c40508e1..39c6c8236 100644 --- a/science/gungho/integration-test/cma_test/cma_test_algorithm_mod.x90 +++ b/science/gungho/integration-test/cma_test/cma_test_algorithm_mod.x90 @@ -53,9 +53,6 @@ module cma_test_algorithm_mod r_solver_operator_type use fs_continuity_mod, only : W0, W1, W2, W2V, W2H, W3, Wchi use driver_coordinates_mod, only : assign_coordinate_field - use finite_element_config_mod, only : element_order_h, & - element_order_v, & - coord_order use extrusion_mod, only: TWOD use mesh_collection_mod, only: mesh_collection ! Kernels for field assignment and manipulation @@ -86,6 +83,12 @@ module cma_test_algorithm_mod use sci_columnwise_op_asm_m2v_lumped_inv_krnl_mod, & only : columnwise_op_asm_m2v_lumped_inv_krnl_type + ! Configuration modules + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: element_order_h, element_order_v, & + coord_order, coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -221,7 +224,9 @@ contains halo_depth = mesh%get_halo_depth() ) end do - call assign_coordinate_field( chi, panel_id, mesh ) + call assign_coordinate_field( chi, panel_id, mesh, & + geometry, topology, & + coord_system, scaled_radius ) ! Construct quadrature rule qr = quadrature_xyoz_type(3, quadrature_rule) diff --git a/science/gungho/integration-test/cma_test/resources/cma_test_configuration.nml b/science/gungho/integration-test/cma_test/resources/cma_test_configuration.nml index 109b1ce28..b645089ca 100644 --- a/science/gungho/integration-test/cma_test/resources/cma_test_configuration.nml +++ b/science/gungho/integration-test/cma_test/resources/cma_test_configuration.nml @@ -43,4 +43,7 @@ &partitioning partitioner = 'cubedsphere' panel_decomposition = 'auto' + tile_size_x = 1 + tile_size_y = 1 + inner_halo_tiles = .false. / diff --git a/science/gungho/source/algorithm/core_dynamics/intermesh_mappings_alg_mod.x90 b/science/gungho/source/algorithm/core_dynamics/intermesh_mappings_alg_mod.x90 index 12e8ac5e3..d233e075b 100644 --- a/science/gungho/source/algorithm/core_dynamics/intermesh_mappings_alg_mod.x90 +++ b/science/gungho/source/algorithm/core_dynamics/intermesh_mappings_alg_mod.x90 @@ -27,16 +27,19 @@ module intermesh_mappings_alg_mod use mesh_collection_mod, only : mesh_collection use mesh_mod, only : mesh_type use mr_indices_mod, only : nummr - use multires_coupling_config_mod, only : recovery_order, & - recovery_order_constant, & - recovery_order_linear, & - reconstruction, & - reconstruction_reversible, & - reconstruction_simple, & - negative_correction, & - negative_correction_none, & - negative_correction_one_by_one, & - negative_correction_consistent + + ! Configuration modules + use finite_element_config_mod, only: nqp_h_exact, nqp_v_exact + use multires_coupling_config_mod, only: recovery_order, & + recovery_order_constant, & + recovery_order_linear, & + reconstruction, & + reconstruction_reversible, & + reconstruction_simple, & + negative_correction, & + negative_correction_none, & + negative_correction_one_by_one, & + negative_correction_consistent implicit none @@ -94,8 +97,12 @@ contains prime_extrusion_mesh => primary_rho%get_mesh() shifted_mesh => mesh_collection%get_mesh(prime_extrusion_mesh, SHIFTED) if (element_order_h > 0 .or. element_order_v > 0) then - detj_primary => get_detj_at_w3_fe(prime_extrusion_mesh%get_id()) - detj_shifted => get_detj_at_w3_fe(shifted_mesh%get_id()) + detj_primary => get_detj_at_w3_fe( prime_extrusion_mesh%get_id(), & + element_order_h, element_order_v, & + nqp_h_exact, nqp_v_exact ) + detj_shifted => get_detj_at_w3_fe( shifted_mesh%get_id(), & + element_order_h, element_order_v, & + nqp_h_exact, nqp_v_exact) else detj_primary => get_detj_at_w3_fv(prime_extrusion_mesh%get_id()) detj_shifted => get_detj_at_w3_fv(shifted_mesh%get_id()) diff --git a/science/gungho/source/algorithm/diagnostics/checks_and_balances_alg_mod.x90 b/science/gungho/source/algorithm/diagnostics/checks_and_balances_alg_mod.x90 index 64b7d5591..4e7b1591e 100644 --- a/science/gungho/source/algorithm/diagnostics/checks_and_balances_alg_mod.x90 +++ b/science/gungho/source/algorithm/diagnostics/checks_and_balances_alg_mod.x90 @@ -42,10 +42,17 @@ contains type( field_type ), pointer :: detJ => null() ! Areas of faces - if (state(igh_u)%get_element_order_h() > 0 .or. & - state(igh_u)%get_element_order_v() > 0) then + integer(i_def) :: element_order_h + integer(i_def) :: element_order_v + + element_order_h = state(igh_u)%get_element_order_h() + element_order_v = state(igh_u)%get_element_order_v() + + if ( element_order_h > 0 .or. & + element_order_v > 0) then ! Get finite element detJ - detJ => get_detj_at_w2_fe(state(igh_u)%get_mesh_id()) + detJ => get_detj_at_w2_fe( state(igh_u)%get_mesh_id(), & + element_order_h, element_order_v ) else ! Get finite volume detJ detJ => get_detj_at_w2_fv(state(igh_u)%get_mesh_id()) diff --git a/science/gungho/source/algorithm/diagnostics/compute_total_energy_alg_mod.x90 b/science/gungho/source/algorithm/diagnostics/compute_total_energy_alg_mod.x90 index 78e1279fc..b3c7a6022 100644 --- a/science/gungho/source/algorithm/diagnostics/compute_total_energy_alg_mod.x90 +++ b/science/gungho/source/algorithm/diagnostics/compute_total_energy_alg_mod.x90 @@ -34,11 +34,16 @@ module compute_total_energy_alg_mod use dycore_constants_mod, only: get_geopotential use mesh_mod, only: mesh_type use mr_indices_mod, only: nummr, imr_cl, imr_ci, imr_r, imr_s - use planet_config_mod, only: cv, gravity use quadrature_xyoz_mod, only: quadrature_xyoz_type use quadrature_rule_gaussian_mod, only: quadrature_rule_gaussian_type use timing_mod, only: start_timing, stop_timing, tik, LPROF + ! Configuration modules + use base_mesh_config_mod, only: geometry + use extrusion_config_mod, only: planet_radius, domain_height + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius, cv, gravity + implicit none private @@ -176,9 +181,15 @@ contains call derived_fields%get_field( 'u_in_w3', u_in_w3 ) call derived_fields%get_field( 'v_in_w3', v_in_w3 ) call derived_fields%get_field( 'w_in_w3', w_in_w3 ) - dA => get_da_msl_proj( twod_mesh%get_id() ) - height_w3 => get_height_fv( W3, mesh%get_id() ) - height_wth => get_height_fv( Wtheta, mesh%get_id() ) + dA => get_da_msl_proj( twod_mesh%get_id(), geometry, & + planet_radius, domain_height ) + + height_w3 => get_height_fv( W3, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) + height_wth => get_height_fv( Wtheta, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) call energy_field%initialise( vector_space = & function_space_collection%get_fs(mesh, 0, 0, W3) ) diff --git a/science/gungho/source/algorithm/diagnostics/compute_total_mass_alg_mod.x90 b/science/gungho/source/algorithm/diagnostics/compute_total_mass_alg_mod.x90 index 35a603d1d..01d6a49b5 100644 --- a/science/gungho/source/algorithm/diagnostics/compute_total_mass_alg_mod.x90 +++ b/science/gungho/source/algorithm/diagnostics/compute_total_mass_alg_mod.x90 @@ -9,6 +9,12 @@ module compute_total_mass_alg_mod use constants_mod, only: r_def, i_def + ! Configuration modules + use base_mesh_config_mod, only: geometry + use extrusion_config_mod, only: planet_radius, domain_height + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -87,10 +93,15 @@ contains select case( method_to_use ) case( integral_method_fd ) - height_w3 => get_height_fv( W3, mesh_id ) - height_wth => get_height_fv( Wtheta, mesh_id ) + height_w3 => get_height_fv( W3, mesh_id, & + geometry, coord_system, & + scaled_radius ) + height_wth => get_height_fv( Wtheta, mesh_id, & + geometry, coord_system, & + scaled_radius ) twod_mesh => mesh_collection%get_mesh( mesh, TWOD ) - dA => get_da_msl_proj( twod_mesh%get_id() ) + dA => get_da_msl_proj( twod_mesh%get_id(), geometry, & + planet_radius, domain_height ) call tot_col_mass%initialise( vector_space = & function_space_collection%get_fs( twod_mesh, 0, 0, W3 ) ) diff --git a/science/gungho/source/algorithm/diagnostics/diagnostic_alg_mod.x90 b/science/gungho/source/algorithm/diagnostics/diagnostic_alg_mod.x90 index 402ac004b..66e435018 100644 --- a/science/gungho/source/algorithm/diagnostics/diagnostic_alg_mod.x90 +++ b/science/gungho/source/algorithm/diagnostics/diagnostic_alg_mod.x90 @@ -8,10 +8,6 @@ module diagnostic_alg_mod use constants_mod, only: i_def, r_def, l_def, str_max_filename - use finite_element_config_mod, only: coord_system, coord_system_native - use base_mesh_config_mod, only: geometry, & - geometry_spherical - use planet_config_mod, only: cp use mesh_mod, only: mesh_type use function_space_collection_mod, only: function_space_collection use fs_continuity_mod, only: W1, W2, W3, Wtheta, W2H @@ -37,6 +33,13 @@ module diagnostic_alg_mod LOG_LEVEL_ERROR use initialise_diagnostics_mod, only: init_diag => init_diagnostic_field + ! Configuration modules + use base_mesh_config_mod, only: geometry, topology, & + geometry_spherical + use finite_element_config_mod, only: coord_system, coord_system_native, & + element_order_h, element_order_v + use planet_config_mod, only: scaled_radius, cp + implicit none private @@ -275,7 +278,9 @@ contains call output_field(1)%copy_field_properties(level) ! Convert field to physical nodal output & sample chi on nodal points - call invoke( nodal_xyz_coordinates_kernel_type(nodal_coordinates, chi, panel_id) ) + call invoke( nodal_xyz_coordinates_kernel_type( nodal_coordinates, chi, panel_id, & + geometry, topology, coord_system, & + scaled_radius ) ) ! If in spherical geometry, ! convert the coordinate field to (longitude, latitude, radius) @@ -344,7 +349,9 @@ contains call field%copy_field_properties(level) ! Convert field to physical nodal output & sample chi on nodal points - call invoke( nodal_xyz_coordinates_kernel_type(nodal_coordinates, chi, panel_id) ) + call invoke( nodal_xyz_coordinates_kernel_type( nodal_coordinates, chi, panel_id, & + geometry, topology, coord_system, & + scaled_radius ) ) output_fs = field%which_function_space() @@ -647,14 +654,26 @@ contains if ( rho_field%get_element_order_h() > 0 .or. & rho_field%get_element_order_v() > 0 ) then - height_w3 => get_height_fe( W3, mesh%get_id() ) - height_wth => get_height_fe( Wtheta, mesh%get_id() ) + + height_w3 => get_height_fe( W3, mesh%get_id(), geometry, & + element_order_h, element_order_v, & + coord_system, scaled_radius ) + height_wth => get_height_fe( Wtheta, mesh%get_id(), geometry, & + element_order_h, element_order_v, & + coord_system, scaled_radius ) + else - height_w3 => get_height_fv( W3, mesh%get_id() ) - height_wth => get_height_fv( Wtheta, mesh%get_id() ) + + height_w3 => get_height_fv( W3, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) + height_wth => get_height_fv( Wtheta, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) + end if - w3_fs => rho_field%get_function_space() + w3_fs => rho_field%get_function_space() ! Set energy_term to have the same properties as height_w3 call height_w3%copy_field_properties(energy_term) diff --git a/science/gungho/source/algorithm/diagnostics/print_field_stats_alg_mod.x90 b/science/gungho/source/algorithm/diagnostics/print_field_stats_alg_mod.x90 index 54d186ce0..667fda8f5 100644 --- a/science/gungho/source/algorithm/diagnostics/print_field_stats_alg_mod.x90 +++ b/science/gungho/source/algorithm/diagnostics/print_field_stats_alg_mod.x90 @@ -13,7 +13,6 @@ module print_field_stats_alg_mod use constants_mod, only: r_def, str_def, i_def, rmdi, & radians_to_degrees, r_tran, l_def use log_mod, only: log_event, log_at_level, log_scratch_space - use base_mesh_config_mod, only: prime_mesh_name use mesh_collection_mod, only: mesh_collection use fs_continuity_mod, only: W3, Wtheta, W2H, W2V use sci_geometric_constants_mod, & @@ -24,6 +23,14 @@ module print_field_stats_alg_mod use extrusion_mod, only: TWOD use sci_field_minmax_alg_mod, only: get_field_minmax + ! Configuration modules + use base_mesh_config_mod, only: prime_mesh_name, geometry, topology, & + f_lat + use finite_element_config_mod, only: element_order_h, element_order_v, & + coord_system + use idealised_config_mod, only: f_lon + use planet_config_mod, only: scaled_radius + implicit none private @@ -321,13 +328,36 @@ subroutine pre_print_field_stats_alg(mesh, fs_id, elt_order_h, elt_order_v, & ! Get fields relating to coordinates to print out location if (elt_order_h > 0 .or. elt_order_v > 0) then - latitude => get_latitude_fe(fs_2d, twod_mesh_id) - longitude => get_longitude_fe(fs_2d, twod_mesh_id) - height => get_height_fe(fs_3d, mesh_id) + + latitude => get_latitude_fe( fs_2d, twod_mesh_id, & + geometry, topology, & + element_order_h, element_order_v, & + coord_system, f_lat, f_lon, & + scaled_radius ) + longitude => get_longitude_fe( fs_2d, twod_mesh_id, & + geometry, topology, & + element_order_h, element_order_v, & + coord_system, f_lat, f_lon, & + scaled_radius ) + height => get_height_fe( fs_3d, mesh_id, geometry, & + element_order_h, element_order_v, & + coord_system, scaled_radius ) + else - latitude => get_latitude_fv(fs_2d, twod_mesh_id) - longitude => get_longitude_fv(fs_2d, twod_mesh_id) - height => get_height_fv(fs_3d, mesh_id) + + latitude => get_latitude_fv( fs_2d, twod_mesh_id, & + geometry, topology, & + element_order_h, element_order_v, & + coord_system, f_lat, f_lon, & + scaled_radius ) + longitude => get_longitude_fv( fs_2d, twod_mesh_id, & + geometry, topology, & + element_order_h, element_order_v, & + coord_system, f_lat, f_lon, & + scaled_radius ) + height => get_height_fv( fs_3d, mesh_id, geometry, & + coord_system, scaled_radius ) + end if ! Initialise 2D fields by copying function space from latitude field diff --git a/science/gungho/source/algorithm/diffusion/leonard_term_alg_mod.x90 b/science/gungho/source/algorithm/diffusion/leonard_term_alg_mod.x90 index 8d622f535..08dbf300f 100644 --- a/science/gungho/source/algorithm/diffusion/leonard_term_alg_mod.x90 +++ b/science/gungho/source/algorithm/diffusion/leonard_term_alg_mod.x90 @@ -25,6 +25,11 @@ module leonard_term_alg_mod use log_mod, only: log_event, LOG_LEVEL_INFO use model_clock_mod, only: model_clock_type + ! Configuration modules + use base_mesh_config_mod, only: geometry + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -119,10 +124,18 @@ subroutine leonard_term_alg(mt_inc_leonard, thetal_inc_leonard, & call turbulence_fields%get_field('dtrdz_tq_bl', dtrdz_tq_bl) dtrdz_fd2 => get_dtrdz_fd2(mesh_id, model_clock) - height_wth => get_height_fv(Wtheta, mesh_id) - height_w3 => get_height_fv(W3, mesh_id) - height_w2 => get_height_fv(W2, mesh_id) - height_w1 => get_height_fv(W1, mesh_id) + height_wth => get_height_fv( Wtheta, mesh_id, & + geometry, coord_system, & + scaled_radius ) + height_w3 => get_height_fv( W3, mesh_id, & + geometry, coord_system, & + scaled_radius ) + height_w2 => get_height_fv( W2, mesh_id, & + geometry, coord_system, & + scaled_radius ) + height_w1 => get_height_fv( W1, mesh_id, & + geometry, coord_system, & + scaled_radius ) panel_id => get_panel_id(mesh_id) ! Set-up arrays for local fields diff --git a/science/gungho/source/algorithm/diffusion/smagorinsky_alg_mod.X90 b/science/gungho/source/algorithm/diffusion/smagorinsky_alg_mod.X90 index 0f2d996b8..915d5d013 100644 --- a/science/gungho/source/algorithm/diffusion/smagorinsky_alg_mod.X90 +++ b/science/gungho/source/algorithm/diffusion/smagorinsky_alg_mod.X90 @@ -43,6 +43,11 @@ module smagorinsky_alg_mod get_dz_at_wtheta use fs_continuity_mod, only: W1, W2 + ! Configuration modules + use base_mesh_config_mod, only: geometry + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -122,8 +127,12 @@ subroutine smagorinsky_alg(dtheta_io, du_io, mr, theta, u, & call derived_fields%get_field('visc_h', visc_h) call derived_fields%get_field('visc_m', visc_m) - height_w1 => get_height_fv(W1, mesh%get_id()) - height_w2 => get_height_fv(W2, mesh%get_id()) + height_w1 => get_height_fv( W1, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) + height_w2 => get_height_fv( W2, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) dx_at_w2 => get_dx_at_w2(mesh%get_id()) panel_id => get_panel_id(mesh%get_id()) @@ -182,7 +191,8 @@ subroutine smagorinsky_alg(dtheta_io, du_io, mr, theta, u, & if (smag_l_calc == smag_l_calc_use_geo) then ! Use geometric mean mixing length - dz_wth => get_dz_at_wtheta(mesh%get_id()) + dz_wth => get_dz_at_wtheta( mesh%get_id(), geometry, & + coord_system, scaled_radius ) one_third = 1.0_r_def / 3.0_r_def call invoke( inc_X_powint_n( delta, 2 ), & diff --git a/science/gungho/source/algorithm/initialisation/init_gungho_prognostics_alg_mod.x90 b/science/gungho/source/algorithm/initialisation/init_gungho_prognostics_alg_mod.x90 index 66aea7659..944696986 100644 --- a/science/gungho/source/algorithm/initialisation/init_gungho_prognostics_alg_mod.x90 +++ b/science/gungho/source/algorithm/initialisation/init_gungho_prognostics_alg_mod.x90 @@ -23,9 +23,6 @@ module init_gungho_prognostics_alg_mod use sci_fem_constants_mod, only: get_inverse_mass_matrix_fe, & get_inverse_mass_matrix_fv, & get_qr_fe, get_qr_fv - use base_mesh_config_mod, only: geometry, & - geometry_spherical, & - geometry_planar use formulation_config_mod, only: eos_method, & eos_method_sampled, & eos_method_projected, & @@ -49,8 +46,6 @@ module init_gungho_prognostics_alg_mod profile_NL_case_4, & profile_rotational, & profile_pw_linear - use planet_config_mod, only: gravity, cp, rd, p_zero, kappa, & - recip_epsilon ! PsyKAl-lite kernels use sci_field_bundle_builtins_mod, only: set_bundle_scalar @@ -85,6 +80,15 @@ module init_gungho_prognostics_alg_mod use mr_indices_mod, only: nummr, mr_names, imr_v use moist_dyn_mod, only: num_moist_factors, gas_law + ! Configuration modules + use base_mesh_config_mod, only: geometry, & + geometry_spherical, & + geometry_planar + use finite_element_config_mod, only: element_order_h, element_order_v, & + coord_system + use planet_config_mod, only: scaled_radius, gravity, cp, rd, & + p_zero, kappa, recip_epsilon + implicit none private @@ -279,13 +283,23 @@ contains mesh_id = exner%get_mesh_id() chi => get_coordinates(mesh_id) panel_id => get_panel_id(mesh_id) + if (element_order_h > 0 .or. element_order_v > 0) then - height_w3 => get_height_fe(W3, mesh_id) - height_wth => get_height_fe(Wtheta, mesh_id) + + height_w3 => get_height_fe( W3, mesh_id, geometry, & + element_order_h, element_order_v, & + coord_system, scaled_radius ) + height_wth => get_height_fe( Wtheta, mesh_id, geometry, & + element_order_h, element_order_v, & + coord_system, scaled_radius ) qr => get_qr_fe() + else - height_w3 => get_height_fv(W3, mesh_id) - height_wth => get_height_fv(Wtheta, mesh_id) + + height_w3 => get_height_fv( W3, mesh_id, geometry, & + coord_system, scaled_radius ) + height_wth => get_height_fv( Wtheta, mesh_id, geometry, & + coord_system, scaled_radius ) qr => get_qr_fv() end if @@ -432,12 +446,23 @@ contains ! TODO: This should not be done here -- will be fixed by #2877 ! This should be done by separate routines from the driver level if( element_order_h > 0 .or. element_order_v > 0 ) then - height_w3 => get_height_fe(W3, mesh_id) - height_wth => get_height_fe(Wtheta, mesh_id) + + height_w3 => get_height_fe( W3, mesh_id, geometry, & + element_order_h, element_order_v, & + coord_system, scaled_radius ) + height_wth => get_height_fe( Wtheta, mesh_id, geometry, & + element_order_h, element_order_v, & + coord_system, scaled_radius ) + else - height_w3 => get_height_fv(W3, mesh_id) - height_wth => get_height_fv(Wtheta, mesh_id) + + height_w3 => get_height_fv( W3, mesh_id, geometry, & + coord_system, scaled_radius ) + height_wth => get_height_fv( Wtheta, mesh_id, geometry, & + coord_system, scaled_radius ) + end if + initial_time = 0.0_r_def call invoke( hydrostatic_exner_kernel_type( exner, theta, moist_dyn, & height_wth, height_w3, & @@ -452,6 +477,4 @@ contains end subroutine init_mr_fields - - end module init_gungho_prognostics_alg_mod diff --git a/science/gungho/source/algorithm/initialisation/init_thermo_profile_alg_mod.x90 b/science/gungho/source/algorithm/initialisation/init_thermo_profile_alg_mod.x90 index e5e0265d5..a6a810e41 100644 --- a/science/gungho/source/algorithm/initialisation/init_thermo_profile_alg_mod.x90 +++ b/science/gungho/source/algorithm/initialisation/init_thermo_profile_alg_mod.x90 @@ -20,6 +20,12 @@ use sci_geometric_constants_mod, only: get_height_fe, & get_coordinates, & get_panel_id +! Configuration modules +use base_mesh_config_mod, only: geometry +use finite_element_config_mod, only: element_order_h, element_order_v, & + coord_system +use planet_config_mod, only: scaled_radius + implicit none private @@ -69,11 +75,17 @@ type( field_type ), pointer :: height_wth => null() mesh_id = theta%get_mesh_id() chi => get_coordinates(mesh_id) panel_id => get_panel_id(mesh_id) + if ( theta%get_element_order_h() > 0 .or. theta%get_element_order_v() > 0 ) then - height_wth => get_height_fe(Wtheta, mesh_id) + height_wth => get_height_fe( Wtheta, mesh_id, geometry, & + element_order_h, element_order_v, & + coord_system, scaled_radius ) else - height_wth => get_height_fv(Wtheta, mesh_id) + height_wth => get_height_fv( Wtheta, mesh_id, & + geometry, coord_system, & + scaled_radius ) end if + profile_extrap = .true. profile_size = temp_prof_size diff --git a/science/gungho/source/algorithm/initialisation/sample_init_u_alg_mod.x90 b/science/gungho/source/algorithm/initialisation/sample_init_u_alg_mod.x90 index e4f4d22fd..277332f10 100644 --- a/science/gungho/source/algorithm/initialisation/sample_init_u_alg_mod.x90 +++ b/science/gungho/source/algorithm/initialisation/sample_init_u_alg_mod.x90 @@ -33,6 +33,12 @@ module sample_init_u_alg_mod use function_space_collection_mod, only: function_space_collection use mesh_mod, only: mesh_type + ! Configuration modules + use base_mesh_config_mod, only: geometry + use finite_element_config_mod, only: element_order_h, element_order_v, & + coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -71,11 +77,23 @@ contains panel_id => get_panel_id( mesh_id ) if ( element_order_h > 0 .or. element_order_v > 0 ) then - height_wth => get_height_fe( Wtheta, mesh_id ) - height_w3 => get_height_fe( W3, mesh_id ) + + height_wth => get_height_fe( Wtheta, mesh_id, geometry, & + element_order_h, element_order_v, & + coord_system, scaled_radius ) + height_w3 => get_height_fe( W3, mesh_id, geometry, & + element_order_h, element_order_v, & + coord_system, scaled_radius ) + else - height_wth => get_height_fv( Wtheta, mesh_id ) - height_w3 => get_height_fv( W3, mesh_id ) + + height_wth => get_height_fv( Wtheta, mesh_id, & + geometry, coord_system, & + scaled_radius ) + height_w3 => get_height_fv( W3, mesh_id, & + geometry, coord_system, & + scaled_radius ) + end if call u_in_w3%initialise( vector_space = & diff --git a/science/gungho/source/algorithm/interpolation/interpolation_alg_mod.x90 b/science/gungho/source/algorithm/interpolation/interpolation_alg_mod.x90 index 713001204..3e4625830 100644 --- a/science/gungho/source/algorithm/interpolation/interpolation_alg_mod.x90 +++ b/science/gungho/source/algorithm/interpolation/interpolation_alg_mod.x90 @@ -38,6 +38,11 @@ module interpolation_alg_mod use sci_nodal_xyz_coordinates_kernel_mod, & only: nodal_xyz_coordinates_kernel_type + ! Configuration modules + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none public :: interp_w2_to_w3wth_alg @@ -100,7 +105,9 @@ module interpolation_alg_mod setval_c(physical_wind_w3(2), 0.0_r_def), & setval_c(physical_wind_w3(3), 0.0_r_def), & convert_hdiv_field_kernel_type(physical_wind_w3, u_in_w2, chi, panel_id), & - nodal_xyz_coordinates_kernel_type(physical_chi_w3, chi, panel_id) ) + nodal_xyz_coordinates_kernel_type( physical_chi_w3, chi, & + panel_id, geometry, topology, & + coord_system, scaled_radius ) ) call invoke( convert_cart2sphere_vector_kernel_type(physical_wind_w3, physical_chi_w3) ) call invoke( setval_X(u_in_w3, physical_wind_w3(1)), & setval_X(v_in_w3, physical_wind_w3(2)), & @@ -114,7 +121,9 @@ module interpolation_alg_mod inc_X_times_Y(physical_wind_w2(1), w2_rmultiplicity), & inc_X_times_Y(physical_wind_w2(2), w2_rmultiplicity), & inc_X_times_Y(physical_wind_w2(3), w2_rmultiplicity), & - nodal_xyz_coordinates_kernel_type(physical_chi_w2, chi, panel_id) ) + nodal_xyz_coordinates_kernel_type( physical_chi_w2, chi, & + panel_id, geometry, topology, & + coord_system, scaled_radius ) ) call invoke( convert_cart2sphere_vector_kernel_type(physical_wind_w2, physical_chi_w2) ) call invoke( extract_w_kernel_type(w_in_wth, physical_wind_w2(3)) ) @@ -177,7 +186,9 @@ module interpolation_alg_mod ! Compute wind on W2 ! Based on set_wind in map_fd_prognostics_alg_mod with sample_physics_winds=.true. ! Maps computed here to remove dependency on physical_op_constants_mod which requires sample_physics_winds=.true. - call invoke( compute_sample_u_ops_kernel_type(u_map, v_map, w_map, chi, panel_id), & + call invoke( compute_sample_u_ops_kernel_type(u_map, v_map, w_map, chi, & + panel_id, geometry, topology, & + coord_system, scaled_radius), & setval_c(u_in_w2, 0.0_r_def), & dg_matrix_vector_kernel_type(u_broken, u_in_w3, u_map), & dg_inc_matrix_vector_kernel_type(u_broken, v_in_w3, v_map), & diff --git a/science/gungho/source/algorithm/limited_area/map_um_lbc_inputs_alg_mod.x90 b/science/gungho/source/algorithm/limited_area/map_um_lbc_inputs_alg_mod.x90 index 40fa4510e..613643821 100644 --- a/science/gungho/source/algorithm/limited_area/map_um_lbc_inputs_alg_mod.x90 +++ b/science/gungho/source/algorithm/limited_area/map_um_lbc_inputs_alg_mod.x90 @@ -18,6 +18,11 @@ module map_um_lbc_inputs_alg_mod use sci_sample_wtheta_to_w3_kernel_mod, only: sample_wtheta_to_w3_kernel_type use sci_geometric_constants_mod, only: get_height_fv + ! Configuration modules + use base_mesh_config_mod, only: geometry + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none public :: map_um_lbc_inputs @@ -53,8 +58,10 @@ contains type(field_type) :: qsum_w3 integer(i_def) :: mesh_id - mesh_id = rho%get_mesh_id() - height_w3 => get_height_fv( W3, mesh_id ) + mesh_id = rho%get_mesh_id() + height_w3 => get_height_fv( W3, mesh_id, & + geometry, coord_system, & + scaled_radius ) ! Convert to a total air density ! rho = rho/r/r diff --git a/science/gungho/source/algorithm/physics/external_forcing_alg_mod.X90 b/science/gungho/source/algorithm/physics/external_forcing_alg_mod.X90 index a5dc88e87..2f57a82a7 100644 --- a/science/gungho/source/algorithm/physics/external_forcing_alg_mod.X90 +++ b/science/gungho/source/algorithm/physics/external_forcing_alg_mod.X90 @@ -60,7 +60,6 @@ module external_forcing_alg_mod use mesh_mod, only: mesh_type use mr_indices_mod, only: nummr use io_config_mod, only: write_diag, use_xios_io - use planet_config_mod, only: kappa use section_choice_config_mod, only: cloud, cloud_um use cloud_config_mod, only: scheme, scheme_pc2 @@ -81,6 +80,11 @@ module external_forcing_alg_mod use external_forcing_diagnostics_mod, only: write_forcing_diagnostics + ! Configuration modules + use base_mesh_config_mod, only: geometry + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius, kappa + implicit none private @@ -158,7 +162,9 @@ contains if ( LPROF ) call start_timing( id, 'external_forcing' ) mesh => theta%get_mesh() - height_wth => get_height_fv( Wtheta, mesh%get_id() ) + height_wth => get_height_fv( Wtheta, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) if ( theta_forcing /= theta_forcing_none .or. theta_relaxation .or. & vertadvect_forcing ) then @@ -307,8 +313,12 @@ contains ! zero. ! panel_id => get_panel_id(mesh%get_id()) - height_w1 => get_height_fv(W1, mesh%get_id()) - height_w2 => get_height_fv(W2, mesh%get_id()) + height_w1 => get_height_fv( W1, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) + height_w2 => get_height_fv( W2, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) dx_at_w2 => get_dx_at_w2(mesh%get_id()) diff --git a/science/gungho/source/algorithm/physics/geostrophic_forcing_alg_mod.x90 b/science/gungho/source/algorithm/physics/geostrophic_forcing_alg_mod.x90 index fadfceb93..2957851b8 100644 --- a/science/gungho/source/algorithm/physics/geostrophic_forcing_alg_mod.x90 +++ b/science/gungho/source/algorithm/physics/geostrophic_forcing_alg_mod.x90 @@ -7,7 +7,6 @@ !> @brief Apply geostrophic forcing to the horizontal wind component fields module geostrophic_forcing_alg_mod -use base_mesh_config_mod, only: f_lat use constants_mod, only: i_def, r_def, l_def use kernel_mod, only: kernel_type use field_mod, only: field_type @@ -19,9 +18,13 @@ use sci_geometric_constants_mod, only: get_height_fv use log_mod, only: log_event, LOG_LEVEL_ERROR use map_fd_to_prognostics_alg_mod, only: set_wind use mesh_mod, only: mesh_type -use planet_config_mod, only: kappa, p_zero, omega use timestepping_config_mod, only: dt +! Configuration modules +use base_mesh_config_mod, only: geometry, f_lat +use finite_element_config_mod, only: coord_system +use planet_config_mod, only: scaled_radius, kappa, p_zero, omega + implicit none private @@ -147,7 +150,9 @@ else pressure_coord = .true. case(coordinate_height) mesh_id = du_in_w3%get_mesh_id() - height_w3 => get_height_fv(W3, mesh_id) + height_w3 => get_height_fv( W3, mesh_id, & + geometry, coord_system, & + scaled_radius ) pressure_coord = .false. case default call log_event('Unknown coordinate', LOG_LEVEL_ERROR) diff --git a/science/gungho/source/algorithm/physics/map_fd_to_prognostics_alg_mod.x90 b/science/gungho/source/algorithm/physics/map_fd_to_prognostics_alg_mod.x90 index 42d036507..f1a42ee68 100644 --- a/science/gungho/source/algorithm/physics/map_fd_to_prognostics_alg_mod.x90 +++ b/science/gungho/source/algorithm/physics/map_fd_to_prognostics_alg_mod.x90 @@ -62,7 +62,8 @@ module map_fd_to_prognostics_alg_mod use finite_element_config_mod, only: coord_system, coord_system_native use physics_config_mod, only: sample_physics_winds, & sample_physics_winds_correction - use planet_config_mod, only: gravity, p_zero, kappa, rd, cp + use planet_config_mod, only: scaled_radius, gravity, p_zero, & + kappa, rd, cp implicit none @@ -256,9 +257,15 @@ contains w2b_fs => function_space_collection%get_fs(mesh, 0, 0, W2broken) rmultiplicity_w2 => get_rmultiplicity_fv(W2, mesh%get_id()) - u_lon_map => get_u_lon_sample(mesh%get_id()) - u_lat_map => get_u_lat_sample(mesh%get_id()) - u_up_map => get_u_up_sample(mesh%get_id()) + u_lon_map => get_u_lon_sample( mesh%get_id(), & + geometry, topology, & + coord_system, scaled_radius ) + u_lat_map => get_u_lat_sample( mesh%get_id(), & + geometry, topology, & + coord_system, scaled_radius ) + u_up_map => get_u_up_sample( mesh%get_id(), & + geometry, topology, & + coord_system, scaled_radius ) call u_broken%initialise( w2b_fs ) @@ -281,7 +288,10 @@ contains call u_lon_large%initialise( u_lon%get_function_space(), halo_depth=2 ) call u_lat_large%initialise( u_lat%get_function_space(), halo_depth=2 ) - displacement => get_w3_to_w2_displacement(mesh%get_id()) + displacement => get_w3_to_w2_displacement( mesh%get_id(), & + geometry, topology, & + coord_system, scaled_radius ) + chi => get_coordinates(mesh%get_id()) panel_id => get_panel_id(mesh%get_id()) @@ -302,7 +312,8 @@ contains convert_phys_to_hdiv_kernel_type(u_correction, & u_lon_w2, u_lat_w2, & u_up_w2, chi, panel_id, & - geometry), & + geometry, topology, & + coord_system, scaled_radius), & ! Increment wind with correction field inc_X_plus_Y(u, u_correction) ) end if @@ -311,9 +322,15 @@ contains call u%copy_field_properties(r_u) - u_lon_map => get_u_lon_map( mesh%get_id() ) - u_lat_map => get_u_lat_map( mesh%get_id() ) - u_up_map => get_u_up_map( mesh%get_id() ) + u_lon_map => get_u_lon_map( mesh%get_id(), & + geometry, topology, & + coord_system, scaled_radius ) + u_lat_map => get_u_lat_map( mesh%get_id(), & + geometry, topology, & + coord_system, scaled_radius ) + u_up_map => get_u_up_map( mesh%get_id(), & + geometry, topology, & + coord_system, scaled_radius ) call invoke( name="galerkin_projection_from_lonlatr", & setval_c( u, 0.0_r_def ), & @@ -346,8 +363,6 @@ contains only : hydro_shallow_to_deep_kernel_type use moist_dyn_mod, only : num_moist_factors use matrix_vector_kernel_mod, only : matrix_vector_kernel_type - use sci_nodal_xyz_coordinates_kernel_mod, & - only : nodal_xyz_coordinates_kernel_type use sci_mass_matrix_solver_alg_mod, & only : mass_matrix_solver_alg use sample_eos_pressure_kernel_mod, & @@ -384,8 +399,12 @@ contains height_wth, vert_coriolis, mesh, mask ) mesh => exner%get_mesh() - height_w3 => get_height_fv( W3, mesh%get_id() ) - height_wth => get_height_fv( Wtheta, mesh%get_id() ) + height_w3 => get_height_fv( W3, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) + height_wth => get_height_fv( Wtheta, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) geopotential => get_geopotential( mesh%get_id() ) ! If lbc_mask wasn't supplied, create a dummy mask diff --git a/science/gungho/source/algorithm/physics/map_physics_fields_alg_mod.x90 b/science/gungho/source/algorithm/physics/map_physics_fields_alg_mod.x90 index 435733f97..a6cc3c019 100644 --- a/science/gungho/source/algorithm/physics/map_physics_fields_alg_mod.x90 +++ b/science/gungho/source/algorithm/physics/map_physics_fields_alg_mod.x90 @@ -31,6 +31,12 @@ module map_physics_fields_alg_mod use sci_field_minmax_alg_mod, only: log_field_minmax use timing_mod, only: start_timing, stop_timing, tik, LPROF + + ! Configuration modules + use base_mesh_config_mod, only: geometry + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -141,8 +147,12 @@ contains call log_event( 'Calculate 3D shear', LOG_LEVEL_DEBUG ) ! Calculate 3D shear call derived_fields%get_field('shear', shear) - height_wth => get_height_fv(Wtheta, mesh%get_id()) - height_w3 => get_height_fv(W3, mesh%get_id()) + height_wth => get_height_fv( Wtheta, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) + height_w3 => get_height_fv( W3, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) dx_at_w2 => get_dx_at_w2(mesh%get_id()) panel_id => get_panel_id(mesh%get_id()) diff --git a/science/gungho/source/algorithm/physics/physics_mappings_alg_mod.x90 b/science/gungho/source/algorithm/physics/physics_mappings_alg_mod.x90 index 3353b333b..5060b818a 100644 --- a/science/gungho/source/algorithm/physics/physics_mappings_alg_mod.x90 +++ b/science/gungho/source/algorithm/physics/physics_mappings_alg_mod.x90 @@ -7,13 +7,9 @@ !>@brief A wrapper for mappings of FE fields to physics fields module physics_mappings_alg_mod - use base_mesh_config_mod, only: geometry, & - geometry_spherical use constants_mod, only: r_def, i_def, l_def use sci_fem_constants_mod, only: get_rmultiplicity_fv, get_qr_fv use field_mod, only: field_type - use finite_element_config_mod, only: coord_system, & - coord_system_native use fs_continuity_mod, only: W3, WTHETA, W2, W2H use function_space_mod, only: function_space_type use function_space_collection_mod, only: function_space_collection @@ -48,6 +44,13 @@ module physics_mappings_alg_mod only: nodal_xyz_coordinates_kernel_type use sci_field_minmax_alg_mod, only: log_field_minmax + ! Configuration modules + use base_mesh_config_mod, only: geometry, topology, & + geometry_spherical + use finite_element_config_mod, only: coord_system, & + coord_system_native + use planet_config_mod, only: scaled_radius + implicit none private @@ -101,8 +104,12 @@ contains if (( target_field%which_function_space() == WTHETA ) & .and. ( source_field%which_function_space() == W3 ) ) then ! Target is lowest order Wtheta, source is lowest order W3 - height_w3 => get_height_fv(W3, mesh%get_id() ) - height_wt => get_height_fv(WTHETA, mesh%get_id() ) + height_w3 => get_height_fv( W3, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) + height_wt => get_height_fv( WTHETA, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) call invoke( sample_w3_to_wtheta_kernel_type(target_field, source_field, & height_wt, height_w3 ) ) @@ -182,7 +189,9 @@ contains call u1_field%copy_field_properties(physical_chi(1)) call u1_field%copy_field_properties(physical_chi(2)) call u1_field%copy_field_properties(physical_chi(3)) - call invoke( nodal_xyz_coordinates_kernel_type(physical_chi, chi, panel_id) ) + call invoke( nodal_xyz_coordinates_kernel_type( physical_chi, chi, & + panel_id, geometry, topology, & + coord_system, scaled_radius ) ) call invoke( convert_cart2sphere_vector_kernel_type(wind_map, physical_chi) ) end if @@ -258,7 +267,9 @@ contains ! Convert coordinate field to physical space - call invoke( nodal_xyz_coordinates_kernel_type(physical_chi, chi, panel_id) ) + call invoke( nodal_xyz_coordinates_kernel_type( physical_chi, chi, panel_id, & + geometry, topology, & + coord_system, scaled_radius) ) ! Convert 3D wind field to 3 components using the Piola transform diff --git a/science/gungho/source/algorithm/physics/temp_tend_profile_alg_mod.x90 b/science/gungho/source/algorithm/physics/temp_tend_profile_alg_mod.x90 index b983d8fd7..3b53b4ab6 100644 --- a/science/gungho/source/algorithm/physics/temp_tend_profile_alg_mod.x90 +++ b/science/gungho/source/algorithm/physics/temp_tend_profile_alg_mod.x90 @@ -13,9 +13,13 @@ use field_mod, only: field_type use fs_continuity_mod, only: Wtheta use sci_geometric_constants_mod, only: get_height_fv use log_mod, only: log_event, LOG_LEVEL_ERROR -use planet_config_mod, only: kappa, p_zero use timestepping_config_mod, only: dt +! Configuration modules +use base_mesh_config_mod, only: geometry +use finite_element_config_mod, only: coord_system +use planet_config_mod, only: scaled_radius, kappa, p_zero + implicit none private @@ -94,7 +98,9 @@ else pressure_coord = .true. case( coordinate_height ) mesh_id = dtheta%get_mesh_id() - height_wth => get_height_fv( Wtheta, mesh_id ) + height_wth => get_height_fv( Wtheta, mesh_id, & + geometry, coord_system, & + scaled_radius ) pressure_coord = .false. case default call log_event( 'Unknown coordinate', LOG_LEVEL_ERROR ) diff --git a/science/gungho/source/algorithm/physics/theta_relax_alg_mod.x90 b/science/gungho/source/algorithm/physics/theta_relax_alg_mod.x90 index ca2419405..f90e00d1a 100644 --- a/science/gungho/source/algorithm/physics/theta_relax_alg_mod.x90 +++ b/science/gungho/source/algorithm/physics/theta_relax_alg_mod.x90 @@ -23,7 +23,6 @@ module theta_relax_alg_mod use function_space_collection_mod, only: function_space_collection use sci_geometric_constants_mod, only: get_height_fv use mesh_mod, only: mesh_type - use planet_config_mod, only: kappa, p_zero use timestepping_config_mod, only: dt !> @todo Data passed to the kernel via module 'use' statements. !> When PSyclone supports passing of arrays into kernels (issue #1312), @@ -34,6 +33,11 @@ module theta_relax_alg_mod profile_heights use prof_temporal_interp_mod, only: prof_temporal_interp + ! Configuration modules + use base_mesh_config_mod, only: geometry + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius, kappa, p_zero + implicit none private @@ -123,7 +127,9 @@ contains height_wth => exner_in_wth else mesh_id = dtheta_relax%get_mesh_id() - height_wth => get_height_fv( Wtheta, mesh_id ) + height_wth => get_height_fv( Wtheta, mesh_id, & + geometry, coord_system, & + scaled_radius ) end if profile_extrap = .false. call invoke( setval_X( dtheta_relax, horiz_mean), & diff --git a/science/gungho/source/algorithm/physics/update_energy_correction_alg_mod.x90 b/science/gungho/source/algorithm/physics/update_energy_correction_alg_mod.x90 index c65fa6218..346a0a0d5 100644 --- a/science/gungho/source/algorithm/physics/update_energy_correction_alg_mod.x90 +++ b/science/gungho/source/algorithm/physics/update_energy_correction_alg_mod.x90 @@ -10,7 +10,6 @@ module update_energy_correction_alg_mod use energy_correction_config_mod, only: encorr_usage, & encorr_usage_diag, & reset_hours - use extrusion_config_mod, only: planet_radius use field_mod, only: field_type use function_space_mod, only: function_space_type use log_mod, only: log_event, & @@ -19,7 +18,12 @@ module update_energy_correction_alg_mod LOG_LEVEL_INFO use mesh_mod, only: mesh_type use sci_geometric_constants_mod, only: get_da_msl_proj - use planet_config_mod, only: cv + + ! Configuration modules + use base_mesh_config_mod, only: geometry + use extrusion_config_mod, only: planet_radius, domain_height + use planet_config_mod, only: cv + implicit none @@ -61,7 +65,8 @@ contains correction_period = reset_hours * 3600.0_r_def fs_2d => accumulated_fluxes%get_function_space() - dA => get_da_msl_proj(twod_mesh%get_id()) + dA => get_da_msl_proj( twod_mesh%get_id(), geometry, & + planet_radius, domain_height ) call invoke( inc_aX_times_Y(dt, accumulated_fluxes, dA), & diff --git a/science/gungho/source/algorithm/physics/vapour_forcing_profile_alg_mod.x90 b/science/gungho/source/algorithm/physics/vapour_forcing_profile_alg_mod.x90 index 25b25dd2e..7ec68f704 100644 --- a/science/gungho/source/algorithm/physics/vapour_forcing_profile_alg_mod.x90 +++ b/science/gungho/source/algorithm/physics/vapour_forcing_profile_alg_mod.x90 @@ -13,9 +13,13 @@ use field_mod, only: field_type use fs_continuity_mod, only: Wtheta use sci_geometric_constants_mod, only: get_height_fv use log_mod, only: log_event, LOG_LEVEL_ERROR -use planet_config_mod, only: kappa, p_zero use timestepping_config_mod, only: dt +! Configuration modules +use base_mesh_config_mod, only: geometry +use finite_element_config_mod, only: coord_system +use planet_config_mod, only: scaled_radius, kappa, p_zero + implicit none private @@ -95,7 +99,9 @@ else pressure_coord = .true. case(coordinate_height) mesh_id = dmr_v%get_mesh_id() - height_wth => get_height_fv(Wtheta, mesh_id) + height_wth => get_height_fv( Wtheta, mesh_id, & + geometry, coord_system, & + scaled_radius ) pressure_coord = .false. case default call log_event('Unknown coordinate', LOG_LEVEL_ERROR) diff --git a/science/gungho/source/algorithm/physics/vertadvect_forcing_alg_mod.x90 b/science/gungho/source/algorithm/physics/vertadvect_forcing_alg_mod.x90 index aca9d454a..1ba4624c1 100644 --- a/science/gungho/source/algorithm/physics/vertadvect_forcing_alg_mod.x90 +++ b/science/gungho/source/algorithm/physics/vertadvect_forcing_alg_mod.x90 @@ -11,7 +11,6 @@ module vertadvect_forcing_alg_mod use constants_mod, only: i_def, r_def, l_def use field_mod, only: field_type - use finite_element_config_mod, only: element_order_h, element_order_v use fs_continuity_mod, only: Wtheta, W3 use function_space_collection_mod, only: function_space_collection use sci_geometric_constants_mod, only: get_height_fv @@ -27,6 +26,12 @@ module vertadvect_forcing_alg_mod profile_heights use prof_temporal_interp_mod, only: prof_temporal_interp + ! Configuration modules + use base_mesh_config_mod, only: geometry + use finite_element_config_mod, only: element_order_h, element_order_v, & + coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -113,10 +118,14 @@ contains ! There's a choice to be made here. Either advect then average, or average ! then advect. Choose the latter, replicating what's done in the UM and MONC. mesh_id = theta%get_mesh_id() - height_wth => get_height_fv( Wtheta, mesh_id ) + height_wth => get_height_fv( Wtheta, mesh_id, & + geometry, coord_system, & + scaled_radius ) mesh_id = rho%get_mesh_id() - height_w3 => get_height_fv( W3, mesh_id ) + height_w3 => get_height_fv( W3, mesh_id, & + geometry, coord_system, & + scaled_radius ) ! Vertical advection of potential temperature call horiz_mean_alg( field_mean, nlayers, twod_mesh, theta ) diff --git a/science/gungho/source/algorithm/physics/wind_forcing_profile_alg_mod.x90 b/science/gungho/source/algorithm/physics/wind_forcing_profile_alg_mod.x90 index d03fffb2f..57678eb71 100644 --- a/science/gungho/source/algorithm/physics/wind_forcing_profile_alg_mod.x90 +++ b/science/gungho/source/algorithm/physics/wind_forcing_profile_alg_mod.x90 @@ -16,9 +16,13 @@ module wind_forcing_profile_alg_mod use log_mod, only: log_event, LOG_LEVEL_ERROR use map_fd_to_prognostics_alg_mod, only: set_wind use mesh_mod, only: mesh_type - use planet_config_mod, only: kappa, p_zero use timestepping_config_mod, only: dt + ! Configuration modules + use base_mesh_config_mod, only: geometry + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius, kappa, p_zero + implicit none private @@ -126,7 +130,9 @@ contains pressure_coord = .true. case( coordinate_height ) mesh_id = du_in_w3%get_mesh_id() - height_w3 => get_height_fv( W3, mesh_id ) + height_w3 => get_height_fv( W3, mesh_id, & + geometry, coord_system, & + scaled_radius ) pressure_coord = .false. case default call log_event( 'Unknown coordinate', LOG_LEVEL_ERROR ) diff --git a/science/gungho/source/algorithm/runtime_constants/limited_area_constants_mod.x90 b/science/gungho/source/algorithm/runtime_constants/limited_area_constants_mod.x90 index bfdc36ab0..475828e41 100644 --- a/science/gungho/source/algorithm/runtime_constants/limited_area_constants_mod.x90 +++ b/science/gungho/source/algorithm/runtime_constants/limited_area_constants_mod.x90 @@ -269,7 +269,7 @@ contains !> @param[in] use_fe Whether to use finite element or finite volume subroutine create_multigrid_masks(finest_mesh, use_fe) - use function_space_chain_mod, only: multigrid_function_space_chain + use multigrid_mod, only: multigrid_function_space_chain use multigrid_config_mod, only: multigrid_chain_nitems use sci_restrict_masked_w2_kernel_mod, & only: restrict_masked_w2_kernel_type diff --git a/science/gungho/source/algorithm/runtime_constants/physics_constants_mod.X90 b/science/gungho/source/algorithm/runtime_constants/physics_constants_mod.X90 index 94a95dcf1..13467adc4 100644 --- a/science/gungho/source/algorithm/runtime_constants/physics_constants_mod.X90 +++ b/science/gungho/source/algorithm/runtime_constants/physics_constants_mod.X90 @@ -34,6 +34,13 @@ module physics_constants_mod use timing_mod, only: start_timing, stop_timing, & tik, LPROF + ! Configuration modules + use base_mesh_config_mod, only: geometry, topology, f_lat + use finite_element_config_mod, only: element_order_h, element_order_v, & + coord_system + use idealised_config_mod, only: f_lon + use planet_config_mod, only: scaled_radius + implicit none private @@ -124,10 +131,18 @@ contains mesh_id = mesh%get_id() - height_w1 => get_height_fv(W1, mesh_id) - height_w2 => get_height_fv(W2, mesh_id) - height_w3 => get_height_fv(W3, mesh_id) - height_wth => get_height_fv(Wtheta, mesh_id) + height_w1 => get_height_fv( W1, mesh_id, & + geometry, coord_system, & + scaled_radius ) + height_w2 => get_height_fv( W2, mesh_id, & + geometry, coord_system, & + scaled_radius ) + height_w3 => get_height_fv( W3, mesh_id, & + geometry, coord_system, & + scaled_radius ) + height_wth => get_height_fv( Wtheta, mesh_id, & + geometry, coord_system, & + scaled_radius ) delta_at_wtheta => get_delta_at_wtheta(mesh_id) if ( LPROF ) call start_timing( id, 'runtime_constants.physics' ) @@ -424,7 +439,11 @@ contains ! Create constant if it doesn't already exist if (.not. constant_exists) then twod_mesh => mesh_collection%get_mesh(mesh, TWOD) - latitude => get_latitude_fv(W3, mesh_id) + latitude => get_latitude_fv( W3, mesh_id, & + geometry, topology, & + element_order_h, element_order_v, & + coord_system, f_lat, f_lon, & + scaled_radius ) fs => function_space_collection%get_fs(twod_mesh, 0, 0, W3, stph_spectral_dim) if ( LPROF ) call start_timing( id, 'runtime_constants.physics' ) diff --git a/science/gungho/source/algorithm/runtime_constants/transport_constants_mod.x90 b/science/gungho/source/algorithm/runtime_constants/transport_constants_mod.x90 index 727fbd934..660c4cf48 100644 --- a/science/gungho/source/algorithm/runtime_constants/transport_constants_mod.x90 +++ b/science/gungho/source/algorithm/runtime_constants/transport_constants_mod.x90 @@ -54,6 +54,11 @@ module transport_constants_mod use sci_operator_x_times_y_kernel_mod, only: operator_x_times_y_kernel_type use panel_edge_support_mod, only: FAR_AWAY + ! Configuration modules + use base_mesh_config_mod, only: geometry + use finite_element_config_mod, only: coord_system, nqp_h_exact, nqp_v_exact + use planet_config_mod, only: scaled_radius + implicit none private @@ -217,7 +222,7 @@ contains ! Get pointers to coordinates chi => get_coordinates(mesh%get_id()) - chi_ext => get_extended_coordinates(mesh%get_id()) + chi_ext => get_extended_coordinates(mesh%get_id(), coord_system) panel_id => get_panel_id(mesh%get_id()) ! Compute remap weights and indices @@ -582,7 +587,8 @@ contains w3_fs => function_space_collection%get_fs(mesh, 0, 0, W3) - dz_w3_rdef => get_dz_w3(mesh_id) + dz_w3_rdef => get_dz_w3( mesh_id, geometry, & + coord_system, scaled_radius ) call dz_w3_rtran%initialise( dz_w3_rdef%get_function_space() ) call invoke( real_to_real_x(dz_w3_rtran, dz_w3_rdef) ) @@ -638,7 +644,7 @@ contains element_order_h = get_element_order_h_transport() element_order_v = get_element_order_v_transport() if (panel_edge_treatment == panel_edge_treatment_extended_mesh) then - chi => get_extended_coordinates(mesh_id) + chi => get_extended_coordinates(mesh_id, coord_system) else chi => get_coordinates(mesh_id) if (element_order_h == 0 .and. element_order_v == 0) then @@ -646,7 +652,9 @@ contains detj_r_def => get_detj_at_w3_fv(mesh_id) else ! Get the finite element det(J) field - detj_r_def => get_detj_at_w3_fe(mesh_id) + detj_r_def => get_detj_at_w3_fe( mesh_id, & + element_order_h, element_order_v, & + nqp_h_exact, nqp_v_exact ) end if end if panel_id => get_panel_id(mesh_id) @@ -721,7 +729,8 @@ contains detj_at_w2 => get_detj_at_w2_fv(mesh_id) else ! Get the finite element det(J) field - detj_at_w2 => get_detj_at_w2_fe(mesh_id) + detj_at_w2 => get_detj_at_w2_fe( mesh_id, & + element_order_h, element_order_v ) end if ! Create the object as it doesn't exist yet @@ -790,7 +799,8 @@ contains detj_at_w2 => get_detj_at_w2_fv(mesh_id) else ! Get the finite element det(J) field - detj_at_w2 => get_detj_at_w2_fe(mesh_id) + detj_at_w2 => get_detj_at_w2_fe( mesh_id, & + element_order_h, element_order_v ) end if ! Create the object as it doesn't exist yet @@ -913,7 +923,8 @@ contains w2v_fs => function_space_collection%get_fs(mesh, 0, 0, W2v) - dz_w3_rdef => get_dz_w3(mesh_id) + dz_w3_rdef => get_dz_w3( mesh_id, geometry, & + coord_system, scaled_radius ) call dz_w3_rtran%initialise( dz_w3_rdef%get_function_space() ) call invoke( real_to_real_x(dz_w3_rtran, dz_w3_rdef) ) @@ -1744,7 +1755,7 @@ contains ! Compute diagonal mass matrix for extended mesh ------------------------- if ( oned_reconstruction .and. extended_mesh ) then ! @TODO #416: using detj_at_w3_r_tran would avoid this but change KGOs - chi => get_extended_coordinates(mesh%get_id()) + chi => get_extended_coordinates(mesh%get_id(), coord_system) w3_fs => function_space_collection%get_fs( mesh, 0, 0, W3 ) call mm_w3%initialise( w3_fs, w3_fs ) call mm_w3_diag_tmp%initialise( w3_fs ) @@ -1847,7 +1858,9 @@ contains ! Create constant if it doesn't already exist if (.not. constant_exists) then - height => get_height_fv(Wtheta, mesh%get_id()) + height => get_height_fv( Wtheta, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) if ( LPROF ) call start_timing( id, 'runtime_constants.transport' ) ndata_v = 2*(fv_vertical_order + 1) @@ -1912,7 +1925,9 @@ contains ! Create constant if it doesn't already exist if (.not. constant_exists) then - height => get_height_fv(Wtheta, mesh%get_id()) + height => get_height_fv( Wtheta, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) if ( LPROF ) call start_timing( id, 'runtime_constants.transport' ) vertical_order = fv_vertical_order - 1 @@ -2089,7 +2104,7 @@ contains ! Compute diagonal mass matrix for extended mesh ------------------------- if (oned_reconstruction .and. extended_mesh) then - chi => get_extended_coordinates(mesh%get_id()) + chi => get_extended_coordinates(mesh%get_id(), coord_system) wt_fs => function_space_collection%get_fs( mesh, 0, 0, Wtheta ) call mm_wt%initialise( wt_fs, wt_fs ) call mm_wt_diag_tmp%initialise( wt_fs ) @@ -2194,7 +2209,9 @@ contains ! Create constant if it doesn't already exist if (.not. constant_exists) then - height => get_height_fv(Wtheta, mesh%get_id()) + height => get_height_fv( Wtheta, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) if ( LPROF ) call start_timing( id, 'runtime_constants.transport' ) vertical_order = fv_vertical_order + 1 @@ -2252,7 +2269,9 @@ contains ! Create constant if it doesn't already exist if (.not. constant_exists) then - height => get_height_fv(Wtheta, mesh%get_id()) + height => get_height_fv( Wtheta, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) if ( LPROF ) call start_timing( id, 'runtime_constants.transport' ) ndata_v = 2*(fv_vertical_order + 1) diff --git a/science/gungho/source/algorithm/solver/multigrid_preconditioner_alg_mod.x90 b/science/gungho/source/algorithm/solver/multigrid_preconditioner_alg_mod.x90 index deff82faa..0bda4e227 100644 --- a/science/gungho/source/algorithm/solver/multigrid_preconditioner_alg_mod.x90 +++ b/science/gungho/source/algorithm/solver/multigrid_preconditioner_alg_mod.x90 @@ -8,28 +8,27 @@ !> module multigrid_preconditioner_alg_mod - use base_mesh_config_mod, only: prime_mesh_name - use boundaries_config_mod, only: limited_area - use constants_mod, only: i_def, r_solver, l_def - use function_space_mod, only: function_space_type - use function_space_chain_mod, & - only: function_space_chain_type, & - multigrid_function_space_chain - use log_mod, only: log_event, & - LOG_LEVEL_INFO, & - LOG_LEVEL_ERROR, & - log_scratch_space - use r_solver_field_mod, only: r_solver_field_type + use base_mesh_config_mod, only: prime_mesh_name + use boundaries_config_mod, only: limited_area + use constants_mod, only: i_def, r_solver, l_def + use function_space_mod, only: function_space_type + use function_space_chain_mod, only: function_space_chain_type + use log_mod, only: log_event, & + LOG_LEVEL_INFO, & + LOG_LEVEL_ERROR, & + log_scratch_space + use multigrid_mod, only: multigrid_function_space_chain + use r_solver_field_mod, only: r_solver_field_type use sci_abstract_field_operator_mod, & - only: abstract_field_operator_type + only: abstract_field_operator_type use sci_r_solver_field_vector_mod, & - only: r_solver_field_vector_type + only: r_solver_field_vector_type use sci_hierarchical_linear_operator_mod, & - only: abstract_hierarchical_linear_operator_type + only: abstract_hierarchical_linear_operator_type use sci_hierarchical_preconditioner_mod, & - only: abstract_hierarchical_preconditioner_type - use sci_preconditioner_mod, only: abstract_preconditioner_type - use vector_mod, only: abstract_vector_type + only: abstract_hierarchical_preconditioner_type + use sci_preconditioner_mod, only: abstract_preconditioner_type + use vector_mod, only: abstract_vector_type implicit none diff --git a/science/gungho/source/algorithm/solver/pressure_operator_alg_mod.x90 b/science/gungho/source/algorithm/solver/pressure_operator_alg_mod.x90 index 289c66802..a93ce877f 100644 --- a/science/gungho/source/algorithm/solver/pressure_operator_alg_mod.x90 +++ b/science/gungho/source/algorithm/solver/pressure_operator_alg_mod.x90 @@ -47,7 +47,7 @@ module pressure_operator_alg_mod use boundaries_config_mod, only: limited_area use base_mesh_config_mod, only: topology, topology_non_periodic use function_space_mod, only: function_space_type - use function_space_chain_mod, only: multigrid_function_space_chain + use multigrid_mod, only: multigrid_function_space_chain implicit none diff --git a/science/gungho/source/algorithm/solver/si_operators_alg_mod.x90 b/science/gungho/source/algorithm/solver/si_operators_alg_mod.x90 index e36bb1051..21b196414 100644 --- a/science/gungho/source/algorithm/solver/si_operators_alg_mod.x90 +++ b/science/gungho/source/algorithm/solver/si_operators_alg_mod.x90 @@ -10,16 +10,12 @@ !! More details of the solver forumulation can be found in the solver section of: !! https://code.metoffice.gov.uk/trac/lfric/wiki/GhaspSupport/Documentation module si_operators_alg_mod - use base_mesh_config_mod, only: prime_mesh_name + use constants_mod, only: i_def, r_def, r_solver use model_clock_mod, only: model_clock_type use operator_mod, only: operator_type, r_solver_operator_type use field_mod, only: field_type use function_space_mod, only: function_space_type - use finite_element_config_mod, only: element_order_h, & - element_order_v, & - nqp_h_exact, & - nqp_v_exact use function_space_collection_mod, & only: function_space_collection use r_solver_field_mod, only: r_solver_field_type @@ -35,20 +31,26 @@ module si_operators_alg_mod preconditioner_multigrid, & normalise use timing_mod, only: start_timing, stop_timing, tik, LPROF - use function_space_chain_mod, only: multigrid_function_space_chain, & - w2_multigrid_function_space_chain, & - wtheta_multigrid_function_space_chain use formulation_config_mod, only: l_multigrid, & eos_method, & eos_method_sampled, & eos_method_projected, & p2theta_vert, & moisture_in_solver + use multigrid_mod, only: multigrid_function_space_chain, & + w2_multigrid_function_space_chain, & + wtheta_multigrid_function_space_chain use multigrid_config_mod, only: multigrid_chain_nitems use mixed_solver_config_mod, only: eliminate_variables, & eliminate_variables_analytic use moist_dyn_mod, only: num_moist_factors, gas_law, total_mass + ! Configuration modules + use base_mesh_config_mod, only: prime_mesh_name, geometry + use finite_element_config_mod, only: element_order_h, element_order_v, & + nqp_h_exact, nqp_v_exact, coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -535,8 +537,12 @@ contains ! Non-topological operators call exner_in_wth%initialise( vector_space = theta%get_function_space() ) if ( element_order_h == 0 .and. element_order_v == 0) then - height_w3 => get_height_fv(W3, mesh%get_id()) - height_wt => get_height_fv(Wtheta, mesh%get_id()) + height_w3 => get_height_fv( W3, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) + height_wt => get_height_fv( Wtheta, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) call invoke( sample_w3_to_wtheta_kernel_type(exner_in_wth, exner, & height_wt, height_w3 ) ) nullify(height_w3, height_wt) diff --git a/science/gungho/source/algorithm/transport/common/calc_dep_pts_alg_mod.x90 b/science/gungho/source/algorithm/transport/common/calc_dep_pts_alg_mod.x90 index e002948f0..5dc83f124 100644 --- a/science/gungho/source/algorithm/transport/common/calc_dep_pts_alg_mod.x90 +++ b/science/gungho/source/algorithm/transport/common/calc_dep_pts_alg_mod.x90 @@ -97,6 +97,11 @@ module calc_dep_pts_alg_mod get_detj_at_w2_fv, & get_panel_id + ! Configuration modules + use base_mesh_config_mod, only: geometry + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -541,7 +546,9 @@ contains ! SL-style Lagrangian departure points ------------------------------------- case (vertical_method_midpoint, vertical_method_trapezoidal) ! Get cell height - height_w2_rdef => get_height_fv(W2, mesh%get_id()) + height_w2_rdef => get_height_fv( W2, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) call height_w2%initialise(vector_space = height_w2_rdef%get_function_space() ) call invoke( real_to_real_x(height_w2, height_w2_rdef) ) @@ -616,7 +623,9 @@ contains detj_at_w2_ave_rdef => get_detj_at_w2_fv(mesh_id) else ! Higher order elements, use finite element - detj_at_w2_ave_rdef => get_detj_at_w2_fe(mesh_id) + detj_at_w2_ave_rdef => get_detj_at_w2_fe( mesh_id, & + element_order_h, & + element_order_v ) end if ! Set detj_at_w2 to use average Det(J) of neighbouring cells diff --git a/science/gungho/source/algorithm/transport/common/end_of_transport_step_alg_mod.x90 b/science/gungho/source/algorithm/transport/common/end_of_transport_step_alg_mod.x90 index dc382d042..0033632dd 100644 --- a/science/gungho/source/algorithm/transport/common/end_of_transport_step_alg_mod.x90 +++ b/science/gungho/source/algorithm/transport/common/end_of_transport_step_alg_mod.x90 @@ -8,7 +8,6 @@ module end_of_transport_step_alg_mod - use base_mesh_config_mod, only: topology, topology_non_periodic use boundaries_config_mod, only: limited_area, & transport_boundary_depth, & transport_overwrite_freq, & @@ -83,6 +82,11 @@ module end_of_transport_step_alg_mod use sci_field_minmax_alg_mod, only: get_field_minmax use dg_matrix_vector_kernel_mod, only: dg_matrix_vector_kernel_type + ! Configuration modules + use base_mesh_config_mod, only: geometry, topology, topology_non_periodic + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -529,7 +533,8 @@ contains rmultiplicity_shifted => get_rmultiplicity_fv(flux_function_space, shifted_mesh%get_id()) ref_step = transport_counter%get_split_step_of_whole_step_counter() dry_flux => flux_precomputations%get_ref_flux(prime_extrusion_mesh_id, ref_step) - height_wt => get_height_fv(Wtheta, prime_extrusion_mesh_id) + height_wt => get_height_fv( Wtheta, prime_extrusion_mesh_id, & + geometry, coord_system, scaled_radius ) logspace = transport_metadata%get_log_space() face_selector_ew => get_face_selector_ew(prime_extrusion_mesh_id) face_selector_ns => get_face_selector_ns(prime_extrusion_mesh_id) diff --git a/science/gungho/source/algorithm/transport/control/theta_transport_alg_mod.x90 b/science/gungho/source/algorithm/transport/control/theta_transport_alg_mod.x90 index 8184b6dbd..756a81199 100644 --- a/science/gungho/source/algorithm/transport/control/theta_transport_alg_mod.x90 +++ b/science/gungho/source/algorithm/transport/control/theta_transport_alg_mod.x90 @@ -32,7 +32,6 @@ module theta_transport_alg_mod imr_ci, imr_s, imr_g use operator_mod, only: operator_type use physics_mappings_alg_mod, only: map_physics_scalars - use planet_config_mod, only: recip_epsilon, cp, Rd, p_zero use r_tran_field_mod, only: r_tran_field_type use sci_sort_column_above_kernel_mod, & only: sort_column_above_kernel_type @@ -61,6 +60,13 @@ module theta_transport_alg_mod only: transport_rho_times_field_alg use transport_enumerated_types_mod, only: direction_3d + ! Configuration modules + use base_mesh_config_mod, only: geometry + use finite_element_config_mod, only: element_order_h, element_order_v, & + coord_system + use planet_config_mod, only: scaled_radius, recip_epsilon, & + cp, Rd, p_zero + implicit none private @@ -352,10 +358,13 @@ contains if (theta_in_rdef%get_element_order_h() == 0 .and. & theta_in_rdef%get_element_order_v() == 0) then ! Use the finite volume height function - height_wt => get_height_fv(Wtheta, theta_in_rdef%get_mesh_id()) + height_wt => get_height_fv( Wtheta, theta_in_rdef%get_mesh_id(), & + geometry, coord_system, scaled_radius ) else ! Use the finite element height function - height_wt => get_height_fe(Wtheta, theta_in_rdef%get_mesh_id()) + height_wt => get_height_fe( Wtheta, theta_in_rdef%get_mesh_id(), & + geometry, element_order_h, element_order_v, & + coord_system, scaled_radius ) end if call invoke( sort_column_above_kernel_type(theta_out_rdef, height_wt, & adjust_theta_above) ) diff --git a/science/gungho/source/algorithm/transport/ffsl/ffsl_vert_alg_mod.x90 b/science/gungho/source/algorithm/transport/ffsl/ffsl_vert_alg_mod.x90 index b5de0b2f4..7e5c8d89d 100644 --- a/science/gungho/source/algorithm/transport/ffsl/ffsl_vert_alg_mod.x90 +++ b/science/gungho/source/algorithm/transport/ffsl/ffsl_vert_alg_mod.x90 @@ -48,10 +48,13 @@ module ffsl_vert_alg_mod use fv_difference_z_kernel_mod, only: fv_difference_z_kernel_type use fv_divergence_z_kernel_mod, only: fv_divergence_z_kernel_type - ! Configuration options - use transport_config_mod, only: ffsl_unity_3d, & - wind_mono_top, & - wind_mono_top_depth + ! Configuration modules + use transport_config_mod, only: ffsl_unity_3d, & + wind_mono_top, & + wind_mono_top_depth + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius implicit none @@ -335,7 +338,8 @@ contains if ( vertical_order /= 0 ) then ! Get objects only needed for high order flux - dz_w3_rdef => get_dz_w3(mesh_id) + dz_w3_rdef => get_dz_w3( mesh_id, geometry, & + coord_system, scaled_radius ) call dz_w3%initialise( vector_space = field_fs ) call invoke( real_to_real_x(dz_w3, dz_w3_rdef) ) end if diff --git a/science/gungho/source/algorithm/transport/mol/reconstruct_w3_field_alg_mod.x90 b/science/gungho/source/algorithm/transport/mol/reconstruct_w3_field_alg_mod.x90 index 6b9b9e537..adf7700b9 100644 --- a/science/gungho/source/algorithm/transport/mol/reconstruct_w3_field_alg_mod.x90 +++ b/science/gungho/source/algorithm/transport/mol/reconstruct_w3_field_alg_mod.x90 @@ -61,6 +61,10 @@ module reconstruct_w3_field_alg_mod use timing_mod, only: start_timing, stop_timing, & tik, LPROF + ! Configuration modules + use base_mesh_config_mod, only: geometry + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius implicit none @@ -290,7 +294,9 @@ contains end if if ( monotonicity == monotone_koren ) then - height_tr => get_height_fv( Wtheta, mesh%get_id() ) + height_tr => get_height_fv( Wtheta, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) call invoke(name="w3_vert_reconstruction_koren", & polyv_w3_koren_kernel_type( field_new, & field_old, & diff --git a/science/gungho/source/algorithm/transport/mol/wt_advective_update_alg_mod.x90 b/science/gungho/source/algorithm/transport/mol/wt_advective_update_alg_mod.x90 index 554a1605f..8d74f049f 100644 --- a/science/gungho/source/algorithm/transport/mol/wt_advective_update_alg_mod.x90 +++ b/science/gungho/source/algorithm/transport/mol/wt_advective_update_alg_mod.x90 @@ -68,6 +68,11 @@ module wt_advective_update_alg_mod use timing_mod, only: start_timing, stop_timing, & tik, LPROF + ! Configuration modules + use base_mesh_config_mod, only: geometry + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -251,7 +256,9 @@ contains ndata_v = 2_i_def*(vertical_order + 1_i_def) if ( monotonicity == monotone_koren ) then - height_tr => get_height_fv( Wtheta, mesh%get_id() ) + height_tr => get_height_fv( Wtheta, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) call invoke( polyv_wtheta_koren_kernel_type(u_grad_f, & wind, & field, & @@ -382,7 +389,9 @@ contains ! TODO #3325: Make consistent wind be pre-computed if ( consistent_metric ) then ! Consistent wind will be vertical only -- initialise as wind_v - height_rdef => get_height_fv(Wtheta, mesh%get_id()) + height_rdef => get_height_fv( Wtheta, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) call height%initialise( vector_space = height_rdef%get_function_space() ) call invoke( real_to_real_x(height, height_rdef) ) chi => get_coordinates(mesh%get_id()) diff --git a/science/gungho/source/algorithm/transport/sl/compute_sl_coefficients_alg_mod.x90 b/science/gungho/source/algorithm/transport/sl/compute_sl_coefficients_alg_mod.x90 index bbf91ae31..ec7f3f456 100644 --- a/science/gungho/source/algorithm/transport/sl/compute_sl_coefficients_alg_mod.x90 +++ b/science/gungho/source/algorithm/transport/sl/compute_sl_coefficients_alg_mod.x90 @@ -25,6 +25,11 @@ module compute_sl_coefficients_alg_mod use compute_vertical_cubic_coef_kernel_mod, only: compute_vertical_cubic_coef_kernel_type use compute_vertical_quintic_coef_kernel_mod, only: compute_vertical_quintic_coef_kernel_type + ! Configuration modules + use base_mesh_config_mod, only: geometry + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -68,7 +73,9 @@ contains ! Get height at r_tran precision mesh => coeffs(1)%get_mesh() - height_rdef => get_height_fv( Wtheta, mesh%get_id() ) + height_rdef => get_height_fv( Wtheta, mesh%get_id(), & + geometry, coord_system, & + scaled_radius ) call height%initialise( vector_space = height_rdef%get_function_space() ) call invoke( real_to_real_x(height, height_rdef) ) diff --git a/science/gungho/source/driver/gungho_diagnostics_driver_mod.F90 b/science/gungho/source/driver/gungho_diagnostics_driver_mod.F90 index 1bfca57a2..ee6f0bbce 100644 --- a/science/gungho/source/driver/gungho_diagnostics_driver_mod.F90 +++ b/science/gungho/source/driver/gungho_diagnostics_driver_mod.F90 @@ -61,6 +61,13 @@ module gungho_diagnostics_driver_mod use freeze_lev_alg_mod, only : freeze_lev_alg #endif + ! Configuration modules + use base_mesh_config_mod, only: geometry + use extrusion_config_mod, only: planet_radius, domain_height + use finite_element_config_mod, only: element_order_h, element_order_v, & + coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -183,7 +190,9 @@ subroutine gungho_diagnostics_driver( modeldb, & field_name = trim(prefix)//"height_"//trim(fs_names(i)) fs = fs_ids(i) if (diagnostic_to_be_sampled(trim(field_name))) then - height => get_height_fe(fs, mesh%get_id()) + height => get_height_fe( fs, mesh%get_id(), geometry, & + element_order_h, element_order_v, & + coord_system, scaled_radius ) call height%set_write_behaviour(tmp_write_ptr) call height%write_field(trim(field_name)) end if @@ -201,7 +210,8 @@ subroutine gungho_diagnostics_driver( modeldb, & ! Write out grid_cell area at initialisation only if ( use_physics .and. use_xios_io .and. modeldb%clock%is_initialisation() & .and. diagnostic_to_be_sampled("init_area_at_msl") ) then - dA => get_da_msl_proj(twod_mesh%get_id()) + dA => get_da_msl_proj( twod_mesh%get_id(), geometry, & + planet_radius, domain_height ) tmp_write_ptr => write_field_generic call dA%set_write_behaviour(tmp_write_ptr) call dA%write_field("init_area_at_msl") diff --git a/science/gungho/source/driver/gungho_model_mod.F90 b/science/gungho/source/driver/gungho_model_mod.F90 index 8f9dbd0c0..699933d88 100644 --- a/science/gungho/source/driver/gungho_model_mod.F90 +++ b/science/gungho/source/driver/gungho_model_mod.F90 @@ -10,8 +10,7 @@ module gungho_model_mod use add_mesh_map_mod, only : assign_mesh_maps use sci_checksum_alg_mod, only : checksum_alg - use driver_fem_mod, only : init_fem, final_fem, & - init_function_space_chains + use driver_fem_mod, only : init_fem, final_fem use driver_io_mod, only : init_io, final_io, & filelist_populator use driver_mesh_mod, only : init_mesh @@ -21,7 +20,7 @@ module gungho_model_mod check_configuration use energy_correction_config_mod, only : encorr_usage, encorr_usage_none use conservation_algorithm_mod, only : conservation_algorithm - use constants_mod, only : i_def, r_def, l_def, & + use constants_mod, only : i_def, r_def, l_def, imdi, & PRECISION_REAL, r_second, str_def use convert_to_upper_mod, only : convert_to_upper use create_gungho_prognostics_mod, only : process_gungho_prognostics @@ -36,6 +35,8 @@ module gungho_model_mod shifted_extrusion_type, & double_level_extrusion_type, & TWOD, SHIFTED, DOUBLE_LEVEL + use multigrid_mod, only : get_multigrid_tile_size, & + init_multigrid_fs_chain use field_array_mod, only : field_array_type use field_mod, only : field_type use field_spec_mod, only : field_spec_type, processor_type @@ -417,8 +418,8 @@ end subroutine basic_initialisations !> subroutine initialise_infrastructure( io_context_name, modeldb ) - use base_mesh_config_mod, only: GEOMETRY_PLANAR, & - GEOMETRY_SPHERICAL + use base_mesh_config_mod, only: geometry_planar, & + geometry_spherical #ifdef UM_PHYSICS use formulation_config_mod, only: use_physics @@ -486,20 +487,26 @@ subroutine initialise_infrastructure( io_context_name, modeldb ) logical(l_def) :: use_multires_coupling logical(l_def) :: l_multigrid + logical(l_def) :: inner_halo_tiles logical(l_def) :: prepartitioned - logical(l_def) :: apply_partition_check + logical(l_def) :: check_partitions integer(i_def) :: geometry + integer(i_def) :: topology integer(i_def) :: extrusion_method real(r_def) :: domain_bottom real(r_def) :: domain_height real(r_def) :: scaled_radius integer(i_def) :: number_of_layers + integer(i_def) :: tile_size_x + integer(i_def) :: tile_size_y #ifdef UM_PHYSICS real(r_def) :: dt #endif + integer(i_def), allocatable :: tile_size(:,:) + integer(i_def), allocatable :: multigrid_tile_size(:,:) integer(i_def), parameter :: one_layer = 1_i_def @@ -526,12 +533,23 @@ subroutine initialise_infrastructure( io_context_name, modeldb ) prime_mesh_name = modeldb%config%base_mesh%prime_mesh_name() geometry = modeldb%config%base_mesh%geometry() + topology = modeldb%config%base_mesh%topology() prepartitioned = modeldb%config%base_mesh%prepartitioned() domain_height = modeldb%config%extrusion%domain_height() extrusion_method = modeldb%config%extrusion%method() number_of_layers = modeldb%config%extrusion%number_of_layers() scaled_radius = modeldb%config%planet%scaled_radius() + if (prepartitioned) then + tile_size_x = 1 + tile_size_y = 1 + inner_halo_tiles = .false. + else + tile_size_x = maxval([1,modeldb%config%partitioning%tile_size_x()]) + tile_size_y = maxval([1,modeldb%config%partitioning%tile_size_y()]) + inner_halo_tiles = modeldb%config%partitioning%inner_halo_tiles() + end if + !------------------------------------------------------------------------- ! Initialise infrastructure !------------------------------------------------------------------------- @@ -693,10 +711,10 @@ subroutine initialise_infrastructure( io_context_name, modeldb ) ! 1.3a Initialise prime/2d meshes ! --------------------------------------------------------- - apply_partition_check = .false. + check_partitions = .false. if ( .not. prepartitioned .and. & ( l_multigrid .or. use_multires_coupling ) ) then - apply_partition_check = .true. + check_partitions = .true. end if allocate(stencil_depths(size(base_mesh_names))) @@ -704,20 +722,41 @@ subroutine initialise_infrastructure( io_context_name, modeldb ) base_mesh_names, & modeldb%config ) + if (allocated(tile_size)) deallocate(tile_size) + allocate(tile_size(2, size(base_mesh_names))) + tile_size(1,:) = tile_size_x + tile_size(2,:) = tile_size_y + if (l_multigrid) then + multigrid_tile_size = get_multigrid_tile_size( modeldb%config, & + base_mesh_names, & + extrusion ) + where (multigrid_tile_size /= imdi) tile_size = multigrid_tile_size + end if + call init_mesh( modeldb%config, & modeldb%mpi%get_comm_rank(), & modeldb%mpi%get_comm_size(), & - base_mesh_names, & - extrusion, & - stencil_depths, & - apply_partition_check ) - + base_mesh_names, extrusion, & + inner_halo_tiles, tile_size, & + stencil_depths, check_partitions ) allocate( twod_names, source=base_mesh_names ) do i=1, size(twod_names) twod_names(i) = trim(twod_names(i))//'_2d' end do + + if (allocated(tile_size)) deallocate(tile_size) + allocate(tile_size(2, size(base_mesh_names))) + tile_size(1,:) = tile_size_x + tile_size(2,:) = tile_size_y + if (l_multigrid) then + multigrid_tile_size = get_multigrid_tile_size( modeldb%config, & + base_mesh_names, & + extrusion_2d ) + where (multigrid_tile_size /= imdi) tile_size = multigrid_tile_size + end if call create_mesh( base_mesh_names, extrusion_2d, & + inner_halo_tiles, tile_size, & alt_name=twod_names ) call assign_mesh_maps(twod_names) @@ -731,8 +770,22 @@ subroutine initialise_infrastructure( io_context_name, modeldb ) do i=1, size(shifted_names) shifted_names(i) = trim(shifted_names(i))//'_shifted' end do + + if (allocated(tile_size)) deallocate(tile_size) + allocate(tile_size(2, size(meshes_to_shift))) + tile_size(1,:) = tile_size_x + tile_size(2,:) = tile_size_y + if (l_multigrid) then + multigrid_tile_size = get_multigrid_tile_size( modeldb%config, & + meshes_to_shift, & + extrusion_shifted ) + where (multigrid_tile_size /= imdi) tile_size = multigrid_tile_size + end if + call create_mesh( meshes_to_shift, & extrusion_shifted, & + inner_halo_tiles, & + tile_size, & alt_name=shifted_names ) call assign_mesh_maps(shifted_names) @@ -748,8 +801,22 @@ subroutine initialise_infrastructure( io_context_name, modeldb ) do i=1, size(double_names) double_names(i) = trim(double_names(i))//'_double' end do + + if (allocated(tile_size)) deallocate(tile_size) + allocate(tile_size(2, size(meshes_to_shift))) + tile_size(1,:) = tile_size_x + tile_size(2,:) = tile_size_y + if (l_multigrid) then + multigrid_tile_size = get_multigrid_tile_size( modeldb%config, & + meshes_to_double, & + extrusion_double ) + where (multigrid_tile_size /= imdi) tile_size = multigrid_tile_size + end if + call create_mesh( meshes_to_double, & extrusion_double, & + inner_halo_tiles, & + tile_size, & alt_name=double_names ) call assign_mesh_maps(double_names) @@ -763,9 +830,9 @@ subroutine initialise_infrastructure( io_context_name, modeldb ) chi_inventory => get_chi_inventory() panel_id_inventory => get_panel_id_inventory() - call init_fem( mesh_collection, chi_inventory, panel_id_inventory ) + call init_fem( modeldb%config, chi_inventory, panel_id_inventory ) if ( l_multigrid ) then - call init_function_space_chains( mesh_collection, chain_mesh_tags ) + call init_multigrid_fs_chain(chain_mesh_tags) end if @@ -857,6 +924,7 @@ subroutine initialise_infrastructure( io_context_name, modeldb ) call init_io( io_context_name, prime_mesh_name, modeldb, & chi_inventory, panel_id_inventory, & + geometry, topology, & populate_filelist=files_init_ptr, & alt_mesh_names=extra_io_mesh_names, & before_close=before_context_close ) @@ -864,6 +932,7 @@ subroutine initialise_infrastructure( io_context_name, modeldb ) else call init_io( io_context_name, prime_mesh_name, modeldb, & chi_inventory, panel_id_inventory, & + geometry, topology, & populate_filelist=files_init_ptr, & before_close=before_context_close ) end if diff --git a/science/gungho/source/driver/iau_multifile_io/iau_firstfile_io_mod.F90 b/science/gungho/source/driver/iau_multifile_io/iau_firstfile_io_mod.F90 index 537c09d82..2e316fbfc 100644 --- a/science/gungho/source/driver/iau_multifile_io/iau_firstfile_io_mod.F90 +++ b/science/gungho/source/driver/iau_multifile_io/iau_firstfile_io_mod.F90 @@ -9,7 +9,7 @@ module iau_firstfile_io_mod use calendar_mod, only: calendar_type - use constants_mod, only: str_def, l_def + use constants_mod, only: str_def, l_def, i_def, r_def use driver_modeldb_mod, only: modeldb_type use field_collection_mod, only: field_collection_type use field_mod, only: field_type @@ -68,6 +68,11 @@ subroutine iau_incs_firstfile_io ( io_context_name, modeldb, & character(:), allocatable :: split_filename(:) character(str_def) :: short_filename + integer(i_def) :: geometry + integer(i_def) :: topology + integer(i_def) :: coord_system + real(r_def) :: scaled_radius + logical(l_def) :: use_xios_io procedure(callback_clock_arg), pointer :: before_close @@ -82,6 +87,11 @@ subroutine iau_incs_firstfile_io ( io_context_name, modeldb, & prime_mesh_name = modeldb%config%base_mesh%prime_mesh_name() use_xios_io = modeldb%config%io%use_xios_io() + geometry = modeldb%config%base_mesh%geometry() + topology = modeldb%config%base_mesh%topology() + coord_system = modeldb%config%finite_element%coord_system() + scaled_radius = modeldb%config%planet%scaled_radius() + split_filename = split_string( trim(iau_incs_path), '/' ) short_filename = trim(split_filename(size(split_filename))) @@ -118,10 +128,14 @@ subroutine iau_incs_firstfile_io ( io_context_name, modeldb, & allocate(tmp_calendar, source=step_calendar_type(time_origin, time_start)) - call io_context%initialise_xios_context( modeldb%mpi%get_comm(), & - chi, panel_id, & - modeldb%clock, tmp_calendar, & - before_close, & + call io_context%initialise_xios_context( modeldb%mpi%get_comm(), & + chi, panel_id, & + modeldb%clock, & + tmp_calendar, & + before_close, & + geometry, topology, & + coord_system, & + scaled_radius, & start_at_zero=.true. ) ! Finalise XIOS context call io_context%finalise_xios_context() diff --git a/science/gungho/source/driver/iau_multifile_io/iau_multifile_io_mod.F90 b/science/gungho/source/driver/iau_multifile_io/iau_multifile_io_mod.F90 index b223fbc54..34e216f3a 100644 --- a/science/gungho/source/driver/iau_multifile_io/iau_multifile_io_mod.F90 +++ b/science/gungho/source/driver/iau_multifile_io/iau_multifile_io_mod.F90 @@ -11,7 +11,8 @@ module iau_multifile_io_mod use base_mesh_config_mod, only: prime_mesh_name use calendar_mod, only: calendar_type - use constants_mod, only: str_def, str_max_filename, i_def + use constants_mod, only: str_def, str_max_filename, & + i_def, r_def use driver_modeldb_mod, only: modeldb_type use event_mod, only: event_action use event_actor_mod, only: event_actor_type @@ -265,11 +266,21 @@ subroutine step_multifile_io( io_context_name, modeldb, name ) character(str_def) :: time_origin character(str_def) :: time_start + integer(i_def) :: geometry + integer(i_def) :: topology + integer(i_def) :: coord_system + real(r_def) :: scaled_radius + procedure(event_action), pointer :: context_advance procedure(callback_clock_arg), pointer :: before_close nullify(before_close) + geometry = modeldb%config%base_mesh%geometry() + topology = modeldb%config%base_mesh%topology() + coord_system = modeldb%config%finite_element%coord_system() + scaled_radius = modeldb%config%planet%scaled_radius() + chi_inventory => get_chi_inventory() panel_id_inventory => get_panel_id_inventory() @@ -298,6 +309,8 @@ subroutine step_multifile_io( io_context_name, modeldb, name ) chi, panel_id, & modeldb%clock, tmp_calendar, & before_close, & + geometry, topology, & + coord_system, scaled_radius, & start_at_zero=.true. ) ! Attach context advancement to the model's clock diff --git a/science/gungho/source/kernel/core_dynamics/compute_dl_matrix_kernel_mod.F90 b/science/gungho/source/kernel/core_dynamics/compute_dl_matrix_kernel_mod.F90 index 550cbda86..74a80b751 100644 --- a/science/gungho/source/kernel/core_dynamics/compute_dl_matrix_kernel_mod.F90 +++ b/science/gungho/source/kernel/core_dynamics/compute_dl_matrix_kernel_mod.F90 @@ -27,6 +27,7 @@ module compute_dl_matrix_kernel_mod use kernel_mod, only: kernel_type use sci_coordinate_jacobian_mod, only: coordinate_jacobian + ! Configuration modules use base_mesh_config_mod, only: geometry, topology, & geometry_spherical use damping_layer_config_mod, only: dl_type, dl_type_latitude @@ -238,7 +239,9 @@ subroutine compute_dl_matrix_code(cell, nlayers, ncell_3d, & if (geometry == geometry_spherical) then call chi2llr(chi1_at_quad, chi2_at_quad, chi3_at_quad, & - ipanel, long_at_quad, lat_at_quad, r_at_quad) + ipanel, geometry, topology, & + coord_system, scaled_radius, & + long_at_quad, lat_at_quad, r_at_quad) z = r_at_quad - radius if (dl_type == dl_type_latitude) then diff --git a/science/gungho/source/kernel/core_dynamics/rotation_vector_mod.F90 b/science/gungho/source/kernel/core_dynamics/rotation_vector_mod.F90 index 8ed357832..d2bf1083d 100644 --- a/science/gungho/source/kernel/core_dynamics/rotation_vector_mod.F90 +++ b/science/gungho/source/kernel/core_dynamics/rotation_vector_mod.F90 @@ -14,7 +14,11 @@ module rotation_vector_mod use constants_mod, only: r_def, i_def -use planet_config_mod, only: scaled_omega + +! Configuration modules +use base_mesh_config_mod, only: geometry, topology +use finite_element_config_mod, only: coord_system +use planet_config_mod, only: scaled_radius, scaled_omega implicit none @@ -110,7 +114,9 @@ subroutine rotation_vector_sphere(ndf_chi, ngp_h, ngp_v, chi_1, chi_2, chi_3, & end do ! Need to obtain longitude, latitude and radius from position vector - call chi2llr(coords(1), coords(2), coords(3), panel_id, long, lat, r) + call chi2llr(coords(1), coords(2), coords(3), panel_id, & + geometry, topology, coord_system, scaled_radius, & + long, lat, r) ! Get (long,lat,r) components of planet rotation vector rotation_vec(1,i,j) = 0.0_r_def @@ -172,7 +178,9 @@ subroutine vert_vector_sphere(ndf_chi, ngp_h, ngp_v, chi_1, chi_2, chi_3, & end do ! Need to obtain longitude, latitude and radius from position vector - call chi2llr(coords(1), coords(2), coords(3), panel_id, long, lat, r) + call chi2llr(coords(1), coords(2), coords(3), panel_id, & + geometry, topology, coord_system, scaled_radius, & + long, lat, r) ! Get (long,lat,r) components of planet rotation vector vert_vec(1,i,j) = 0.0_r_def diff --git a/science/gungho/source/kernel/diagnostics/compute_total_aam_kernel_mod.F90 b/science/gungho/source/kernel/diagnostics/compute_total_aam_kernel_mod.F90 index 786b4f2d8..a71ee5fb4 100644 --- a/science/gungho/source/kernel/diagnostics/compute_total_aam_kernel_mod.F90 +++ b/science/gungho/source/kernel/diagnostics/compute_total_aam_kernel_mod.F90 @@ -25,6 +25,7 @@ module compute_total_aam_kernel_mod use fs_continuity_mod, only : W2, W3 use kernel_mod, only : kernel_type + ! Configuration modules use base_mesh_config_mod, only: geometry, topology use finite_element_config_mod, only: coord_system use planet_config_mod, only: scaled_radius @@ -195,10 +196,15 @@ subroutine compute_total_aam_code( & end do ! Obtain (X,Y,Z) and (lon,lat,r) coords - call chi2xyz(coords(1), coords(2), coords(3), & - ipanel, x_vec(1), x_vec(2), x_vec(3)) - call chi2llr(coords(1), coords(2), coords(3), & - ipanel, llr_vec(1), llr_vec(2), llr_vec(3)) + call chi2xyz( coords(1), coords(2), coords(3), & + ipanel, geometry, topology, & + coord_system, scaled_radius, & + x_vec(1), x_vec(2), x_vec(3) ) + + call chi2llr( coords(1), coords(2), coords(3), & + ipanel, geometry, topology, & + coord_system, scaled_radius, & + llr_vec(1), llr_vec(2), llr_vec(3) ) ! get position vector with spherical components r_vec(:) = cart2sphere_vector(x_vec, x_vec) diff --git a/science/gungho/source/kernel/external_forcing/deep_hot_jupiter_kernel_mod.F90 b/science/gungho/source/kernel/external_forcing/deep_hot_jupiter_kernel_mod.F90 index 376c727bf..19befcaa8 100644 --- a/science/gungho/source/kernel/external_forcing/deep_hot_jupiter_kernel_mod.F90 +++ b/science/gungho/source/kernel/external_forcing/deep_hot_jupiter_kernel_mod.F90 @@ -31,6 +31,11 @@ module deep_hot_jupiter_kernel_mod deep_hot_jupiter_equilibrium_theta use kernel_mod, only: kernel_type + ! Configuration modules + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -136,7 +141,9 @@ subroutine deep_hot_jupiter_code(nlayers, & coords(3) = coords(3) + chi_3( location )/ndf_chi end do - call chi2llr(coords(1), coords(2), coords(3), ipanel, lon, lat, radius) + call chi2llr( coords(1), coords(2), coords(3), ipanel, & + geometry, topology, coord_system, scaled_radius, & + lon, lat, radius ) do k = 0, nlayers diff --git a/science/gungho/source/kernel/external_forcing/earth_like_kernel_mod.F90 b/science/gungho/source/kernel/external_forcing/earth_like_kernel_mod.F90 index 8cd1cdf1c..de1991dbe 100644 --- a/science/gungho/source/kernel/external_forcing/earth_like_kernel_mod.F90 +++ b/science/gungho/source/kernel/external_forcing/earth_like_kernel_mod.F90 @@ -31,6 +31,11 @@ module earth_like_kernel_mod earth_like_equilibrium_theta use kernel_mod, only: kernel_type + ! Configuration modules + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -156,7 +161,9 @@ subroutine earth_like_code(nlayers, & coords(3) = coords(3) + chi_3( location )/ndf_chi end do - call chi2llr(coords(1), coords(2), coords(3), ipanel, lon, lat, radius) + call chi2llr(coords(1), coords(2), coords(3), ipanel, & + geometry, topology, coord_system, scaled_radius, & + lon, lat, radius) exner0 = exner_in_wth(map_wth(1)) diff --git a/science/gungho/source/kernel/external_forcing/held_suarez_fv_kernel_mod.F90 b/science/gungho/source/kernel/external_forcing/held_suarez_fv_kernel_mod.F90 index 63f3acc14..6c776c4b7 100644 --- a/science/gungho/source/kernel/external_forcing/held_suarez_fv_kernel_mod.F90 +++ b/science/gungho/source/kernel/external_forcing/held_suarez_fv_kernel_mod.F90 @@ -31,6 +31,11 @@ module held_suarez_fv_kernel_mod held_suarez_equilibrium_theta use external_forcing_config_mod, only: hs_random + ! Configuration modules + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -144,7 +149,9 @@ subroutine held_suarez_fv_code(nlayers, & coords(3) = coords(3) + chi_3( loc )/ndf_chi end do - call chi2llr(coords(1), coords(2), coords(3), ipanel, lon, lat, radius) + call chi2llr(coords(1), coords(2), coords(3), ipanel, & + geometry, topology, coord_system, scaled_radius, & + lon, lat, radius) exner0 = exner_in_wth(map_wth(1)) diff --git a/science/gungho/source/kernel/external_forcing/shallow_hot_jupiter_kernel_mod.F90 b/science/gungho/source/kernel/external_forcing/shallow_hot_jupiter_kernel_mod.F90 index 6413a4be0..eeb4e0426 100644 --- a/science/gungho/source/kernel/external_forcing/shallow_hot_jupiter_kernel_mod.F90 +++ b/science/gungho/source/kernel/external_forcing/shallow_hot_jupiter_kernel_mod.F90 @@ -31,6 +31,11 @@ module shallow_hot_jupiter_kernel_mod shallow_hot_jupiter_equilibrium_theta use kernel_mod, only: kernel_type + ! Configuration modules + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -156,7 +161,9 @@ subroutine shallow_hot_jupiter_code(nlayers, & coords(3) = coords(3) + chi_3( location )/ndf_chi end do - call chi2llr(coords(1), coords(2), coords(3), ipanel, lon, lat, radius) + call chi2llr(coords(1), coords(2), coords(3), ipanel, & + geometry, topology, coord_system, scaled_radius, & + lon, lat, radius) exner0 = exner_in_wth(map_wth(1)) diff --git a/science/gungho/source/kernel/external_forcing/tidally_locked_earth_kernel_mod.F90 b/science/gungho/source/kernel/external_forcing/tidally_locked_earth_kernel_mod.F90 index 3a052826b..fc9298a66 100644 --- a/science/gungho/source/kernel/external_forcing/tidally_locked_earth_kernel_mod.F90 +++ b/science/gungho/source/kernel/external_forcing/tidally_locked_earth_kernel_mod.F90 @@ -32,6 +32,11 @@ module tidally_locked_earth_kernel_mod use held_suarez_forcings_mod, only: held_suarez_newton_frequency use kernel_mod, only: kernel_type + ! Configuration modules + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -143,7 +148,10 @@ subroutine tidally_locked_earth_code(nlayers, & coords(3) = coords(3) + chi_3( location )/ndf_chi end do - call chi2llr(coords(1), coords(2), coords(3), ipanel, lon, lat, radius) + call chi2llr(coords(1), coords(2), coords(3), & + ipanel, geometry, topology, & + coord_system, scaled_radius, & + lon, lat, radius) exner0 = exner_in_wth(map_wth(1)) diff --git a/science/gungho/source/kernel/initialisation/hydrostatic_exner_kernel_mod.F90 b/science/gungho/source/kernel/initialisation/hydrostatic_exner_kernel_mod.F90 index 2b5206f60..2dbc29494 100644 --- a/science/gungho/source/kernel/initialisation/hydrostatic_exner_kernel_mod.F90 +++ b/science/gungho/source/kernel/initialisation/hydrostatic_exner_kernel_mod.F90 @@ -18,11 +18,16 @@ module hydrostatic_exner_kernel_mod ANY_DISCONTINUOUS_SPACE_3, & CELL_COLUMN, GH_EVALUATOR use constants_mod, only : r_def, i_def -use idealised_config_mod, only : test use kernel_mod, only : kernel_type use fs_continuity_mod, only : Wtheta, W3 use formulation_config_mod, only : init_exner_bt, shallow +! Configuration modules +use base_mesh_config_mod, only: geometry, topology +use finite_element_config_mod, only: coord_system +use idealised_config_mod, only: test +use planet_config_mod, only: scaled_radius + implicit none private @@ -174,7 +179,10 @@ subroutine hydrostatic_exner_code(nlayers, exner, theta, & coords(3) = coords(3) + chi_3_e(dfc)*basis_chi_on_wt(1,dfc,wt_dof) end do - call chi2xyz(coords(1), coords(2), coords(3), ipanel, xyz(1), xyz(2), xyz(3)) + call chi2xyz( coords(1), coords(2), coords(3), & + ipanel, geometry, topology, & + coord_system, scaled_radius, & + xyz(1), xyz(2), xyz(3) ) ! Exner at the model surface or top exner_start = analytic_pressure( xyz, test, 0.0_r_def) diff --git a/science/gungho/source/kernel/initialisation/initial_exner_sample_kernel_mod.F90 b/science/gungho/source/kernel/initialisation/initial_exner_sample_kernel_mod.F90 index 08f6e076c..3ae802f4e 100644 --- a/science/gungho/source/kernel/initialisation/initial_exner_sample_kernel_mod.F90 +++ b/science/gungho/source/kernel/initialisation/initial_exner_sample_kernel_mod.F90 @@ -16,9 +16,14 @@ module initial_exner_sample_kernel_mod GH_EVALUATOR use constants_mod, only : r_def, i_def use fs_continuity_mod, only : W3 - use idealised_config_mod, only : test use kernel_mod, only : kernel_type + ! Configuration modules + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system + use idealised_config_mod, only: test + use planet_config_mod, only: scaled_radius + implicit none private @@ -130,8 +135,10 @@ subroutine initial_exner_sample_code(nlayers, & coords(3) = coords(3) + chi_3_e(df1)*basis_chi_on_w3(1,df1,df) end do - call chi2xyz(coords(1), coords(2), coords(3), & - ipanel, xyz(1), xyz(2), xyz(3)) + call chi2xyz( coords(1), coords(2), coords(3), & + ipanel, geometry, topology, & + coord_system, scaled_radius, & + xyz(1), xyz(2), xyz(3) ) exner(map_w3(df) + k) = analytic_pressure(xyz, test, current_time) diff --git a/science/gungho/source/kernel/initialisation/initial_mr_kernel_mod.F90 b/science/gungho/source/kernel/initialisation/initial_mr_kernel_mod.F90 index e3fd12f7b..383deb378 100644 --- a/science/gungho/source/kernel/initialisation/initial_mr_kernel_mod.F90 +++ b/science/gungho/source/kernel/initialisation/initial_mr_kernel_mod.F90 @@ -13,55 +13,61 @@ module initial_mr_kernel_mod - use argument_mod, only: arg_type, func_type, & - GH_FIELD, GH_REAL, & - GH_SCALAR, GH_BASIS, & - GH_WRITE, GH_READ, & - ANY_SPACE_9, & - ANY_DISCONTINUOUS_SPACE_3, & - GH_EVALUATOR, CELL_COLUMN - use fs_continuity_mod, only: W3, Wtheta - use constants_mod, only: r_def, i_def - use kernel_mod, only: kernel_type - use section_choice_config_mod, only: cloud, cloud_um - use idealised_config_mod, only: test, test_bryan_fritsch, & - test_grabowski_clark, & - test_isot_dry_atm - use initial_pressure_config_mod, only: method, method_balanced - - implicit none + use argument_mod, only: arg_type, func_type, & + GH_FIELD, GH_REAL, & + GH_SCALAR, GH_BASIS, & + GH_WRITE, GH_READ, & + ANY_SPACE_9, & + ANY_DISCONTINUOUS_SPACE_3, & + GH_EVALUATOR, CELL_COLUMN + use fs_continuity_mod, only: W3, Wtheta + use constants_mod, only: r_def, i_def + use kernel_mod, only: kernel_type + use section_choice_config_mod, only: cloud, cloud_um + use idealised_config_mod, only: test, test_bryan_fritsch, & + test_grabowski_clark, & + test_isot_dry_atm + use initial_pressure_config_mod, only: method, method_balanced + + ! Configuration modules + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + + implicit none + private + + !------------------------------------------------------------------------------- + ! Public types + !------------------------------------------------------------------------------- + !> The type declaration for the kernel. Contains the metadata needed by the Psy layer + type, public, extends(kernel_type) :: initial_mr_kernel_type private + type(arg_type) :: meta_args(9) = (/ & + arg_type(GH_FIELD, GH_REAL, GH_READ, Wtheta), & + arg_type(GH_FIELD, GH_REAL, GH_READ, W3), & + arg_type(GH_FIELD, GH_REAL, GH_READ, W3), & + arg_type(GH_FIELD*6, GH_REAL, GH_WRITE, Wtheta), & + arg_type(GH_FIELD*3, GH_REAL, GH_READ, ANY_SPACE_9), & + arg_type(GH_FIELD, GH_REAL, GH_READ, ANY_DISCONTINUOUS_SPACE_3), & + arg_type(GH_SCALAR, GH_REAL, GH_READ), & + arg_type(GH_SCALAR, GH_REAL, GH_READ), & + arg_type(GH_SCALAR, GH_REAL, GH_READ) & + /) + type(func_type) :: meta_funcs(1) = (/ & + func_type(ANY_SPACE_9, GH_BASIS) & + /) + integer :: operates_on = CELL_COLUMN + integer :: gh_shape = GH_EVALUATOR + contains + procedure, nopass :: initial_mr_code + end type + +!------------------------------------------------------------------------------- +! Contained functions/subroutines +!------------------------------------------------------------------------------- + public :: initial_mr_code - !------------------------------------------------------------------------------- - ! Public types - !------------------------------------------------------------------------------- - !> The type declaration for the kernel. Contains the metadata needed by the Psy layer - type, public, extends(kernel_type) :: initial_mr_kernel_type - private - type(arg_type) :: meta_args(9) = (/ & - arg_type(GH_FIELD, GH_REAL, GH_READ, Wtheta), & - arg_type(GH_FIELD, GH_REAL, GH_READ, W3), & - arg_type(GH_FIELD, GH_REAL, GH_READ, W3), & - arg_type(GH_FIELD*6, GH_REAL, GH_WRITE, Wtheta), & - arg_type(GH_FIELD*3, GH_REAL, GH_READ, ANY_SPACE_9), & - arg_type(GH_FIELD, GH_REAL, GH_READ, ANY_DISCONTINUOUS_SPACE_3), & - arg_type(GH_SCALAR, GH_REAL, GH_READ), & - arg_type(GH_SCALAR, GH_REAL, GH_READ), & - arg_type(GH_SCALAR, GH_REAL, GH_READ) & - /) - type(func_type) :: meta_funcs(1) = (/ & - func_type(ANY_SPACE_9, GH_BASIS) & - /) - integer :: operates_on = CELL_COLUMN - integer :: gh_shape = GH_EVALUATOR - contains - procedure, nopass :: initial_mr_code - end type - - !------------------------------------------------------------------------------- - ! Contained functions/subroutines - !------------------------------------------------------------------------------- - public :: initial_mr_code contains !> @brief The subroutine which is called directly by the Psy layer @@ -169,8 +175,10 @@ subroutine initial_mr_code(nlayers, theta, exner, rho, & coords(3) = coords(3) + chi_3_e(dfc)*chi_basis(1,dfc,df) end do - call chi2xyz(coords(1), coords(2), coords(3), & - ipanel, xyz(1), xyz(2), xyz(3)) + call chi2xyz( coords(1), coords(2), coords(3), & + ipanel, geometry, topology, & + coord_system, scaled_radius, & + xyz(1), xyz(2), xyz(3) ) !----------------------------------------------------------------------! ! Get thermodynamic variables at DoF @@ -234,8 +242,10 @@ subroutine initial_mr_code(nlayers, theta, exner, rho, & coords(3) = coords(3) + chi_3_e(dfc)*chi_basis(1,dfc,df) end do - call chi2xyz(coords(1), coords(2), coords(3), & - ipanel, xyz(1), xyz(2), xyz(3)) + call chi2xyz( coords(1), coords(2), coords(3), & + ipanel, geometry, topology, & + coord_system, scaled_radius, & + xyz(1), xyz(2), xyz(3) ) !----------------------------------------------------------------------! ! Get thermodynamic variables at DoF diff --git a/science/gungho/source/kernel/initialisation/initial_rho_sample_kernel_mod.F90 b/science/gungho/source/kernel/initialisation/initial_rho_sample_kernel_mod.F90 index 4327e91d1..f57fbf3fe 100644 --- a/science/gungho/source/kernel/initialisation/initial_rho_sample_kernel_mod.F90 +++ b/science/gungho/source/kernel/initialisation/initial_rho_sample_kernel_mod.F90 @@ -20,9 +20,14 @@ module initial_rho_sample_kernel_mod ANY_DISCONTINUOUS_SPACE_3, & CELL_COLUMN, GH_EVALUATOR use constants_mod, only : r_def, i_def - use idealised_config_mod, only : test use kernel_mod, only : kernel_type + ! Configuration modules + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system + use idealised_config_mod, only: test + use planet_config_mod, only: scaled_radius + implicit none private @@ -130,8 +135,10 @@ subroutine initial_rho_sample_kernel_code(nlayers, & coords(3) = coords(3) + chi_3_e(df1)*chi_basis(1,df1,df) end do - call chi2xyz(coords(1), coords(2), coords(3), & - ipanel, xyz(1), xyz(2), xyz(3)) + call chi2xyz( coords(1), coords(2), coords(3), & + ipanel, geometry, topology, & + coord_system, scaled_radius, & + xyz(1), xyz(2), xyz(3) ) rho(map_rho(df) + k) = analytic_density(xyz, test, time) diff --git a/science/gungho/source/kernel/initialisation/initial_streamfunc_kernel_mod.F90 b/science/gungho/source/kernel/initialisation/initial_streamfunc_kernel_mod.F90 index e6f53573f..eda2e60e7 100644 --- a/science/gungho/source/kernel/initialisation/initial_streamfunc_kernel_mod.F90 +++ b/science/gungho/source/kernel/initialisation/initial_streamfunc_kernel_mod.F90 @@ -18,12 +18,13 @@ module initial_streamfunc_kernel_mod use constants_mod, only : r_def, i_def, PI use fs_continuity_mod, only : W1 use kernel_mod, only : kernel_type -use initial_wind_config_mod, only : profile +! Configuration modules use base_mesh_config_mod, only: geometry, topology, & geometry_planar, & geometry_spherical use finite_element_config_mod, only: coord_system +use initial_wind_config_mod, only: profile use planet_config_mod, only: scaled_radius implicit none @@ -201,8 +202,10 @@ subroutine initial_streamfunc_code(nlayers, & if ( geometry == geometry_spherical ) then ! Need (lon,lat,r) coordinates - call chi2llr(coords(1), coords(2), coords(3), & - ipanel, llr(1), llr(2), llr(3)) + call chi2llr( coords(1), coords(2), coords(3), & + ipanel, geometry, topology, & + coord_system, scaled_radius, & + llr(1), llr(2), llr(3) ) psi_spherical = analytic_streamfunction( llr, profile, 3, option3, & time, domain_max_x ) diff --git a/science/gungho/source/kernel/initialisation/initial_theta_kernel_mod.F90 b/science/gungho/source/kernel/initialisation/initial_theta_kernel_mod.F90 index 55dfe8df7..adbbcee58 100644 --- a/science/gungho/source/kernel/initialisation/initial_theta_kernel_mod.F90 +++ b/science/gungho/source/kernel/initialisation/initial_theta_kernel_mod.F90 @@ -13,122 +13,130 @@ module initial_theta_kernel_mod - use argument_mod, only: arg_type, func_type, & - GH_FIELD, GH_REAL, & - GH_WRITE, GH_READ, & - ANY_SPACE_9, GH_BASIS, & - ANY_DISCONTINUOUS_SPACE_3, & - CELL_COLUMN, GH_EVALUATOR - use constants_mod, only: r_def, i_def - use fs_continuity_mod, only: Wtheta - use kernel_mod, only: kernel_type - use idealised_config_mod, only: test - - implicit none - + use argument_mod, only: arg_type, func_type, & + GH_FIELD, GH_REAL, & + GH_WRITE, GH_READ, & + ANY_SPACE_9, GH_BASIS, & + ANY_DISCONTINUOUS_SPACE_3, & + CELL_COLUMN, GH_EVALUATOR + use constants_mod, only: r_def, i_def + use fs_continuity_mod, only: Wtheta + use kernel_mod, only: kernel_type + + ! Configuration modules + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system + use idealised_config_mod, only: test + use planet_config_mod, only: scaled_radius + + implicit none + + private + + !------------------------------------------------------------------------------- + ! Public types + !------------------------------------------------------------------------------- + !> The type declaration for the kernel. Contains the metadata needed by the Psy layer + type, public, extends(kernel_type) :: initial_theta_kernel_type private - - !------------------------------------------------------------------------------- - ! Public types - !------------------------------------------------------------------------------- - !> The type declaration for the kernel. Contains the metadata needed by the Psy layer - type, public, extends(kernel_type) :: initial_theta_kernel_type - private - type(arg_type) :: meta_args(3) = (/ & - arg_type(GH_FIELD, GH_REAL, GH_WRITE, Wtheta), & - arg_type(GH_FIELD*3, GH_REAL, GH_READ, ANY_SPACE_9), & - arg_type(GH_FIELD, GH_REAL, GH_READ, ANY_DISCONTINUOUS_SPACE_3) & - /) - type(func_type) :: meta_funcs(1) = (/ & - func_type(ANY_SPACE_9, GH_BASIS) & - /) - integer :: operates_on = CELL_COLUMN - integer :: gh_shape = GH_EVALUATOR - contains - procedure, nopass :: initial_theta_code - end type - - !------------------------------------------------------------------------------- - ! Contained functions/subroutines - !------------------------------------------------------------------------------- - public :: initial_theta_code + type(arg_type) :: meta_args(3) = (/ & + arg_type(GH_FIELD, GH_REAL, GH_WRITE, Wtheta), & + arg_type(GH_FIELD*3, GH_REAL, GH_READ, ANY_SPACE_9), & + arg_type(GH_FIELD, GH_REAL, GH_READ, ANY_DISCONTINUOUS_SPACE_3) & + /) + type(func_type) :: meta_funcs(1) = (/ & + func_type(ANY_SPACE_9, GH_BASIS) & + /) + integer :: operates_on = CELL_COLUMN + integer :: gh_shape = GH_EVALUATOR + contains + procedure, nopass :: initial_theta_code + end type + + !------------------------------------------------------------------------------- + ! Contained functions/subroutines + !------------------------------------------------------------------------------- + public :: initial_theta_code contains - !> @brief Computes the initial theta field - !! @param[in] nlayers Number of layers - !! @param[in,out] theta Potential temperature - !! @param[in] chi_1 First component of the chi coordinate field - !! @param[in] chi_2 Second component of the chi coordinate field - !! @param[in] chi_3 Third component of the chi coordinate field - !! @param[in] panel_id A field giving the ID for mesh panels - !! @param[in] ndf_wtheta Number of degrees of freedom per cell for wtheta - !! @param[in] undf_wtheta Number of total degrees of freedom for wtheta - !! @param[in] map_wtheta Dofmap for the cell at the base of the column - !! @param[in] ndf_chi Number of degrees of freedom per cell for chi - !! @param[in] undf_chi Number of total degrees of freedom for chi - !! @param[in] map_chi Dofmap for the cell at the base of the column - !! @param[in] chi_basis Basis functions evaluated at Wtheta points - !! @param[in] ndf_pid Number of degrees of freedom per cell for panel_id - !! @param[in] undf_pid Number of unique degrees of freedom for panel_id - !! @param[in] map_pid Dofmap for the cell at the base of the column for panel_id - subroutine initial_theta_code(nlayers, & - theta, & - chi_1, chi_2, chi_3, & - panel_id, & - ndf_wtheta, undf_wtheta, map_wtheta, & - ndf_chi, undf_chi, map_chi, chi_basis, & - ndf_pid, undf_pid, map_pid ) - - use analytic_temperature_profiles_mod, only : analytic_temperature - use sci_chi_transform_mod, only : chi2xyz - - implicit none - - ! Arguments - integer(kind=i_def), intent(in) :: nlayers, ndf_wtheta, ndf_chi, ndf_pid - integer(kind=i_def), intent(in) :: undf_wtheta, undf_chi, undf_pid - - integer(kind=i_def), dimension(ndf_wtheta), intent(in) :: map_wtheta - integer(kind=i_def), dimension(ndf_chi), intent(in) :: map_chi - integer(kind=i_def), dimension(ndf_pid), intent(in) :: map_pid - - real(kind=r_def), dimension(undf_wtheta), intent(inout) :: theta - real(kind=r_def), dimension(undf_chi), intent(in) :: chi_1, chi_2, chi_3 - real(kind=r_def), dimension(undf_pid), intent(in) :: panel_id - real(kind=r_def), dimension(1,ndf_chi,ndf_wtheta), intent(in) :: chi_basis - - ! Internal variables - real(kind=r_def), dimension(ndf_chi) :: chi_1_e, chi_2_e, chi_3_e - real(kind=r_def) :: coords(3), xyz(3) - integer(kind=i_def) :: df, dfc, k, ipanel - - ipanel = int(panel_id(map_pid(1)), i_def) - - ! Compute the pointwise theta profile - - do k = 0, nlayers-1 - do dfc = 1, ndf_chi - chi_1_e(dfc) = chi_1( map_chi(dfc) + k) - chi_2_e(dfc) = chi_2( map_chi(dfc) + k) - chi_3_e(dfc) = chi_3( map_chi(dfc) + k) - end do - - do df = 1, ndf_wtheta - coords(:) = 0.0_r_def - do dfc = 1, ndf_chi - coords(1) = coords(1) + chi_1_e(dfc)*chi_basis(1,dfc,df) - coords(2) = coords(2) + chi_2_e(dfc)*chi_basis(1,dfc,df) - coords(3) = coords(3) + chi_3_e(dfc)*chi_basis(1,dfc,df) - end do - - call chi2xyz(coords(1), coords(2), coords(3), & - ipanel, xyz(1), xyz(2), xyz(3)) - theta(map_wtheta(df) + k) = analytic_temperature(xyz, test) - - end do - end do - - end subroutine initial_theta_code +!> @brief Computes the initial theta field +!! @param[in] nlayers Number of layers +!! @param[in,out] theta Potential temperature +!! @param[in] chi_1 First component of the chi coordinate field +!! @param[in] chi_2 Second component of the chi coordinate field +!! @param[in] chi_3 Third component of the chi coordinate field +!! @param[in] panel_id A field giving the ID for mesh panels +!! @param[in] ndf_wtheta Number of degrees of freedom per cell for wtheta +!! @param[in] undf_wtheta Number of total degrees of freedom for wtheta +!! @param[in] map_wtheta Dofmap for the cell at the base of the column +!! @param[in] ndf_chi Number of degrees of freedom per cell for chi +!! @param[in] undf_chi Number of total degrees of freedom for chi +!! @param[in] map_chi Dofmap for the cell at the base of the column +!! @param[in] chi_basis Basis functions evaluated at Wtheta points +!! @param[in] ndf_pid Number of degrees of freedom per cell for panel_id +!! @param[in] undf_pid Number of unique degrees of freedom for panel_id +!! @param[in] map_pid Dofmap for the cell at the base of the column for panel_id +subroutine initial_theta_code(nlayers, & + theta, & + chi_1, chi_2, chi_3, & + panel_id, & + ndf_wtheta, undf_wtheta, map_wtheta, & + ndf_chi, undf_chi, map_chi, chi_basis, & + ndf_pid, undf_pid, map_pid ) + + use analytic_temperature_profiles_mod, only : analytic_temperature + use sci_chi_transform_mod, only : chi2xyz + + implicit none + + ! Arguments + integer(kind=i_def), intent(in) :: nlayers, ndf_wtheta, ndf_chi, ndf_pid + integer(kind=i_def), intent(in) :: undf_wtheta, undf_chi, undf_pid + + integer(kind=i_def), dimension(ndf_wtheta), intent(in) :: map_wtheta + integer(kind=i_def), dimension(ndf_chi), intent(in) :: map_chi + integer(kind=i_def), dimension(ndf_pid), intent(in) :: map_pid + + real(kind=r_def), dimension(undf_wtheta), intent(inout) :: theta + real(kind=r_def), dimension(undf_chi), intent(in) :: chi_1, chi_2, chi_3 + real(kind=r_def), dimension(undf_pid), intent(in) :: panel_id + real(kind=r_def), dimension(1,ndf_chi,ndf_wtheta), intent(in) :: chi_basis + + ! Internal variables + real(kind=r_def), dimension(ndf_chi) :: chi_1_e, chi_2_e, chi_3_e + real(kind=r_def) :: coords(3), xyz(3) + integer(kind=i_def) :: df, dfc, k, ipanel + + ipanel = int(panel_id(map_pid(1)), i_def) + + ! Compute the pointwise theta profile + + do k = 0, nlayers-1 + do dfc = 1, ndf_chi + chi_1_e(dfc) = chi_1( map_chi(dfc) + k) + chi_2_e(dfc) = chi_2( map_chi(dfc) + k) + chi_3_e(dfc) = chi_3( map_chi(dfc) + k) + end do + + do df = 1, ndf_wtheta + coords(:) = 0.0_r_def + do dfc = 1, ndf_chi + coords(1) = coords(1) + chi_1_e(dfc)*chi_basis(1,dfc,df) + coords(2) = coords(2) + chi_2_e(dfc)*chi_basis(1,dfc,df) + coords(3) = coords(3) + chi_3_e(dfc)*chi_basis(1,dfc,df) + end do + + call chi2xyz( coords(1), coords(2), coords(3), & + ipanel, geometry, topology, & + coord_system, scaled_radius, & + xyz(1), xyz(2), xyz(3) ) + + theta(map_wtheta(df) + k) = analytic_temperature(xyz, test) + + end do + end do + +end subroutine initial_theta_code end module initial_theta_kernel_mod diff --git a/science/gungho/source/kernel/initialisation/initial_u_kernel_mod.F90 b/science/gungho/source/kernel/initialisation/initial_u_kernel_mod.F90 index ca19b15bb..990a77731 100644 --- a/science/gungho/source/kernel/initialisation/initial_u_kernel_mod.F90 +++ b/science/gungho/source/kernel/initialisation/initial_u_kernel_mod.F90 @@ -22,6 +22,7 @@ module initial_u_kernel_mod use fs_continuity_mod, only : W2 use kernel_mod, only : kernel_type + ! Configuration modules use base_mesh_config_mod, only: geometry, topology, & geometry_spherical use finite_element_config_mod, only: coord_system @@ -63,52 +64,52 @@ module initial_u_kernel_mod !----------------------------------------------------------------------------- ! Contained functions/subroutines !----------------------------------------------------------------------------- -public :: initial_u_code + public :: initial_u_code contains - !> @brief Compute the right hand side to initialise the wind field. - !! @param[in] nlayers Number of layers - !! @param[in,out] rhs Right hand side field to compute - !! @param[in] chi_1 1st coordinate field - !! @param[in] chi_2 2nd coordinate field - !! @param[in] chi_3 3rd coordinate field - !! @param[in] panel_id A field giving the ID for mesh panels. - !! @param[in] time Time (timestep multiplied by dt) - !! @param[in] domain_max_x Domain maximum x-coordinate. - !! @param[in] domain_max_y Domain maximum y-coordinate. - !! @param[in] ndf Number of degrees of freedom per cell for W2 - !! @param[in] undf Total number of degrees of freedom for W2 - !! @param[in] map Dofmap for the cell at the base of the column for W2 - !! @param[in] basis Basis functions for W2 evaluated at gaussian quadrature points - !! @param[in] ndf_chi Number of degrees of freedom per cell for chi - !! @param[in] undf_chi Number of unique degrees of freedom for chi - !! @param[in] map_chi Dofmap for the cell at the base of the column for chi - !! @param[in] chi_basis Basis functions for Wchi evaluated at - !! gaussian quadrature points - !! @param[in] chi_diff_basis Differential of the Wchi basis functions - !! evaluated at gaussian quadrature point - !! @param[in] ndf_pid Number of degrees of freedom per cell for panel_id - !! @param[in] undf_pid Number of unique degrees of freedom for panel_id - !! @param[in] map_pid Dofmap for the cell at the base of the column for panel_id - !! @param[in] nqp_h Number of quadrature points in the horizontal - !! @param[in] nqp_v Number of quadrature points in the vertical - !! @param[in] wqp_h Horizontal quadrature weights - !! @param[in] wqp_v Vertical quadrature weights - subroutine initial_u_code(nlayers, & - rhs, & - chi_1, chi_2, chi_3, & - panel_id, & - time, & - domain_max_x, & - domain_max_y, & - ndf, undf, map, basis, & - ndf_chi, undf_chi, & - map_chi, chi_basis, & - chi_diff_basis, & - ndf_pid, undf_pid, map_pid, & - nqp_h, nqp_v, wqp_h, wqp_v & - ) +!> @brief Compute the right hand side to initialise the wind field. +!! @param[in] nlayers Number of layers +!! @param[in,out] rhs Right hand side field to compute +!! @param[in] chi_1 1st coordinate field +!! @param[in] chi_2 2nd coordinate field +!! @param[in] chi_3 3rd coordinate field +!! @param[in] panel_id A field giving the ID for mesh panels. +!! @param[in] time Time (timestep multiplied by dt) +!! @param[in] domain_max_x Domain maximum x-coordinate. +!! @param[in] domain_max_y Domain maximum y-coordinate. +!! @param[in] ndf Number of degrees of freedom per cell for W2 +!! @param[in] undf Total number of degrees of freedom for W2 +!! @param[in] map Dofmap for the cell at the base of the column for W2 +!! @param[in] basis Basis functions for W2 evaluated at gaussian quadrature points +!! @param[in] ndf_chi Number of degrees of freedom per cell for chi +!! @param[in] undf_chi Number of unique degrees of freedom for chi +!! @param[in] map_chi Dofmap for the cell at the base of the column for chi +!! @param[in] chi_basis Basis functions for Wchi evaluated at +!! gaussian quadrature points +!! @param[in] chi_diff_basis Differential of the Wchi basis functions +!! evaluated at gaussian quadrature point +!! @param[in] ndf_pid Number of degrees of freedom per cell for panel_id +!! @param[in] undf_pid Number of unique degrees of freedom for panel_id +!! @param[in] map_pid Dofmap for the cell at the base of the column for panel_id +!! @param[in] nqp_h Number of quadrature points in the horizontal +!! @param[in] nqp_v Number of quadrature points in the vertical +!! @param[in] wqp_h Horizontal quadrature weights +!! @param[in] wqp_v Vertical quadrature weights +subroutine initial_u_code(nlayers, & + rhs, & + chi_1, chi_2, chi_3, & + panel_id, & + time, & + domain_max_x, & + domain_max_y, & + ndf, undf, map, basis, & + ndf_chi, undf_chi, & + map_chi, chi_basis, & + chi_diff_basis, & + ndf_pid, undf_pid, map_pid, & + nqp_h, nqp_v, wqp_h, wqp_v & + ) use analytic_wind_profiles_mod, only : analytic_wind use sci_chi_transform_mod, only : chi2llr @@ -207,8 +208,10 @@ subroutine initial_u_code(nlayers, & if ( geometry == geometry_spherical ) then ! Need to obtain longitude, latitude and radius from position vector - call chi2llr(coords(1), coords(2), coords(3), & - ipanel, llr(1), llr(2), llr(3)) + call chi2llr( coords(1), coords(2), coords(3), & + ipanel, geometry, topology, & + coord_system, scaled_radius, & + llr(1), llr(2), llr(3) ) ! Obtain (lon,lat,r) components of u and then transform to (X,Y,Z) components u_spherical = analytic_wind( llr, time, profile, n_options, & diff --git a/science/gungho/source/kernel/initialisation/set_exner_kernel_mod.F90 b/science/gungho/source/kernel/initialisation/set_exner_kernel_mod.F90 index 692fda7c8..779ab42b7 100644 --- a/science/gungho/source/kernel/initialisation/set_exner_kernel_mod.F90 +++ b/science/gungho/source/kernel/initialisation/set_exner_kernel_mod.F90 @@ -18,6 +18,7 @@ module set_exner_kernel_mod use fs_continuity_mod, only : W3 use kernel_mod, only : kernel_type + ! Configuration modules use base_mesh_config_mod, only: geometry, topology use finite_element_config_mod, only: coord_system use idealised_config_mod, only: test @@ -166,7 +167,9 @@ subroutine set_exner_code(nlayers, & ! Get (X,Y,Z) coordinates call chi2xyz(coords(1), coords(2), coords(3), & - ipanel, xyz(1), xyz(2), xyz(3)) + ipanel, geometry, topology, & + coord_system, scaled_radius, & + xyz(1), xyz(2), xyz(3) ) exner_ref = analytic_pressure(xyz, test, time) diff --git a/science/gungho/source/kernel/initialisation/set_rho_kernel_mod.F90 b/science/gungho/source/kernel/initialisation/set_rho_kernel_mod.F90 index 670c72a7a..e9006ae26 100644 --- a/science/gungho/source/kernel/initialisation/set_rho_kernel_mod.F90 +++ b/science/gungho/source/kernel/initialisation/set_rho_kernel_mod.F90 @@ -19,6 +19,7 @@ module set_rho_kernel_mod use constants_mod, only : r_def, i_def use kernel_mod, only : kernel_type + ! Configuration modules use base_mesh_config_mod, only: geometry, topology use finite_element_config_mod, only: coord_system use idealised_config_mod, only: test @@ -166,8 +167,10 @@ subroutine set_rho_code(nlayers, rho, & end do ! Need (X,Y,Z) coordinate - call chi2xyz(coords(1), coords(2), coords(3), & - ipanel, xyz(1), xyz(2), xyz(3)) + call chi2xyz( coords(1), coords(2), coords(3), & + ipanel, geometry, topology, & + coord_system, scaled_radius, & + xyz(1), xyz(2), xyz(3) ) rho_ref = analytic_density(xyz, test, time) diff --git a/science/gungho/source/kernel/transport/common/panel_edge_coords_kernel_mod.F90 b/science/gungho/source/kernel/transport/common/panel_edge_coords_kernel_mod.F90 index cdfd8984c..2c1776e18 100644 --- a/science/gungho/source/kernel/transport/common/panel_edge_coords_kernel_mod.F90 +++ b/science/gungho/source/kernel/transport/common/panel_edge_coords_kernel_mod.F90 @@ -18,6 +18,11 @@ module panel_edge_coords_kernel_mod OWNED_AND_HALO_CELL_COLUMN use constants_mod, only: r_def, i_def, l_def +! Configuration modules +use base_mesh_config_mod, only: geometry, topology +use finite_element_config_mod, only: coord_system +use planet_config_mod, only: scaled_radius + implicit none private @@ -221,10 +226,9 @@ subroutine panel_edge_coords_1d( alpha, beta, chi_1, chi_2, chi_3, & ! Fill small local arrays with the coordinates do df = 1, ndf_wx ! Ignore height coordinate as this is not needed - call chi2xyz( & - chi_1(map_wx(df)), chi_2(map_wx(df)), chi_3(map_wx(df)), & - owned_panel, xyz(1), xyz(2), xyz(3) & - ) + call chi2xyz( chi_1(map_wx(df)), chi_2(map_wx(df)), chi_3(map_wx(df)), & + owned_panel, geometry, topology, coord_system, scaled_radius, & + xyz(1), xyz(2), xyz(3) ) ! Transform to the Cartesian coordinates in the *native* coordinate system ! by applying the inverse of any mesh rotation and stretching: if (to_rotate) then diff --git a/science/gungho/source/kernel/transport/common/panel_edge_weights_kernel_mod.F90 b/science/gungho/source/kernel/transport/common/panel_edge_weights_kernel_mod.F90 index 2a4e40b85..9367ec6e4 100644 --- a/science/gungho/source/kernel/transport/common/panel_edge_weights_kernel_mod.F90 +++ b/science/gungho/source/kernel/transport/common/panel_edge_weights_kernel_mod.F90 @@ -22,6 +22,11 @@ module panel_edge_weights_kernel_mod use constants_mod, only: r_tran, r_def, i_def, l_def, LARGE_REAL_POSITIVE use reference_element_mod, only: W, S, N, E +! Configuration modules +use base_mesh_config_mod, only: geometry, topology +use finite_element_config_mod, only: coord_system +use planet_config_mod, only: scaled_radius + implicit none private @@ -449,7 +454,8 @@ subroutine panel_edge_weights_1d( remap_weights, remap_indices, & ! Convert chi fields to native cubed-sphere coordinates, on owned panel call chi2xyz( & alpha(wx_stencil_1d(df, n)), beta(wx_stencil_1d(df, n)), & - unit_radius, owned_panel, xyz(1), xyz(2), xyz(3) & + unit_radius, owned_panel, geometry, topology, coord_system, & + scaled_radius, xyz(1), xyz(2), xyz(3) & ) ! Transform to the Cartesian coordinates in the *native* coordinate ! system by applying the inverse of any mesh rotation and stretching: diff --git a/science/gungho/source/kernel/transport/mol/poly1d_advective_coeffs_kernel_mod.F90 b/science/gungho/source/kernel/transport/mol/poly1d_advective_coeffs_kernel_mod.F90 index ffa40a452..84fb98103 100644 --- a/science/gungho/source/kernel/transport/mol/poly1d_advective_coeffs_kernel_mod.F90 +++ b/science/gungho/source/kernel/transport/mol/poly1d_advective_coeffs_kernel_mod.F90 @@ -35,6 +35,10 @@ module poly1d_advective_coeffs_kernel_mod use fs_continuity_mod, only : Wtheta use kernel_mod, only : kernel_type +! Configuration modules +use base_mesh_config_mod, only: geometry, topology +use finite_element_config_mod, only: coord_system + implicit none private @@ -300,8 +304,11 @@ subroutine poly1d_advective_coeffs_code(one_layer, & ! Convert x0 to XYZ coordinate system ipanel = int(panel_id(smap_pid(1,1)), i_def) chi = x0 + r0 - call chir2xyz(chi(1), chi(2), chi(3), & - ipanel, x0(1), x0(2), x0(3)) + call chir2xyz( chi(1), chi(2), chi(3), & + ipanel, geometry, & + topology, coord_system, & + x0(1), x0(2), x0(3) ) + ! Initialise polynomial coefficients to zero do df = 0, ndata-1 coeff(map_c(1) + df) = 0.0_r_tran @@ -328,8 +335,10 @@ subroutine poly1d_advective_coeffs_code(one_layer, & ipanel = int(panel_id(smap_pid(1,edge+1)), i_def) end if chi = x1 + r0 - call chir2xyz(chi(1), chi(2), chi(3), & - ipanel, x1(1), x1(2), x1(3)) + call chir2xyz( chi(1), chi(2), chi(3), & + ipanel, geometry, & + topology, coord_system, & + x1(1), x1(2), x1(3) ) ! Unit normal to plane containing points 0 and 1 ! cross_product is zero if x0(3) = x1(3) = 0, which occurs for the first level in @@ -357,8 +366,10 @@ subroutine poly1d_advective_coeffs_code(one_layer, & ! Convert xq to XYZ coordinate system if ( .not. extended_mesh ) ipanel = int(panel_id(smap_pid(1,map1d(stencil,edge))), i_def) chi = xq + r0 - call chir2xyz(chi(1), chi(2), chi(3), & - ipanel, xq(1), xq(2), xq(3)) + call chir2xyz( chi(1), chi(2), chi(3), & + ipanel, geometry, & + topology, coord_system, & + xq(1), xq(2), xq(3) ) xq(3) = ispherical*xq(3) + (1_i_def-ispherical)*x0(3) ! Second: Compute the local coordinate of each quadrature point from the @@ -395,8 +406,10 @@ subroutine poly1d_advective_coeffs_code(one_layer, & ! Convert xq to XYZ coordinate system ipanel = int(panel_id(smap_pid(1,1)), i_def) chi = xq + r0 - call chir2xyz(chi(1), chi(2), chi(3), & - ipanel, xq(1), xq(2), xq(3)) + call chir2xyz( chi(1), chi(2), chi(3), & + ipanel, geometry, & + topology, coord_system, & + xq(1), xq(2), xq(3) ) ! Obtain local coordinates of gauss points on this edge xx = local_distance_1d(x0, xq, xn1, domain_x, domain_y, spherical) diff --git a/science/gungho/source/kernel/transport/mol/poly1d_flux_coeffs_kernel_mod.F90 b/science/gungho/source/kernel/transport/mol/poly1d_flux_coeffs_kernel_mod.F90 index 105125f22..9828531ff 100644 --- a/science/gungho/source/kernel/transport/mol/poly1d_flux_coeffs_kernel_mod.F90 +++ b/science/gungho/source/kernel/transport/mol/poly1d_flux_coeffs_kernel_mod.F90 @@ -35,6 +35,10 @@ module poly1d_flux_coeffs_kernel_mod use fs_continuity_mod, only : W3 use kernel_mod, only : kernel_type +! Configuration modules +use base_mesh_config_mod, only: geometry, topology +use finite_element_config_mod, only: coord_system + implicit none private @@ -293,8 +297,9 @@ subroutine poly1d_flux_coeffs_code(one_layer, & ipanel = int(panel_id(smap_pid(1,1)), i_def) end if chi = x0 + r0 - call chir2xyz(chi(1), chi(2), chi(3), & - ipanel, x0(1), x0(2), x0(3)) + call chir2xyz( chi(1), chi(2), chi(3), ipanel, & + geometry, topology, coord_system, & + x0(1), x0(2), x0(3) ) ! Initialise polynomial coefficients to zero do df = 0, ndata-1 @@ -318,8 +323,9 @@ subroutine poly1d_flux_coeffs_code(one_layer, & ! Convert x1 to XYZ coordinate system if ( .not. extended_mesh ) ipanel = int(panel_id(smap_pid(1,face+1)), i_def) chi = x1 + r0 - call chir2xyz(chi(1), chi(2), chi(3), & - ipanel, x1(1), x1(2), x1(3)) + call chir2xyz( chi(1), chi(2), chi(3), ipanel, & + geometry, topology, coord_system, & + x1(1), x1(2), x1(3) ) x1(3) = ispherical*x1(3) + (1_i_def-ispherical)*x0(3) ! Unit normal to plane containing points 0 and 1 @@ -341,8 +347,9 @@ subroutine poly1d_flux_coeffs_code(one_layer, & ! Convert xq to XYZ coordinate system if ( .not. extended_mesh ) ipanel = int(panel_id(smap_pid(1, map1d(stencil,face))), i_def) chi = xq + r0 - call chir2xyz(chi(1), chi(2), chi(3), & - ipanel, xq(1), xq(2), xq(3)) + call chir2xyz( chi(1), chi(2), chi(3), ipanel, & + geometry, topology, coord_system, & + xq(1), xq(2), xq(3) ) ! Second: Compute the local coordinate of each quadrature point from the ! physical coordinate @@ -377,8 +384,9 @@ subroutine poly1d_flux_coeffs_code(one_layer, & ! Convert xq to XYZ coordinate system if ( .not. extended_mesh ) ipanel = int(panel_id(smap_pid(1,1)), i_def) chi = xq + r0 - call chir2xyz(chi(1), chi(2), chi(3), & - ipanel, xq(1), xq(2), xq(3)) + call chir2xyz( chi(1), chi(2), chi(3), ipanel, & + geometry, topology, coord_system, & + xq(1), xq(2), xq(3) ) ! Obtain local coordinates of gauss points on this face xx = local_distance_1d(x0, xq, xn1, domain_x, domain_y, spherical) diff --git a/science/gungho/source/kernel/transport/mol/poly2d_advective_coeffs_kernel_mod.F90 b/science/gungho/source/kernel/transport/mol/poly2d_advective_coeffs_kernel_mod.F90 index 4024c9b32..b344af1fb 100644 --- a/science/gungho/source/kernel/transport/mol/poly2d_advective_coeffs_kernel_mod.F90 +++ b/science/gungho/source/kernel/transport/mol/poly2d_advective_coeffs_kernel_mod.F90 @@ -33,6 +33,10 @@ module poly2d_advective_coeffs_kernel_mod use fs_continuity_mod, only : Wtheta use kernel_mod, only : kernel_type +! Configuration modules +use base_mesh_config_mod, only: geometry, topology +use finite_element_config_mod, only: coord_system + implicit none private @@ -273,8 +277,9 @@ subroutine poly2d_advective_coeffs_code(one_layer, & ! Convert x0 to XYZ coordinate system ipanel = int(panel_id(smap_pid(1,1)), i_def) chi = x0 + r0 - call chir2xyz(chi(1), chi(2), chi(3), & - ipanel, x0(1), x0(2), x0(3)) + call chir2xyz( chi(1), chi(2), chi(3), ipanel, & + geometry, topology, coord_system, & + x0(1), x0(2), x0(3) ) ! Avoid issues when x0(3) == 0 if ( k == 0) x0(3) = x0(3) + z0 @@ -291,8 +296,9 @@ subroutine poly2d_advective_coeffs_code(one_layer, & ! Convert x1 to XYZ coordinate system ipanel = int(panel_id(smap_pid(1,2)), i_def) chi = x1 + r0 - call chir2xyz(chi(1), chi(2), chi(3), & - ipanel, x1(1), x1(2), x1(3)) + call chir2xyz( chi(1), chi(2), chi(3), ipanel, & + geometry, topology, coord_system, & + x1(1), x1(2), x1(3) ) x1(3) = ispherical*x1(3) + (1_i_def - ispherical)*x0(3) ! Unit normal to plane containing points 0 and 1 @@ -317,8 +323,9 @@ subroutine poly2d_advective_coeffs_code(one_layer, & ! Convert xq to XYZ coordinate system ipanel = int(panel_id(smap_pid(1, stencil)), i_def) chi = xq + r0 - call chir2xyz(chi(1), chi(2), chi(3), & - ipanel, xq(1), xq(2), xq(3)) + call chir2xyz( chi(1), chi(2), chi(3), ipanel, & + geometry, topology, coord_system, & + xq(1), xq(2), xq(3) ) ! Avoid issues when x0(3) == 0 if ( k == 0) xq(3) = xq(3) + z0 @@ -377,8 +384,9 @@ subroutine poly2d_advective_coeffs_code(one_layer, & ! Convert xq to XYZ coordinate system ipanel = int(panel_id(smap_pid(1, 1)), i_def) chi = xq + r0 - call chir2xyz(chi(1), chi(2), chi(3), & - ipanel, xq(1), xq(2), xq(3)) + call chir2xyz( chi(1), chi(2), chi(3), ipanel, & + geometry, topology, coord_system, & + xq(1), xq(2), xq(3) ) ! Obtain local coordinates of gauss points on this edge xx = local_distance_2d(x0, xq, xn1, domain_x, domain_y, spherical) diff --git a/science/gungho/source/kernel/transport/mol/poly2d_flux_coeffs_kernel_mod.F90 b/science/gungho/source/kernel/transport/mol/poly2d_flux_coeffs_kernel_mod.F90 index d57163aeb..87f3505e4 100644 --- a/science/gungho/source/kernel/transport/mol/poly2d_flux_coeffs_kernel_mod.F90 +++ b/science/gungho/source/kernel/transport/mol/poly2d_flux_coeffs_kernel_mod.F90 @@ -33,6 +33,10 @@ module poly2d_flux_coeffs_kernel_mod use fs_continuity_mod, only : W3 use kernel_mod, only : kernel_type +! Configuration modules +use base_mesh_config_mod, only: geometry, topology +use finite_element_config_mod, only: coord_system + implicit none private @@ -42,7 +46,7 @@ module poly2d_flux_coeffs_kernel_mod !> The type declaration for the kernel. Contains the metadata needed by the Psy layer type, public, extends(kernel_type) :: poly2d_flux_coeffs_kernel_type private - type(arg_type) :: meta_args(11) = (/ & + type(arg_type) :: meta_args(11) = (/ & arg_type(GH_FIELD, GH_REAL, GH_WRITE, ANY_DISCONTINUOUS_SPACE_1), & arg_type(GH_FIELD, GH_REAL, GH_READ, W3, STENCIL(REGION)), & arg_type(GH_FIELD*3, GH_REAL, GH_READ, ANY_SPACE_1, STENCIL(REGION)), & @@ -266,12 +270,14 @@ subroutine poly2d_flux_coeffs_code(one_layer, & ! Convert x0 & x1 to XYZ coordinate system ipanel = int(panel_id(smap_pid(1,1)), i_def) chi = x0 + r0 - call chir2xyz(chi(1), chi(2), chi(3), & - ipanel, x0(1), x0(2), x0(3)) + call chir2xyz( chi(1), chi(2), chi(3), ipanel, & + geometry, topology, coord_system, & + x0(1), x0(2), x0(3) ) ipanel = int(panel_id(smap_pid(1,2)), i_def) chi = x1 + r0 - call chir2xyz(chi(1), chi(2), chi(3), & - ipanel, x1(1), x1(2), x1(3)) + call chir2xyz( chi(1), chi(2), chi(3), ipanel, & + geometry, topology, coord_system, & + x1(1), x1(2), x1(3) ) x1(3) = ispherical*x1(3) + (1_i_def - ispherical)*x0(3) ! Unit normal to plane containing points 0 and 1 @@ -299,8 +305,9 @@ subroutine poly2d_flux_coeffs_code(one_layer, & ! Convert xq to XYZ coordinate system ipanel = int(panel_id(smap_pid(1,stencil)), i_def) chi = xq + r0 - call chir2xyz(chi(1), chi(2), chi(3), & - ipanel, xq(1), xq(2), xq(3)) + call chir2xyz( chi(1), chi(2), chi(3), ipanel, & + geometry, topology, coord_system, & + xq(1), xq(2), xq(3) ) ! Second: Compute the local coordinate of each quadrature point from the ! physical coordinate @@ -351,8 +358,9 @@ subroutine poly2d_flux_coeffs_code(one_layer, & ! Convert xq to XYZ coordinate system ipanel = int(panel_id(smap_pid(1,1)), i_def) chi = xq + r0 - call chir2xyz(chi(1), chi(2), chi(3), & - ipanel, xq(1), xq(2), xq(3)) + call chir2xyz( chi(1), chi(2), chi(3), ipanel, & + geometry, topology, coord_system, & + xq(1), xq(2), xq(3) ) xx = local_distance_2d(x0, xq, xn1, domain_x, domain_y, spherical) diff --git a/science/gungho/source/orography/assign_orography_field_mod.F90 b/science/gungho/source/orography/assign_orography_field_mod.F90 index 3bd401e04..d9f88d7c5 100644 --- a/science/gungho/source/orography/assign_orography_field_mod.F90 +++ b/science/gungho/source/orography/assign_orography_field_mod.F90 @@ -17,19 +17,11 @@ module assign_orography_field_mod use constants_mod, only : r_def, i_def, l_def - use orography_config_mod, only : orog_init_option, & - orog_init_option_analytic, & - orog_init_option_ancil, & - orog_init_option_none, & + use orography_config_mod, only : orog_init_option, & + orog_init_option_analytic, & + orog_init_option_ancil, & + orog_init_option_none, & orog_init_option_start_dump - use base_mesh_config_mod, only : geometry, & - geometry_spherical, & - topology, & - topology_fully_periodic, & - prime_mesh_name - use finite_element_config_mod, only : coord_system, & - coord_order, & - coord_system_xyz use mesh_collection_mod, only : mesh_collection use coord_transform_mod, only : xyz2llr, llr2xyz use sci_chi_transform_mod, only : chi2llr @@ -50,6 +42,16 @@ module assign_orography_field_mod use function_space_collection_mod, only : function_space_collection use surface_altitude_alg_mod, only : surface_altitude_alg + ! Configuration modules + use base_mesh_config_mod, only: geometry, & + geometry_spherical, & + topology, & + topology_fully_periodic + use finite_element_config_mod, only: coord_system, & + coord_order, & + coord_system_xyz + use planet_config_mod, only: scaled_radius + implicit none private @@ -65,11 +67,11 @@ module assign_orography_field_mod interface - subroutine analytic_orography_interface(nlayers, & - ndf_chi, undf_chi, map_chi, & - ndf_pid, undf_pid, map_pid, & - domain_surface, domain_height, & - chi_1_in, chi_2_in, chi_3_in, & + subroutine analytic_orography_interface(nlayers, & + ndf_chi, undf_chi, map_chi, & + ndf_pid, undf_pid, map_pid, & + domain_surface, domain_height, & + chi_1_in, chi_2_in, chi_3_in, & chi_1, chi_2, chi_3, panel_id) import :: i_def, r_def @@ -94,14 +96,14 @@ end subroutine analytic_orography_interface interface - subroutine ancil_orography_interface(nlayers, & - chi_1, chi_2, chi_3, & - chi_1_in, chi_2_in, chi_3_in, & - panel_id, & - surface_altitude, & - domain_surface, domain_height, & - ndf_chi, undf_chi, map_chi, & - ndf_pid, undf_pid, map_pid, & + subroutine ancil_orography_interface(nlayers, & + chi_1, chi_2, chi_3, & + chi_1_in, chi_2_in, chi_3_in, & + panel_id, & + surface_altitude, & + domain_surface, domain_height, & + ndf_chi, undf_chi, map_chi, & + ndf_pid, undf_pid, map_pid, & ndf, undf, map, basis) import :: i_def, r_def @@ -140,12 +142,12 @@ end subroutine ancil_orography_interface !> routines calculate analytic orography from horizontal coordinates or else !> use the surface_altitude field and then update the vertical coordinate. !> - !> @param[in,out] chi_inventory Contains all of the model's coordinate - !! fields, itemised by mesh - !> @param[in] panel_id_inventory Contains all of the model's panel ID - !! fields, itemised by mesh - !> @param[in] mesh Mesh to apply orography to - !> @param[in] surface_altitude Field containing the surface altitude + !> @param[in,out] chi_inventory Contains all of the model's coordinate + !! fields, itemised by mesh + !> @param[in] panel_id_inventory Contains all of the model's panel ID + !! fields, itemised by mesh + !> @param[in] mesh Mesh to apply orography to + !> @param[in] surface_altitude Field containing the surface altitude !============================================================================= subroutine assign_orography_field(chi_inventory, panel_id_inventory, & mesh, surface_altitude) @@ -549,10 +551,10 @@ subroutine analytic_orography_spherical_native(nlayers, & ! Model coordinates need to be converted to (long,lat,r) for reading ! analytic orography radius = chi_3_in(dfk) + domain_surface - call chi2llr( & - chi_1_in(dfk), chi_2_in(dfk), radius, ipanel, & - longitude, latitude, dummy_radius & - ) + call chi2llr( & + chi_1_in(dfk), chi_2_in(dfk), radius, ipanel, & + geometry, topology, coord_system, scaled_radius, & + longitude, latitude, dummy_radius ) ! Calculate surface height for each DoF using selected analytic orography surface_height = orography_profile%analytic_orography(longitude, latitude) diff --git a/science/linear/integration-test/nwp_gal9/nwp_gal9.f90 b/science/linear/integration-test/nwp_gal9/nwp_gal9.f90 index 5d2e0ee75..37c778568 100644 --- a/science/linear/integration-test/nwp_gal9/nwp_gal9.f90 +++ b/science/linear/integration-test/nwp_gal9/nwp_gal9.f90 @@ -116,7 +116,9 @@ program nwp_gal9 call init_comm( application_name, modeldb ) call init_config( filename, gungho_required_namelists, & config=modeldb%config ) - call init_logger( modeldb%mpi%get_comm(), application_name ) + call init_logger( modeldb%config, & + modeldb%mpi%get_comm(), & + application_name ) call init_collections() call init_time( modeldb ) call initialise( application_name, modeldb ) diff --git a/science/linear/integration-test/nwp_gal9/resources/nwp_gal9_configuration.nml b/science/linear/integration-test/nwp_gal9/resources/nwp_gal9_configuration.nml index 044f4ad24..77a67f111 100644 --- a/science/linear/integration-test/nwp_gal9/resources/nwp_gal9_configuration.nml +++ b/science/linear/integration-test/nwp_gal9/resources/nwp_gal9_configuration.nml @@ -262,6 +262,8 @@ n_coarsesmooth=4, n_postsmooth=2, n_presmooth=2, smooth_relaxation=0.8, +coarsen_multigrid_tiles = .false. +max_tiled_multigrid_level = 1 / &esm_couple l_esm_couple_test=.false., @@ -275,6 +277,9 @@ panel_decomposition='auto', panel_xproc=6, panel_yproc=1, partitioner='cubedsphere', +tile_size_x = 1 +tile_size_y = 1 +inner_halo_tiles = .false. / &physics configure_segments=.false., diff --git a/science/linear/integration-test/runge_kutta/resources/runge_kutta_configuration.nml b/science/linear/integration-test/runge_kutta/resources/runge_kutta_configuration.nml index f89c1bd50..a19ddf9b2 100644 --- a/science/linear/integration-test/runge_kutta/resources/runge_kutta_configuration.nml +++ b/science/linear/integration-test/runge_kutta/resources/runge_kutta_configuration.nml @@ -180,7 +180,11 @@ partitioner='cubedsphere', panel_decomposition='auto', panel_xproc=1, panel_yproc=1, +tile_size_x = 1 +tile_size_y = 1 +inner_halo_tiles = .false. / + &planet cp=1005.0, gravity=9.80665, diff --git a/science/linear/integration-test/runge_kutta/runge_kutta.f90 b/science/linear/integration-test/runge_kutta/runge_kutta.f90 index fee8f8dff..d107ff954 100644 --- a/science/linear/integration-test/runge_kutta/runge_kutta.f90 +++ b/science/linear/integration-test/runge_kutta/runge_kutta.f90 @@ -140,7 +140,9 @@ program runge_kutta call init_comm( application_name, modeldb ) call init_config( filename, gungho_required_namelists, & config=modeldb%config ) - call init_logger( modeldb%mpi%get_comm(), application_name ) + call init_logger( modeldb%config, & + modeldb%mpi%get_comm(), & + application_name ) call init_collections() call init_time( modeldb ) call initialise( application_name, modeldb ) diff --git a/science/linear/integration-test/semi_implicit/resources/semi_implicit_configuration.nml b/science/linear/integration-test/semi_implicit/resources/semi_implicit_configuration.nml index 792710e1b..31d303498 100644 --- a/science/linear/integration-test/semi_implicit/resources/semi_implicit_configuration.nml +++ b/science/linear/integration-test/semi_implicit/resources/semi_implicit_configuration.nml @@ -181,6 +181,9 @@ panel_decomposition='auto', panel_xproc=1, panel_yproc=1, partitioner='cubedsphere', +tile_size_x = 1 +tile_size_y = 1 +inner_halo_tiles = .false. / &physics / diff --git a/science/linear/integration-test/semi_implicit/semi_implicit.f90 b/science/linear/integration-test/semi_implicit/semi_implicit.f90 index c80fbb4d7..3c504620c 100644 --- a/science/linear/integration-test/semi_implicit/semi_implicit.f90 +++ b/science/linear/integration-test/semi_implicit/semi_implicit.f90 @@ -104,7 +104,9 @@ program semi_implicit call init_comm( application_name, modeldb ) call init_config( filename, gungho_required_namelists, & config=modeldb%config ) - call init_logger( modeldb%mpi%get_comm(), application_name ) + call init_logger( modeldb%config, & + modeldb%mpi%get_comm(), & + application_name ) call init_collections() call init_time( modeldb ) call initialise( application_name, modeldb ) diff --git a/science/linear/source/algorithm/linear_physics/tl_bdy_lyr_alg.x90 b/science/linear/source/algorithm/linear_physics/tl_bdy_lyr_alg.x90 index dba063823..509a5e85e 100644 --- a/science/linear/source/algorithm/linear_physics/tl_bdy_lyr_alg.x90 +++ b/science/linear/source/algorithm/linear_physics/tl_bdy_lyr_alg.x90 @@ -32,6 +32,12 @@ module tl_bdy_lyr_alg_mod use tl_compute_aubu_kernel_mod, only: tl_compute_aubu_kernel_type use tl_bl_inc_kernel_mod, only: tl_bl_inc_kernel_type + ! Configuration modules + use base_mesh_config_mod, only: geometry + use finite_element_config_mod, only: element_order_h, element_order_v, & + coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -87,9 +93,15 @@ subroutine tl_bdy_lyr_alg(modeldb, u_bl_inc, u, ls_state, dt) call ls_fields%get_field('ls_land_fraction', ls_land_fraction) mesh => u%get_mesh() - height_w2 => get_height_fe(W2, mesh%get_id()) - height_w3 => get_height_fe(W3, mesh%get_id()) - height_wth => get_height_fe(Wtheta, mesh%get_id()) + height_w2 => get_height_fe( W2, mesh%get_id(), geometry, & + element_order_h, element_order_v, & + coord_system, scaled_radius ) + height_w3 => get_height_fe( W3, mesh%get_id(), geometry, & + element_order_h, element_order_v, & + coord_system, scaled_radius ) + height_wth => get_height_fe( Wtheta, mesh%get_id(), geometry, & + element_order_h, element_order_v, & + coord_system, scaled_radius ) w2_rmultiplicity => get_rmultiplicity_fe(W2, mesh%get_id()) diff --git a/science/linear/source/kernel/core_dynamics/initial_theta_ref_kernel_mod.F90 b/science/linear/source/kernel/core_dynamics/initial_theta_ref_kernel_mod.F90 index 0b6f1779e..724d9b816 100644 --- a/science/linear/source/kernel/core_dynamics/initial_theta_ref_kernel_mod.F90 +++ b/science/linear/source/kernel/core_dynamics/initial_theta_ref_kernel_mod.F90 @@ -21,6 +21,11 @@ module initial_theta_ref_kernel_mod use fs_continuity_mod, only: Wtheta, Wchi use kernel_mod, only: kernel_type + ! Configuration modules + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -123,8 +128,10 @@ subroutine initial_theta_ref_code(nlayers, & coords(3) = coords(3) + chi_3_e(dfc)*chi_basis(1,dfc,df) end do - call chi2xyz(coords(1), coords(2), coords(3), & - ipanel, xyz(1), xyz(2), xyz(3)) + call chi2xyz( coords(1), coords(2), coords(3), & + ipanel, geometry, topology, & + coord_system, scaled_radius, & + xyz(1), xyz(2), xyz(3) ) theta(map_wtheta(df) + k) = analytic_ref_temperature(xyz, test) end do