test2e_generic Subroutine

subroutine test2e_generic(rc, minIndex, maxIndex, gridEdgeLWidth, gridEdgeUWidth, regDecomp, datacopyflag, staggerloc, gridToFieldMap, ungriddedLBound, ungriddedUBound, totalLWidth, totalUWidth, fieldget)

Arguments

Type IntentOptional Attributes Name
integer, intent(out) :: rc
integer, dimension(:) :: minIndex
integer, dimension(:) :: maxIndex
integer, optional, dimension(:) :: gridEdgeLWidth
integer, optional, dimension(:) :: gridEdgeUWidth
integer, optional, dimension(:) :: regDecomp
type(ESMF_DataCopy_Flag), optional :: datacopyflag
type(ESMF_StaggerLoc), optional :: staggerloc
integer, optional, dimension(:) :: gridToFieldMap
integer, optional, dimension(:) :: ungriddedLBound
integer, optional, dimension(:) :: ungriddedUBound
integer, optional, dimension(:) :: totalLWidth
integer, optional, dimension(:) :: totalUWidth
logical, optional :: fieldget

Source Code

    subroutine test2e_generic(rc, minindex, maxindex, &
        gridEdgeLWidth, gridEdgeUWidth, &
        regDecomp, &
        datacopyflag, &
        staggerloc, &
        gridToFieldMap, &
        ungriddedLBound, ungriddedUBound, &
        totalLWidth, totalUWidth, &
        fieldget)
        integer, intent(out)  :: rc
        integer, dimension(:)   :: minIndex
        integer, dimension(:)   :: maxIndex
        integer, dimension(:), optional   :: gridEdgeLWidth, gridEdgeUWidth
        integer, dimension(:), optional   :: regDecomp
        type(ESMF_DataCopy_Flag),   optional   :: datacopyflag
        type(ESMF_STAGGERLOC), optional   :: staggerloc
        integer, dimension(:), optional   :: gridToFieldMap
        integer, dimension(:), optional   :: ungriddedLBound, ungriddedUBound
        integer, dimension(:), optional   :: totalLWidth, totalUWidth
        logical, optional                 :: fieldget

        type(ESMF_Field)        :: field
        type(ESMF_Grid)         :: grid
        integer                 :: localrc, i

        type(ESMF_Grid)         :: grid1
        type(ESMF_Array)        :: array
        type(ESMF_TypeKind_Flag)     :: typekind
        integer                 :: dimCount
        type(ESMF_StaggerLoc)   :: lstaggerloc
        integer, dimension(3) :: lgridToFieldMap
        integer, dimension(3) :: lungriddedLBound 
        integer, dimension(3) :: lungriddedUBound 
        integer, dimension(3,1) :: ltotalLWidth
        integer, dimension(3,1) :: ltotalUWidth

        real, dimension(:,:,:), allocatable    :: farray
        type(ESMF_VM)                          :: vm
        integer                                :: lpe

        integer, dimension(3)        :: ec, cc, g2fm, mhlw, mhuw, dg2fm, f2dgm, dg2gm
        integer, dimension(3)        :: gelb, geub, gclb, gcub
        integer, dimension(3)        :: fsize
        integer                                :: gridDimCount, forderIndex

        rc = ESMF_SUCCESS
        localrc = ESMF_SUCCESS

        grid = ESMF_GridCreateNoPeriDim(minIndex=minIndex, maxIndex=maxindex, &
                                  gridEdgeLWidth=gridEdgeLWidth, gridEdgeUWidth=gridEdgeUWidth, &
                                  regDecomp=regDecomp, name="testgrid", rc=localrc)
        if (ESMF_LogFoundError(localrc, &
            ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT, rcToReturn=rc)) return

        call ESMF_GridGet(grid, dimCount=gridDimCount, distgridToGridMap=dg2gm, rc=localrc)
        if (ESMF_LogFoundError(localrc, &
            ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT, rcToReturn=rc)) return
        call ESMF_GridGet(grid, localDe=0, staggerloc=staggerloc, &
           exclusiveLBound=gelb, exclusiveUBound=geub, exclusiveCount=ec,  &
           computationalLBound=gclb, computationalUBound=gcub, computationalCount=cc, rc=localrc)
        if (ESMF_LogFoundError(localrc, &
            ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT, rcToReturn=rc)) return
