subroutine Setup1PeriodicConn(dimCount, minIndex, maxIndex, &
polekindflag, periodicDim, poleDim, connList, periodicDimOut, rc)
integer, intent(in) :: dimCount
integer, intent(in) :: minIndex(:)
integer, intent(in) :: maxIndex(:)
type(ESMF_PoleKind_Flag), intent(in), optional :: polekindflag(2)
integer, intent(in), optional :: periodicDim
integer, intent(in), optional :: poleDim
type(ESMF_DistgridConnection), pointer :: connList(:)
integer, intent(out) :: periodicDimOut
integer, intent(out), optional :: rc
type(ESMF_PoleKind_Flag) :: polekindflagLocal(2)
integer :: periodicDimLocal
integer :: poleDimLocal
integer :: connListCount, connListPos,i
integer :: posVec(ESMF_MAXDIM)
integer :: orientVec(ESMF_MAXDIM)
integer :: widthIndex(ESMF_MAXDIM)
integer :: localrc
#if DEBUG_POLEKIND
if(present(polekindflag)) then
print *, "Setup1PeriodicConn", polekindflag(1), polekindflag(2)
endif
#endif
! Error check input
if (present(periodicDim)) then
if (periodicDim .gt. dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_INCOMP, &
msg="- periodicDim must be less than or equal to dimension of Grid", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (periodicDim .lt. 1) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="- periodicDim must be at least 1", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(poleDim)) then
if (poleDim .gt. dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_INCOMP, &
msg="- poleDim must be less than or equal to dimension of Grid", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (poleDim .lt. 1) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="- poleDim must be at least 1", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
! Set defaults
if (present(polekindflag)) then
polekindflagLocal(1)=polekindflag(1)
polekindflagLocal(2)=polekindflag(2)
else
polekindflagLocal(1)=ESMF_POLEKIND_MONOPOLE
polekindflagLocal(2)=ESMF_POLEKIND_MONOPOLE
endif
if (present(periodicDim)) then
periodicDimLocal=periodicDim
else
periodicDimLocal=1
endif
if (present(poleDim)) then
poleDimLocal=poleDim
else
poleDimLocal=2
endif
! ...more error checking
if (periodicDimLocal == poleDimLocal) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_INCOMP, &
msg="- periodicDim must not be equal to poleDim", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Output the localperiodicDim
periodicDimOut=periodicDimLocal
! calculate the count of elements in each index
widthIndex=0
do i=1,dimCount
widthIndex(i)=maxIndex(i)-minIndex(i)+1
enddo
! Count number of connections
connListCount=1 ! for periodic dim
if (polekindflagLocal(1) .ne. ESMF_POLEKIND_NONE) then
connListCount=connListCount+1
endif
if (polekindflagLocal(2) .ne. ESMF_POLEKIND_NONE) then
connListCount=connListCount+1
endif
! Allocate connection list
allocate(connList(connListCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating connList", &
ESMF_CONTEXT, rcToReturn=rc)) return
! Add periodic connection
posVec=0
posVec(periodicDimLocal)=widthIndex(periodicDimLocal)
call ESMF_DistgridConnectionSet(connection=connList(1), &
tileIndexA=1,tileIndexB=1, &
positionVector=posVec(1:dimCount), &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Init orient vec
do i=1,ESMF_MAXDIM
orientvec(i)=i
enddo
! Fill in pole connections
connListPos=2 ! 2 because periodic is 1
! Lower end
if (polekindflaglocal(1) .eq. ESMF_POLEKIND_MONOPOLE) then
! setup monopole connection
posVec=0
posVec(periodicDimLocal)=widthIndex(periodicDimLocal)/2
posVec(poleDimLocal)=1
orientVec(poleDimLocal)=-orientVec(poleDimLocal) ! make pole dim -
call ESMF_DistgridConnectionSet(connection=connList(connListPos), &
tileIndexA=1,tileIndexB=1, &
positionVector=posVec(1:dimCount), &
orientationVector=orientVec(1:dimCount), &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Advance postion in list
connListPos=connListPos+1
else if (polekindflaglocal(1) .eq. ESMF_POLEKIND_BIPOLE) then
! setup bipole connection
posVec=0
posVec(periodicDimLocal)=widthIndex(periodicDimLocal)+1
posVec(poleDimLocal)=1
orientVec(poleDimLocal)=-orientVec(poleDimLocal) ! make pole dim -
orientVec(periodicDimLocal)=-orientVec(periodicDimLocal) ! make periodic dim -
call ESMF_DistgridConnectionSet(connection=connList(connListPos), &
tileIndexA=1,tileIndexB=1, &
positionVector=posVec(1:dimCount), &
orientationVector=orientVec(1:dimCount), &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Advance postion in list
connListPos=connListPos+1
endif
! Reinit orient vec
do i=1,ESMF_MAXDIM
orientvec(i)=i
enddo
! Upper end
if (polekindflaglocal(2) .eq. ESMF_POLEKIND_MONOPOLE) then
! setup monopole connection
posVec=0
posVec(periodicDimLocal)=widthIndex(periodicDimLocal)/2
posVec(poleDimLocal)=2*widthIndex(poleDimLocal)+1
orientVec(poleDimLocal)=-orientVec(poleDimLocal) ! make pole dim -
call ESMF_DistgridConnectionSet(connection=connList(connListPos), &
tileIndexA=1,tileIndexB=1, &
positionVector=posVec(1:dimCount), &
orientationVector=orientVec(1:dimCount), &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
else if (polekindflaglocal(2) .eq. ESMF_POLEKIND_BIPOLE) then
! setup bipole connection
posVec=0
posVec(periodicDimLocal)=widthIndex(periodicDimLocal)+1
posVec(poleDimLocal)=2*widthIndex(poleDimLocal)+1
orientVec(poleDimLocal)=-orientVec(poleDimLocal) ! make pole dim -
orientVec(periodicDimLocal)=-orientVec(periodicDimLocal) ! make periodic dim -
call ESMF_DistgridConnectionSet(connection=connList(connListPos), &
tileIndexA=1,tileIndexB=1, &
positionVector=posVec(1:dimCount), &
orientationVector=orientVec(1:dimCount), &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
end subroutine Setup1PeriodicConn