ESMF_XGridMatch Function

public function ESMF_XGridMatch(xgrid1, xgrid2, rc)

Arguments

Type IntentOptional Attributes Name
type(ESMF_XGrid), intent(in) :: xgrid1
type(ESMF_XGrid), intent(in) :: xgrid2
integer, intent(out), optional :: rc

Return Value logical


Source Code

      function ESMF_XGridMatch(xgrid1, xgrid2, rc)
!
! !RETURN VALUE:
      logical :: ESMF_XGridMatch
!
! !ARGUMENTS:
      type(ESMF_XGrid), intent(in)   :: xgrid1, xgrid2 
      integer, intent(out), optional :: rc   
!
! !DESCRIPTION:
!      Compare two {\tt XGrid}s and check if they match each other. The 
!      comparison is incremental. First the internal pointer association
!      is checked to see if they are the same object. A deep check of 
!      individual XGrid members is carried out subsequently.
!
!      The method returns an error code if problems are found.  
!
!     The arguments are:
!     \begin{description}
!     \item [xgrid1]
!           First {\tt ESMF\_XGrid} to match.
!     \item [xgrid2]
!           Second {\tt ESMF\_XGrid} to match.
!     \item [{[rc]}]
!           Return code; equals {\tt ESMF\_SUCCESS} if the {\tt xgrid} 
!           is valid.
!     \end{description}
!
!EOPI

      integer :: localrc, i

      type(ESMF_XGridType), pointer :: fp1, fp2
      type(ESMF_Status) :: xgridstatus
      integer :: ngridA1, ngridB1
      integer :: ngridA2, ngridB2

      ! Initialize
      localrc = ESMF_RC_NOT_IMPL
      if (present(rc)) rc = ESMF_RC_NOT_IMPL
      ESMF_XGridMatch = .false.

      ! Check variables
      ESMF_INIT_CHECK_DEEP(ESMF_XGridGetInit,xgrid1,rc)
      ESMF_INIT_CHECK_DEEP(ESMF_XGridGetInit,xgrid2,rc)

      ! Identical pointer
      if(associated(xgrid1%xgtypep, xgrid2%xgtypep)) then
        ESMF_XGridMatch = .true.
        if(present(rc)) rc = ESMF_SUCCESS
        return
      endif

      ! Compare Grids contained
      fp1 => xgrid1%xgtypep
      fp2 => xgrid2%xgtypep
      ! Side A Grids
      if(associated(fp1%sideA)) ngridA1 = size(fp1%sideA, 1)
      if(associated(fp2%sideA)) ngridA2 = size(fp2%sideA, 1)
      if(ngridA1 /= ngridA2) then
        if(present(rc)) rc = ESMF_SUCCESS
        return
      endif
      if(.not. associated(fp1%sideA, fp2%sideA)) then
        do i = 1, ngridA1
          if(.not. ESMF_XGridGeomBaseMatch(fp1%sideA(i), fp2%sideA(i))) then
            if(present(rc)) rc = ESMF_SUCCESS
            return
          endif
        enddo
      endif
      ! Side B Grids
      if(associated(fp1%sideB)) ngridB1 = size(fp1%sideB, 1)
      if(associated(fp2%sideB)) ngridB2 = size(fp2%sideB, 1)
      if(ngridB1 /= ngridB2) then
        if(present(rc)) rc = ESMF_SUCCESS
        return
      endif
      if(.not. associated(fp1%sideB, fp2%sideB)) then
        do i = 1, ngridB1
          if(.not. ESMF_XGridGeomBaseMatch(fp1%sideB(i), fp2%sideB(i))) then
            if(present(rc)) rc = ESMF_SUCCESS
            return
          endif
        enddo
      endif

      ! Balanced DistGrid
      if(ESMF_DistGridMatch(fp1%distgridM, fp2%distgridM) &
        == ESMF_DISTGRIDMATCH_NONE) then
        if(present(rc)) rc = ESMF_SUCCESS
        return
      endif

      ! Side A DistGrids
      if(associated(fp1%distgridA)) ngridA1 = size(fp1%distgridA, 1)
      if(associated(fp2%distgridA)) ngridA2 = size(fp2%distgridA, 1)
      if(ngridA1 /= ngridA2) then
        if(present(rc)) rc = ESMF_SUCCESS
        return
      endif
      if(.not. associated(fp1%distgridA, fp2%distgridA)) then
        do i = 1, ngridA1
          if(ESMF_DistGridMatch(fp1%distgridA(i), fp2%distgridA(i)) &
            == ESMF_DISTGRIDMATCH_NONE) then
            if(present(rc)) rc = ESMF_SUCCESS
            return
          endif
        enddo
      endif
      ! Side B DistGrids
      if(associated(fp1%distgridB)) ngridB1 = size(fp1%distgridB, 1)
      if(associated(fp2%distgridB)) ngridB2 = size(fp2%distgridB, 1)
      if(ngridB1 /= ngridB2) then
        if(present(rc)) rc = ESMF_SUCCESS
        return
      endif
      if(.not. associated(fp1%distgridB, fp2%distgridB)) then
        do i = 1, ngridB1
          if(ESMF_DistGridMatch(fp1%distgridB(i), fp2%distgridB(i)) &
            == ESMF_DISTGRIDMATCH_NONE) then
            if(present(rc)) rc = ESMF_SUCCESS
            return
          endif
        enddo
      endif

      ! TODO: Compare the SparseMat objects

      ! All critical internal objects match
      ESMF_XGridMatch = .true.

      if (present(rc)) rc = ESMF_SUCCESS

      end function ESMF_XGridMatch