From 2ace94564a08aec4d7ab7eca0e57c0289e52d5b1 Mon Sep 17 00:00:00 2001 From: Ryan Mulhall <35538242+rem1776@users.noreply.github.com> Date: Tue, 19 Mar 2024 16:32:50 -0400 Subject: [PATCH] Fix: dmUpdate nvhpc compile error (#1473) --- diag_manager/diag_data.F90 | 5 ++++- exchange/xgrid.F90 | 27 ++++++++++++++++++++++----- 2 files changed, 26 insertions(+), 6 deletions(-) diff --git a/diag_manager/diag_data.F90 b/diag_manager/diag_data.F90 index 5926ad10a..abf08d18f 100644 --- a/diag_manager/diag_data.F90 +++ b/diag_manager/diag_data.F90 @@ -585,7 +585,10 @@ subroutine fms_add_attribute(this, att_name, att_value) this%att_value = att_value type is (character(len=*)) allocate(character(len=len(att_value)) :: this%att_value(natt)) - this%att_value = att_value + select type(aval => this%att_value) + type is (character(len=*)) + aval = att_value + end select end select end subroutine fms_add_attribute diff --git a/exchange/xgrid.F90 b/exchange/xgrid.F90 index 4194ef274..88cfdbbba 100644 --- a/exchange/xgrid.F90 +++ b/exchange/xgrid.F90 @@ -1514,7 +1514,7 @@ end subroutine get_ocean_model_area_elements !> @brief Sets up exchange grid connectivity using grid specification file and !! processor domain decomposition. subroutine setup_xmap(xmap, grid_ids, grid_domains, grid_file, atm_grid, lnd_ug_domain) - type (xmap_type), intent(inout) :: xmap + type(xmap_type), intent(inout) :: xmap character(len=3), dimension(:), intent(in ) :: grid_ids type(Domain2d), dimension(:), intent(in ) :: grid_domains character(len=*), intent(in ) :: grid_file @@ -1524,7 +1524,8 @@ subroutine setup_xmap(xmap, grid_ids, grid_domains, grid_file, atm_grid, lnd_ug_ integer :: g, p, i integer :: nxgrid_file, i1, i2, i3, tile1, tile2, j integer :: nxc, nyc, out_unit - type (grid_type), pointer, save :: grid =>NULL(), grid1 =>NULL() + type(grid_type), pointer :: grid => NULL()!< pointer to loop through grid_type's in list + type(grid_type), pointer, save :: grid1 => NULL() !< saved pointer to the first grid in the list real(r8_kind), dimension(3) :: xxx real(r8_kind), dimension(:,:), allocatable :: check_data real(r8_kind), dimension(:,:,:), allocatable :: check_data_3D @@ -1541,6 +1542,8 @@ subroutine setup_xmap(xmap, grid_ids, grid_domains, grid_file, atm_grid, lnd_ug_ integer :: lnd_ug_id, l integer, allocatable :: grid_index(:) type(FmsNetcdfFile_t) :: gridfileobj, mosaicfileobj, fileobj + type(grid_type), allocatable, target :: grids_tmp(:) !< added for nvhpc workaround, stores xmap's + !! grid_type array so we can safely point to it call mpp_clock_begin(id_setup_xmap) @@ -1593,9 +1596,17 @@ subroutine setup_xmap(xmap, grid_ids, grid_domains, grid_file, atm_grid, lnd_ug_ endif call mpp_clock_begin(id_load_xgrid) - do g=1,size(grid_ids(:)) - grid => xmap%grids(g) - if (g==1) grid1 => xmap%grids(g) + + ! nvhpc compiler workaround + ! saves grid array as an allocatable and points to that to avoid error from pointing to xmap%grids in loop + grids_tmp = xmap%grids + + grid1 => xmap%grids(1) + + do g=1, size(grid_ids(:)) + + grid => grids_tmp(g) + grid%id = grid_ids (g) grid%domain = grid_domains(g) grid%on_this_pe = mpp_domain_is_initialized(grid_domains(g)) @@ -1855,6 +1866,9 @@ subroutine setup_xmap(xmap, grid_ids, grid_domains, grid_file, atm_grid, lnd_ug_ grid%frac_area = 1.0_r8_kind endif + ! nvhpc workaround, needs to save the grid pointer since its allocatable + xmap%grids(g) = grid + ! load exchange cells, sum grid cell areas, set your1my2/your2my1 select case(xmap%version) case(VERSION1) @@ -1960,6 +1974,9 @@ subroutine setup_xmap(xmap, grid_ids, grid_domains, grid_file, atm_grid, lnd_ug_ where (grid%area>0.0_r8_kind) grid%area_inv = 1.0_r8_kind/grid%area endif end if + + ! nvhpc workaround, needs to save the grid pointer since its allocatable + xmap%grids(g) = grid end do if(xmap%version == VERSION2) call close_file(gridfileobj)