From ef2a5a9524fb07409ecf26d216c7d8ecec732fb0 Mon Sep 17 00:00:00 2001 From: Caitlyn Mcallister Date: Thu, 21 Sep 2023 11:27:41 -0400 Subject: [PATCH] fix merge conflicts --- data_override/include/data_override.inc | 116 ++++++++++++------------ diag_integral/diag_integral.F90 | 6 +- exchange/xgrid.F90 | 22 ++--- mpp/include/mpp_gather.fh | 2 +- mpp/include/mpp_scatter.fh | 2 +- 5 files changed, 74 insertions(+), 74 deletions(-) diff --git a/data_override/include/data_override.inc b/data_override/include/data_override.inc index 663d2b0fcf..c886b99742 100644 --- a/data_override/include/data_override.inc +++ b/data_override/include/data_override.inc @@ -603,13 +603,13 @@ end subroutine get_domainUG !=============================================================================================== !> @brief Routine to perform data override for scalar fields -subroutine DATA_OVERRIDE_0D_(gridname,fieldname_code,data,time,override,data_index) +subroutine DATA_OVERRIDE_0D_(gridname,fieldname_code,data_out,time,override,data_index) character(len=3), intent(in) :: gridname !< model grid ID (ocn,ice,atm,lnd) character(len=*), intent(in) :: fieldname_code !< field name as used in the model (may be !! different from the name in NetCDF data file) logical, intent(out), optional :: override !< true if the field has been overriden succesfully type(time_type), intent(in) :: time !< (target) model time - real(FMS_DATA_OVERRIDE_KIND_), intent(out) :: data !< output data array returned by this call + real(FMS_DATA_OVERRIDE_KIND_), intent(out) :: data_out !< output data array returned by this call integer, intent(in), optional :: data_index character(len=512) :: filename !< file containing source data @@ -646,7 +646,7 @@ subroutine DATA_OVERRIDE_0D_(gridname,fieldname_code,data,time,override,data_ind factor = data_table(index1)%factor if(fieldname == "") then - data = factor + data_out = factor if(PRESENT(override)) override = .true. return else @@ -681,8 +681,8 @@ subroutine DATA_OVERRIDE_0D_(gridname,fieldname_code,data,time,override,data_ind endif !if curr_position < 0 !10 do time interp to get data in compute_domain - call time_interp_external(id_time, time, data, verbose=.false.) - data = data*factor + call time_interp_external(id_time, time, data_out, verbose=.false.) + data_out = data_out*factor !$OMP END SINGLE if(PRESENT(override)) override = .true. @@ -722,13 +722,13 @@ subroutine DATA_OVERRIDE_2D_(gridname,fieldname,data_2D,time,override, is_in, ie end subroutine DATA_OVERRIDE_2D_ !> @brief This routine performs data override for 3D fields -subroutine DATA_OVERRIDE_3D_(gridname,fieldname_code,data,time,override,data_index, is_in, ie_in, js_in, je_in) +subroutine DATA_OVERRIDE_3D_(gridname,fieldname_code,return_data,time,override,data_index, is_in, ie_in, js_in, je_in) character(len=3), intent(in) :: gridname !< model grid ID character(len=*), intent(in) :: fieldname_code !< field name as used in the model logical, optional, intent(out) :: override !< true if the field has been overriden succesfully type(time_type), intent(in) :: time !< (target) model time integer, optional, intent(in) :: data_index - real(FMS_DATA_OVERRIDE_KIND_), dimension(:,:,:), intent(inout) :: data !< data returned by this call + real(FMS_DATA_OVERRIDE_KIND_), dimension(:,:,:), intent(inout) :: return_data !< data returned by this call integer, optional, intent(in) :: is_in, ie_in, js_in, je_in logical, dimension(:,:,:), allocatable :: mask_out @@ -795,7 +795,7 @@ subroutine DATA_OVERRIDE_3D_(gridname,fieldname_code,data,time,override,data_ind factor = data_table(index1)%factor if(fieldname == "") then - data = factor + return_data = factor if(PRESENT(override)) override = .true. return else @@ -837,23 +837,23 @@ subroutine DATA_OVERRIDE_3D_(gridname,fieldname_code,data,time,override,data_ind override_array(curr_position)%numthreads = omp_get_num_threads() #endif !--- data_override may be called from physics windows. The following are possible situations -!--- 1. size(data,1) == nxd and size(data,2) == nyd ( on data domain and there is only one window). -!--- 2. nxc is divisible by size(data,1), nyc is divisible by size(data,2), -!--- nwindow = (nxc/size(data(1))*(nyc/size(data,2)), also we require nwindows is divisible by nthreads. -!--- The another restrition is that size(data,1) == ie_in - is_in + 1, -!--- size(data,2) == je_in - js_in + 1 +!--- 1. size(return_data,1) == nxd and size(return_data,2) == nyd ( on return_data domain and there is only one window). +!--- 2. nxc is divisible by size(return_data,1), nyc is divisible by size(return_data,2), +!--- nwindow = (nxc/size(return_data(1))*(nyc/size(return_data,2)), also we require nwindows is divisible by nthreads. +!--- The another restrition is that size(return_data,1) == ie_in - is_in + 1, +!--- size(return_data,2) == je_in - js_in + 1 nwindows = 1 - if( nxd == size(data,1) .AND. nyd == size(data,2) ) then ! + if( nxd == size(return_data,1) .AND. nyd == size(return_data,2) ) then ! use_comp_domain = .false. - else if ( mod(nxc, size(data,1)) ==0 .AND. mod(nyc, size(data,2)) ==0 ) then + else if ( mod(nxc, size(return_data,1)) ==0 .AND. mod(nyc, size(return_data,2)) ==0 ) then use_comp_domain = .true. - nwindows = (nxc/size(data,1))*(nyc/size(data,2)) + nwindows = (nxc/size(return_data,1))*(nyc/size(return_data,2)) else call mpp_error(FATAL, & & "data_override: data is not on data domain and compute domain is not divisible by size(data)") endif - override_array(curr_position)%window_size(1) = size(data,1) - override_array(curr_position)%window_size(2) = size(data,2) + override_array(curr_position)%window_size(1) = size(return_data,1) + override_array(curr_position)%window_size(2) = size(return_data,2) window_size = override_array(curr_position)%window_size override_array(curr_position)%numwindows = nwindows @@ -999,7 +999,7 @@ subroutine DATA_OVERRIDE_3D_(gridname,fieldname_code,data,time,override,data_ind je_src = override_array(curr_position)%je_src window_size = override_array(curr_position)%window_size !---make sure data size match window_size - if( window_size(1) .NE. size(data,1) .OR. window_size(2) .NE. size(data,2) ) then + if( window_size(1) .NE. size(return_data,1) .OR. window_size(2) .NE. size(return_data,2) ) then call mpp_error(FATAL, "data_override: window_size does not match size(data)") endif !9 Get id_time previously stored in override_array @@ -1071,92 +1071,92 @@ subroutine DATA_OVERRIDE_3D_(gridname,fieldname_code,data,time,override,data_ind ! Determine if data in netCDF file is 2D or not data_file_is_2D = .false. - if((dims(3) == 1) .and. (size(data,3)>1)) data_file_is_2D = .true. + if((dims(3) == 1) .and. (size(return_data,3)>1)) data_file_is_2D = .true. - if(dims(3) .NE. 1 .and. (size(data,3) .NE. dims(3))) & - call mpp_error(FATAL, "data_override: dims(3) .NE. 1 and size(data,3) .NE. dims(3)") + if(dims(3) .NE. 1 .and. (size(return_data,3) .NE. dims(3))) & + call mpp_error(FATAL, "data_override: dims(3) .NE. 1 and size(return_data,3) .NE. dims(3)") if(ongrid) then if (.not. use_comp_domain) then !< Determine the size of the halox and the part of `data` that is in the compute domain - nhalox = (size(data,1) - nxc)/2 - nhaloy = (size(data,2) - nyc)/2 - startingi = lbound(data,1) + nhalox - startingj = lbound(data,2) + nhaloy - endingi = ubound(data,1) - nhalox - endingj = ubound(data,2) - nhaloy + nhalox = (size(return_data,1) - nxc)/2 + nhaloy = (size(return_data,2) - nyc)/2 + startingi = lbound(return_data,1) + nhalox + startingj = lbound(return_data,2) + nhaloy + endingi = ubound(return_data,1) - nhalox + endingj = ubound(return_data,2) - nhaloy end if !10 do time interp to get data in compute_domain if(data_file_is_2D) then if (use_comp_domain) then - call time_interp_external(id_time,time,data(:,:,1),verbose=.false., & + call time_interp_external(id_time,time,return_data(:,:,1),verbose=.false., & is_in=is_in,ie_in=ie_in,js_in=js_in,je_in=je_in,window_id=window_id) else !> If this in an ongrid case and you are not in the compute domain, send in `data` to be the correct !! size - call time_interp_external(id_time,time,data(startingi:endingi,startingj:endingj,1),verbose=.false., & + call time_interp_external(id_time,time,return_data(startingi:endingi,startingj:endingj,1),verbose=.false., & is_in=is_in,ie_in=ie_in,js_in=js_in,je_in=je_in,window_id=window_id) end if - data(:,:,1) = data(:,:,1)*factor - do i = 2, size(data,3) - data(:,:,i) = data(:,:,1) + return_data(:,:,1) = return_data(:,:,1)*factor + do i = 2, size(return_data,3) + return_data(:,:,i) = return_data(:,:,1) end do else if (use_comp_domain) then - call time_interp_external(id_time,time,data,verbose=.false., & + call time_interp_external(id_time,time,return_data,verbose=.false., & is_in=is_in,ie_in=ie_in,js_in=js_in,je_in=je_in,window_id=window_id) else !> If this in an ongrid case and you are not in the compute domain, send in `data` to be the correct !! size - call time_interp_external(id_time,time,data(startingi:endingi,startingj:endingj,:),verbose=.false., & + call time_interp_external(id_time,time,return_data(startingi:endingi,startingj:endingj,:),verbose=.false., & is_in=is_in,ie_in=ie_in,js_in=js_in,je_in=je_in,window_id=window_id) end if - data = data*factor + return_data = return_data*factor endif else ! off grid case ! do time interp to get global data if(data_file_is_2D) then if( data_table(index1)%region_type == NO_REGION ) then - call time_interp_external(id_time,time,data(:,:,1),verbose=.false., & + call time_interp_external(id_time,time,return_data(:,:,1),verbose=.false., & horz_interp=override_array(curr_position)%horz_interp(window_id), & is_in=is_in,ie_in=ie_in,js_in=js_in,je_in=je_in,window_id=window_id) - data(:,:,1) = data(:,:,1)*factor - do i = 2, size(data,3) - data(:,:,i) = data(:,:,1) + return_data(:,:,1) = return_data(:,:,1)*factor + do i = 2, size(return_data,3) + return_data(:,:,i) = return_data(:,:,1) enddo else - allocate(mask_out(size(data,1), size(data,2),1)) + allocate(mask_out(size(return_data,1), size(return_data,2),1)) mask_out = .false. - call time_interp_external(id_time,time,data(:,:,1),verbose=.false., & + call time_interp_external(id_time,time,return_data(:,:,1),verbose=.false., & horz_interp=override_array(curr_position)%horz_interp(window_id), & mask_out =mask_out(:,:,1), & is_in=is_in,ie_in=ie_in,js_in=js_in,je_in=je_in,window_id=window_id) where(mask_out(:,:,1)) - data(:,:,1) = data(:,:,1)*factor + reuturn_data(:,:,1) = return_data(:,:,1)*factor end where - do i = 2, size(data,3) + do i = 2, size(return_data,3) where(mask_out(:,:,1)) - data(:,:,i) = data(:,:,1) + return_data(:,:,i) = return_data(:,:,1) end where enddo deallocate(mask_out) endif else if( data_table(index1)%region_type == NO_REGION ) then - call time_interp_external(id_time,time,data,verbose=.false., & + call time_interp_external(id_time,time,return_data,verbose=.false., & horz_interp=override_array(curr_position)%horz_interp(window_id), & is_in=is_in,ie_in=ie_in,js_in=js_in,je_in=je_in,window_id=window_id) - data = data*factor + return_data = return_data*factor else - allocate(mask_out(size(data,1), size(data,2), size(data,3)) ) + allocate(mask_out(size(return_data,1), size(return_data,2), size(return_data,3)) ) mask_out = .false. - call time_interp_external(id_time,time,data,verbose=.false., & + call time_interp_external(id_time,time,return_data,verbose=.false., & horz_interp=override_array(curr_position)%horz_interp(window_id), & mask_out =mask_out, & is_in=is_in,ie_in=ie_in,js_in=js_in,je_in=je_in,window_id=window_id) where(mask_out) - data = data*factor + return_data = return_data*factor end where deallocate(mask_out) endif @@ -1168,10 +1168,10 @@ subroutine DATA_OVERRIDE_3D_(gridname,fieldname_code,data,time,override,data_ind end subroutine DATA_OVERRIDE_3D_ !> @brief Data override for 1D unstructured grids -subroutine DATA_OVERRIDE_UG_1D_(gridname,fieldname,data,time,override) +subroutine DATA_OVERRIDE_UG_1D_(gridname,fieldname,return_data,time,override) character(len=3), intent(in) :: gridname !< model grid ID character(len=*), intent(in) :: fieldname !< field to override - real(FMS_DATA_OVERRIDE_KIND_), dimension(:), intent(inout) :: data !< data returned by this call + real(FMS_DATA_OVERRIDE_KIND_), dimension(:), intent(inout) :: return_data !< data returned by this call type(time_type), intent(in) :: time !< model time logical, intent(out), optional :: override !< true if the field has been overriden succesfully !local vars @@ -1197,16 +1197,16 @@ subroutine DATA_OVERRIDE_UG_1D_(gridname,fieldname,data,time,override) call DATA_OVERRIDE_2D_(gridname,fieldname,data_SG,time,override) - call mpp_pass_SG_to_UG(UG_domain, data_SG(:,:), data(:)) + call mpp_pass_SG_to_UG(UG_domain, data_SG(:,:), return_data(:)) deallocate(data_SG) end subroutine DATA_OVERRIDE_UG_1D_ !> @brief Data override for 2D unstructured grids -subroutine DATA_OVERRIDE_UG_2D_(gridname,fieldname,data,time,override) +subroutine DATA_OVERRIDE_UG_2D_(gridname,fieldname,return_data,time,override) character(len=3), intent(in) :: gridname !< model grid ID character(len=*), intent(in) :: fieldname !< field to override - real(FMS_DATA_OVERRIDE_KIND_), dimension(:,:), intent(inout) :: data !< data returned by this call + real(FMS_DATA_OVERRIDE_KIND_), dimension(:,:), intent(inout) :: return_data !< data returned by this call type(time_type), intent(in) :: time !< model time logical, intent(out), optional :: override !< true if the field has been overriden succesfully !local vars @@ -1228,18 +1228,18 @@ subroutine DATA_OVERRIDE_UG_2D_(gridname,fieldname,data,time,override) enddo if(index1 .eq. -1) return ! NO override was performed - nlevel = size(data,2) + nlevel = size(return_data,2) nlevel_max = nlevel call mpp_max(nlevel_max) call get_domainUG(gridname,UG_domain,comp_domain) allocate(data_SG(comp_domain(1):comp_domain(2),comp_domain(3):comp_domain(4),nlevel_max)) - allocate(data_UG(size(data,1), nlevel_max)) + allocate(data_UG(size(return_data,1), nlevel_max)) data_SG = 0._lkind call DATA_OVERRIDE_3D_(gridname,fieldname,data_SG,time,override) call mpp_pass_SG_to_UG(UG_domain, data_SG(:,:,:), data_UG(:,:)) - data(:,1:nlevel) = data_UG(:,1:nlevel) + return_data(:,1:nlevel) = data_UG(:,1:nlevel) deallocate(data_SG, data_UG) end subroutine DATA_OVERRIDE_UG_2D_ diff --git a/diag_integral/diag_integral.F90 b/diag_integral/diag_integral.F90 index aa7e8a96f5..ed898a52d3 100644 --- a/diag_integral/diag_integral.F90 +++ b/diag_integral/diag_integral.F90 @@ -1057,10 +1057,10 @@ end function diag_integral_alarm !! @param [in] integral field weighting functions !! @param [out] !! @return real array data2 -function vert_diag_integral (data, wt) result (data2) -real(r8_kind), dimension (:,:,:), intent(in) :: data !< integral field data arrays +function vert_diag_integral (field_data, wt) result (data2) +real(r8_kind), dimension (:,:,:), intent(in) :: field_data !< integral field data arrays real(r8_kind), dimension (:,:,:), intent(in) :: wt !< integral field weighting functions -real(r8_kind), dimension (size(data,1),size(data,2)) :: data2 +real(r8_kind), dimension (size(field_data,1),size(field_data,2)) :: data2 !------------------------------------------------------------------------------- ! local variables: diff --git a/exchange/xgrid.F90 b/exchange/xgrid.F90 index 3876ffc4d2..9f52d64558 100644 --- a/exchange/xgrid.F90 +++ b/exchange/xgrid.F90 @@ -1460,7 +1460,7 @@ end subroutine get_grid_version2 subroutine get_area_elements_fms2_io(fileobj, name, get_area_data) type(FmsNetcdfDomainFile_t), intent(in) :: fileobj character(len=*), intent(in) :: name - real(r8_kind), intent(out) :: data(:,:) + real(r8_kind), intent(out) :: get_area_data(:,:) if(variable_exists(fileobj, name)) then call read_data(fileobj, name, get_area_data) @@ -1468,7 +1468,7 @@ subroutine get_area_elements_fms2_io(fileobj, name, get_area_data) call error_mesg('xgrid_mod', 'no field named '//trim(name)//' in grid file '//trim(fileobj%path)// & ' Will set data to negative values...', NOTE) ! area elements no present in grid_spec file, set to negative values.... - data = -1.0_r8_kind + get_area_data = -1.0_r8_kind endif end subroutine get_area_elements_fms2_io @@ -4431,7 +4431,7 @@ subroutine stock_move_3d(from, to, grid_index, stock_data3d, xmap, & type(stock_type), intent(inout), optional :: from, to integer, intent(in) :: grid_index !< grid index - real(r8_kind), intent(in) :: data(:,:,:) !< data array is 3d + real(r8_kind), intent(in) :: stock_data3d(:,:,:) !< data array is 3d type(xmap_type), intent(in) :: xmap real(r8_kind), intent(in) :: delta_t integer, intent(in) :: from_side !< ISTOCK_TOP, ISTOCK_BOTTOM, or ISTOCK_SIDE @@ -4455,7 +4455,7 @@ subroutine stock_move_3d(from, to, grid_index, stock_data3d, xmap, & endif from_dq = delta_t * 4.0_r8_kind * PI * radius**2 * sum( sum(xmap%grids(grid_index)%area * & - & sum(xmap%grids(grid_index)%frac_area * data, DIM=3), DIM=1)) + & sum(xmap%grids(grid_index)%frac_area * stock_data3d, DIM=3), DIM=1)) to_dq = from_dq ! update only if argument is present. @@ -4490,7 +4490,7 @@ subroutine stock_move_2d(from, to, grid_index, stock_data2d, xmap, & type(stock_type), intent(inout), optional :: from, to integer, optional, intent(in) :: grid_index - real(r8_kind), intent(in) :: data(:,:) !< data array is 2d + real(r8_kind), intent(in) :: stock_data2d(:,:) !< data array is 2d type(xmap_type), intent(in) :: xmap real(r8_kind), intent(in) :: delta_t integer, intent(in) :: from_side !< ISTOCK_TOP, ISTOCK_BOTTOM, or ISTOCK_SIDE @@ -4511,7 +4511,7 @@ subroutine stock_move_2d(from, to, grid_index, stock_data2d, xmap, & if( .not. present(grid_index) .or. grid_index==1 ) then ! only makes sense if grid_index == 1 - from_dq = delta_t * 4.0_r8_kind*PI*radius**2 * sum(sum(xmap%grids(1)%area * data, DIM=1)) + from_dq = delta_t * 4.0_r8_kind*PI*radius**2 * sum(sum(xmap%grids(1)%area * stock_data2d, DIM=1)) to_dq = from_dq else @@ -4555,7 +4555,7 @@ subroutine stock_move_ug_3d(from, to, grid_index, stock_ug_data3d, xmap, & type(stock_type), intent(inout), optional :: from, to integer, intent(in) :: grid_index !< grid index - real(r8_kind), intent(in) :: data(:,:) !< data array is 3d + real(r8_kind), intent(in) :: stock_ug_data3d(:,:) !< data array is 3d type(xmap_type), intent(in) :: xmap real(r8_kind), intent(in) :: delta_t integer, intent(in) :: from_side !< ISTOCK_TOP, ISTOCK_BOTTOM, or ISTOCK_SIDE @@ -4563,7 +4563,7 @@ subroutine stock_move_ug_3d(from, to, grid_index, stock_ug_data3d, xmap, & real(r8_kind), intent(in) :: radius !< earth radius character(len=*), intent(in), optional :: verbose integer, intent(out) :: ier - real(r8_kind), dimension(size(data,1),size(data,2)) :: tmp + real(r8_kind), dimension(size(stock_ug_data3d,1),size(stock_ug_data3d,2)) :: tmp real(r8_kind) :: from_dq, to_dq @@ -4579,7 +4579,7 @@ subroutine stock_move_ug_3d(from, to, grid_index, stock_ug_data3d, xmap, & return endif - tmp = xmap%grids(grid_index)%frac_area(:,1,:) * data + tmp = xmap%grids(grid_index)%frac_area(:,1,:) * stock_ug_data3d from_dq = delta_t * 4.0_r8_kind * PI * radius**2 * sum( xmap%grids(grid_index)%area(:,1) * & & sum(tmp, DIM=2)) to_dq = from_dq @@ -4610,7 +4610,7 @@ subroutine stock_integrate_2d(integrate_data2d, xmap, delta_t, radius, res, ier) use mpp_mod, only : mpp_sum - real(r8_kind), intent(in) :: data(:,:) !< data array is 2d + real(r8_kind), intent(in) :: integrate_data2d(:,:) !< data array is 2d type(xmap_type), intent(in) :: xmap real(r8_kind), intent(in) :: delta_t real(r8_kind), intent(in) :: radius !< earth radius @@ -4625,7 +4625,7 @@ subroutine stock_integrate_2d(integrate_data2d, xmap, delta_t, radius, res, ier) return endif - res = delta_t * 4.0_r8_kind * PI * radius**2 * sum(sum(xmap%grids(1)%area * data, DIM=1)) + res = delta_t * 4.0_r8_kind * PI * radius**2 * sum(sum(xmap%grids(1)%area * integrate_data2d, DIM=1)) end subroutine stock_integrate_2d !####################################################################### diff --git a/mpp/include/mpp_gather.fh b/mpp/include/mpp_gather.fh index b50c48c3a2..d51960de2f 100644 --- a/mpp/include/mpp_gather.fh +++ b/mpp/include/mpp_gather.fh @@ -123,7 +123,7 @@ subroutine MPP_GATHER_PELIST_2D_(is, ie, js, je, pelist, array_seg, gather_data, arr3D(1:size(array_seg,1),1:size(array_seg,2),1:1) => array_seg if (is_root_pe) then - data3D(1:size(data,1),1:size(data,2),1:1) => data + data3D(1:size(gather_data,1),1:size(gather_data,2),1:1) => gather_data else data3D => null() endif diff --git a/mpp/include/mpp_scatter.fh b/mpp/include/mpp_scatter.fh index 9a40bdb1e6..181796e87e 100644 --- a/mpp/include/mpp_scatter.fh +++ b/mpp/include/mpp_scatter.fh @@ -39,7 +39,7 @@ subroutine MPP_SCATTER_PELIST_2D_(is, ie, js, je, pelist, array_seg, input_data, arr3D(1:size(array_seg,1),1:size(array_seg,2),1:1) => array_seg if (is_root_pe) then - data3D(1:size(data,1),1:size(data,2),1:1) => data + data3D(1:size(input_data,1),1:size(input_data,2),1:1) => input_data else data3D => null() endif