!        call ESMF_GridGetArrayUndistInfo(grid, &
!             staggerloc=staggerloc, & 
!             gridToArrayMap=g2fm, &
!             distgridToArrayMap=dg2fm, &
!             rc=localrc)
!        if (ESMF_LogFoundError(localrc, &
!            ESMF_ERR_PASSTHRU, &
!            ESMF_CONTEXT, rcToReturn=rc)) return

        if(present(gridToFieldMap)) then
            g2fm(1:size(gridToFieldMap)) = gridToFieldMap
        else
            do i = 1, 3
                g2fm(i) = i
            enddo
        endif
        mhlw = 0
        if(present(totalLWidth)) then
            mhlw(1:gridDimCount) = totalLWidth(1:gridDimCount)
        endif
        mhuw = 0
        if(present(totalUWidth)) then
            mhuw(1:gridDimCount) = totalUWidth(1:gridDimCount)
        endif
        fsize = 10
        ! create a couple of mappings following index mapping lemma 1 and lemma 7
        do i = 1, gridDimCount
            dg2fm(i) = g2fm(dg2gm(i))
        enddo
        f2dgm = 0
        do i = 1, gridDimCount
            f2dgm(dg2fm(i)) = i
        enddo
        forderIndex = 1
        do i = 1, 3
            !fsize(g2fm(i)) = max(cc(i)+mhlw(g2fm(i))+mhuw(g2fm(i)), ec(i))
            if(f2dgm(i) .gt. 0) then
                fsize(i) = max(cc(f2dgm(i))+mhlw(forderIndex)+mhuw(forderIndex), ec(f2dgm(i)))
                forderIndex = forderIndex + 1
            endif
        enddo
        call ESMF_VMGetGlobal(vm, rc=localrc)
        if (ESMF_LogFoundError(localrc, &
            ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT, rcToReturn=rc)) return
        call ESMF_VMGet(vm, localPet=lpe, rc=localrc)
        if (ESMF_LogFoundError(localrc, &
            ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT, rcToReturn=rc)) return
!        write(*, "(A7, 17I3)") 'MZS: ', lpe, ec(1:3), cc(1:3), fsize(1:3), &
!            dg2fm(1:3), f2dgm(1:3), gridDimCount

        allocate(farray(fsize(1), fsize(2), fsize(3)))

        field = ESMF_FieldCreate(grid, farray, &
            indexflag=ESMF_INDEX_DELOCAL, datacopyflag=datacopyflag, &
            staggerloc=staggerloc,  gridToFieldMap=gridToFieldMap, &
            ungriddedLBound=ungriddedLBound, ungriddedUBound=ungriddedUBound, &
            totalLWidth=totalLWidth, totalUWidth=totalUWidth, rc=localrc)
        if (ESMF_LogFoundError(localrc, &
            ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT, rcToReturn=rc)) return

        if(present(fieldget)) then
          if(fieldget) then
            call ESMF_FieldGet(field, grid=grid1, array=array, typekind=typekind, &
                dimCount=dimCount, staggerloc=lstaggerloc, gridToFieldMap=lgridToFieldMap, &
                ungriddedLBound=lungriddedLBound, ungriddedUBound=lungriddedUBound, &
                totalLWidth=ltotalLWidth, totalUWidth=ltotalUWidth, &
                rc=localrc)
                if (ESMF_LogFoundError(localrc, &
                    ESMF_ERR_PASSTHRU, &
                    ESMF_CONTEXT, rcToReturn=rc)) return
          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
        deallocate(farray)
    end subroutine test2e_generic