get_fptr_shape_private Function

public function get_fptr_shape_private(gridToFieldMap, localElementCount, has_vertical, rc) result(fptr_shape)

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: gridToFieldMap(:)
integer, intent(in) :: localElementCount(:)
logical, intent(in) :: has_vertical
integer, intent(out), optional :: rc

Return Value integer, (ARRAY_RANK)


Calls

proc~~get_fptr_shape_private~~CallsGraph proc~get_fptr_shape_private get_fptr_shape_private interface~mapl_assert MAPL_Assert proc~get_fptr_shape_private->interface~mapl_assert proc~mapl_return MAPL_Return proc~get_fptr_shape_private->proc~mapl_return at at proc~mapl_return->at insert insert proc~mapl_return->insert proc~mapl_throw_exception MAPL_throw_exception proc~mapl_return->proc~mapl_throw_exception

Called by

proc~~get_fptr_shape_private~~CalledByGraph proc~get_fptr_shape_private get_fptr_shape_private proc~test_get_fptr_shape_0d test_get_fptr_shape_0D proc~test_get_fptr_shape_0d->proc~get_fptr_shape_private proc~test_get_fptr_shape_2d test_get_fptr_shape_2D proc~test_get_fptr_shape_2d->proc~get_fptr_shape_private proc~test_get_fptr_shape_2d_ungrid test_get_fptr_shape_2D_ungrid proc~test_get_fptr_shape_2d_ungrid->proc~get_fptr_shape_private proc~test_get_fptr_shape_3d test_get_fptr_shape_3D proc~test_get_fptr_shape_3d->proc~get_fptr_shape_private proc~test_get_fptr_shape_general test_get_fptr_shape_general proc~test_get_fptr_shape_general->proc~get_fptr_shape_private proc~test_get_fptr_shape_noz test_get_fptr_shape_noz proc~test_get_fptr_shape_noz->proc~get_fptr_shape_private proc~test_get_fptr_shape_vert_only test_get_fptr_shape_vert_only proc~test_get_fptr_shape_vert_only->proc~get_fptr_shape_private proc~test_get_fptr_shape_vert_ungrid test_get_fptr_shape_vert_ungrid proc~test_get_fptr_shape_vert_ungrid->proc~get_fptr_shape_private proc~test_get_fptr_shape_wrong_order_raise_exception test_get_fptr_shape_wrong_order_raise_exception proc~test_get_fptr_shape_wrong_order_raise_exception->proc~get_fptr_shape_private

Source Code

   function get_fptr_shape_private(gridToFieldMap, localElementCount, has_vertical, rc) &
         &result(fptr_shape)
      integer :: fptr_shape(ARRAY_RANK)
      integer, intent(in) :: gridToFieldMap(:)
      integer, intent(in) :: localElementCount(:)
      logical, intent(in) :: has_vertical
      integer, optional, intent(out) :: rc
      integer :: rank, i
      integer, allocatable :: grid_dims(:)
      integer, allocatable :: ungridded_dims(:)
      integer :: horz_size, vert_size, ungridded_size
      integer :: vert_dim
      
      vert_dim = 0
      vert_size = 1

      rank = size(localElementCount)
      grid_dims = pack(gridToFieldMap, gridToFieldMap /= 0)
      _ASSERT(all(grid_dims <= size(grid_dims)), 'MAPL expects geom dims before ungridded.')
      if(has_vertical) vert_dim = 1 
      if(size(grid_dims) > 0) vert_dim = maxval(grid_dims) + vert_dim
      ungridded_dims = pack([(i,i=1,rank)], [(all([vert_dim, grid_dims] /= i), i=1, rank)])
      horz_size = product([(localElementCount(grid_dims(i)), i=1, size(grid_dims))])
      if(has_vertical) vert_size = localElementCount(vert_dim)
      ungridded_size = product([(localElementCount(ungridded_dims(i)), i=1, size(ungridded_dims))])
      fptr_shape = [horz_size, vert_size, ungridded_size]
      _RETURN(_SUCCESS)

   end function get_fptr_shape_private