21 integer,
dimension(:,:),
allocatable :: sizes
22 integer :: nfields, max_y_point, max_x_point
39 integer,
dimension(:,:),
intent(in) :: sizes
40 integer,
intent(in) :: nfields, interpolations_to_perform
41 logical,
intent(in) :: xdim, ydim
51 do i=1,interpolations_to_perform
68 if (
allocated(stencil%interpolated_fields))
then 69 do i=1,
size(stencil%interpolated_fields,1)
70 do j=1,
size(stencil%interpolated_fields,2)
71 if (
allocated(stencil%interpolated_fields(i,j)%data))
deallocate(stencil%interpolated_fields(i,j)%data)
74 deallocate(stencil%fields, stencil%interpolated_fields)
76 if (
allocated(stencil%sizes))
deallocate(stencil%sizes)
87 subroutine interpolate_to_dual(local_grid, field, stencil, x, y, interpolated_fields, interpolation_id)
88 type(prognostic_field_type),
intent(inout) :: field
89 type(local_grid_type),
intent(inout) :: local_grid
91 type(prognostic_field_type),
dimension(:),
allocatable,
intent(inout) :: interpolated_fields
92 integer,
intent(in) :: x, y, interpolation_id
94 integer :: i,j,n, x_top, base_x, y_start, y_top, x_start, abs_x_top
95 logical,
dimension(3) :: interpolate_in_dimension
97 interpolate_in_dimension = get_field_interpolation_index(field)
99 do n=1,stencil%nfields
100 base_x=x-(stencil%sizes(n,1)+1)
101 abs_x_top=x+stencil%sizes(n,1)
103 if (base_x .lt. 0) x_start=x_start+(0-base_x)
104 x_top=stencil%sizes(n,1)*2+1
105 y_start=y-stencil%sizes(n,2)
106 y_top=y+stencil%sizes(n,2)
107 if (y_start .lt. 1) y_start=1
114 stencil%interpolated_fields(interpolation_id,n)%data(:,j,i))
123 stencil%interpolated_fields(interpolation_id,n)%data(:,:,i)=&
124 stencil%interpolated_fields(interpolation_id,n)%data(:,:,i+1)
127 do j=y_start, y_top-1
129 stencil%interpolated_fields(interpolation_id,n)%data(:,j,x_top))
134 stencil%interpolated_fields(interpolation_id,n)%data(:,y_top,x_top))
148 type(local_grid_type),
intent(inout) :: local_grid
149 integer,
intent(in) :: j,i
150 logical,
dimension(3) :: interpolate_in_dimension
151 type(prognostic_field_ptr_type),
intent(inout) :: field
152 real(kind=DEFAULT_PRECISION),
dimension(:),
intent(inout) :: column_stencil_values
154 integer :: k, y_interpol, x_interpol
156 y_interpol=merge(j+1, j, interpolate_in_dimension(2))
157 x_interpol=merge(i+1, i, interpolate_in_dimension(3))
159 do k=1, local_grid%size(z_index)
160 if (y_interpol .lt. 1 .or. y_interpol .gt. local_grid%local_domain_end_index(y_index)+ local_grid%halo_size(y_index) &
161 .or. x_interpol .lt. 1 .or. x_interpol .gt. local_grid%local_domain_end_index(x_index)+ local_grid%halo_size(x_index) &
162 .or. (interpolate_in_dimension(1) .and. k == local_grid%size(z_index)))
then 163 column_stencil_values(k)=field%ptr%data(k,j,i)
165 column_stencil_values(k)=0.5_default_precision*(&
166 field%ptr%data(k,j,i) + field%ptr%data(merge(k+1, k, interpolate_in_dimension(1)), y_interpol, x_interpol))
180 type(prognostic_field_type),
dimension(:),
allocatable,
intent(inout) :: interpolated_fields
181 type(local_grid_type),
intent(inout) :: local_grid
183 integer,
intent(in) :: x, y, interpolation_id
185 integer :: i, y_min_src, y_max_src, x_max_src, y_min_tgt, y_max_tgt, x_min_tgt, x_max_tgt
187 do i=1,stencil%nfields
188 y_min_src=y-stencil%sizes(i,2)
189 y_min_tgt=1-stencil%sizes(i,2)
190 y_max_src=y+stencil%sizes(i,2)
191 y_max_tgt=1+stencil%sizes(i,2)
192 x_min_tgt=1-stencil%sizes(i,1)
193 x_max_src=stencil%sizes(i,1)*2+1
194 x_max_tgt=1+stencil%sizes(i,1)
195 if (y_min_src .lt. 1)
then 196 y_min_tgt=y_min_tgt+(1-y_min_src)
200 interpolated_fields(i)%data(:,y_min_tgt:y_max_tgt, x_min_tgt:x_max_tgt)=&
201 stencil%interpolated_fields(interpolation_id, i)%data(:, y_min_src:y_max_src, 1:x_max_src)
A pointer to the prognostic field. This is so we can wrap prognostics up in an array and still refer ...
Contains prognostic field definitions and functions.
A prognostic field which is assumed to be 3D.
subroutine, public interpolate_to_dual(local_grid, field, stencil, x, y, interpolated_fields, interpolation_id)
Interpolates the (vector) flow fields from the primal to dual grid based upon a specific field interp...
integer, parameter, public default_precision
MPI communication type which we use for the prognostic and calculation data.
integer, parameter, public z_index
Grid index parameters.
Contains common definitions for the data and datatypes used by MONC.
logical function, dimension(3), public get_field_interpolation_index(field)
Retrieves the index(s) that require interpolation to go from the primal the dual grid.
subroutine calculate_interpolated_cell_value(local_grid, j, i, interpolate_in_dimension, field, column_stencil_values)
Calculates the interpolated values for each point in a column. The exact method of interpolation depe...
Defined the local grid, i.e. the grid held on this process after decomposition.
Performs the interpolation between the primal and dual grids via a stencil approach. For performance reasons, for each field we store the entirety of the y dimension and the number of x slices required by the stencil. Therefore a new interpolation is simply the calculation of one point and reuse of existing computed points (unless this is the first x or y.) The applicable interpolation stenciled data is copied out, with :,1,1 being the central point, minus and plus in each y and x dimension as determined by the stencil size. This is done so that the stencil size can easily be different for each flow field and this is the case with u (where we need u-2 in the X.)
subroutine copy_interpolated_to_prognostic(interpolated_fields, stencil, local_grid, x, y, interpolation_id)
Copies stencil number of interpolated values from the store used by this functionality to preallocate...
Functionality to support the different types of grid and abstraction between global grids and local o...
Configuration for a specific stencil interpolation to perform.
subroutine, public free_stencil(stencil)
Frees up the memory allocated to a stencil.
integer, parameter, public y_index
integer, parameter, public x_index
type(grid_stencil_type) function, public create_stencil(local_grid, fields, nfields, interpolations_to_perform, sizes, xdim, ydim)
Creates a stencil configuration which will then be used for interpolation.