test_globalindex Subroutine

subroutine test_globalindex(pinflag, testEmptyComplete, rc)

Arguments

Type IntentOptional Attributes Name
type(ESMF_Pin_Flag), optional :: pinflag
logical, optional :: testEmptyComplete
integer, intent(out) :: rc

Source Code

    subroutine test_globalindex(pinflag, testEmptyComplete, rc)
        type(ESMF_Pin_Flag), optional :: pinflag
        logical,             optional :: testEmptyComplete
        integer, intent(out)          :: rc
        integer                 :: localrc
        type(ESMF_Field)        :: field
        type(ESMF_Grid)         :: grid
        real (ESMF_KIND_R8), pointer:: farray(:,:)
        type(ESMF_VM)           :: vm
        integer                 :: localPet, petCount
        integer                 :: localDeCount, ssiLocalDeCount
        integer                 :: compLBnd(2), compUBnd(2)
        type(ESMF_ArraySpec)    :: arrayspec
        logical                 :: correct
        logical                 :: ssiSharedMemoryEnabled, testEC

        rc = ESMF_SUCCESS
        localrc = ESMF_SUCCESS
        correct=.true.

        call ESMF_VMGetGlobal(vm, rc=localrc)
        if (ESMF_LogFoundError(localrc, &
            ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT, rcToReturn=rc)) return

        call ESMF_VMGet(vm, petCount=petCount, localPet=localpet, &
          ssiSharedMemoryEnabledFlag=ssiSharedMemoryEnabled, rc=localrc)
        if (ESMF_LogFoundError(localrc, &
            ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT, rcToReturn=rc)) return

        ! only do this if there is 4 Pets
        if (petCount .eq. 4) then
           ! create grid with global indices
           grid = ESMF_GridCreateNoPeriDim(minIndex=(/1,1/), maxIndex=(/16,20/), &
                                  regDecomp=(/2,2/), indexflag=ESMF_INDEX_GLOBAL , rc=localrc)
           if (ESMF_LogFoundError(localrc, &
               ESMF_ERR_PASSTHRU, &
               ESMF_CONTEXT, rcToReturn=rc)) return

           ! set arrayspec
           call ESMF_ArraySpecSet(arrayspec, rank=2, typekind=ESMF_TYPEKIND_R8, rc=localrc)
           if (ESMF_LogFoundError(localrc, &
               ESMF_ERR_PASSTHRU, &
               ESMF_CONTEXT, rcToReturn=rc)) return

            if (present(pinflag).and.(.not.ssiSharedMemoryEnabled)) then
              ! force DE-TO-PET pinning
              pinflag = ESMF_PIN_DE_TO_PET
            endif

            testEC = .false.
            if (present(testEmptyComplete)) testEC = testEmptyComplete

            if (testEC) then
              ! create field on grid via EmptyCreate() and EmptyComplete()
              field = ESMF_FieldEmptyCreate(rc=localrc)
              if (ESMF_LogFoundError(localrc, &
                ESMF_ERR_PASSTHRU, &
                ESMF_CONTEXT, rcToReturn=rc)) return
              call ESMF_FieldEmptySet(field, grid, rc=localrc)
              if (ESMF_LogFoundError(localrc, &
                ESMF_ERR_PASSTHRU, &
                ESMF_CONTEXT, rcToReturn=rc)) return
              call ESMF_FieldEmptyComplete(field, arrayspec, pinflag=pinflag, &
                rc=localrc)
              if (ESMF_LogFoundError(localrc, &
                ESMF_ERR_PASSTHRU, &
                ESMF_CONTEXT, rcToReturn=rc)) return
            else
              ! create field on grid via FieldCreate()
              field = ESMF_FieldCreate(grid, arrayspec, pinflag=pinflag, &
                rc=localrc)
              if (ESMF_LogFoundError(localrc, &
                ESMF_ERR_PASSTHRU, &
                ESMF_CONTEXT, rcToReturn=rc)) return
            endif

            ! Get field bounds
            call ESMF_FieldGet(field, localde=0, farrayPtr=farray, &
                computationalLBound=compLBnd, computationalUBound=compUBnd, &
                rc=localrc)
            if (ESMF_LogFoundError(localrc, &
                ESMF_ERR_PASSTHRU, &
                ESMF_CONTEXT, rcToReturn=rc)) return
           
            ! check bounds
            if (localpet .eq. 0) then
               if (compLBnd(1) .ne. 1) correct=.false.
               if (compLBnd(2) .ne. 1) correct=.false.
               if (compUBnd(1) .ne. 8) correct=.false.
               if (compUBnd(2) .ne. 10) correct=.false.
            else if (localpet .eq. 1) then
               if (compLBnd(1) .ne. 9) correct=.false.
               if (compLBnd(2) .ne. 1) correct=.false.
               if (compUBnd(1) .ne. 16) correct=.false.
               if (compUBnd(2) .ne. 10) correct=.false.
            else if (localpet .eq. 2) then
               if (compLBnd(1) .ne. 1) correct=.false.
               if (compLBnd(2) .ne. 11) correct=.false.
               if (compUBnd(1) .ne. 8) correct=.false.
               if (compUBnd(2) .ne. 20) correct=.false.
            else if (localpet .eq. 3) then
               if (compLBnd(1) .ne. 9) correct=.false.
               if (compLBnd(2) .ne. 11) correct=.false.
               if (compUBnd(1) .ne. 16) correct=.false.
               if (compUBnd(2) .ne. 20) correct=.false.
            endif

            if (present(pinflag)) then
              if (pinflag == ESMF_PIN_DE_TO_SSI) then
                ! check that each PET sees all 4 DEs across the SSI
                call ESMF_FieldGet(field, localDeCount=localDeCount, &
                  ssiLocalDeCount=ssiLocalDeCount, rc=localrc)
                if (ESMF_LogFoundError(localrc, &
                  ESMF_ERR_PASSTHRU, &
                  ESMF_CONTEXT, rcToReturn=rc)) return
                if (localDeCount /= 1) correct=.false.
                if (ssiLocalDeCount /= 4) correct=.false.
              endif
            endif

            call ESMF_FieldDestroy(field, rc=localrc)
            if (ESMF_LogFoundError(localrc, &
                ESMF_ERR_PASSTHRU, &
                ESMF_CONTEXT, rcToReturn=rc)) return

            call ESMF_GridDestroy(grid, rc=localrc)
            if (ESMF_LogFoundError(localrc, &
                ESMF_ERR_PASSTHRU, &
                ESMF_CONTEXT, rcToReturn=rc)) return
       endif

       ! return rc based on correct
       if (correct) then
         rc=ESMF_SUCCESS
       else
         rc=ESMF_FAILURE
       endif

    end subroutine test_globalindex