regrid Subroutine

public subroutine regrid(srcField, dstField, missing, rc)

Arguments

Type IntentOptional Attributes Name
type(ESMF_Field), intent(in) :: srcField
type(ESMF_Field), intent(inout) :: dstField
real(kind=REAL32), intent(in), optional :: missing
integer, intent(out), optional :: rc

Calls

proc~~regrid~~CallsGraph proc~regrid regrid ESMF_FieldRegrid ESMF_FieldRegrid proc~regrid->ESMF_FieldRegrid ESMF_FieldRegridStore ESMF_FieldRegridStore proc~regrid->ESMF_FieldRegridStore ESMF_GridGetItem ESMF_GridGetItem proc~regrid->ESMF_GridGetItem esmf_arrayget esmf_arrayget proc~regrid->esmf_arrayget esmf_fieldget esmf_fieldget proc~regrid->esmf_fieldget mpi_allreduce mpi_allreduce proc~regrid->mpi_allreduce none~at~180 StringRouteHandleMap%at proc~regrid->none~at~180 none~insert~155 StringRouteHandleMap%insert proc~regrid->none~insert~155 proc~all_gather all_gather proc~regrid->proc~all_gather proc~mapl_return MAPL_Return proc~regrid->proc~mapl_return proc~mapl_verify MAPL_Verify proc~regrid->proc~mapl_verify proc~run_length_encode run_length_encode proc~regrid->proc~run_length_encode none~find~39 StringRouteHandleMap%find none~at~180->none~find~39 none~insert_pair~12 StringRouteHandleMap%insert_pair none~insert~155->none~insert_pair~12 proc~all_gather->proc~mapl_verify mpi_allgather mpi_allgather proc~all_gather->mpi_allgather mpi_allgatherv mpi_allgatherv proc~all_gather->mpi_allgatherv 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 proc~mapl_verify->proc~mapl_throw_exception

Called by

proc~~regrid~~CalledByGraph proc~regrid regrid proc~write_data RegridSupport%write_data proc~write_data->proc~regrid program~main~2 main program~main~2->proc~write_data

Source Code

   subroutine regrid(srcField, dstField, missing, rc)
     type (ESMF_Field), intent(in) :: srcField
     type (ESMF_Field), intent(inout) :: dstField
     real (kind=REAL32), optional, intent(in) :: missing
     integer, optional, intent(out) :: rc

     integer :: status
     real(kind=REAL32), pointer :: src_array(:,:)
     real(kind=REAL32), pointer :: dst_array(:,:)
     type (ESMF_RouteHandle), pointer :: handle
     character(len=:), allocatable :: local_key
     character(len=:), allocatable :: global_key
     integer, pointer :: mask(:,:)
     type (ESMF_Array) :: mask_array
     type (ESMF_Grid) :: grid
     logical :: have_missing, any_missing

     call ESMF_FieldGet(srcField, 0, src_array)
     if (present(missing)) then
        have_missing = any(missing == src_array)
        call MPI_AllReduce(have_missing, any_missing, 1, MPI_LOGICAL, MPI_LOR, MPI_COMM_WORLD, ierror)
        _VERIFY(ierror)
        if (any_missing) then
           local_key = run_length_encode(reshape(src_array,[size(src_array)]) == missing)
           global_key = all_gather(local_key)

           handle => route_handles%at(global_key)
           if (.not. associated(handle)) then
              allocate(handle)

              call ESMF_FieldGet(srcfield, grid=grid, rc=status)
              _VERIFY(status)
              call ESMF_GridGetItem(grid, staggerLoc=ESMF_STAGGERLOC_CENTER, &
                   & itemflag=ESMF_GRIDITEM_MASK, array=mask_array, rc=status)
              _VERIFY(status)
              call ESMF_ArrayGet(mask_array, farrayptr=mask, rc=status)
              _VERIFY(status)

              where (src_array == missing)
                 mask = 0
              elsewhere
                 mask = 1
              end where

              call ESMF_FieldRegridStore(srcField, dstField, &
                   & regridmethod=ESMF_REGRIDMETHOD_BILINEAR, lineType=ESMF_LINETYPE_GREAT_CIRCLE, &
                   & srcTermProcessing=srcTerm, &
                   & srcMaskValues = [0], &
                   & unmappedAction=ESMF_UNMAPPEDACTION_IGNORE, &
                   & routehandle=handle, rc=status)
              _VERIFY(status)

              call route_handles%insert(global_key, handle)

           endif

           call ESMF_FieldGet(dstField, 0, dst_array)
           dst_array = missing
           call ESMF_FieldRegrid(srcField, dstField, routeHandle=handle, &
                & termorderflag=ESMF_TERMORDER_SRCSEQ, &
                & zeroregion=ESMF_REGION_SELECT, &
                & rc=status)
           _VERIFY(status)

           _RETURN(_SUCCESS)
        else
           handle => default_route_handle
        end if
     else
        handle => default_route_handle
     end if

     call ESMF_FieldRegrid(srcField, dstField, routeHandle=handle, &
          & termorderflag=ESMF_TERMORDER_SRCSEQ, rc=status)
     _VERIFY(status)

     _RETURN(_SUCCESS)
   end subroutine regrid