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

Calls

proc~~test_globalindex~~CallsGraph proc~test_globalindex test_globalindex esmf_fieldcreate esmf_fieldcreate proc~test_globalindex->esmf_fieldcreate esmf_fielddestroy esmf_fielddestroy proc~test_globalindex->esmf_fielddestroy esmf_fieldemptycomplete esmf_fieldemptycomplete proc~test_globalindex->esmf_fieldemptycomplete esmf_fieldemptycreate esmf_fieldemptycreate proc~test_globalindex->esmf_fieldemptycreate esmf_fieldemptyset esmf_fieldemptyset proc~test_globalindex->esmf_fieldemptyset esmf_fieldget esmf_fieldget proc~test_globalindex->esmf_fieldget interface~esmf_gridcreatenoperidim ESMF_GridCreateNoPeriDim proc~test_globalindex->interface~esmf_gridcreatenoperidim interface~esmf_vmget ESMF_VMGet proc~test_globalindex->interface~esmf_vmget proc~esmf_arrayspecset ESMF_ArraySpecSet proc~test_globalindex->proc~esmf_arrayspecset proc~esmf_griddestroy ESMF_GridDestroy proc~test_globalindex->proc~esmf_griddestroy proc~esmf_logfounderror ESMF_LogFoundError proc~test_globalindex->proc~esmf_logfounderror proc~esmf_vmgetglobal ESMF_VMGetGlobal proc~test_globalindex->proc~esmf_vmgetglobal proc~esmf_gridcreatenoperidima ESMF_GridCreateNoPeriDimA interface~esmf_gridcreatenoperidim->proc~esmf_gridcreatenoperidima proc~esmf_gridcreatenoperidimi ESMF_GridCreateNoPeriDimI interface~esmf_gridcreatenoperidim->proc~esmf_gridcreatenoperidimi proc~esmf_gridcreatenoperidimr ESMF_GridCreateNoPeriDimR interface~esmf_gridcreatenoperidim->proc~esmf_gridcreatenoperidimr proc~esmf_vmgetdefault ESMF_VMGetDefault interface~esmf_vmget->proc~esmf_vmgetdefault proc~esmf_vmgetpetspecific ESMF_VMGetPetSpecific interface~esmf_vmget->proc~esmf_vmgetpetspecific proc~esmf_logseterror ESMF_LogSetError proc~esmf_arrayspecset->proc~esmf_logseterror proc~esmf_griddestroy->proc~esmf_logfounderror c_esmc_griddestroy c_esmc_griddestroy proc~esmf_griddestroy->c_esmc_griddestroy proc~esmf_gridgetinit ESMF_GridGetInit proc~esmf_griddestroy->proc~esmf_gridgetinit proc~esmf_imerr ESMF_IMErr proc~esmf_griddestroy->proc~esmf_imerr esmf_breakpoint esmf_breakpoint proc~esmf_logfounderror->esmf_breakpoint proc~esmf_logrc2msg ESMF_LogRc2Msg proc~esmf_logfounderror->proc~esmf_logrc2msg proc~esmf_logwrite ESMF_LogWrite proc~esmf_logfounderror->proc~esmf_logwrite

Called by

proc~~test_globalindex~~CalledByGraph proc~test_globalindex test_globalindex program~esmf_fieldcreategetutest ESMF_FieldCreateGetUTest program~esmf_fieldcreategetutest->proc~test_globalindex

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