subroutine SetupTileConn(dimCount, minIndex, maxIndex, &
connflagDim1, connflagDim2, connflagDim3, connList, rc)
integer, intent(in) :: dimCount
integer, intent(in) :: minIndex(:)
integer, intent(in) :: maxIndex(:)
type(ESMF_GridConn_Flag), intent(in), optional :: connflagDim1(:)
type(ESMF_GridConn_Flag), intent(in), optional :: connflagDim2(:)
type(ESMF_GridConn_Flag), intent(in), optional :: connflagDim3(:)
type(ESMF_DistgridConnection), pointer :: connList(:)
integer, intent(out), optional :: rc
integer :: periodicDimLocal
integer :: connListCount
integer :: connListPos
integer :: localrc
type(ESMF_GridConn_Flag) :: connflagDim1Local(2)
type(ESMF_GridConn_Flag) :: connflagDim2Local(2)
type(ESMF_GridConn_Flag) :: connflagDim3Local(2)
logical :: hasPeriod, hasPole
integer :: posVec(ESMF_MAXDIM),i
integer :: orientVec(ESMF_MAXDIM)
integer :: widthIndex(ESMF_MAXDIM)
if (present(connflagDim1)) then
if (size(connflagDim1) .ne. 2) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="- connflagDim1 must have size 2", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(connflagDim2)) then
if (size(connflagDim2) .ne. 2) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="- connflagDim2 must have size 2", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(connflagDim3)) then
if (size(connflagDim3) .ne. 2) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="- connflagDim3 must have size 2", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(connflagDim3) .and. (dimCount <3)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="- connflagDim3 should not be specified if Grid dim <3", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Set defaults
if (present(connflagDim1)) then
connflagDim1Local=connflagDim1
else
connflagDim1Local=ESMF_GRIDCONN_NONE
endif
if (present(connflagDim2)) then
connflagDim2Local=connflagDim2
else
connflagDim2Local=ESMF_GRIDCONN_NONE
endif
if (present(connflagDim3)) then
connflagDim3Local=connflagDim3
else
connflagDim3Local=ESMF_GRIDCONN_NONE
endif
! more error checking
if ((connflagDim1Local(1) .eq. ESMF_GRIDCONN_PERIODIC) .and. &
(connflagDim1Local(2) .ne. ESMF_GRIDCONN_PERIODIC)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="- periodicity must be specified on both ends", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if ((connflagDim1Local(1) .ne. ESMF_GRIDCONN_PERIODIC) .and. &
(connflagDim1Local(2) .eq. ESMF_GRIDCONN_PERIODIC)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="- periodicity must be specified on both ends", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! more error checking
if ((connflagDim2Local(1) .eq. ESMF_GRIDCONN_PERIODIC) .and. &
(connflagDim2Local(2) .ne. ESMF_GRIDCONN_PERIODIC)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="- periodicity must be specified on both ends", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if ((connflagDim2Local(1) .ne. ESMF_GRIDCONN_PERIODIC) .and. &
(connflagDim2Local(2) .eq. ESMF_GRIDCONN_PERIODIC)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="- periodicity must be specified on both ends", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! more error checking
if ((connflagDim3Local(1) .eq. ESMF_GRIDCONN_PERIODIC) .and. &
(connflagDim3Local(2) .ne. ESMF_GRIDCONN_PERIODIC)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="- periodicity must be specified on both ends", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if ((connflagDim3Local(1) .ne. ESMF_GRIDCONN_PERIODIC) .and. &
(connflagDim3Local(2) .eq. ESMF_GRIDCONN_PERIODIC)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="- periodicity must be specified on both ends", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Check for periodicity
hasPeriod=.false.
if ((connflagDim1Local(1) .eq. ESMF_GRIDCONN_PERIODIC) .or. &
(connflagDim1Local(2) .eq. ESMF_GRIDCONN_PERIODIC)) then
hasPeriod=.true.
periodicDimLocal=1
endif
if ((connflagDim2Local(1) .eq. ESMF_GRIDCONN_PERIODIC) .or. &
(connflagDim2Local(2) .eq. ESMF_GRIDCONN_PERIODIC)) then
hasPeriod=.true.
periodicDimLocal=2
endif
if ((connflagDim3Local(1) .eq. ESMF_GRIDCONN_PERIODIC) .or. &
(connflagDim3Local(2) .eq. ESMF_GRIDCONN_PERIODIC)) then
hasPeriod=.true.
periodicDimLocal=3
endif
! Check for poles
hasPole=.false.
if ((connflagDim1Local(1) .eq. ESMF_GRIDCONN_POLE) .or. &
(connflagDim1Local(1) .eq. ESMF_GRIDCONN_BIPOLE) .or. &
(connflagDim1Local(2) .eq. ESMF_GRIDCONN_POLE) .or. &
(connflagDim1Local(2) .eq. ESMF_GRIDCONN_BIPOLE)) then
hasPole=.true.
endif
if ((connflagDim2Local(1) .eq. ESMF_GRIDCONN_POLE) .or. &
(connflagDim2Local(1) .eq. ESMF_GRIDCONN_BIPOLE) .or. &
(connflagDim2Local(2) .eq. ESMF_GRIDCONN_POLE) .or. &
(connflagDim2Local(2) .eq. ESMF_GRIDCONN_BIPOLE)) then
hasPole=.true.
endif
if ((connflagDim3Local(1) .eq. ESMF_GRIDCONN_POLE) .or. &
(connflagDim3Local(1) .eq. ESMF_GRIDCONN_BIPOLE) .or. &
(connflagDim3Local(2) .eq. ESMF_GRIDCONN_POLE) .or. &
(connflagDim3Local(2) .eq. ESMF_GRIDCONN_BIPOLE)) then
hasPole=.true.
endif
! Error check
if (hasPole .and. .not. hasPeriod) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="- if a grid has a pole, it must be periodic", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! calculate the count of elements in each index
widthIndex=0
do i=1,dimCount
widthIndex(i)=maxIndex(i)-minIndex(i)+1
enddo
! Count connections
connListCount=0
!!!!!!!!! Connections for 1 !!!!!!!!!!!!!!!!!!!!!1
if (connflagDim1Local(1) .eq. ESMF_GRIDCONN_PERIODIC) then
connListCount=connListCount+1
else if (connflagDim1Local(1) .eq. ESMF_GRIDCONN_POLE) then
connListCount=connListCount+1
else if (connflagDim1Local(1) .eq. ESMF_GRIDCONN_BIPOLE) then
connListCount=connListCount+1
endif
if (connflagDim1Local(2) .eq. ESMF_GRIDCONN_POLE) then
connListCount=connListCount+1
else if (connflagDim1Local(2) .eq. ESMF_GRIDCONN_BIPOLE) then
connListCount=connListCount+1
endif
!!!!!!!!! Connections for 2 !!!!!!!!!!!!!!!!!!!!!1
if (connflagDim2Local(1) .eq. ESMF_GRIDCONN_PERIODIC) then
connListCount=connListCount+1
else if (connflagDim2Local(1) .eq. ESMF_GRIDCONN_POLE) then
connListCount=connListCount+1
else if (connflagDim2Local(1) .eq. ESMF_GRIDCONN_BIPOLE) then
connListCount=connListCount+1
endif
if (connflagDim2Local(2) .eq. ESMF_GRIDCONN_POLE) then
connListCount=connListCount+1
else if (connflagDim2Local(2) .eq. ESMF_GRIDCONN_BIPOLE) then
connListCount=connListCount+1
endif
!!!!!!!!! Connections for 3 !!!!!!!!!!!!!!!!!!!!!1
if (connflagDim3Local(1) .eq. ESMF_GRIDCONN_PERIODIC) then
connListCount=connListCount+1
else if (connflagDim3Local(1) .eq. ESMF_GRIDCONN_POLE) then
connListCount=connListCount+1
else if (connflagDim3Local(1) .eq. ESMF_GRIDCONN_BIPOLE) then
connListCount=connListCount+1
endif
if (connflagDim3Local(2) .eq. ESMF_GRIDCONN_POLE) then
connListCount=connListCount+1
else if (connflagDim3Local(2) .eq. ESMF_GRIDCONN_BIPOLE) then
connListCount=connListCount+1
endif
! Allocate connection list to maximum number possible
allocate(connList(connListCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating connList", &
ESMF_CONTEXT, rcToReturn=rc)) return
! init connectionCount
connListPos=1
!!!!!!!!! Connections for 1 !!!!!!!!!!!!!!!!!!!!!1
! Init orient vec
do i=1,ESMF_MAXDIM
orientvec(i)=i
enddo
if (connflagDim1Local(1) .eq. ESMF_GRIDCONN_PERIODIC) then
posVec=0
posVec(1)=widthIndex(1)
call ESMF_DistgridConnectionSet(connection=connList(connListPos), &
tileIndexA=1,tileIndexB=1, &
positionVector=posVec(1:dimCount), &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
connListPos=connListPos+1
else if (connflagDim1Local(1) .eq. ESMF_GRIDCONN_POLE) then
! do pole connection
posVec=0
posVec(periodicDimLocal)=widthIndex(periodicDimLocal)/2
posVec(1)=1
orientVec(1)=-orientVec(1) ! 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
connListPos=connListPos+1
else if (connflagDim1Local(1) .eq. ESMF_GRIDCONN_BIPOLE) then
posVec=0
posVec(periodicDimLocal)=widthIndex(periodicDimLocal)+1
posVec(1)=1
orientVec(1)=-orientVec(1) ! 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
connListPos=connListPos+1
endif
! Init orient vec
do i=1,ESMF_MAXDIM
orientvec(i)=i
enddo
if (connflagDim1Local(2) .eq. ESMF_GRIDCONN_POLE) then
posVec=0
posVec(periodicDimLocal)=widthIndex(periodicDimLocal)/2
posVec(1)=2*widthIndex(1)+1
orientVec(1)=-orientVec(1) ! 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
connListPos=connListPos+1
else if (connflagDim1Local(2) .eq. ESMF_GRIDCONN_BIPOLE) then
posVec=0
posVec(periodicDimLocal)=widthIndex(periodicDimLocal)+1
posVec(1)=2*widthIndex(1)+1
orientVec(1)=-orientVec(1) ! 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
connListPos=connListPos+1
endif
!!!!!!!!! Connections for 2 !!!!!!!!!!!!!!!!!!!!!1
! Init orient vec
do i=1,ESMF_MAXDIM
orientvec(i)=i
enddo
if (connflagDim2Local(1) .eq. ESMF_GRIDCONN_PERIODIC) then
posVec=0
posVec(2)=widthIndex(2)
call ESMF_DistgridConnectionSet(connection=connList(connListPos), &
tileIndexA=1,tileIndexB=1, &
positionVector=posVec(1:dimCount), &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
connListPos=connListPos+1
else if (connflagDim2Local(1) .eq. ESMF_GRIDCONN_POLE) then
! do pole connection
posVec=0
posVec(periodicDimLocal)=widthIndex(periodicDimLocal)/2
posVec(2)=1
orientVec(2)=-orientVec(2) ! 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
connListPos=connListPos+1
else if (connflagDim2Local(1) .eq. ESMF_GRIDCONN_BIPOLE) then
posVec=0
posVec(periodicDimLocal)=widthIndex(periodicDimLocal)+1
posVec(2)=1
orientVec(2)=-orientVec(2) ! 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
connListPos=connListPos+1
endif
! Init orient vec
do i=1,ESMF_MAXDIM
orientvec(i)=i
enddo
if (connflagDim2Local(2) .eq. ESMF_GRIDCONN_POLE) then
posVec=0
posVec(periodicDimLocal)=widthIndex(periodicDimLocal)/2
posVec(2)=2*widthIndex(2)+1
orientVec(2)=-orientVec(2) ! 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
connListPos=connListPos+1
else if (connflagDim2Local(2) .eq. ESMF_GRIDCONN_BIPOLE) then
posVec=0
posVec(periodicDimLocal)=widthIndex(periodicDimLocal)+1
posVec(2)=2*widthIndex(2)+1
orientVec(2)=-orientVec(2) ! 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
connListPos=connListPos+1
endif
!!!!!!!!! Connections for 3 !!!!!!!!!!!!!!!!!!!!!1
! Init orient vec
do i=1,ESMF_MAXDIM
orientvec(i)=i
enddo
if (connflagDim3Local(1) .eq. ESMF_GRIDCONN_PERIODIC) then
posVec=0
posVec(3)=widthIndex(3)
call ESMF_DistgridConnectionSet(connection=connList(connListPos), &
tileIndexA=1,tileIndexB=1, &
positionVector=posVec(1:dimCount), &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
connListPos=connListPos+1
else if (connflagDim3Local(1) .eq. ESMF_GRIDCONN_POLE) then
! do pole connection
posVec=0
posVec(periodicDimLocal)=widthIndex(periodicDimLocal)/2
posVec(3)=1
orientVec(3)=-orientVec(3) ! 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
connListPos=connListPos+1
else if (connflagDim3Local(1) .eq. ESMF_GRIDCONN_BIPOLE) then
posVec=0
posVec(periodicDimLocal)=widthIndex(periodicDimLocal)+1
posVec(3)=1
orientVec(3)=-orientVec(3) ! 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
connListPos=connListPos+1
endif
! Init orient vec
do i=1,ESMF_MAXDIM
orientvec(i)=i
enddo
if (connflagDim3Local(2) .eq. ESMF_GRIDCONN_POLE) then
posVec=0
posVec(periodicDimLocal)=widthIndex(periodicDimLocal)/2
posVec(3)=2*widthIndex(3)+1
orientVec(3)=-orientVec(3) ! 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
connListPos=connListPos+1
else if (connflagDim3Local(2) .eq. ESMF_GRIDCONN_BIPOLE) then
posVec=0
posVec(periodicDimLocal)=widthIndex(periodicDimLocal)+1
posVec(3)=2*widthIndex(3)+1
orientVec(3)=-orientVec(3) ! 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
connListPos=connListPos+1
endif
end subroutine SetupTileConn