f_esmf_xgridgetsparsematb2x Subroutine

subroutine f_esmf_xgridgetsparsematb2x(xgrid, sideBIndex_base0, factorListCount, factorList, factorIndexList, rc)

Arguments

Type IntentOptional Attributes Name
type(ESMF_XGrid) :: xgrid
integer, intent(in) :: sideBIndex_base0
integer, intent(out) :: factorListCount
type(C_PTR) :: factorList
type(C_PTR) :: factorIndexList
integer, intent(out) :: rc

Source Code

  subroutine f_esmf_xgridgetsparsematb2x(xgrid,           &
                                         sideBIndex_base0, &
                                         factorListCount, &
                                         factorList,      &
                                         factorIndexList, &
                                         rc)

    use ESMF_XGridMod
    use ESMF_XGridGetMod
    use ESMF_XGridCreateMod
    use ESMF_XGridGeomBaseMod
    use ESMF_UtilTypesMod
    use ESMF_BaseMod
    use ESMF_LogErrMod
    use iso_c_binding

    implicit none

    type(ESMF_XGrid)     :: xgrid
    integer, intent(in)  :: sideBIndex_base0
    integer, intent(out) :: factorListCount
    type(C_PTR)          :: factorList
    type(C_PTR)          :: factorIndexList
    integer, intent(out) :: rc              

    ! Local Variables
    real(ESMF_KIND_R8), pointer    :: factorListFPtr(:)
    integer(ESMF_KIND_I4), pointer :: factorIndexListFPtr(:,:)
    integer :: sideBGridCount, sideBMeshCount
    type(ESMF_XGridSpec), allocatable :: sparseMatB2X(:)
    integer :: sideBIndex

    ! Init rc
    rc = ESMF_RC_NOT_IMPL

    ! Make sideA index base 1
    sideBIndex=sideBIndex_base0+1

    ! Get number of side B Grids
    call ESMF_XGridGet(xgrid, sideBGridCount=sideBGridCount, rc=rc)
    if (ESMF_LogFoundError(rc, ESMF_ERR_PASSTHRU, &
      ESMF_CONTEXT, rcToReturn=rc)) return

    ! Get number of side B Meshes
    call ESMF_XGridGet(xgrid, sideBMeshCount=sideBMeshCount, rc=rc)
    if (ESMF_LogFoundError(rc, ESMF_ERR_PASSTHRU, &
      ESMF_CONTEXT, rcToReturn=rc)) return
    
    ! Make sure the index is not too big
    if (sideBIndex > sideBGridCount+sideBMeshCount) then
      call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, & 
         msg="sideBIndex bigger than the number of Grids and Meshes on side B", &
         ESMF_CONTEXT, rcToReturn=rc) 
      return
    endif

    ! Make sure the index is not too small
    if (sideBIndex < 1) then
      call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, & 
         msg="sideBIndex below 1 in Fortran or 0 in C.", &
         ESMF_CONTEXT, rcToReturn=rc) 
      return
    endif


    ! Allocate XGridSpec array
    allocate(sparseMatB2X(sideBGridCount+sideBMeshCount))

    ! Get info
    call ESMF_XGridGet(xgrid, sparseMatB2X=sparseMatB2X, rc=rc)
    if (ESMF_LogFoundError(rc, ESMF_ERR_PASSTHRU, &
      ESMF_CONTEXT, rcToReturn=rc)) return

    ! Get sparse matrix information
    factorListCount = size(sparseMatB2X(sideBIndex)%factorList, 1)

    ! Associate the Fortran pointers with C pointers. Only do this if
    ! factors were created during the regrid store call.
    if (factorListCount > 0) then
       factorList = C_LOC(sparseMatB2X(sideBIndex)%factorList(1))
       factorIndexList = C_LOC(sparseMatB2X(sideBIndex)%factorIndexList(1,1))
    endif

    ! set rc to success
    rc = ESMF_SUCCESS
  
  end subroutine f_esmf_xgridgetsparsematb2x