Skip to content

Commit

Permalink
fix merge conflicts
Browse files Browse the repository at this point in the history
  • Loading branch information
@mcallic2
mcallic2 committed Sep 21, 2023
1 parent 7eb5cc9 commit ef2a5a9
Show file tree
Hide file tree
Showing 5 changed files with 74 additions and 74 deletions.
116 changes: 58 additions & 58 deletions data_override/include/data_override.inc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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.
Expand Down Expand Up @@ -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

Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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_
6 changes: 3 additions & 3 deletions diag_integral/diag_integral.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1057,10 +1057,10 @@ end function diag_integral_alarm
!! @param [in] <wt> integral field weighting functions
!! @param [out] <data2>
!! @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:
Expand Down
Loading

0 comments on commit ef2a5a9

Please sign in to comment.