<p><b>dwj07@fsu.edu</b> 2012-05-18 15:13:12 -0600 (Fri, 18 May 2012)</p><p><br>
        -- BRANCH COMMIT --<br>
<br>
        New exchange list creation routine.<br>
        New all to all routines.<br>
        New halo exchange routines.<br>
<br>
        These new communication routines support local copies.<br>
        Mpas still doesn't run in this branch yet. But this is some initial work that needs to be done prior to creating blocks.<br>
</p><hr noshade><pre><font color="gray">Modified: branches/omp_blocks/multiple_blocks/src/framework/mpas_dmpar.F
===================================================================
--- branches/omp_blocks/multiple_blocks/src/framework/mpas_dmpar.F        2012-05-18 20:56:37 UTC (rev 1921)
+++ branches/omp_blocks/multiple_blocks/src/framework/mpas_dmpar.F        2012-05-18 21:13:12 UTC (rev 1922)
@@ -542,1922 +542,3398 @@
    
    end subroutine mpas_dmpar_compute_index_range!}}}
 
-   subroutine mpas_dmpar_get_owner_list(dminfo, &amp;!{{{
-                                   nOwnedList, nNeededList, &amp;
-                                   ownedList, neededList, &amp;
-                                   sendList, recvList, inOffset)
+   ! ----- NEW ROUTINES BELOW ----- !
 
+subroutine mpas_dmpar_get_exch_list(haloLayer, ownedListField, neededListField, offsetListField)!{{{
+
       implicit none
 
-      type (dm_info), intent(in) :: dminfo
-      integer, intent(in) :: nOwnedList, nNeededList
-      integer, dimension(nOwnedList), intent(in) :: ownedList
-      integer, dimension(nNeededList), intent(in) :: neededList
-      type (exchange_list), pointer :: sendList
-      type (exchange_list), pointer :: recvList
-      integer, optional :: inOffset
+      integer, intent(in) :: haloLayer
+      type (field1dInteger), pointer :: ownedListField, neededListField
+      type (field0dInteger), pointer, optional :: offsetListField
 
-      integer :: i, j, k, kk
+      type (dm_info), pointer :: dminfo
+
+      integer :: i, j, k, kk, iBlock
       integer :: totalSize, nMesgRecv, nMesgSend, recvNeighbor, sendNeighbor, currentProc, offset
-      integer :: numToSend, numToRecv
-      integer, dimension(nOwnedList) :: recipientList
-      integer, dimension(2,nOwnedList) :: ownedListSorted
+      integer :: totalSent, totalRecv
+      integer, allocatable, dimension(:) :: numToSend, numToRecv
+      integer, allocatable, dimension(:) :: ownedList, ownedListIndex, ownedBlock, neededList, neededListIndex, neededBlock
+      integer, allocatable, dimension(:) :: offsetList
+      integer, allocatable, dimension(:,:) :: ownedListSorted, ownedBlockSorted, recipientList
       integer, allocatable, dimension(:) :: ownerListIn, ownerListOut
-      type (exchange_list), pointer :: sendListPtr, recvListPtr
+      type (mpas_exchange_list), pointer :: exchListPtr, exchListPtr2
+      type (field1dInteger), pointer :: fieldCursor, fieldCursor2
+      type (field0dInteger), pointer :: offsetCursor
+      integer :: nOwnedBlocks, nNeededBlocks
+      integer :: nOwnedList, nNeededList
       integer :: mpi_ierr, mpi_rreq, mpi_sreq
 
 
+      !
+      ! *** NB: This code assumes that block % blockID values are local block IDs and are in the range [1, numBlocks]
+      !         where numBlocks is the number of blocks owned by each task
+      !
+
+
+      ! For the ownedListField:
+      !    - ownedList contains a list of the global indices owned by all blocks
+      !    - ownedListIndex contains a list of the block-local indices of the global indices owned by all blocks
+      !    - ownedBlock contains the local block ID associated with each index 
+      !
+      ! Example:
+      !    ownedList      := ( 21 13 15 01 05 06 33 42 44 45 )     ! Global indices from all blocks on this task
+      !    ownedListIndex := (  1  2  3  4  1  2  3  4  5  6 )     ! Local  indices of global indices on each block
+      !    ownedBlock     := (  1  1  1  1  2  2  2  2  2  2 )     ! Local  indices of global indices on each block
+      !
+    
+      ! For the neededListField:
+      !    similar to the owneListField...
+
+
+      ! 
+      ! Determine total number of owned indices on this task, and 
+      !   initialize output send and recv lists for ownedListField
+      ! 
+
+      write(6,*) ' Setting up exchange lists'
+      dminfo =&gt; ownedListField % block % domain % dminfo
+
+      nOwnedList = 0
+      nOwnedBlocks = 0
+      fieldCursor =&gt; ownedListField
+      do while (associated(fieldCursor))
+        nOwnedBlocks = nOwnedBlocks + 1
+        nOwnedList = nOwnedList + fieldCursor % dimSizes(1)
+        fieldCursor =&gt; fieldCursor % next
+      end do
+
+
+      !
+      ! Determine total number of needed indices on this task
+      !
+      nNeededList = 0
+      nNeededBlocks = 0
+      fieldCursor =&gt; neededListField
+      do while (associated(fieldCursor))
+        nNeededBlocks = nNeededBlocks + 1
+        nNeededList = nNeededList + fieldCursor % dimSizes(1)
+        fieldCursor =&gt; fieldCursor % next
+      end do
+
 #ifdef _MPI
-      allocate(sendList)
-      allocate(recvList)
-      nullify(sendList % next)
-      nullify(recvList % next)
-      sendListPtr =&gt; sendList
-      recvListPtr =&gt; recvList
+      !
+      ! Gather list of all owned indices and their associated blocks on this task
+      !
+      allocate(ownedList(nOwnedList))
+      allocate(ownedBlock(nOwnedList))
+      fieldCursor =&gt; ownedListField
+      i = 1
+      do while (associated(fieldCursor))
+        ownedList(i:i+fieldCursor % dimSizes(1)-1) = fieldCursor % array(:)
+        ownedBlock(i:i+fieldCursor % dimSizes(1)-1) = fieldCursor % block % localBlockID
+        i = i + fieldCursor % dimSizes(1)
+        fieldCursor =&gt; fieldCursor % next
+      end do
 
-      offset = 0
-      if(present(inOffset)) then
-         offset = inOffset
-      end if
-      
+      !
+      ! Gather list of all needed indices and their associated blocks on this task
+      !
+      allocate(neededList(nNeededList))
+      allocate(neededBlock(nNeededList))
+      fieldCursor =&gt; neededListField
+      i = 1
+      do while (associated(fieldCursor))
+        neededList(i:i+fieldCursor % dimSizes(1)-1) = fieldCursor % array(:)
+        neededBlock(i:i+fieldCursor % dimSizes(1)-1) = fieldCursor % block % localBlockID
+        i = i + fieldCursor % dimSizes(1)
+        fieldCursor =&gt; fieldCursor % next
+      end do
+
+
+      !
+      ! Get list of index offsets for all blocks
+      !
+      allocate(offsetList(nNeededBlocks))
+      if (present(offsetListField)) then
+        offsetCursor =&gt; offsetListField
+        i = 0
+        do while (associated(offsetCursor))
+          i = i + 1
+          offsetList(i) = offsetCursor % scalar
+          offsetCursor =&gt; offsetCursor % next
+        end do
+      else
+        offsetList(:) = 0
+      end if 
+
+
+      !
+      ! Obtain sorted list of global indices owned by this task and the associated local indices and block IDs
+      !
+      allocate(ownedListIndex(nOwnedList))
+      allocate(ownedListSorted(2,nOwnedList))
+      allocate(recipientList(2,nOwnedList))
+      j = 1
       do i=1,nOwnedList
-         ownedListSorted(1,i) = ownedList(i)
-         ownedListSorted(2,i) = i
+        ownedListSorted(1,i) = ownedList(i)
+        if (i &gt; 1) then
+          if(ownedBlock(i) /= ownedBlock(i-1)) j = 1
+        end if
+        ownedListIndex(i) = j
+        ownedListSorted(2,i) = j
+        j = j + 1
       end do
       call quicksort(nOwnedList, ownedListSorted)
 
+      allocate(ownedBlockSorted(2,nOwnedList))
+      do i=1,nOwnedList
+        ownedBlockSorted(1,i) = ownedList(i)
+        ownedBlockSorted(2,i) = ownedBlock(i)
+      end do
+      call quicksort(nOwnedList, ownedBlockSorted)
+
+
+      allocate(neededListIndex(nOwnedList))
+      j = 1
+      do i=1,nNeededList
+        if (i &gt; 1) then 
+          if(neededBlock(i) /= neededBlock(i-1)) j = 1
+        end if
+        neededListIndex(i) = j
+        j = j + 1
+      end do
+
+
+      !
+      ! Set totalSize to the maximum number of items in any task's needed list
+      !
       call MPI_Allreduce(nNeededList, totalSize, 1, MPI_INTEGERKIND, MPI_MAX, dminfo % comm, mpi_ierr)
 
       allocate(ownerListIn(totalSize))
       allocate(ownerListOut(totalSize))
 
       nMesgRecv = nNeededList
+      nMesgSend = nMesgRecv
       ownerListIn(1:nNeededList) = neededList(1:nNeededList)
 
       recvNeighbor = mod(dminfo % my_proc_id + dminfo % nprocs - 1, dminfo % nprocs)
       sendNeighbor = mod(dminfo % my_proc_id + 1, dminfo % nprocs)
 
-      do i=1, dminfo % nprocs
+      allocate(numToSend(nOwnedBlocks))
+      allocate(numToRecv(nNeededBlocks))
 
-         recipientList(:) = -1
-         numToSend = 0
+      write(6,*) ' First send/recvs'
+      ! Initial send of data to neighbors.
+      call MPI_Irecv(nMesgRecv, 1, MPI_INTEGERKIND, recvNeighbor, i, dminfo % comm, mpi_rreq, mpi_ierr)
+      call MPI_Isend(nMesgSend, 1, MPI_INTEGERKIND, sendNeighbor, i, dminfo % comm, mpi_sreq, mpi_ierr)
+      call MPI_Wait(mpi_rreq, MPI_STATUS_IGNORE, mpi_ierr)
+      call MPI_Wait(mpi_sreq, MPI_STATUS_IGNORE, mpi_ierr)
+      call MPI_Irecv(ownerListIn, nMesgRecv, MPI_INTEGERKIND, recvNeighbor, i, dminfo % comm, mpi_rreq, mpi_ierr)
+      call MPI_Isend(ownerListOut, nMesgSend, MPI_INTEGERKIND, sendNeighbor, i, dminfo % comm, mpi_sreq, mpi_ierr)
+      call MPI_Wait(mpi_rreq, MPI_STATUS_IGNORE, mpi_ierr)
+      call MPI_Wait(mpi_sreq, MPI_STATUS_IGNORE, mpi_ierr)
 
-         currentProc = mod(dminfo % my_proc_id + dminfo % nprocs - i + 1, dminfo % nprocs)
-         do j=1,nMesgRecv
-            if (ownerListIn(j) &gt; 0) then
-               k = mpas_binary_search(ownedListSorted, 2, 1, nOwnedList, ownerListIn(j))
-               if (k &lt;= nOwnedList) then
-                  ownerListOut(j) = -1 * dminfo % my_proc_id
-                  numToSend = numToSend + 1
-                  recipientList(ownedListSorted(2,k)) = numToSend
-               else
-                  ownerListOut(j) = ownerListIn(j)
-               end if
+      ! 
+      ! For each processor (including ourself), mark the indices that we will provide to
+      !    that processor in ownerListOut, and build a send list for that processor if we
+      !    do need to send any indices
+      ! 
+      write(6,*) 'i loop'
+      do i=2, dminfo % nprocs
+        recipientList = -1
+        numToSend(:) = 0
+        totalSent = 0
+
+        currentProc = mod(dminfo % my_proc_id + dminfo % nprocs - i + 1, dminfo % nprocs)
+        do j=1,nMesgRecv
+          if (ownerListIn(j) &gt; 0) then
+            k = mpas_binary_search(ownedListSorted, 2, 1, nOwnedList, ownerListIn(j))
+            if (k &lt;= nOwnedList) then
+              ownerListOut(j) = -1 * dminfo % my_proc_id
+              numToSend(ownedBlockSorted(2,k)) = numToSend(ownedBlockSorted(2,k)) + 1
+              totalSent = totalSent + 1
+              ! recipientList(1,:) represents the index in the srcList to place this data
+              recipientList(1,ownedListSorted(2,k)) = numToSend(ownedBlockSorted(2,k))
+              ! recipientList(2,:) represnets the index in the buffer to place this data
+              recipientList(2,ownedListSorted(2,k)) = totalSent
             else
-               ownerListOut(j) = ownerListIn(j)
+              ownerListOut(j) = ownerListIn(j)
             end if
-         end do
+          else
+            ownerListOut(j) = ownerListIn(j)
+          end if
+        end do
 
-         if (numToSend &gt; 0) then
-            allocate(sendListPtr % next)
-            sendListPtr =&gt; sendListPtr % next
-            sendListPtr % procID = currentProc
-            sendListPtr % blockID = currentProc     ! Currently, we have just one block per task, so blockID = procID
-            sendListPtr % nlist = numToSend
-            allocate(sendListPtr % list(numToSend))
-            nullify(sendListPtr % next)
+        fieldCursor =&gt; ownedListField
+        do while (associated(fieldCursor))
+          iBlock = fieldCursor % block % localBlockID + 1
+
+          ! Find end of send list
+          ! *** NEED TO HANDLE COPY LISTS TOO ***
+          exchListPtr =&gt; fieldCursor % sendList(haloLayer)
+          exchListPtr2 =&gt; fieldCursor % sendList(haloLayer) % next
+          do while(associated(exchListPtr2))
+            exchListPtr =&gt; exchListPtr % next
+            exchListPtr2 =&gt; exchListPtr2 % next
+          end do
+
+          if (numToSend(iBlock) &gt; 0) then
+            allocate(exchListPtr % next)
+            exchListPtr =&gt; exchListPtr % next
+            exchListPtr % endPointID = currentProc
+            exchListPtr % nlist = numToSend(iBlock)
+            allocate(exchListPtr % srcList(numToSend(iBlock)))
+            allocate(exchListPtr % destList(numToSend(iBlock)))
+            nullify(exchListPtr % next)
             kk = 1
             do j=1,nOwnedList
-               if (recipientList(j) /= -1) then
-                  sendListPtr % list(recipientList(j)) = j
+              if (recipientList(1,j) /= -1) then
+                if(ownedBlock(j) == fieldCursor % block % blockID) then
+                  exchListPtr % srcList(recipientList(1,j)) = ownedListIndex(j)
+                  exchListPtr % destList(recipientList(1,j)) = recipientList(2,j)
                   kk = kk + 1
-               end if
+                end if
+              end if
             end do
-         end if
+          end if
 
-         nMesgSend = nMesgRecv
-         call MPI_Irecv(nMesgRecv, 1, MPI_INTEGERKIND, recvNeighbor, i, dminfo % comm, mpi_rreq, mpi_ierr)
-         call MPI_Isend(nMesgSend, 1, MPI_INTEGERKIND, sendNeighbor, i, dminfo % comm, mpi_sreq, mpi_ierr)
-         call MPI_Wait(mpi_rreq, MPI_STATUS_IGNORE, mpi_ierr)
-         call MPI_Wait(mpi_sreq, MPI_STATUS_IGNORE, mpi_ierr)
-         call MPI_Irecv(ownerListIn, nMesgRecv, MPI_INTEGERKIND, recvNeighbor, i, dminfo % comm, mpi_rreq, mpi_ierr)
-         call MPI_Isend(ownerListOut, nMesgSend, MPI_INTEGERKIND, sendNeighbor, i, dminfo % comm, mpi_sreq, mpi_ierr)
-         call MPI_Wait(mpi_rreq, MPI_STATUS_IGNORE, mpi_ierr)
-         call MPI_Wait(mpi_sreq, MPI_STATUS_IGNORE, mpi_ierr)
+          fieldCursor =&gt; fieldCursor % next
+        end do
+
+        nMesgSend = nMesgRecv
+        call MPI_Irecv(nMesgRecv, 1, MPI_INTEGERKIND, recvNeighbor, i, dminfo % comm, mpi_rreq, mpi_ierr)
+        call MPI_Isend(nMesgSend, 1, MPI_INTEGERKIND, sendNeighbor, i, dminfo % comm, mpi_sreq, mpi_ierr)
+        call MPI_Wait(mpi_rreq, MPI_STATUS_IGNORE, mpi_ierr)
+        call MPI_Wait(mpi_sreq, MPI_STATUS_IGNORE, mpi_ierr)
+        call MPI_Irecv(ownerListIn, nMesgRecv, MPI_INTEGERKIND, recvNeighbor, i, dminfo % comm, mpi_rreq, mpi_ierr)
+        call MPI_Isend(ownerListOut, nMesgSend, MPI_INTEGERKIND, sendNeighbor, i, dminfo % comm, mpi_sreq, mpi_ierr)
+        call MPI_Wait(mpi_rreq, MPI_STATUS_IGNORE, mpi_ierr)
+        call MPI_Wait(mpi_sreq, MPI_STATUS_IGNORE, mpi_ierr)
       end do
 
+
+      !
+      ! With our needed list returned to us, build receive lists based on which indices were
+      !    marked by other tasks
+      !
       do i=0, dminfo % nprocs - 1
+        if(i .ne. dminfo % my_proc_id) then
+          numToRecv(:) = 0
+          do j=1,nNeededList
+            if (ownerListIn(j) == -i) numToRecv(neededBlock(j)) = numToRecv(neededBlock(j)) + 1
+          end do
 
-         numToRecv = 0
-         do j=1,nNeededList
-            if (ownerListIn(j) == -i) numToRecv = numToRecv + 1
-         end do
-         if (numToRecv &gt; 0) then
-            allocate(recvListPtr % next)
-            recvListPtr =&gt; recvListPtr % next
-            recvListPtr % procID = i
-            recvListPtr % blockID = i     ! Currently, we have just one block per task, so blockID = procID
-            recvListPtr % nlist = numToRecv
-            allocate(recvListPtr % list(numToRecv))
-            nullify(recvListPtr % next)
-            kk = 1
-            do j=1,nNeededList
-               if (ownerListIn(j) == -i) then
-                  recvListPtr % list(kk) = j + offset
-                  kk = kk + 1
-               end if
+          fieldCursor =&gt; neededListField
+          totalRecv = 0
+          do while (associated(fieldCursor))
+            iBlock = fieldCursor % block % localBlockID + 1
+
+            ! Find end of recv list
+            exchListPtr =&gt; fieldCursor % recvList(haloLayer)
+            exchListPtr2 =&gt; fieldCursor % recvList(haloLayer) % next
+            do while(associated(exchListPtr2))
+              exchListPtr =&gt; exchListPtr % next
+              exchListPtr2 =&gt; exchListPtr2 % next
             end do
-         end if
 
+            if (numToRecv(iBlock) &gt; 0) then
+              allocate(exchListPtr % next)
+              exchListPtr =&gt; exchListPtr % next
+              exchListPtr % endPointID = i
+              exchListPtr % nlist = numToRecv(iBlock)
+              allocate(exchListPtr % srcList(numToRecv(iBlock)))
+              allocate(exchListPtr % destList(numToRecv(iBlock)))
+              nullify(exchListPtr % next)
+              kk = 1
+              do j=1,nNeededList
+                if (ownerListIn(j) == -i) then
+                  if (neededBlock(j) == fieldCursor % block % blockID) then
+                    totalRecv = totalRecv + 1
+                    exchListPtr % srcList(kk) = totalRecv
+                    exchListPtr % destList(kk) = neededListIndex(j) + offsetList(iBlock)
+                    kk = kk + 1
+                  end if
+                end if
+              end do
+            end if
+
+            fieldCursor =&gt; fieldCursor % next
+          end do
+        end if
       end do
 
+      !
+      ! Free up memory
+      !
+      deallocate(numToSend)
+      deallocate(numToRecv)
+      deallocate(ownedList)
+      deallocate(ownedListIndex)
+      deallocate(ownedBlock)
+      deallocate(neededList)
+      deallocate(neededListIndex)
+      deallocate(neededBlock)
+      deallocate(ownedListSorted)
+      deallocate(ownedBlockSorted)
+      deallocate(recipientList)
       deallocate(ownerListIn)
       deallocate(ownerListOut)
+      deallocate(offsetList)
+#endif
 
-      sendListPtr =&gt; sendList
-      sendList =&gt; sendList % next
-      deallocate(sendListPtr)
+      ! Build Copy Lists
+      allocate(numToSend(1))
+      fieldCursor =&gt; ownedListField
+      do while (associated(fieldCursor))
+        allocate(ownedListSorted(2, fieldCursor % dimSizes(1)))
+        allocate(recipientList(2, fieldcursor % dimSizes(1)))
 
-      recvListPtr =&gt; recvList
-      recvList =&gt; recvList % next
-      deallocate(recvListPtr)
+        numToSend = 0
+        recipientList = -1
 
-#else
-      allocate(recvList)
-      recvList % procID = dminfo % my_proc_id
-      recvList % blockID = dminfo % my_proc_id     ! Currently, we have just one block per task, so blockID = procID
-      recvList % nlist = nNeededList
-      allocate(recvList % list(nNeededList))
-      nullify(recvList % next)
-      do j=1,nNeededList
-         recvList % list(j) = j
+        do i = 1, fieldCursor % dimSizes(1)
+          ownedListSorted(1, i) = fieldCursor % array(i)
+          ownedListSorted(2, i) = i
+        end do
+
+        call quicksort(fieldCursor % dimSizes(1), ownedListSorted)
+
+        fieldCursor2 =&gt; neededListField
+        do while(associated(fieldCursor2))
+          do i = 1, fieldCursor2 % dimSizes(1)
+            k = mpas_binary_search(ownedListSorted, 2, 1, fieldCursor % dimSizes(1), fieldCursor2 % array(i))
+            if (k &lt;= fieldCursor % dimSizes(1)) then
+              numToSend(1) = numToSend(1) + 1
+              ! recipientList(1,:) represents the needed block id
+              recipientList(1,ownedListSorted(2,k)) = fieldCursor2 % block % localBlockID
+              ! recipientList(2,:) represnets the index in the buffer to place this data
+              recipientList(2,ownedListSorted(2,k)) = i
+            end if
+          end do
+
+          if(numToSend(1) &gt; 0) then
+            ! Find end of copy list
+            exchListPtr =&gt; fieldCursor % copyList(haloLayer)
+            exchListPtr2 =&gt; fieldCursor % copyList(haloLayer) % next
+            do while(associated(exchListPtr2))
+              exchListPtr =&gt; exchListPtr % next
+              exchListPtr2 =&gt; exchListPtr2 % next
+            end do
+    
+            allocate(exchListPtr % next)
+            exchListPtr =&gt; exchListPtr % next
+            exchListPtr % endPointID = fieldCursor2 % block % localBlockID
+            exchListPtr % nlist = numToSend(1)
+            allocate(exchListPtr % srcList(numToSend(1)))
+            allocate(exchListPtr % destList(numToSend(1)))
+            nullify(exchListPtr % next)
+            kk = 1
+            do j=1,fieldCursor % dimSizes(1)
+             if(recipientList(1,j) == fieldCursor2 % block % blockID) then
+               exchListPtr % srcList(kk) = j
+               exchListPtr % destList(kk) = recipientList(2,j)
+               kk = kk + 1
+             end if
+            end do
+          end if
+          fieldCursor2 =&gt; fieldCursor % next
+        end do
+
+        deallocate(recipientList)
+        deallocate(ownedListSorted)
+        fieldCursor =&gt; fieldCursor % next
       end do
+      deallocate(numToSend)
 
-      allocate(sendList)
-      sendList % procID = dminfo % my_proc_id
-      sendList % blockID = dminfo % my_proc_id     ! Currently, we have just one block per task, so blockID = procID
-      sendList % nlist = nOwnedList
-      allocate(sendList % list(nOwnedList))
-      nullify(sendList % next)
-      do j=1,nOwnedList
-         sendList % list(j) = j
+      !
+      ! The first item in each send and recv list is invalid, so advance these pointers
+      !    to point to the first valid item in the list
+      !
+      fieldCursor =&gt; ownedListField
+      do while (associated(fieldCursor))
+        exchListPtr =&gt; fieldCursor % sendList(haloLayer)
+        fieldCursor % sendList(haloLayer) = fieldCursor % sendList(haloLayer) % next
+        deallocate(exchListPtr)
+
+        fieldCursor =&gt; fieldCursor % next
       end do
-#endif
 
-   end subroutine mpas_dmpar_get_owner_list!}}}
+      fieldCursor =&gt; neededListField
+      do while(associated(fieldCursor))
+        exchListPtr =&gt; fieldCursor % recvList(haloLayer)
+        fieldCursor % recvList(haloLayer) = fieldCursor % recvList(haloLayer) % next
+        deallocate(exchListPtr)
 
-   subroutine mpas_dmpar_alltoall_field1d_integer(dminfo, fieldIn, fieldout)!{{{
+        exchListPtr =&gt; fieldCursor % copyList(haloLayer)
+        fieldCursor % copyList(haloLayer) = fieldCursor % copyList(haloLayer) % next
+        deallocate(exchListPtr)
 
+        fieldcursor =&gt; fieldCursor % next
+      end do
+
+   end subroutine mpas_dmpar_get_exch_list!}}}
+
+   subroutine mpas_dmpar_alltoall_field1d_integer(fieldIn, fieldout, haloLayersIn)!{{{
+
      implicit none
 
-     type (dm_info), intent(in) :: dminfo
      type (field1dInteger), pointer :: fieldIn
      type (field1dInteger), pointer :: fieldOut
+     integer, dimension(:), pointer, optional :: haloLayersIn
 
      type (field1dInteger), pointer :: fieldInPtr, fieldOutPtr
-     type (exchange_list), pointer :: sendListPtr, recvListPtr, copyListPtr
+     type (mpas_exchange_list), pointer :: exchListPtr, exchListPtr2
+     type (mpas_communication_list), pointer :: sendList, recvList, commListPtr, commListPtr2
+     type (dm_info), pointer :: dminfo
 
+     logical :: comm_list_found
+
      integer :: lastPackedIdx, lastUnpackedIdx, nPacked, nUnpacked
+     integer :: nAdded, bufferOffset
      integer :: mpi_ierr
-     integer :: i
+     integer :: iHalo, i
+     integer :: nHaloLayers
+     integer, dimension(:), pointer :: haloLayers
 
+     dminfo =&gt; fieldIn % block % domain % dminfo
+
+     if(present(haloLayersIn)) then
+       nHaloLayers = size(haloLayersIn)
+       allocate(haloLayers(nHaloLayers))
+       do iHalo = 1, nHaloLayers
+         haloLayers(iHalo) = haloLayersIn(iHalo)
+       end do
+     else
+       nHaloLayers = size(fieldIn % sendList)
+       allocate(haloLayers(nHaloLayers))
+       do iHalo = 1, nHaloLayers
+         haloLayers(iHalo) = iHalo
+       end do
+     end if
+
 #ifdef _MPI
+     allocate(sendList)
+     nullify(sendList % next)
 
-     ! Initiate mpi_irecv calls
-     fieldOutPtr =&gt; fieldOut
-     do while (associated(fieldOutPtr))
-       recvListPtr =&gt; fieldOutPtr % recvList(1) % next
+     allocate(recvList)
+     nullify(recvList % next)
 
-       do while(associated(recvListPtr))
-         allocate(recvListPtr % ibuffer(recvListPtr % nlist))
-         call MPI_Irecv(recvListPtr % ibuffer, recvListPtr % nlist, MPI_INTEGERKIND, &amp;
-                        recvListPtr % procID, recvListPtr % procID, dminfo % comm, recvListPtr % reqID, mpi_ierr)
+     ! Setup recieve lists, and determine the size of their buffers.
+     do iHalo = 1, nHaloLayers
+       fieldOutPtr =&gt; fieldOut
+       do while(associated(fieldOutPtr))
+         exchListPtr =&gt; fieldOutPtr % recvList(haloLayers(iHalo))
+         do while(associated(exchListPtr))
+           comm_list_found = .false.
+  
+           ! Search for an already created commList to this processor.
+           commListPtr =&gt; recvList
+           do while(associated(commListPtr))
+             if(commListPtr % procID == exchListPtr % endPointID) then
+               commListPtr % nList = commListPtr % nList + exchListPtr % nList 
+               comm_list_found = .true.
+               exit
+             end if
+  
+             commListPtr =&gt; commListPtr % next
+           end do
+  
+           ! If no comm list exists, create a new one.
+           if(.not. comm_list_found) then
+             commListPtr =&gt; recvList
+             commListPtr2 =&gt; commListPtr % next
+             do while(associated(commListPtr2))
+               commListPtr =&gt; commListPtr % next
+               commListPtr2 =&gt; commListPtr % next
+             end do
+  
+             allocate(commListPtr % next)
+             commListPtr =&gt; commListPtr % next
+             commListPtr % procID = exchListPtr % endPointID
+             commListPtr % nList = exchListPtr % nList
+           end if
+  
+           exchListPtr =&gt; exchListPtr % next
+         end do
+  
+         fieldOutPtr =&gt; fieldOutPtr % next
+       end do
+     end do
 
-         recvListPtr =&gt; recvListPtr % next
+     ! Allocate buffers for recieves, and initiate mpi_irecv calls.
+     commListPtr =&gt; recvList
+     do while(associated(commListPtr))
+       allocate(commListPtr % ibuffer(commListPtr % nList))
+       call MPI_Irecv(commListPtr % ibuffer, commListPtr % nList, MPI_INTEGERKIND, commListPtr % procID, commListPtr % procID, dminfo % comm, commListPtr % reqID, mpi_ierr)
+       commListPtr =&gt; commListPtr
+     end do
+
+     ! Setup send lists, and determine the size of their buffers.
+     do iHalo = 1, nHaloLayers
+       fieldInPtr =&gt; fieldIn
+       do while(associated(fieldInPtr))
+         exchListPtr =&gt; fieldInPtr % sendList(haloLayers(iHalo))
+         do while(associated(exchListPtr))
+           comm_list_found = .false.
+  
+           ! Search for an already created commList to this processor.
+           commListPtr =&gt; sendList
+           do while(associated(commListPtr))
+             if(commListPtr % procID == exchListPtr % endPointID) then
+               commListPtr % nList = commListPtr % nList + exchListPtr % nList 
+               comm_list_found = .true.
+               exit
+             end if
+  
+             commListPtr =&gt; commListPtr % next
+           end do
+  
+           ! If no comm list exists, create a new one.
+           if(.not. comm_list_found) then
+             commListPtr =&gt; sendList
+             commListPtr2 =&gt; commListPtr % next
+             do while(associated(commListPtr2))
+               commListPtr =&gt; commListPtr % next
+               commListPtr2 =&gt; commListPtr % next
+             end do
+  
+             allocate(commListPtr % next)
+             commListPtr =&gt; commListPtr % next
+             commListPtr % procID = exchListPtr % endPointID
+             commListPtr % nList = exchListPtr % nList
+           end if
+  
+           exchListPtr =&gt; exchListPtr % next
+         end do
+  
+         fieldInPtr =&gt; fieldInPtr % next
        end do
-       fieldOutPtr =&gt; fieldOutPtr % next
      end do
 
-     ! Initiate mpi_isend calls, and handle local copies
-     fieldInPtr =&gt; fieldIn
-     do while (associated(fieldInPtr))
-       sendListPtr =&gt; fieldInPtr % sendList(1) % next
-       do while (associated(sendListPtr))
+     ! Allocate sendLists, copy data into buffer, and initiate mpi_isends
+     commListPtr =&gt; sendList
+     do while(associated(commListPtr))
+       allocate(commListPtr % ibuffer(commListPtr % nList))
+       bufferOffset = 0
+       do iHalo = 1, nHaloLayers
+         nAdded = 0
+         fieldInPtr =&gt; fieldIn
+         do while(associated(fieldInPtr))
+           exchListPtr =&gt; fieldInPtr % sendList(haloLayers(iHalo))
+           do while(associated(exchListPtr))
+             if(exchListPtr % endPointID == commListPtr % procID) then
+               do i = 1, exchListPtr % nList
+                 commListPtr % ibuffer(exchListPtr % destList(i) + bufferOffset) = fieldInPtr % array(exchListPtr % srcList(i))
+                 nAdded = nAdded + 1
+               end do
+             end if
+  
+             exchListPtr =&gt; exchListPtr % next
+           end do
+  
+           fieldInPtr =&gt; fieldInPtr % next
+         end do
+         bufferOffset = bufferOffset + nAdded
+       end do
 
-         if (sendListPtr % procID == dminfo % my_proc_id) then ! Local Copy
+       call MPI_Isend(commListPtr % ibuffer, commListPtr % nlist, MPI_INTEGERKIND, &amp;
+                      commListPtr % procID, dminfo % my_proc_id, dminfo % comm, commListPtr % reqID, mpi_ierr)
+
+       commListPtr =&gt; commListPtr % next
+     end do
+#endif     
+
+     ! Handle Local Copies. Only local copies if no MPI
+     do iHalo = 1, nHaloLayers
+       fieldInPtr =&gt; fieldIn
+       do while(associated(fieldInPtr))
+         exchListPtr =&gt; fieldInPtr % copyList(haloLayers(iHalo))
+         do while(associated(exchListPtr))
            fieldOutPtr =&gt; fieldOut
-           do while (associated(fieldOutPtr))
-             if(fieldOutPtr % block % blockID == sendListPtr % blockID) then
-               copyListPtr =&gt; fieldOutPtr % copyList(1) % next
-               do while(associated(copyListPtr))
-                 if(copyListPtr % blockID == fieldInPtr % block % blockID) then
-                   do i = 1, copyListPtr % nList
-                     fieldOutPtr % array(copyListPtr % list(i)) = fieldInPtr % array(sendListPtr % list(i))
-                   end do
-                 end if
-                 copyListPtr =&gt; copyListPtr % next
+           do while(associated(fieldOutPtr))
+             if(exchListPtr % endPointID == fieldOutPtr % block % localBlockID) then
+               do i = 1, exchListPtr % nList
+                 fieldOutPtr % array(exchListPtr % destList(i)) = fieldInPtr % array(exchListPtr % srcList(i))
                end do
              end if
              fieldOutPtr =&gt; fieldOutPtr % next
            end do
-         else ! mpi_isend
-           allocate(sendListPtr % ibuffer(sendListPtr % nlist))
-           call mpas_pack_send_buf1d_integer(fieldInPtr % dimSizes(1), fieldInPtr % array, sendListPtr, 1, sendListPtr % nlist, &amp;
-                                             sendListPtr % ibuffer, nPacked, lastPackedIdx)
-           call MPI_Isend(sendListPtr % ibuffer, sendListPtr % nlist, MPI_INTEGERKIND, &amp;
-                          sendListPtr % procID, dminfo % my_proc_id, dminfo % comm, sendListPtr % reqID, mpi_ierr)
-         end if
-         sendListPtr =&gt; sendListPtr % next
+  
+           exchListPtr =&gt; exchListPtr % next
+         end do
        end do
-       fieldInPtr =&gt; fieldInPtr % next
      end do
 
-     ! Recieve all mpi_irecv commands, and unpack data into array
-     ! Deallocate recieve buffers
-     fieldOutPtr =&gt; fieldOut
-     do while (associated(fieldOutPtr))
-       recvListPtr =&gt; fieldOutPtr % recvList(1) % next
-       do while (associated(recvListPtr))
-         call MPI_Wait(recvListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
-         call mpas_unpack_recv_buf1d_integer(fieldOutPtr % dimSizes(1), fieldOutPtr % array, recvListPtr, 1, recvListPtr % nlist, &amp;
-                                             recvListPtr % ibuffer, nUnpacked, lastUnpackedIdx)
-         deallocate(recvListPtr % ibuffer)
-         recvListPtr =&gt; recvListPtr % next
+#ifdef _MPI
+     ! Wait for MPI_Irecv's to finish, and unpack data.
+     commListPtr =&gt; recvList
+     do while(associated(commListPtr))
+       call MPI_Wait(commListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
+
+       bufferOffset = 0
+       do iHalo = 1, nHaloLayers
+         nAdded = 0
+         fieldOutPtr =&gt; fieldOut
+         do while(associated(fieldOutPtr))
+           exchListPtr =&gt; fieldOutPtr % recvList(haloLayers(iHalo))
+           do while(associated(exchListPtr))
+             if(exchListPtr % endPointID == commListPtr % procID) then
+               do i = 1, exchListPtr % nList
+                 fieldOutPtr % array(exchListPtr % destList(i)) = commListPtr % ibuffer(exchListPtr % srcList(i) + bufferOffset)
+                 nAdded = nAdded + 1
+               end do
+             end if
+             exchListPtr =&gt; exchListPtr % next
+           end do
+  
+           fieldOutPtr =&gt; fieldOutPtr % next
+         end do
+         bufferOffset = bufferOffset + nAdded
        end do
-       fieldOutPtr =&gt; fieldOutPtr % next
+
+       commListPtr =&gt; commListPtr % next
      end do
 
-     ! Dellocate send buffers
-     fieldInPtr =&gt; fieldIn
-     do while (associated(fieldInPtr))
-       sendListPtr =&gt; fieldInPtr % sendList(1) % next
-       do while (associated(sendListPtr))
-          if (sendListPtr % procID /= dminfo % my_proc_id) then
-             call MPI_Wait(sendListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
-             deallocate(sendListPtr % ibuffer)
-          end if
-          sendListPtr =&gt; sendListPtr % next
-       end do
-       fieldInPtr =&gt; fieldInPtr % next
+     ! Wait for MPI_Isend's to finish.
+     commListPtr =&gt; sendList
+     do while(associated(commListPtr))
+       call MPI_Wait(commListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
+       commListPtr =&gt; commListPtr % next
      end do
 
-#else
-     ! Only local copies if no mpi
-     fieldOutPtr =&gt; fieldOut
-     do while (associated(fieldOutPtr))
-       copyListPtr =&gt; fieldOutPtr % copyList(1) % next
-       do while (associated(copyListPtr))
-         fieldInPtr =&gt; fieldIn
-         do while (associated(fieldInPtr))
-           if(copyListPtr % blockID == fieldInPtr % block % blockID) then
-             sendListPtr =&gt; fieldInPtr % sendList(1) % next
-             do while (associated(sendListPtr))
-               if(sendListPtr % blockID == fieldOutPtr % block % blockID) then
-                 do i = 1, copyListPtr % nList
-                   fieldOutPtr % array(copyListPtr % list(i)) = fieldInPtr % array(sendListPtr % list(i))
-                 end do
-               end if
-               sendListPtr =&gt; sendListPtr % next
-             end do
-           end if
-           fieldInPtr =&gt; fieldInPtr % next
-         end do
-         copyListPtr =&gt; copyListPtr % next
-       end do
-       fieldOutPtr =&gt; fieldOutPtr % next
-     end do
+     ! Destroy commLists.
+     call mpas_dmpar_destroy_communication_list(sendList)
+     call mpas_dmpar_destroy_communication_list(recvList)
 #endif
 
    end subroutine mpas_dmpar_alltoall_field1d_integer!}}}
 
-   subroutine mpas_dmpar_alltoall_field2d_integer(dminfo, fieldIn, fieldout)!{{{
+   subroutine mpas_dmpar_alltoall_field2d_integer(fieldIn, fieldout, haloLayersIn)!{{{
 
      implicit none
 
-     type (dm_info), intent(in) :: dminfo
      type (field2dInteger), pointer :: fieldIn
      type (field2dInteger), pointer :: fieldOut
+     integer, dimension(:), pointer, optional :: haloLayersIn
 
      type (field2dInteger), pointer :: fieldInPtr, fieldOutPtr
-     type (exchange_list), pointer :: sendListPtr, recvListPtr, copyListPtr
+     type (mpas_exchange_list), pointer :: exchListPtr, exchListPtr2
+     type (mpas_communication_list), pointer :: sendList, recvList, commListPtr, commListPtr2
+     type (dm_info), pointer :: dminfo
 
-     integer :: nBuffer
+     logical :: comm_list_found
+
      integer :: lastPackedIdx, lastUnpackedIdx, nPacked, nUnpacked
+     integer :: nAdded, bufferOffset
      integer :: mpi_ierr
-     integer :: i
+     integer :: iHalo, i, j
+     integer :: nHaloLayers
+     integer, dimension(:), pointer :: haloLayers
+     
+     dminfo =&gt; fieldIn % block % domain % dminfo
 
+     if(present(haloLayersIn)) then
+       nHaloLayers = size(haloLayersIn)
+       allocate(haloLayers(nHaloLayers))
+       do iHalo = 1, nHaloLayers
+         haloLayers(iHalo) = haloLayersIn(i)
+       end do
+     else
+       nHaloLayers = size(fieldIn % sendList)
+       allocate(haloLayers(nHaloLayers))
+       do iHalo = 1, nHaloLayers
+         haloLayers(iHalo) = i
+       end do
+     end if
+
 #ifdef _MPI
+     allocate(sendList)
+     nullify(sendList % next)
 
-     ! Initiate mpi_irecv calls
-     fieldOutPtr =&gt; fieldOut
-     do while (associated(fieldOutPtr))
-       recvListPtr =&gt; fieldOutPtr % recvList(1) % next
+     allocate(recvList)
+     nullify(recvList % next)
 
-       do while(associated(recvListPtr))
-         nBuffer = recvListPtr % nList * fieldOutPtr % dimSizes(1)
-         allocate(recvListPtr % ibuffer(nBuffer))
-         call MPI_Irecv(recvListPtr % ibuffer, nBuffer, MPI_INTEGERKIND, &amp;
-                        recvListPtr % procID, recvListPtr % procID, dminfo % comm, recvListPtr % reqID, mpi_ierr)
-
-         recvListPtr =&gt; recvListPtr % next
+     ! Setup recieve lists, and determine the size of their buffers.
+     do iHalo = 1, nHaloLayers
+       fieldOutPtr =&gt; fieldOut
+       do while(associated(fieldOutPtr))
+         exchListPtr =&gt; fieldOutPtr % recvList(haloLayers(iHalo))
+         do while(associated(exchListPtr))
+           comm_list_found = .false.
+  
+           ! Search for an already created commList to this processor.
+           commListPtr =&gt; recvList
+           do while(associated(commListPtr))
+             if(commListPtr % procID == exchListPtr % endPointID) then
+               commListPtr % nList = commListPtr % nList + exchListPtr % nList  * fieldOutPtr % dimSizes(1)
+               comm_list_found = .true.
+               exit
+             end if
+  
+             commListPtr =&gt; commListPtr % next
+           end do
+  
+           ! If no comm list exists, create a new one.
+           if(.not. comm_list_found) then
+             commListPtr =&gt; recvList
+             commListPtr2 =&gt; commListPtr % next
+             do while(associated(commListPtr2))
+               commListPtr =&gt; commListPtr % next
+               commListPtr2 =&gt; commListPtr % next
+             end do
+  
+             allocate(commListPtr % next)
+             commListPtr =&gt; commListPtr % next
+             commListPtr % procID = exchListPtr % endPointID
+             commListPtr % nList = exchListPtr % nList * fieldOutPtr % dimSizes(1)
+           end if
+  
+           exchListPtr =&gt; exchListPtr % next
+         end do
+  
+         fieldOutPtr =&gt; fieldOutPtr % next
        end do
-       fieldOutPtr =&gt; fieldOutPtr % next
      end do
 
-     ! Initiate mpi_isend calls, and handle local copies
-     fieldInPtr =&gt; fieldIn
-     do while (associated(fieldInPtr))
-       sendListPtr =&gt; fieldInPtr % sendList(1) % next
-       do while (associated(sendListPtr))
+     ! Allocate buffers for recieves, and initiate mpi_irecv calls.
+     commListPtr =&gt; recvList
+     do while(associated(commListPtr))
+       allocate(commListPtr % ibuffer(commListPtr % nList))
+       call MPI_Irecv(commListPtr % ibuffer, commListPtr % nList, MPI_INTEGERKIND, commListPtr % procID, commListPtr % procID, dminfo % comm, commListPtr % reqID, mpi_ierr)
+       commListPtr =&gt; commListPtr
+     end do
 
-         if (sendListPtr % procID == dminfo % my_proc_id) then ! Local Copy
-           fieldOutPtr =&gt; fieldOut
-           do while (associated(fieldOutPtr))
-             if(fieldOutPtr % block % blockID == sendListPtr % blockID) then
-               copyListPtr =&gt; fieldOutPtr % copyList(1) % next
-               do while(associated(copyListPtr))
-                 if(copyListPtr % blockID == fieldInPtr % block % blockID) then
-                   do i = 1, copyListPtr % nList
-                     fieldOutPtr % array(:,copyListPtr % list(i)) = fieldInPtr % array(:,sendListPtr % list(i))
-                   end do
-                 end if
-                 copyListPtr =&gt; copyListPtr % next
-               end do
+     ! Setup send lists, and determine the size of their buffers.
+     do iHalo = 1, nHaloLayers
+       fieldInPtr =&gt; fieldIn
+       do while(associated(fieldInPtr))
+         exchListPtr =&gt; fieldInPtr % sendList(haloLayers(iHalo))
+         do while(associated(exchListPtr))
+           comm_list_found = .false.
+  
+           ! Search for an already created commList to this processor.
+           commListPtr =&gt; sendList
+           do while(associated(commListPtr))
+             if(commListPtr % procID == exchListPtr % endPointID) then
+               commListPtr % nList = commListPtr % nList + exchListPtr % nList * fieldInPtr % dimSizes(1)
+               comm_list_found = .true.
+               exit
              end if
-             fieldOutPtr =&gt; fieldOutPtr % next
+  
+             commListPtr =&gt; commListPtr % next
            end do
-         else ! mpi_isend
-           nBuffer = sendLisTPtr % nList * fieldInPtr % dimSizes(1)
-           allocate(sendListPtr % ibuffer(nBuffer))
-           call mpas_pack_send_buf2d_integer(1, fieldInPtr % dimSizes(1), fieldInPtr % dimSizes(2), fieldInPtr % array, sendListPtr, 1, nBuffer, &amp;
-                                             sendListPtr % ibuffer, nPacked, lastPackedIdx)
-
-           call MPI_Isend(sendListPtr % ibuffer, nBuffer, MPI_INTEGERKIND, &amp;
-                          sendListPtr % procID, dminfo % my_proc_id, dminfo % comm, sendListPtr % reqID, mpi_ierr)
-         end if
-         sendListPtr =&gt; sendListPtr % next
+  
+           ! If no comm list exists, create a new one.
+           if(.not. comm_list_found) then
+             commListPtr =&gt; sendList
+             commListPtr2 =&gt; commListPtr % next
+             do while(associated(commListPtr2))
+               commListPtr =&gt; commListPtr % next
+               commListPtr2 =&gt; commListPtr % next
+             end do
+  
+             allocate(commListPtr % next)
+             commListPtr =&gt; commListPtr % next
+             commListPtr % procID = exchListPtr % endPointID
+             commListPtr % nList = exchListPtr % nList * fieldInPtr % dimSizes(1)
+           end if
+  
+           exchListPtr =&gt; exchListPtr % next
+         end do
+  
+         fieldInPtr =&gt; fieldInPtr % next
        end do
-       fieldInPtr =&gt; fieldInPtr % next
      end do
 
-     ! Recieve all mpi_irecv commands, and unpack data into array
-     ! Deallocate recieve buffers
-     fieldOutPtr =&gt; fieldOut
-     do while (associated(fieldOutPtr))
-       recvListPtr =&gt; fieldOutPtr % recvList(1) % next
-       do while (associated(recvListPtr))
-         call MPI_Wait(recvListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
+     ! Allocate sendLists, copy data into buffer, and initiate mpi_isends
+     commListPtr =&gt; sendList
+     do while(associated(commListPtr))
+       allocate(commListPtr % ibuffer(commListPtr % nList))
+       bufferOffset = 0
+       do iHalo = 1, nHaloLayers
+         nAdded = 0
+         fieldInPtr =&gt; fieldIn
+         do while(associated(fieldInPtr))
+           exchListPtr =&gt; fieldInPtr % sendList(haloLayers(iHalo))
+           do while(associated(exchListPtr))
+             if(exchListPtr % endPointID == commListPtr % procID) then
+               do i = 1, exchListPtr % nList
+                 do j = 1, fieldInPtr % dimSizes(1)
+                   commListPtr % ibuffer((exchListPtr % destList(i)-1) * fieldInPtr % dimSizes(1) + j  + bufferOffset) = fieldInPtr % array(j, exchListPtr % srcList(i))
+                   nAdded = nAdded + 1
+                 end do
+               end do
+             end if
+  
+             exchListPtr =&gt; exchListPtr % next
+           end do
+  
+           fieldInPtr =&gt; fieldInPtr % next
+         end do
+         bufferOffset = bufferOffset + nAdded
+       end do
 
-         nBuffer = recvListPtr % nList * fieldOutPtr % dimSizes(1)
+       call MPI_Isend(commListPtr % ibuffer, commListPtr % nlist, MPI_INTEGERKIND, &amp;
+                      commListPtr % procID, dminfo % my_proc_id, dminfo % comm, commListPtr % reqID, mpi_ierr)
 
-         call mpas_unpack_recv_buf2d_integer(1, fieldOutPtr % dimSizes(1), fieldOutPtr % dimSizes(2), fieldOutPtr % array, recvListPtr, 1, nBuffer, &amp;
-                                             recvListPtr % ibuffer, nUnpacked, lastUnpackedIdx)
-         deallocate(recvListPtr % ibuffer)
-         recvListPtr =&gt; recvListPtr % next
-       end do
-       fieldOutPtr =&gt; fieldOutPtr % next
+       commListPtr =&gt; commListPtr % next
      end do
+#endif     
 
-     ! Dellocate send buffers
-     fieldInPtr =&gt; fieldIn
-     do while (associated(fieldInPtr))
-       sendListPtr =&gt; fieldInPtr % sendList(1) % next
-       do while (associated(sendListPtr))
-          if (sendListPtr % procID /= dminfo % my_proc_id) then
-             call MPI_Wait(sendListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
-             deallocate(sendListPtr % ibuffer)
-          end if
-          sendListPtr =&gt; sendListPtr % next
+     ! Handle Local Copies. Only local copies if no MPI
+     do iHalo = 1, nHaloLayers
+       fieldInPtr =&gt; fieldIn
+       do while(associated(fieldInPtr))
+         exchListPtr =&gt; fieldInPtr % copyList(haloLayers(iHalo))
+         do while(associated(exchListPtr))
+           fieldOutPtr =&gt; fieldOut
+           do while(associated(fieldOutPtr))
+             if(exchListPtr % endPointID == fieldOutPtr % block % localBlockID) then
+               do i = 1, exchListPtr % nList
+                 fieldOutPtr % array(:, exchListPtr % destList(i)) = fieldInPtr % array(:, exchListPtr % srcList(i))
+               end do
+             end if
+             fieldOutPtr =&gt; fieldOutPtr % next
+           end do
+  
+           exchListPtr =&gt; exchListPtr % next
+         end do
        end do
-       fieldInPtr =&gt; fieldInPtr % next
      end do
 
-#else
-     ! Only local copies if no mpi
-     fieldOutPtr =&gt; fieldOut
-     do while (associated(fieldOutPtr))
-       copyListPtr =&gt; fieldOutPtr % copyList(1) % next
-       do while (associated(copyListPtr))
-         fieldInPtr =&gt; fieldIn
-         do while (associated(fieldInPtr))
-           if(copyListPtr % blockID == fieldInPtr % block % blockID) then
-             sendListPtr =&gt; fieldInPtr % sendList(1) % next
-             do while (associated(sendListPtr))
-               if(sendListPtr % blockID == fieldOutPtr % block % blockID) then
-                 do i = 1, copyListPtr % nList
-                   fieldOutPtr % array(:, copyListPtr % list(i)) = fieldInPtr % array(:, sendListPtr % list(i))
+#ifdef _MPI
+     ! Wait for MPI_Irecv's to finish, and unpack data.
+     commListPtr =&gt; recvList
+     do while(associated(commListPtr))
+       call MPI_Wait(commListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
+
+       bufferOffset = 0
+       do iHalo = 1, nHaloLayers
+         nAdded = 0
+         fieldOutPtr =&gt; fieldOut
+         do while(associated(fieldOutPtr))
+           exchListPtr =&gt; fieldOutPtr % recvList(haloLayers(iHalo))
+           do while(associated(exchListPtr))
+             if(exchListPtr % endPointID == commListPtr % procID) then
+               do i = 1, exchListPtr % nList
+                 do j = 1, fieldOutPtr % dimSizes(1)
+                   fieldOutPtr % array(j, exchListPtr % destList(i)) = commListPtr % ibuffer((exchListPtr % srcList(i)-1) * fieldOutPtr % dimSizes(1) + j + bufferOffset)
+                   nAdded = nAdded + 1
                  end do
-               end if
-               sendListPtr =&gt; sendListPtr % next
-             end do
-           end if
-           fieldInPtr =&gt; fieldInPtr % next
+               end do
+             end if
+             exchListPtr =&gt; exchListPtr % next
+           end do
+  
+           fieldOutPtr =&gt; fieldOutPtr % next
          end do
-         copyListPtr =&gt; copyListPtr % next
+         bufferOffset = bufferOffset + nAdded
        end do
-       fieldOutPtr =&gt; fieldOutPtr % next
+
+       commListPtr =&gt; commListPtr % next
      end do
+
+     ! Wait for MPI_Isend's to finish.
+     commListPtr =&gt; sendList
+     do while(associated(commListPtr))
+       call MPI_Wait(commListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
+       commListPtr =&gt; commListPtr % next
+     end do
+
+     ! Destroy commLists.
+     call mpas_dmpar_destroy_communication_list(sendList)
+     call mpas_dmpar_destroy_communication_list(recvList)
 #endif
 
    end subroutine mpas_dmpar_alltoall_field2d_integer!}}}
 
-   subroutine mpas_dmpar_alltoall_field3d_integer(dminfo, fieldIn, fieldout)!{{{
+   subroutine mpas_dmpar_alltoall_field3d_integer(fieldIn, fieldout, haloLayersIn)!{{{
 
      implicit none
 
-     type (dm_info), intent(in) :: dminfo
      type (field3dInteger), pointer :: fieldIn
      type (field3dInteger), pointer :: fieldOut
+     integer, dimension(:), pointer, optional :: haloLayersIn
 
      type (field3dInteger), pointer :: fieldInPtr, fieldOutPtr
-     type (exchange_list), pointer :: sendListPtr, recvListPtr, copyListPtr
+     type (mpas_exchange_list), pointer :: exchListPtr, exchListPtr2
+     type (mpas_communication_list), pointer :: sendList, recvList, commListPtr, commListPtr2
+     type (dm_info), pointer :: dminfo
 
-     integer :: nBuffer
+     logical :: comm_list_found
+
      integer :: lastPackedIdx, lastUnpackedIdx, nPacked, nUnpacked
+     integer :: nAdded, bufferOffset
      integer :: mpi_ierr
-     integer :: i
+     integer :: iHalo, i, j, k
+     integer :: nHaloLayers
+     integer, dimension(:), pointer :: haloLayers
+     
+     dminfo =&gt; fieldIn % block % domain % dminfo
 
+     if(present(haloLayersIn)) then
+       nHaloLayers = size(haloLayersIn)
+       allocate(haloLayers(nHaloLayers))
+       do iHalo = 1, nHaloLayers
+         haloLayers(iHalo) = haloLayersIn(i)
+       end do
+     else
+       nHaloLayers = size(fieldIn % sendList)
+       allocate(haloLayers(nHaloLayers))
+       do iHalo = 1, nHaloLayers
+         haloLayers(iHalo) = i
+       end do
+     end if
+
 #ifdef _MPI
+     allocate(sendList)
+     nullify(sendList % next)
 
-     ! Initiate mpi_irecv calls
-     fieldOutPtr =&gt; fieldOut
-     do while (associated(fieldOutPtr))
-       recvListPtr =&gt; fieldOutPtr % recvList(1) % next
+     allocate(recvList)
+     nullify(recvList % next)
 
-       do while(associated(recvListPtr))
-         nBuffer = recvListPtr % nList * fieldOutPtr % dimSizes(1) * fieldOutPtr % dimSizes(2)
-         allocate(recvListPtr % ibuffer(nBuffer))
-         call MPI_Irecv(recvListPtr % ibuffer, nBuffer, MPI_INTEGERKIND, &amp;
-                        recvListPtr % procID, recvListPtr % procID, dminfo % comm, recvListPtr % reqID, mpi_ierr)
+     ! Setup recieve lists, and determine the size of their buffers.
+     do iHalo = 1, nHaloLayers
+       fieldOutPtr =&gt; fieldOut
+       do while(associated(fieldOutPtr))
+         exchListPtr =&gt; fieldOutPtr % recvList(haloLayers(iHalo))
+         do while(associated(exchListPtr))
+           comm_list_found = .false.
+  
+           ! Search for an already created commList to this processor.
+           commListPtr =&gt; recvList
+           do while(associated(commListPtr))
+             if(commListPtr % procID == exchListPtr % endPointID) then
+               commListPtr % nList = commListPtr % nList + exchListPtr % nList  * fieldOutPtr % dimSizes(1) * fieldOutPtr % dimSizes(2)
+               comm_list_found = .true.
+               exit
+             end if
+  
+             commListPtr =&gt; commListPtr % next
+           end do
+  
+           ! If no comm list exists, create a new one.
+           if(.not. comm_list_found) then
+             commListPtr =&gt; recvList
+             commListPtr2 =&gt; commListPtr % next
+             do while(associated(commListPtr2))
+               commListPtr =&gt; commListPtr % next
+               commListPtr2 =&gt; commListPtr % next
+             end do
+  
+             allocate(commListPtr % next)
+             commListPtr =&gt; commListPtr % next
+             commListPtr % procID = exchListPtr % endPointID
+             commListPtr % nList = exchListPtr % nList * fieldOutPtr % dimSizes(1) * fieldOutPtr % dimSizes(2)
+           end if
+  
+           exchListPtr =&gt; exchListPtr % next
+         end do
+  
+         fieldOutPtr =&gt; fieldOutPtr % next
+       end do
+     end do
 
-         recvListPtr =&gt; recvListPtr % next
+     ! Allocate buffers for recieves, and initiate mpi_irecv calls.
+     commListPtr =&gt; recvList
+     do while(associated(commListPtr))
+       allocate(commListPtr % ibuffer(commListPtr % nList))
+       call MPI_Irecv(commListPtr % ibuffer, commListPtr % nList, MPI_INTEGERKIND, commListPtr % procID, commListPtr % procID, dminfo % comm, commListPtr % reqID, mpi_ierr)
+       commListPtr =&gt; commListPtr
+     end do
+
+     ! Setup send lists, and determine the size of their buffers.
+     do iHalo = 1, nHaloLayers
+       fieldInPtr =&gt; fieldIn
+       do while(associated(fieldInPtr))
+         exchListPtr =&gt; fieldInPtr % sendList(haloLayers(iHalo))
+         do while(associated(exchListPtr))
+           comm_list_found = .false.
+  
+           ! Search for an already created commList to this processor.
+           commListPtr =&gt; sendList
+           do while(associated(commListPtr))
+             if(commListPtr % procID == exchListPtr % endPointID) then
+               commListPtr % nList = commListPtr % nList + exchListPtr % nList * fieldInPtr % dimSizes(1) * fieldInPtr % dimSizes(2)
+               comm_list_found = .true.
+               exit
+             end if
+  
+             commListPtr =&gt; commListPtr % next
+           end do
+  
+           ! If no comm list exists, create a new one.
+           if(.not. comm_list_found) then
+             commListPtr =&gt; sendList
+             commListPtr2 =&gt; commListPtr % next
+             do while(associated(commListPtr2))
+               commListPtr =&gt; commListPtr % next
+               commListPtr2 =&gt; commListPtr % next
+             end do
+  
+             allocate(commListPtr % next)
+             commListPtr =&gt; commListPtr % next
+             commListPtr % procID = exchListPtr % endPointID
+             commListPtr % nList = exchListPtr % nList * fieldInPtr % dimSizes(1) * fieldInPtr % dimSizes(2)
+           end if
+  
+           exchListPtr =&gt; exchListPtr % next
+         end do
+  
+         fieldInPtr =&gt; fieldInPtr % next
        end do
-       fieldOutPtr =&gt; fieldOutPtr % next
      end do
 
-     ! Initiate mpi_isend calls, and handle local copies
-     fieldInPtr =&gt; fieldIn
-     do while (associated(fieldInPtr))
-       sendListPtr =&gt; fieldInPtr % sendList(1) % next
-       do while (associated(sendListPtr))
-
-         if (sendListPtr % procID == dminfo % my_proc_id) then ! Local Copy
-           fieldOutPtr =&gt; fieldOut
-           do while (associated(fieldOutPtr))
-             if(fieldOutPtr % block % blockID == sendListPtr % blockID) then
-               copyListPtr =&gt; fieldOutPtr % copyList(1) % next
-               do while(associated(copyListPtr))
-                 if(copyListPtr % blockID == fieldInPtr % block % blockID) then
-                   do i = 1, copyListPtr % nList
-                     fieldOutPtr % array(:,:,copyListPtr % list(i)) = fieldInPtr % array(:,:,sendListPtr % list(i))
+     ! Allocate sendLists, copy data into buffer, and initiate mpi_isends
+     commListPtr =&gt; sendList
+     do while(associated(commListPtr))
+       allocate(commListPtr % ibuffer(commListPtr % nList))
+       bufferOffset = 0
+       do iHalo = 1, nHaloLayers
+         nAdded = 0
+         fieldInPtr =&gt; fieldIn
+         do while(associated(fieldInPtr))
+           exchListPtr =&gt; fieldInPtr % sendList(haloLayers(iHalo))
+           do while(associated(exchListPtr))
+             if(exchListPtr % endPointID == commListPtr % procID) then
+               do i = 1, exchListPtr % nList
+                 do j = 1, fieldInPtr % dimSizes(1)
+                   do k = 1, fieldInPtr % dimSizes(2)
+                     commListPtr % ibuffer((exchListPtr % destList(i)-1) * fieldInPtr % dimSizes(1) * fieldInPtr % dimSizes(2) + (j-1) * fieldInPtr % dimSizes(1) + k &amp;
+                                           + bufferOffset) = fieldInPtr % array(k, j, exchListPtr % srcList(i))
+                     nAdded = nAdded + 1
                    end do
-                 end if
-                 copyListPtr =&gt; copyListPtr % next
+                 end do
                end do
              end if
-             fieldOutPtr =&gt; fieldOutPtr % next
+  
+             exchListPtr =&gt; exchListPtr % next
            end do
-         else ! mpi_isend
-           nBuffer = sendLisTPtr % nList * fieldInPtr % dimSizes(1) * fieldInPtr % dimSizes(2)
-           allocate(sendListPtr % ibuffer(nBuffer))
-           call mpas_pack_send_buf3d_integer(1, fieldInPtr % dimSizes(1), 1, fieldInPtr % dimSizes(2), fieldInPtr % dimSizes(3), &amp;
-                                             fieldInPtr % array, sendListPtr, 1, nBuffer, &amp;
-                                             sendListPtr % ibuffer, nPacked, lastPackedIdx)
-
-           call MPI_Isend(sendListPtr % ibuffer, nBuffer, MPI_INTEGERKIND, &amp;
-                          sendListPtr % procID, dminfo % my_proc_id, dminfo % comm, sendListPtr % reqID, mpi_ierr)
-         end if
-         sendListPtr =&gt; sendListPtr % next
+  
+           fieldInPtr =&gt; fieldInPtr % next
+         end do
+         bufferOffset = bufferOffset + nAdded
        end do
-       fieldInPtr =&gt; fieldInPtr % next
-     end do
 
-     ! Recieve all mpi_irecv commands, and unpack data into array
-     ! Deallocate recieve buffers
-     fieldOutPtr =&gt; fieldOut
-     do while (associated(fieldOutPtr))
-       recvListPtr =&gt; fieldOutPtr % recvList(1) % next
-       do while (associated(recvListPtr))
-         call MPI_Wait(recvListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
+       call MPI_Isend(commListPtr % ibuffer, commListPtr % nlist, MPI_INTEGERKIND, &amp;
+                      commListPtr % procID, dminfo % my_proc_id, dminfo % comm, commListPtr % reqID, mpi_ierr)
 
-         nBuffer = recvListPtr % nList * fieldOutPtr % dimSizes(1) * fieldOutPtr % dimSizes(2)
-
-         call mpas_unpack_recv_buf3d_integer(1, fieldOutPtr % dimSizes(1), 1, fieldOutPtr % dimSizes(2), fieldOutPtr % dimSizes(3), &amp;
-                                             fieldOutPtr % array, recvListPtr, 1, nBuffer, &amp;
-                                             recvListPtr % ibuffer, nUnpacked, lastUnpackedIdx)
-         deallocate(recvListPtr % ibuffer)
-         recvListPtr =&gt; recvListPtr % next
-       end do
-       fieldOutPtr =&gt; fieldOutPtr % next
+       commListPtr =&gt; commListPtr % next
      end do
+#endif     
 
-     ! Dellocate send buffers
-     fieldInPtr =&gt; fieldIn
-     do while (associated(fieldInPtr))
-       sendListPtr =&gt; fieldInPtr % sendList(1) % next
-       do while (associated(sendListPtr))
-          if (sendListPtr % procID /= dminfo % my_proc_id) then
-             call MPI_Wait(sendListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
-             deallocate(sendListPtr % ibuffer)
-          end if
-          sendListPtr =&gt; sendListPtr % next
+     ! Handle Local Copies. Only local copies if no MPI
+     do iHalo = 1, nHaloLayers
+       fieldInPtr =&gt; fieldIn
+       do while(associated(fieldInPtr))
+         exchListPtr =&gt; fieldInPtr % copyList(haloLayers(iHalo))
+         do while(associated(exchListPtr))
+           fieldOutPtr =&gt; fieldOut
+           do while(associated(fieldOutPtr))
+             if(exchListPtr % endPointID == fieldOutPtr % block % localBlockID) then
+               do i = 1, exchListPtr % nList
+                 fieldOutPtr % array(:, :, exchListPtr % destList(i)) = fieldInPtr % array(:, :, exchListPtr % srcList(i))
+               end do
+             end if
+             fieldOutPtr =&gt; fieldOutPtr % next
+           end do
+  
+           exchListPtr =&gt; exchListPtr % next
+         end do
        end do
-       fieldInPtr =&gt; fieldInPtr % next
      end do
 
-#else
-     ! Only local copies if no mpi
-     fieldOutPtr =&gt; fieldOut
-     do while (associated(fieldOutPtr))
-       copyListPtr =&gt; fieldOutPtr % copyList(1) % next
-       do while (associated(copyListPtr))
-         fieldInPtr =&gt; fieldIn
-         do while (associated(fieldInPtr))
-           if(copyListPtr % blockID == fieldInPtr % block % blockID) then
-             sendListPtr =&gt; fieldInPtr % sendList(1) % next
-             do while (associated(sendListPtr))
-               if(sendListPtr % blockID == fieldOutPtr % block % blockID) then
-                 do i = 1, copyListPtr % nList
-                   fieldOutPtr % array(:, :, copyListPtr % list(i)) = fieldInPtr % array(:, :, sendListPtr % list(i))
+#ifdef _MPI
+     ! Wait for MPI_Irecv's to finish, and unpack data.
+     commListPtr =&gt; recvList
+     do while(associated(commListPtr))
+       call MPI_Wait(commListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
+
+       bufferOffset = 0
+       do iHalo = 1, nHaloLayers
+         nAdded = 0
+         fieldOutPtr =&gt; fieldOut
+         do while(associated(fieldOutPtr))
+           exchListPtr =&gt; fieldOutPtr % recvList(haloLayers(iHalo))
+           do while(associated(exchListPtr))
+             if(exchListPtr % endPointID == commListPtr % procID) then
+               do i = 1, exchListPtr % nList
+                 do j = 1, fieldOutPtr % dimSizes(1)
+                   do k = 1, fieldOutPtr % dimSizes(2)
+                     fieldOutPtr % array(k, j, exchListPtr % destList(i)) = commListPtr % ibuffer((exchListPtr % srcList(i)-1) * fieldOutPtr % dimSizes(1) * fieldOutPtr % dimSizes(2) &amp;
+                                                                          + (j-1) * fieldOutPtr % dimSizes(1) + k + bufferOffset)
+                     nAdded = nAdded + 1
+                   end do
                  end do
-               end if
-               sendListPtr =&gt; sendListPtr % next
-             end do
-           end if
-           fieldInPtr =&gt; fieldInPtr % next
+               end do
+             end if
+             exchListPtr =&gt; exchListPtr % next
+           end do
+  
+           fieldOutPtr =&gt; fieldOutPtr % next
          end do
-         copyListPtr =&gt; copyListPtr % next
+         bufferOffset = bufferOffset + nAdded
        end do
-       fieldOutPtr =&gt; fieldOutPtr % next
+
+       commListPtr =&gt; commListPtr % next
      end do
+
+     ! Wait for MPI_Isend's to finish.
+     commListPtr =&gt; sendList
+     do while(associated(commListPtr))
+       call MPI_Wait(commListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
+       commListPtr =&gt; commListPtr % next
+     end do
+
+     ! Destroy commLists.
+     call mpas_dmpar_destroy_communication_list(sendList)
+     call mpas_dmpar_destroy_communication_list(recvList)
 #endif
 
    end subroutine mpas_dmpar_alltoall_field3d_integer!}}}
 
-   subroutine mpas_dmpar_alltoall_field1d_real(dminfo, fieldIn, fieldout)!{{{
+   subroutine mpas_dmpar_alltoall_field1d_real(fieldIn, fieldout, haloLayersIn)!{{{
 
      implicit none
 
-     type (dm_info), intent(in) :: dminfo
      type (field1dReal), pointer :: fieldIn
      type (field1dReal), pointer :: fieldOut
+     integer, dimension(:), pointer, optional :: haloLayersIn
 
      type (field1dReal), pointer :: fieldInPtr, fieldOutPtr
-     type (exchange_list), pointer :: sendListPtr, recvListPtr, copyListPtr
+     type (mpas_exchange_list), pointer :: exchListPtr, exchListPtr2
+     type (mpas_communication_list), pointer :: sendList, recvList, commListPtr, commListPtr2
+     type (dm_info), pointer :: dminfo
 
+     logical :: comm_list_found
+
      integer :: lastPackedIdx, lastUnpackedIdx, nPacked, nUnpacked
+     integer :: nAdded, bufferOffset
      integer :: mpi_ierr
-     integer :: i
+     integer :: iHalo, i
+     integer :: nHaloLayers
+     integer, dimension(:), pointer :: haloLayers
+     
+     dminfo =&gt; fieldIn % block % domain % dminfo
 
+     if(present(haloLayersIn)) then
+       nHaloLayers = size(haloLayersIn)
+       allocate(haloLayers(nHaloLayers))
+       do iHalo = 1, nHaloLayers
+         haloLayers(iHalo) = haloLayersIn(i)
+       end do
+     else
+       nHaloLayers = size(fieldIn % sendList)
+       allocate(haloLayers(nHaloLayers))
+       do iHalo = 1, nHaloLayers
+         haloLayers(iHalo) = i
+       end do
+     end if
+
 #ifdef _MPI
+     allocate(sendList)
+     nullify(sendList % next)
 
-     ! Initiate mpi_irecv calls
-     fieldOutPtr =&gt; fieldOut
-     do while (associated(fieldOutPtr))
-       recvListPtr =&gt; fieldOutPtr % recvList(1) % next
+     allocate(recvList)
+     nullify(recvList % next)
 
-       do while(associated(recvListPtr))
-         allocate(recvListPtr % rbuffer(recvListPtr % nlist))
-         call MPI_Irecv(recvListPtr % rbuffer, recvListPtr % nlist, MPI_realKIND, &amp;
-                        recvListPtr % procID, recvListPtr % procID, dminfo % comm, recvListPtr % reqID, mpi_ierr)
+     ! Setup recieve lists, and determine the size of their buffers.
+     do iHalo = 1, nHaloLayers
+       fieldOutPtr =&gt; fieldOut
+       do while(associated(fieldOutPtr))
+         exchListPtr =&gt; fieldOutPtr % recvList(haloLayers(iHalo))
+         do while(associated(exchListPtr))
+           comm_list_found = .false.
+  
+           ! Search for an already created commList to this processor.
+           commListPtr =&gt; recvList
+           do while(associated(commListPtr))
+             if(commListPtr % procID == exchListPtr % endPointID) then
+               commListPtr % nList = commListPtr % nList + exchListPtr % nList 
+               comm_list_found = .true.
+               exit
+             end if
+  
+             commListPtr =&gt; commListPtr % next
+           end do
+  
+           ! If no comm list exists, create a new one.
+           if(.not. comm_list_found) then
+             commListPtr =&gt; recvList
+             commListPtr2 =&gt; commListPtr % next
+             do while(associated(commListPtr2))
+               commListPtr =&gt; commListPtr % next
+               commListPtr2 =&gt; commListPtr % next
+             end do
+  
+             allocate(commListPtr % next)
+             commListPtr =&gt; commListPtr % next
+             commListPtr % procID = exchListPtr % endPointID
+             commListPtr % nList = exchListPtr % nList
+           end if
+  
+           exchListPtr =&gt; exchListPtr % next
+         end do
+  
+         fieldOutPtr =&gt; fieldOutPtr % next
+       end do
+     end do
 
-         recvListPtr =&gt; recvListPtr % next
+     ! Allocate buffers for recieves, and initiate mpi_irecv calls.
+     commListPtr =&gt; recvList
+     do while(associated(commListPtr))
+       allocate(commListPtr % rbuffer(commListPtr % nList))
+       call MPI_Irecv(commListPtr % rbuffer, commListPtr % nList, MPI_REALKIND, commListPtr % procID, commListPtr % procID, dminfo % comm, commListPtr % reqID, mpi_ierr)
+       commListPtr =&gt; commListPtr
+     end do
+
+     ! Setup send lists, and determine the size of their buffers.
+     do iHalo = 1, nHaloLayers
+       fieldInPtr =&gt; fieldIn
+       do while(associated(fieldInPtr))
+         exchListPtr =&gt; fieldInPtr % sendList(haloLayers(iHalo))
+         do while(associated(exchListPtr))
+           comm_list_found = .false.
+  
+           ! Search for an already created commList to this processor.
+           commListPtr =&gt; sendList
+           do while(associated(commListPtr))
+             if(commListPtr % procID == exchListPtr % endPointID) then
+               commListPtr % nList = commListPtr % nList + exchListPtr % nList 
+               comm_list_found = .true.
+               exit
+             end if
+  
+             commListPtr =&gt; commListPtr % next
+           end do
+  
+           ! If no comm list exists, create a new one.
+           if(.not. comm_list_found) then
+             commListPtr =&gt; sendList
+             commListPtr2 =&gt; commListPtr % next
+             do while(associated(commListPtr2))
+               commListPtr =&gt; commListPtr % next
+               commListPtr2 =&gt; commListPtr % next
+             end do
+  
+             allocate(commListPtr % next)
+             commListPtr =&gt; commListPtr % next
+             commListPtr % procID = exchListPtr % endPointID
+             commListPtr % nList = exchListPtr % nList
+           end if
+  
+           exchListPtr =&gt; exchListPtr % next
+         end do
+  
+         fieldInPtr =&gt; fieldInPtr % next
        end do
-       fieldOutPtr =&gt; fieldOutPtr % next
      end do
 
-     ! Initiate mpi_isend calls, and handle local copies
-     fieldInPtr =&gt; fieldIn
-     do while (associated(fieldInPtr))
-       sendListPtr =&gt; fieldInPtr % sendList(1) % next
-       do while (associated(sendListPtr))
+     ! Allocate sendLists, copy data into buffer, and initiate mpi_isends
+     commListPtr =&gt; sendList
+     do while(associated(commListPtr))
+       allocate(commListPtr % rbuffer(commListPtr % nList))
+       bufferOffset = 0
+       do iHalo = 1, nHaloLayers
+         nAdded = 0
+         fieldInPtr =&gt; fieldIn
+         do while(associated(fieldInPtr))
+           exchListPtr =&gt; fieldInPtr % sendList(haloLayers(iHalo))
+           do while(associated(exchListPtr))
+             if(exchListPtr % endPointID == commListPtr % procID) then
+               do i = 1, exchListPtr % nList
+                 commListPtr % rbuffer(exchListPtr % destList(i) + bufferOffset) = fieldInPtr % array(exchListPtr % srcList(i))
+                 nAdded = nAdded + 1
+               end do
+             end if
+  
+             exchListPtr =&gt; exchListPtr % next
+           end do
+  
+           fieldInPtr =&gt; fieldInPtr % next
+         end do
+         bufferOffset = bufferOffset + nAdded
+       end do
 
-         if (sendListPtr % procID == dminfo % my_proc_id) then ! Local Copy
+       call MPI_Isend(commListPtr % rbuffer, commListPtr % nlist, MPI_REALKIND, &amp;
+                      commListPtr % procID, dminfo % my_proc_id, dminfo % comm, commListPtr % reqID, mpi_ierr)
+
+       commListPtr =&gt; commListPtr % next
+     end do
+#endif     
+
+     ! Handle Local Copies. Only local copies if no MPI
+     do iHalo = 1, nHaloLayers
+       fieldInPtr =&gt; fieldIn
+       do while(associated(fieldInPtr))
+         exchListPtr =&gt; fieldInPtr % copyList(haloLayers(iHalo))
+         do while(associated(exchListPtr))
            fieldOutPtr =&gt; fieldOut
-           do while (associated(fieldOutPtr))
-             if(fieldOutPtr % block % blockID == sendListPtr % blockID) then
-               copyListPtr =&gt; fieldOutPtr % copyList(1) % next
-               do while(associated(copyListPtr))
-                 if(copyListPtr % blockID == fieldInPtr % block % blockID) then
-                   do i = 1, copyListPtr % nList
-                     fieldOutPtr % array(copyListPtr % list(i)) = fieldInPtr % array(sendListPtr % list(i))
-                   end do
-                 end if
-                 copyListPtr =&gt; copyListPtr % next
+           do while(associated(fieldOutPtr))
+             if(exchListPtr % endPointID == fieldOutPtr % block % localBlockID) then
+               do i = 1, exchListPtr % nList
+                 fieldOutPtr % array(exchListPtr % destList(i)) = fieldInPtr % array(exchListPtr % srcList(i))
                end do
              end if
              fieldOutPtr =&gt; fieldOutPtr % next
            end do
-         else ! mpi_isend
-           allocate(sendListPtr % rbuffer(sendListPtr % nlist))
-           call mpas_pack_send_buf1d_real(fieldInPtr % dimSizes(1), fieldInPtr % array, sendListPtr, 1, sendListPtr % nlist, &amp;
-                                             sendListPtr % rbuffer, nPacked, lastPackedIdx)
-           call MPI_Isend(sendListPtr % rbuffer, sendListPtr % nlist, MPI_realKIND, &amp;
-                          sendListPtr % procID, dminfo % my_proc_id, dminfo % comm, sendListPtr % reqID, mpi_ierr)
-         end if
-         sendListPtr =&gt; sendListPtr % next
+  
+           exchListPtr =&gt; exchListPtr % next
+         end do
        end do
-       fieldInPtr =&gt; fieldInPtr % next
      end do
 
-     ! Recieve all mpi_irecv commands, and unpack data into array
-     ! Deallocate recieve buffers
-     fieldOutPtr =&gt; fieldOut
-     do while (associated(fieldOutPtr))
-       recvListPtr =&gt; fieldOutPtr % recvList(1) % next
-       do while (associated(recvListPtr))
-         call MPI_Wait(recvListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
-         call mpas_unpack_recv_buf1d_real(fieldOutPtr % dimSizes(1), fieldOutPtr % array, recvListPtr, 1, recvListPtr % nlist, &amp;
-                                             recvListPtr % rbuffer, nUnpacked, lastUnpackedIdx)
-         deallocate(recvListPtr % rbuffer)
-         recvListPtr =&gt; recvListPtr % next
+#ifdef _MPI
+     ! Wait for MPI_Irecv's to finish, and unpack data.
+     commListPtr =&gt; recvList
+     do while(associated(commListPtr))
+       call MPI_Wait(commListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
+
+       bufferOffset = 0
+       do iHalo = 1, nHaloLayers
+         nAdded = 0
+         fieldOutPtr =&gt; fieldOut
+         do while(associated(fieldOutPtr))
+           exchListPtr =&gt; fieldOutPtr % recvList(haloLayers(iHalo))
+           do while(associated(exchListPtr))
+             if(exchListPtr % endPointID == commListPtr % procID) then
+               do i = 1, exchListPtr % nList
+                 fieldOutPtr % array(exchListPtr % destList(i)) = commListPtr % rbuffer(exchListPtr % srcList(i) + bufferOffset)
+                 nAdded = nAdded + 1
+               end do
+             end if
+             exchListPtr =&gt; exchListPtr % next
+           end do
+  
+           fieldOutPtr =&gt; fieldOutPtr % next
+         end do
+         bufferOffset = bufferOffset + nAdded
        end do
-       fieldOutPtr =&gt; fieldOutPtr % next
+
+       commListPtr =&gt; commListPtr % next
      end do
 
-     ! Dellocate send buffers
-     fieldInPtr =&gt; fieldIn
-     do while (associated(fieldInPtr))
-       sendListPtr =&gt; fieldInPtr % sendList(1) % next
-       do while (associated(sendListPtr))
-          if (sendListPtr % procID /= dminfo % my_proc_id) then
-             call MPI_Wait(sendListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
-             deallocate(sendListPtr % rbuffer)
-          end if
-          sendListPtr =&gt; sendListPtr % next
-       end do
-       fieldInPtr =&gt; fieldInPtr % next
+     ! Wait for MPI_Isend's to finish.
+     commListPtr =&gt; sendList
+     do while(associated(commListPtr))
+       call MPI_Wait(commListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
+       commListPtr =&gt; commListPtr % next
      end do
 
-#else
-     ! Only local copies if no mpi
-     fieldOutPtr =&gt; fieldOut
-     do while (associated(fieldOutPtr))
-       copyListPtr =&gt; fieldOutPtr % copyList(1) % next
-       do while (associated(copyListPtr))
-         fieldInPtr =&gt; fieldIn
-         do while (associated(fieldInPtr))
-           if(copyListPtr % blockID == fieldInPtr % block % blockID) then
-             sendListPtr =&gt; fieldInPtr % sendList(1) % next
-             do while (associated(sendListPtr))
-               if(sendListPtr % blockID == fieldOutPtr % block % blockID) then
-                 do i = 1, copyListPtr % nList
-                   fieldOutPtr % array(copyListPtr % list(i)) = fieldInPtr % array(sendListPtr % list(i))
-                 end do
-               end if
-               sendListPtr =&gt; sendListPtr % next
-             end do
-           end if
-           fieldInPtr =&gt; fieldInPtr % next
-         end do
-         copyListPtr =&gt; copyListPtr % next
-       end do
-       fieldOutPtr =&gt; fieldOutPtr % next
-     end do
+     ! Destroy commLists.
+     call mpas_dmpar_destroy_communication_list(sendList)
+     call mpas_dmpar_destroy_communication_list(recvList)
 #endif
 
    end subroutine mpas_dmpar_alltoall_field1d_real!}}}
 
-   subroutine mpas_dmpar_alltoall_field2d_real(dminfo, fieldIn, fieldout)!{{{
+   subroutine mpas_dmpar_alltoall_field2d_real(fieldIn, fieldout, haloLayersIn)!{{{
 
      implicit none
 
-     type (dm_info), intent(in) :: dminfo
      type (field2dReal), pointer :: fieldIn
      type (field2dReal), pointer :: fieldOut
+     integer, dimension(:), pointer, optional :: haloLayersIn
 
      type (field2dReal), pointer :: fieldInPtr, fieldOutPtr
-     type (exchange_list), pointer :: sendListPtr, recvListPtr, copyListPtr
+     type (mpas_exchange_list), pointer :: exchListPtr, exchListPtr2
+     type (mpas_communication_list), pointer :: sendList, recvList, commListPtr, commListPtr2
+     type (dm_info), pointer :: dminfo
 
-     integer :: nBuffer
+     logical :: comm_list_found
+
      integer :: lastPackedIdx, lastUnpackedIdx, nPacked, nUnpacked
+     integer :: nAdded, bufferOffset
      integer :: mpi_ierr
-     integer :: i
+     integer :: iHalo, i, j
+     integer :: nHaloLayers
+     integer, dimension(:), pointer :: haloLayers
+     
+     dminfo =&gt; fieldIn % block % domain % dminfo
 
+     if(present(haloLayersIn)) then
+       nHaloLayers = size(haloLayersIn)
+       allocate(haloLayers(nHaloLayers))
+       do iHalo = 1, nHaloLayers
+         haloLayers(iHalo) = haloLayersIn(i)
+       end do
+     else
+       nHaloLayers = size(fieldIn % sendList)
+       allocate(haloLayers(nHaloLayers))
+       do iHalo = 1, nHaloLayers
+         haloLayers(iHalo) = i
+       end do
+     end if
+
 #ifdef _MPI
+     allocate(sendList)
+     nullify(sendList % next)
 
-     ! Initiate mpi_irecv calls
-     fieldOutPtr =&gt; fieldOut
-     do while (associated(fieldOutPtr))
-       recvListPtr =&gt; fieldOutPtr % recvList(1) % next
+     allocate(recvList)
+     nullify(recvList % next)
 
-       do while(associated(recvListPtr))
-         nBuffer = recvListPtr % nList * fieldOutPtr % dimSizes(1)
-         allocate(recvListPtr % rbuffer(nBuffer))
-         call MPI_Irecv(recvListPtr % rbuffer, nBuffer, MPI_realKIND, &amp;
-                        recvListPtr % procID, recvListPtr % procID, dminfo % comm, recvListPtr % reqID, mpi_ierr)
-
-         recvListPtr =&gt; recvListPtr % next
+     ! Setup recieve lists, and determine the size of their buffers.
+     do iHalo = 1, nHaloLayers
+       fieldOutPtr =&gt; fieldOut
+       do while(associated(fieldOutPtr))
+         exchListPtr =&gt; fieldOutPtr % recvList(haloLayers(iHalo))
+         do while(associated(exchListPtr))
+           comm_list_found = .false.
+  
+           ! Search for an already created commList to this processor.
+           commListPtr =&gt; recvList
+           do while(associated(commListPtr))
+             if(commListPtr % procID == exchListPtr % endPointID) then
+               commListPtr % nList = commListPtr % nList + exchListPtr % nList  * fieldOutPtr % dimSizes(1)
+               comm_list_found = .true.
+               exit
+             end if
+  
+             commListPtr =&gt; commListPtr % next
+           end do
+  
+           ! If no comm list exists, create a new one.
+           if(.not. comm_list_found) then
+             commListPtr =&gt; recvList
+             commListPtr2 =&gt; commListPtr % next
+             do while(associated(commListPtr2))
+               commListPtr =&gt; commListPtr % next
+               commListPtr2 =&gt; commListPtr % next
+             end do
+  
+             allocate(commListPtr % next)
+             commListPtr =&gt; commListPtr % next
+             commListPtr % procID = exchListPtr % endPointID
+             commListPtr % nList = exchListPtr % nList * fieldOutPtr % dimSizes(1)
+           end if
+  
+           exchListPtr =&gt; exchListPtr % next
+         end do
+  
+         fieldOutPtr =&gt; fieldOutPtr % next
        end do
-       fieldOutPtr =&gt; fieldOutPtr % next
      end do
 
-     ! Initiate mpi_isend calls, and handle local copies
-     fieldInPtr =&gt; fieldIn
-     do while (associated(fieldInPtr))
-       sendListPtr =&gt; fieldInPtr % sendList(1) % next
-       do while (associated(sendListPtr))
+     ! Allocate buffers for recieves, and initiate mpi_irecv calls.
+     commListPtr =&gt; recvList
+     do while(associated(commListPtr))
+       allocate(commListPtr % rbuffer(commListPtr % nList))
+       call MPI_Irecv(commListPtr % rbuffer, commListPtr % nList, MPI_REALKIND, commListPtr % procID, commListPtr % procID, dminfo % comm, commListPtr % reqID, mpi_ierr)
+       commListPtr =&gt; commListPtr
+     end do
 
-         if (sendListPtr % procID == dminfo % my_proc_id) then ! Local Copy
-           fieldOutPtr =&gt; fieldOut
-           do while (associated(fieldOutPtr))
-             if(fieldOutPtr % block % blockID == sendListPtr % blockID) then
-               copyListPtr =&gt; fieldOutPtr % copyList(1) % next
-               do while(associated(copyListPtr))
-                 if(copyListPtr % blockID == fieldInPtr % block % blockID) then
-                   do i = 1, copyListPtr % nList
-                     fieldOutPtr % array(:,copyListPtr % list(i)) = fieldInPtr % array(:,sendListPtr % list(i))
-                   end do
-                 end if
-                 copyListPtr =&gt; copyListPtr % next
-               end do
+     ! Setup send lists, and determine the size of their buffers.
+     do iHalo = 1, nHaloLayers
+       fieldInPtr =&gt; fieldIn
+       do while(associated(fieldInPtr))
+         exchListPtr =&gt; fieldInPtr % sendList(haloLayers(iHalo))
+         do while(associated(exchListPtr))
+           comm_list_found = .false.
+  
+           ! Search for an already created commList to this processor.
+           commListPtr =&gt; sendList
+           do while(associated(commListPtr))
+             if(commListPtr % procID == exchListPtr % endPointID) then
+               commListPtr % nList = commListPtr % nList + exchListPtr % nList * fieldInPtr % dimSizes(1)
+               comm_list_found = .true.
+               exit
              end if
-             fieldOutPtr =&gt; fieldOutPtr % next
+  
+             commListPtr =&gt; commListPtr % next
            end do
-         else ! mpi_isend
-           nBuffer = sendLisTPtr % nList * fieldInPtr % dimSizes(1)
-           allocate(sendListPtr % rbuffer(nBuffer))
-           call mpas_pack_send_buf2d_real(1, fieldInPtr % dimSizes(1), fieldInPtr % dimSizes(2), fieldInPtr % array, sendListPtr, 1, nBuffer, &amp;
-                                             sendListPtr % rbuffer, nPacked, lastPackedIdx)
-
-           call MPI_Isend(sendListPtr % rbuffer, nBuffer, MPI_realKIND, &amp;
-                          sendListPtr % procID, dminfo % my_proc_id, dminfo % comm, sendListPtr % reqID, mpi_ierr)
-         end if
-         sendListPtr =&gt; sendListPtr % next
+  
+           ! If no comm list exists, create a new one.
+           if(.not. comm_list_found) then
+             commListPtr =&gt; sendList
+             commListPtr2 =&gt; commListPtr % next
+             do while(associated(commListPtr2))
+               commListPtr =&gt; commListPtr % next
+               commListPtr2 =&gt; commListPtr % next
+             end do
+  
+             allocate(commListPtr % next)
+             commListPtr =&gt; commListPtr % next
+             commListPtr % procID = exchListPtr % endPointID
+             commListPtr % nList = exchListPtr % nList * fieldInPtr % dimSizes(1)
+           end if
+  
+           exchListPtr =&gt; exchListPtr % next
+         end do
+  
+         fieldInPtr =&gt; fieldInPtr % next
        end do
-       fieldInPtr =&gt; fieldInPtr % next
      end do
 
-     ! Recieve all mpi_irecv commands, and unpack data into array
-     ! Deallocate recieve buffers
-     fieldOutPtr =&gt; fieldOut
-     do while (associated(fieldOutPtr))
-       recvListPtr =&gt; fieldOutPtr % recvList(1) % next
-       do while (associated(recvListPtr))
-         call MPI_Wait(recvListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
+     ! Allocate sendLists, copy data into buffer, and initiate mpi_isends
+     commListPtr =&gt; sendList
+     do while(associated(commListPtr))
+       allocate(commListPtr % rbuffer(commListPtr % nList))
+       bufferOffset = 0
+       do iHalo = 1, nHaloLayers
+         nAdded = 0
+         fieldInPtr =&gt; fieldIn
+         do while(associated(fieldInPtr))
+           exchListPtr =&gt; fieldInPtr % sendList(haloLayers(iHalo))
+           do while(associated(exchListPtr))
+             if(exchListPtr % endPointID == commListPtr % procID) then
+               do i = 1, exchListPtr % nList
+                 do j = 1, fieldInPtr % dimSizes(1)
+                   commListPtr % rbuffer((exchListPtr % destList(i)-1) * fieldInPtr % dimSizes(1) + j  + bufferOffset) = fieldInPtr % array(j, exchListPtr % srcList(i))
+                   nAdded = nAdded + 1
+                 end do
+               end do
+             end if
+  
+             exchListPtr =&gt; exchListPtr % next
+           end do
+  
+           fieldInPtr =&gt; fieldInPtr % next
+         end do
+         bufferOffset = bufferOffset + nAdded
+       end do
 
-         nBuffer = recvListPtr % nList * fieldOutPtr % dimSizes(1)
+       call MPI_Isend(commListPtr % rbuffer, commListPtr % nlist, MPI_REALKIND, &amp;
+                      commListPtr % procID, dminfo % my_proc_id, dminfo % comm, commListPtr % reqID, mpi_ierr)
 
-         call mpas_unpack_recv_buf2d_real(1, fieldOutPtr % dimSizes(1), fieldOutPtr % dimSizes(2), fieldOutPtr % array, recvListPtr, 1, nBuffer, &amp;
-                                             recvListPtr % rbuffer, nUnpacked, lastUnpackedIdx)
-         deallocate(recvListPtr % rbuffer)
-         recvListPtr =&gt; recvListPtr % next
-       end do
-       fieldOutPtr =&gt; fieldOutPtr % next
+       commListPtr =&gt; commListPtr % next
      end do
+#endif     
 
-     ! Dellocate send buffers
-     fieldInPtr =&gt; fieldIn
-     do while (associated(fieldInPtr))
-       sendListPtr =&gt; fieldInPtr % sendList(1) % next
-       do while (associated(sendListPtr))
-          if (sendListPtr % procID /= dminfo % my_proc_id) then
-             call MPI_Wait(sendListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
-             deallocate(sendListPtr % rbuffer)
-          end if
-          sendListPtr =&gt; sendListPtr % next
+     ! Handle Local Copies. Only local copies if no MPI
+     do iHalo = 1, nHaloLayers
+       fieldInPtr =&gt; fieldIn
+       do while(associated(fieldInPtr))
+         exchListPtr =&gt; fieldInPtr % copyList(haloLayers(iHalo))
+         do while(associated(exchListPtr))
+           fieldOutPtr =&gt; fieldOut
+           do while(associated(fieldOutPtr))
+             if(exchListPtr % endPointID == fieldOutPtr % block % localBlockID) then
+               do i = 1, exchListPtr % nList
+                 fieldOutPtr % array(:, exchListPtr % destList(i)) = fieldInPtr % array(:, exchListPtr % srcList(i))
+               end do
+             end if
+             fieldOutPtr =&gt; fieldOutPtr % next
+           end do
+  
+           exchListPtr =&gt; exchListPtr % next
+         end do
        end do
-       fieldInPtr =&gt; fieldInPtr % next
      end do
 
-#else
-     ! Only local copies if no mpi
-     fieldOutPtr =&gt; fieldOut
-     do while (associated(fieldOutPtr))
-       copyListPtr =&gt; fieldOutPtr % copyList(1) % next
-       do while (associated(copyListPtr))
-         fieldInPtr =&gt; fieldIn
-         do while (associated(fieldInPtr))
-           if(copyListPtr % blockID == fieldInPtr % block % blockID) then
-             sendListPtr =&gt; fieldInPtr % sendList(1) % next
-             do while (associated(sendListPtr))
-               if(sendListPtr % blockID == fieldOutPtr % block % blockID) then
-                 do i = 1, copyListPtr % nList
-                   fieldOutPtr % array(:, copyListPtr % list(i)) = fieldInPtr % array(:, sendListPtr % list(i))
+#ifdef _MPI
+     ! Wait for MPI_Irecv's to finish, and unpack data.
+     commListPtr =&gt; recvList
+     do while(associated(commListPtr))
+       call MPI_Wait(commListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
+
+       bufferOffset = 0
+       do iHalo = 1, nHaloLayers
+         nAdded = 0
+         fieldOutPtr =&gt; fieldOut
+         do while(associated(fieldOutPtr))
+           exchListPtr =&gt; fieldOutPtr % recvList(haloLayers(iHalo))
+           do while(associated(exchListPtr))
+             if(exchListPtr % endPointID == commListPtr % procID) then
+               do i = 1, exchListPtr % nList
+                 do j = 1, fieldOutPtr % dimSizes(1)
+                   fieldOutPtr % array(j, exchListPtr % destList(i)) = commListPtr % rbuffer((exchListPtr % srcList(i)-1) * fieldOutPtr % dimSizes(1) + j + bufferOffset)
+                   nAdded = nAdded + 1
                  end do
-               end if
-               sendListPtr =&gt; sendListPtr % next
-             end do
-           end if
-           fieldInPtr =&gt; fieldInPtr % next
+               end do
+             end if
+             exchListPtr =&gt; exchListPtr % next
+           end do
+  
+           fieldOutPtr =&gt; fieldOutPtr % next
          end do
-         copyListPtr =&gt; copyListPtr % next
+         bufferOffset = bufferOffset + nAdded
        end do
-       fieldOutPtr =&gt; fieldOutPtr % next
+
+       commListPtr =&gt; commListPtr % next
      end do
+
+     ! Wait for MPI_Isend's to finish.
+     commListPtr =&gt; sendList
+     do while(associated(commListPtr))
+       call MPI_Wait(commListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
+       commListPtr =&gt; commListPtr % next
+     end do
+
+     ! Destroy commLists.
+     call mpas_dmpar_destroy_communication_list(sendList)
+     call mpas_dmpar_destroy_communication_list(recvList)
 #endif
 
    end subroutine mpas_dmpar_alltoall_field2d_real!}}}
 
-   subroutine mpas_dmpar_alltoall_field3d_real(dminfo, fieldIn, fieldout)!{{{
+   subroutine mpas_dmpar_alltoall_field3d_real(fieldIn, fieldout, haloLayersIn)!{{{
 
      implicit none
 
-     type (dm_info), intent(in) :: dminfo
      type (field3dReal), pointer :: fieldIn
      type (field3dReal), pointer :: fieldOut
+     integer, dimension(:), pointer, optional :: haloLayersIn
 
      type (field3dReal), pointer :: fieldInPtr, fieldOutPtr
-     type (exchange_list), pointer :: sendListPtr, recvListPtr, copyListPtr
+     type (mpas_exchange_list), pointer :: exchListPtr, exchListPtr2
+     type (mpas_communication_list), pointer :: sendList, recvList, commListPtr, commListPtr2
+     type (dm_info), pointer :: dminfo
 
-     integer :: nBuffer
+     logical :: comm_list_found
+
      integer :: lastPackedIdx, lastUnpackedIdx, nPacked, nUnpacked
+     integer :: nAdded, bufferOffset
      integer :: mpi_ierr
-     integer :: i
+     integer :: iHalo, i, j, k
+     integer :: nHaloLayers
+     integer, dimension(:), pointer :: haloLayers
+     
+     dminfo =&gt; fieldIn % block % domain % dminfo
 
+     if(present(haloLayersIn)) then
+       nHaloLayers = size(haloLayersIn)
+       allocate(haloLayers(nHaloLayers))
+       do iHalo = 1, nHaloLayers
+         haloLayers(iHalo) = haloLayersIn(i)
+       end do
+     else
+       nHaloLayers = size(fieldIn % sendList)
+       allocate(haloLayers(nHaloLayers))
+       do iHalo = 1, nHaloLayers
+         haloLayers(iHalo) = i
+       end do
+     end if
+
 #ifdef _MPI
+     allocate(sendList)
+     nullify(sendList % next)
 
-     ! Initiate mpi_irecv calls
-     fieldOutPtr =&gt; fieldOut
-     do while (associated(fieldOutPtr))
-       recvListPtr =&gt; fieldOutPtr % recvList(1) % next
+     allocate(recvList)
+     nullify(recvList % next)
 
-       do while(associated(recvListPtr))
-         nBuffer = recvListPtr % nList * fieldOutPtr % dimSizes(1) * fieldOutPtr % dimSizes(2)
-         allocate(recvListPtr % rbuffer(nBuffer))
-         call MPI_Irecv(recvListPtr % rbuffer, nBuffer, MPI_realKIND, &amp;
-                        recvListPtr % procID, recvListPtr % procID, dminfo % comm, recvListPtr % reqID, mpi_ierr)
+     ! Setup recieve lists, and determine the size of their buffers.
+     do iHalo = 1, nHaloLayers
+       fieldOutPtr =&gt; fieldOut
+       do while(associated(fieldOutPtr))
+         exchListPtr =&gt; fieldOutPtr % recvList(haloLayers(iHalo))
+         do while(associated(exchListPtr))
+           comm_list_found = .false.
+  
+           ! Search for an already created commList to this processor.
+           commListPtr =&gt; recvList
+           do while(associated(commListPtr))
+             if(commListPtr % procID == exchListPtr % endPointID) then
+               commListPtr % nList = commListPtr % nList + exchListPtr % nList  * fieldOutPtr % dimSizes(1) * fieldOutPtr % dimSizes(2)
+               comm_list_found = .true.
+               exit
+             end if
+  
+             commListPtr =&gt; commListPtr % next
+           end do
+  
+           ! If no comm list exists, create a new one.
+           if(.not. comm_list_found) then
+             commListPtr =&gt; recvList
+             commListPtr2 =&gt; commListPtr % next
+             do while(associated(commListPtr2))
+               commListPtr =&gt; commListPtr % next
+               commListPtr2 =&gt; commListPtr % next
+             end do
+  
+             allocate(commListPtr % next)
+             commListPtr =&gt; commListPtr % next
+             commListPtr % procID = exchListPtr % endPointID
+             commListPtr % nList = exchListPtr % nList * fieldOutPtr % dimSizes(1) * fieldOutPtr % dimSizes(2)
+           end if
+  
+           exchListPtr =&gt; exchListPtr % next
+         end do
+  
+         fieldOutPtr =&gt; fieldOutPtr % next
+       end do
+     end do
 
-         recvListPtr =&gt; recvListPtr % next
+     ! Allocate buffers for recieves, and initiate mpi_irecv calls.
+     commListPtr =&gt; recvList
+     do while(associated(commListPtr))
+       allocate(commListPtr % rbuffer(commListPtr % nList))
+       call MPI_Irecv(commListPtr % rbuffer, commListPtr % nList, MPI_REALKIND, commListPtr % procID, commListPtr % procID, dminfo % comm, commListPtr % reqID, mpi_ierr)
+       commListPtr =&gt; commListPtr
+     end do
+
+     ! Setup send lists, and determine the size of their buffers.
+     do iHalo = 1, nHaloLayers
+       fieldInPtr =&gt; fieldIn
+       do while(associated(fieldInPtr))
+         exchListPtr =&gt; fieldInPtr % sendList(haloLayers(iHalo))
+         do while(associated(exchListPtr))
+           comm_list_found = .false.
+  
+           ! Search for an already created commList to this processor.
+           commListPtr =&gt; sendList
+           do while(associated(commListPtr))
+             if(commListPtr % procID == exchListPtr % endPointID) then
+               commListPtr % nList = commListPtr % nList + exchListPtr % nList * fieldInPtr % dimSizes(1) * fieldInPtr % dimSizes(2)
+               comm_list_found = .true.
+               exit
+             end if
+  
+             commListPtr =&gt; commListPtr % next
+           end do
+  
+           ! If no comm list exists, create a new one.
+           if(.not. comm_list_found) then
+             commListPtr =&gt; sendList
+             commListPtr2 =&gt; commListPtr % next
+             do while(associated(commListPtr2))
+               commListPtr =&gt; commListPtr % next
+               commListPtr2 =&gt; commListPtr % next
+             end do
+  
+             allocate(commListPtr % next)
+             commListPtr =&gt; commListPtr % next
+             commListPtr % procID = exchListPtr % endPointID
+             commListPtr % nList = exchListPtr % nList * fieldInPtr % dimSizes(1) * fieldInPtr % dimSizes(2)
+           end if
+  
+           exchListPtr =&gt; exchListPtr % next
+         end do
+  
+         fieldInPtr =&gt; fieldInPtr % next
        end do
-       fieldOutPtr =&gt; fieldOutPtr % next
      end do
 
-     ! Initiate mpi_isend calls, and handle local copies
-     fieldInPtr =&gt; fieldIn
-     do while (associated(fieldInPtr))
-       sendListPtr =&gt; fieldInPtr % sendList(1) % next
-       do while (associated(sendListPtr))
-
-         if (sendListPtr % procID == dminfo % my_proc_id) then ! Local Copy
-           fieldOutPtr =&gt; fieldOut
-           do while (associated(fieldOutPtr))
-             if(fieldOutPtr % block % blockID == sendListPtr % blockID) then
-               copyListPtr =&gt; fieldOutPtr % copyList(1) % next
-               do while(associated(copyListPtr))
-                 if(copyListPtr % blockID == fieldInPtr % block % blockID) then
-                   do i = 1, copyListPtr % nList
-                     fieldOutPtr % array(:,:,copyListPtr % list(i)) = fieldInPtr % array(:,:,sendListPtr % list(i))
+     ! Allocate sendLists, copy data into buffer, and initiate mpi_isends
+     commListPtr =&gt; sendList
+     do while(associated(commListPtr))
+       allocate(commListPtr % rbuffer(commListPtr % nList))
+       bufferOffset = 0
+       do iHalo = 1, nHaloLayers
+         nAdded = 0
+         fieldInPtr =&gt; fieldIn
+         do while(associated(fieldInPtr))
+           exchListPtr =&gt; fieldInPtr % sendList(haloLayers(iHalo))
+           do while(associated(exchListPtr))
+             if(exchListPtr % endPointID == commListPtr % procID) then
+               do i = 1, exchListPtr % nList
+                 do j = 1, fieldInPtr % dimSizes(1)
+                   do k = 1, fieldInPtr % dimSizes(2)
+                     commListPtr % rbuffer((exchListPtr % destList(i)-1) * fieldInPtr % dimSizes(1) * fieldInPtr % dimSizes(2) + (j-1) * fieldInPtr % dimSizes(1) + k &amp;
+                                           + bufferOffset) = fieldInPtr % array(k, j, exchListPtr % srcList(i))
+                     nAdded = nAdded + 1
                    end do
-                 end if
-                 copyListPtr =&gt; copyListPtr % next
+                 end do
                end do
              end if
-             fieldOutPtr =&gt; fieldOutPtr % next
+  
+             exchListPtr =&gt; exchListPtr % next
            end do
-         else ! mpi_isend
-           nBuffer = sendLisTPtr % nList * fieldInPtr % dimSizes(1) * fieldInPtr % dimSizes(2)
-           allocate(sendListPtr % rbuffer(nBuffer))
-           call mpas_pack_send_buf3d_real(1, fieldInPtr % dimSizes(1), 1, fieldInPtr % dimSizes(2), fieldInPtr % dimSizes(3), &amp;
-                                             fieldInPtr % array, sendListPtr, 1, nBuffer, &amp;
-                                             sendListPtr % rbuffer, nPacked, lastPackedIdx)
-
-           call MPI_Isend(sendListPtr % rbuffer, nBuffer, MPI_realKIND, &amp;
-                          sendListPtr % procID, dminfo % my_proc_id, dminfo % comm, sendListPtr % reqID, mpi_ierr)
-         end if
-         sendListPtr =&gt; sendListPtr % next
+  
+           fieldInPtr =&gt; fieldInPtr % next
+         end do
+         bufferOffset = bufferOffset + nAdded
        end do
-       fieldInPtr =&gt; fieldInPtr % next
-     end do
 
-     ! Recieve all mpi_irecv commands, and unpack data into array
-     ! Deallocate recieve buffers
-     fieldOutPtr =&gt; fieldOut
-     do while (associated(fieldOutPtr))
-       recvListPtr =&gt; fieldOutPtr % recvList(1) % next
-       do while (associated(recvListPtr))
-         call MPI_Wait(recvListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
+       call MPI_Isend(commListPtr % rbuffer, commListPtr % nlist, MPI_REALKIND, &amp;
+                      commListPtr % procID, dminfo % my_proc_id, dminfo % comm, commListPtr % reqID, mpi_ierr)
 
-         nBuffer = recvListPtr % nList * fieldOutPtr % dimSizes(1) * fieldOutPtr % dimSizes(2)
-
-         call mpas_unpack_recv_buf3d_real(1, fieldOutPtr % dimSizes(1), 1, fieldOutPtr % dimSizes(2), fieldOutPtr % dimSizes(3), &amp;
-                                             fieldOutPtr % array, recvListPtr, 1, nBuffer, &amp;
-                                             recvListPtr % rbuffer, nUnpacked, lastUnpackedIdx)
-         deallocate(recvListPtr % rbuffer)
-         recvListPtr =&gt; recvListPtr % next
-       end do
-       fieldOutPtr =&gt; fieldOutPtr % next
+       commListPtr =&gt; commListPtr % next
      end do
+#endif     
 
-     ! Dellocate send buffers
-     fieldInPtr =&gt; fieldIn
-     do while (associated(fieldInPtr))
-       sendListPtr =&gt; fieldInPtr % sendList(1) % next
-       do while (associated(sendListPtr))
-          if (sendListPtr % procID /= dminfo % my_proc_id) then
-             call MPI_Wait(sendListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
-             deallocate(sendListPtr % rbuffer)
-          end if
-          sendListPtr =&gt; sendListPtr % next
+     ! Handle Local Copies. Only local copies if no MPI
+     do iHalo = 1, nHaloLayers
+       fieldInPtr =&gt; fieldIn
+       do while(associated(fieldInPtr))
+         exchListPtr =&gt; fieldInPtr % copyList(haloLayers(iHalo))
+         do while(associated(exchListPtr))
+           fieldOutPtr =&gt; fieldOut
+           do while(associated(fieldOutPtr))
+             if(exchListPtr % endPointID == fieldOutPtr % block % localBlockID) then
+               do i = 1, exchListPtr % nList
+                 fieldOutPtr % array(:, :, exchListPtr % destList(i)) = fieldInPtr % array(:, :, exchListPtr % srcList(i))
+               end do
+             end if
+             fieldOutPtr =&gt; fieldOutPtr % next
+           end do
+  
+           exchListPtr =&gt; exchListPtr % next
+         end do
        end do
-       fieldInPtr =&gt; fieldInPtr % next
      end do
 
-#else
-     ! Only local copies if no mpi
-     fieldOutPtr =&gt; fieldOut
-     do while (associated(fieldOutPtr))
-       copyListPtr =&gt; fieldOutPtr % copyList(1) % next
-       do while (associated(copyListPtr))
-         fieldInPtr =&gt; fieldIn
-         do while (associated(fieldInPtr))
-           if(copyListPtr % blockID == fieldInPtr % block % blockID) then
-             sendListPtr =&gt; fieldInPtr % sendList(1) % next
-             do while (associated(sendListPtr))
-               if(sendListPtr % blockID == fieldOutPtr % block % blockID) then
-                 do i = 1, copyListPtr % nList
-                   fieldOutPtr % array(:, :, copyListPtr % list(i)) = fieldInPtr % array(:, :, sendListPtr % list(i))
+#ifdef _MPI
+     ! Wait for MPI_Irecv's to finish, and unpack data.
+     commListPtr =&gt; recvList
+     do while(associated(commListPtr))
+       call MPI_Wait(commListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
+
+       bufferOffset = 0
+       do iHalo = 1, nHaloLayers
+         nAdded = 0
+         fieldOutPtr =&gt; fieldOut
+         do while(associated(fieldOutPtr))
+           exchListPtr =&gt; fieldOutPtr % recvList(haloLayers(iHalo))
+           do while(associated(exchListPtr))
+             if(exchListPtr % endPointID == commListPtr % procID) then
+               do i = 1, exchListPtr % nList
+                 do j = 1, fieldOutPtr % dimSizes(1)
+                   do k = 1, fieldOutPtr % dimSizes(2)
+                     fieldOutPtr % array(k, j, exchListPtr % destList(i)) = commListPtr % rbuffer((exchListPtr % srcList(i)-1) * fieldOutPtr % dimSizes(1) * fieldOutPtr % dimSizes(2) &amp;
+                                                                          + (j-1) * fieldOutPtr % dimSizes(1) + k + bufferOffset)
+                     nAdded = nAdded + 1
+                   end do
                  end do
-               end if
-               sendListPtr =&gt; sendListPtr % next
-             end do
-           end if
-           fieldInPtr =&gt; fieldInPtr % next
+               end do
+             end if
+             exchListPtr =&gt; exchListPtr % next
+           end do
+  
+           fieldOutPtr =&gt; fieldOutPtr % next
          end do
-         copyListPtr =&gt; copyListPtr % next
+         bufferOffset = bufferOffset + nAdded
        end do
-       fieldOutPtr =&gt; fieldOutPtr % next
+
+       commListPtr =&gt; commListPtr % next
      end do
+
+     ! Wait for MPI_Isend's to finish.
+     commListPtr =&gt; sendList
+     do while(associated(commListPtr))
+       call MPI_Wait(commListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
+       commListPtr =&gt; commListPtr % next
+     end do
+
+     ! Destroy commLists.
+     call mpas_dmpar_destroy_communication_list(sendList)
+     call mpas_dmpar_destroy_communication_list(recvList)
 #endif
 
    end subroutine mpas_dmpar_alltoall_field3d_real!}}}
 
-   subroutine mpas_pack_send_buf1d_integer(nField, field, sendList, startPackIdx, nBuffer, buffer, nPacked, lastPackedIdx)!{{{
+   subroutine mpas_dmpar_exch_halo_field1d_integer(field, haloLayersIn)!{{{
 
       implicit none
 
-      integer, intent(in) :: nField, nBuffer, startPackIdx
-      integer, dimension(*), intent(in) :: field
-      type (exchange_list), intent(in) :: sendList
-      integer, dimension(nBuffer), intent(out) :: buffer
-      integer, intent(inout) :: nPacked, lastPackedIdx
+      type (field1DInteger), pointer :: field
+      integer, dimension(:), intent(in), optional :: haloLayersIn
 
-      integer :: i
+      type (dm_info), pointer :: dminfo
+      type (field1DInteger), pointer :: fieldCursor, fieldCursor2
+      type (mpas_exchange_list), pointer :: exchListPtr
+      type (mpas_communication_list), pointer :: sendList, recvList, commListPtr, commListPtr2
+      integer :: mpi_ierr
+      integer :: nHaloLayers, iHalo, i
+      integer :: bufferOffset, nAdded
+      integer, dimension(:), pointer :: haloLayers
 
-      nPacked = 0
-      do i=startPackIdx, sendList % nlist
-         nPacked = nPacked + 1
-         if (nPacked &gt; nBuffer) then
-            nPacked = nPacked - 1
-            lastPackedIdx = i - 1
-            return
-         end if
-         buffer(nPacked) = field(sendList % list(i))
-      end do
-      lastPackedIdx = sendList % nlist
+      logical comm_list_found
 
-   end subroutine mpas_pack_send_buf1d_integer!}}}
+      dminfo =&gt; field % block % domain % dminfo
 
-   subroutine mpas_pack_send_buf2d_integer(ds, de, nField, field, sendList, startPackIdx, nBuffer, buffer, nPacked, lastPackedIdx)!{{{
+      if(present(haloLayersIn)) then
+        nHaloLayers = size(haloLayersIn)
+        allocate(haloLayers(nHaloLayers))
+        do iHalo = 1, nHaloLayers
+          haloLayers(iHalo) = haloLayersIn(iHalo)
+        end do
+      else
+        nHaloLayers = size(field % sendList)
+        allocate(haloLayers(nHaloLayers))
+        do iHalo = 1, nHaloLayers
+          haloLayers(iHalo) = iHalo
+        end do
+      end if
 
-      implicit none
+#ifdef _MPI
+      allocate(sendList)
+      nullify(sendList % next)
+      sendList % procID = -1
 
-      integer, intent(in) :: ds, de, nField, nBuffer, startPackIdx
-      integer, dimension(ds:de,*), intent(in) :: field
-      type (exchange_list), intent(in) :: sendList
-      integer, dimension(nBuffer), intent(out) :: buffer
-      integer, intent(inout) :: nPacked, lastPackedIdx
+      allocate(recvList)
+      nullify(recvList % next)
+      recvList % procID = -1
 
-      integer :: i, n
+      dminfo   = field % block % domain % dminfo
 
-      n = de-ds+1
+      ! Determine size of buffers for communication lists
+      fieldCursor =&gt; field
+      do while(associated(fieldCursor))
 
-      if (n &gt; nBuffer) then
-         write(0,*) 'packSendBuf2dInteger: Not enough space in buffer', &amp;
-          ' to fit a single slice.'
-         return
-      end if
+        ! Need to aggregate across halo layers
+        do iHalo = 1, nHaloLayers
+          
+          ! Determine size from send lists
+          exchListPtr =&gt; fieldCursor % sendList(haloLayers(iHalo))
+          do while(associated(exchListPtr))
+            comm_list_found = .false.
 
-      nPacked = 0
-      do i=startPackIdx, sendList % nlist
-         nPacked = nPacked + n
-         if (nPacked &gt; nBuffer) then
-            nPacked = nPacked - n
-            lastPackedIdx = i - 1
-            return
-         end if
-         buffer(nPacked-n+1:nPacked) = field(ds:de,sendList % list(i))
+            commListPtr =&gt; sendList
+            do while(associated(commListPtr))
+              if(commListPtr % procID == exchListPtr % endPointId) then
+                comm_list_found = .true.
+                commListPtr % nList = commListPtr % nList + exchListPtr % nList
+                exit
+              end if
+
+              commListPtr =&gt; commListPtr % next
+            end do
+
+            if(.not. comm_list_found) then
+              commListPtr =&gt; sendList
+              commListPtr2 =&gt; commListPtr % next
+              do while(associated(commListPtr2))
+                commListPtr =&gt; commListPtr % next
+                commListPtr2 =&gt; commListPtr % next
+              end do
+
+              allocate(commListPtr % next)
+              commListPtr =&gt; commListPtr % next
+              nullify(commListPtr % next)
+              commListPtr % procID = exchListPtr % endPointID
+              commListPtr % nList = exchListPtr % nList
+            end if
+
+            exchListPtr =&gt; exchListPtr % next
+          end do
+
+          ! Determine size from recv lists
+          exchListPtr =&gt; fieldCursor % recvList(haloLayers(iHalo))
+          do while(associated(exchListPtr))
+            comm_list_found = .false.
+
+            commListPtr =&gt; recvList
+            do while(associated(commListPtr))
+              if(commListPtr % procID == exchListPtr % endPointId) then
+                comm_list_found = .true.
+                commListPtr % nList = commListPtr % nList + exchListPtr % nList
+                exit
+              end if
+
+              commListPtr =&gt; commListPtr % next
+            end do
+
+            if(.not. comm_list_found) then
+              commListPtr =&gt; recvList
+              commListPtr2 =&gt; commListPtr % next
+              do while(associated(commListPtr2))
+                commListPtr =&gt; commListPtr % next
+                commListPtr2 =&gt; commListPtr % next
+              end do
+
+              allocate(commListPtr % next)
+              commListPtr =&gt; commListPtr % next
+              nullify(commListPtr % next)
+              commListPtr % procID = exchListPtr % endPointID
+              commListPtr % nList = exchListPtr % nList
+            end if
+
+            exchListPtr =&gt; exchListPtr % next
+          end do
+        end do
+
+        fieldCursor =&gt; fieldCursor % next
       end do
-      lastPackedIdx = sendList % nlist
 
-   end subroutine mpas_pack_send_buf2d_integer!}}}
+      ! Remove the dead head pointer on send and recv list
+      commListPtr =&gt; sendList
+      sendList =&gt; sendList % next
+      deallocate(commListPtr)
 
-   subroutine mpas_pack_send_buf3d_integer(d1s, d1e, d2s, d2e, nField, field, sendList, startPackIdx, nBuffer, buffer, nPacked, lastPackedIdx)!{{{
+      commListPtr =&gt; recvList
+      recvList =&gt; recvList % next
+      deallocate(commListPtr)
 
-      implicit none
+      ! Allocate space in recv lists, and initiate mpi_irecv calls
+      commListPtr =&gt; recvList
+      do while(associated(commListPtr))
+        allocate(commListPtr % ibuffer(commListPtr % nList))
+        call MPI_Irecv(commListPtr % ibuffer, commListPtr % nList, MPI_INTEGERKIND, commListPtr % procID, commListPtr % procID, dminfo % comm, commListPtr % reqID, mpi_ierr)
 
-      integer, intent(in) :: d1s, d1e, d2s, d2e, nField, nBuffer, startPackIdx
-      integer, dimension(d1s:d1e,d2s:d2e,*), intent(in) :: field
-      type (exchange_list), intent(in) :: sendList
-      integer, dimension(nBuffer), intent(out) :: buffer
-      integer, intent(inout) :: nPacked, lastPackedIdx
+        commListPtr =&gt; commListPtr % next
+      end do
 
-      integer :: i, j, k, n
+      ! Allocate space in send lists, copy data into buffer, and initiate mpi_isend calls
+      commListPtr =&gt; sendList
+      do while(associated(commListPtr))
+        allocate(commListPtr % ibuffer(commListPtr % nList))
+        bufferOffset = 0
+        do iHalo = 1, nHaloLayers
+          nAdded = 0
+          fieldCursor =&gt; field
+          do while(associated(fieldCursor))
+            exchListPtr =&gt; fieldCursor % sendList(haloLayers(iHalo))
+            do while(associated(exchListPtr))
+              if(exchListPtr % endPointID == commListPtr % procID) then
+                do  i = 1, exchListPtr % nList
+                  commListPtr % ibuffer(exchListPtr % destList(i) + bufferOffset) = fieldCursor % array(exchListPtr % srcList(i))
+                  nAdded = nAdded + 1
+                end do
+              end if
 
-      n = (d1e-d1s+1) * (d2e-d2s+1)
+              exchListPtr =&gt; exchListPtr % next
+            end do
 
-      if (n &gt; nBuffer) then
-         write(0,*) 'packSendBuf3dInteger: Not enough space in buffer', &amp;
-          ' to fit a single slice.'
-         return
-      end if
+            fieldCursor =&gt; fieldCursor % next
+          end do
+          bufferOffset = bufferOffset + nAdded
+        end do
 
-      nPacked = 0
-      do i=startPackIdx, sendList % nlist
-         nPacked = nPacked + n
-         if (nPacked &gt; nBuffer) then
-            nPacked = nPacked - n
-            lastPackedIdx = i - 1
-            return
-         end if
-         k = nPacked-n+1
-         do j=d2s,d2e
-            buffer(k:k+d1e-d1s) = field(d1s:d1e,j,sendList % list(i))
-            k = k + d1e-d1s+1
-         end do
+        call MPI_Isend(commListPtr % ibuffer, commListPtr % nList, MPI_INTEGERKIND, commListPtr % procID, dminfo % my_proc_id, dminfo % comm, commListPtr % reqID, mpi_ierr)
+        commListPtr =&gt; commListPtr % next
       end do
-      lastPackedIdx = sendList % nlist
+#endif
 
-   end subroutine mpas_pack_send_buf3d_integer!}}}
+      ! Handle local copy. If MPI is off, then only local copies are performed.
+      fieldCursor =&gt; field
+      do while(associated(field))
+        do iHalo = 1, nHaloLayers
+          exchListPtr =&gt; fieldCursor % copyList(haloLayers(iHalo))
 
-   subroutine mpas_pack_send_buf1d_real(nField, field, sendList, startPackIdx, nBuffer, buffer, nPacked, lastPackedIdx)!{{{
+          do while(associated(exchListPtr))
+            fieldCursor2 =&gt; field
+            do while(associated(fieldCursor2))
+              if(exchListPtr % endPointID == fieldCursor2 % block % localBlockID) then
+                do i = 1, exchListPtr % nList
+                  fieldCursor2 % array(exchListPtr % destList(i)) = fieldCursor % array(exchListPtr % srcList(i))
+                end do
+              end if
+              
+              fieldCursor2 =&gt; fieldCursor2 % next
+            end do
 
-      implicit none
+            exchListPtr =&gt; exchListPtr % next
+          end do
+        end do
 
-      integer, intent(in) :: nField, nBuffer, startPackIdx
-      real (kind=RKIND), dimension(*), intent(in) :: field
-      type (exchange_list), intent(in) :: sendList
-      real (kind=RKIND), dimension(nBuffer), intent(out) :: buffer
-      integer, intent(inout) :: nPacked, lastPackedIdx
+        fieldCursor =&gt; fieldCursor % next
+      end do
 
-      integer :: i
+#ifdef _MPI
 
-      nPacked = 0
-      do i=startPackIdx, sendList % nlist
-         nPacked = nPacked + 1
-         if (nPacked &gt; nBuffer) then
-            nPacked = nPacked - 1
-            lastPackedIdx = i - 1
-            return
-         end if
-         buffer(nPacked) = field(sendList % list(i))
+      ! Wait for mpi_irecv to finish, and unpack data from buffer
+      commListPtr =&gt; recvList
+      do while(associated(commListPtr))
+        call MPI_Wait(commListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
+        bufferOffset = 0
+        do iHalo = 1, nHaloLayers
+          nAdded = 0
+          fieldCursor =&gt; field
+          do while(associated(fieldCursor))
+            exchListPtr =&gt; fieldCursor % recvList(iHalo)
+            do while(associated(exchListPtr))
+              if(exchListPtr % endPointID == commListPtr % procID) then
+                do i = 1, exchListPtr % nList
+                  fieldCursor % array(exchListPtr % destList(i)) = commListPtr % ibuffer(exchListPtr % srcList(i) + bufferOffset)
+                  nAdded = nAdded + 1
+                end do
+              end if
+              exchListPtr =&gt; exchListPtr % next
+            end do
+            
+            fieldCursor =&gt; fieldCursor % next
+          end do
+          bufferOffset = bufferOffset + nAdded
+        end do
+        commListPtr =&gt; commListPtr % next
       end do
-      lastPackedIdx = sendList % nlist
 
-   end subroutine mpas_pack_send_buf1d_real!}}}
+      ! wait for mpi_isend to finish.
+      commListPtr =&gt; sendList
+      do while(associated(commListPtr))
+        call MPI_Wait(commListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
+        commListPtr =&gt; commListPtr % next
+      end do
 
-   subroutine mpas_pack_send_buf2d_real(ds, de, nField, field, sendList, startPackIdx, nBuffer, buffer, nPacked, lastPackedIdx)!{{{
+     ! Destroy commLists.
+     call mpas_dmpar_destroy_communication_list(sendList)
+     call mpas_dmpar_destroy_communication_list(recvList)
+#endif
 
+   end subroutine mpas_dmpar_exch_halo_field1d_integer!}}}
+
+   subroutine mpas_dmpar_exch_halo_field2d_integer(field, haloLayersIn)!{{{
+
       implicit none
 
-      integer, intent(in) :: ds, de, nField, nBuffer, startPackIdx
-      real (kind=RKIND), dimension(ds:de,*), intent(in) :: field
-      type (exchange_list), intent(in) :: sendList
-      real (kind=RKIND), dimension(nBuffer), intent(out) :: buffer
-      integer, intent(inout) :: nPacked, lastPackedIdx
+      type (field2DInteger), pointer :: field
+      integer, dimension(:), intent(in), optional :: haloLayersIn
 
-      integer :: i, n
+      type (dm_info), pointer :: dminfo
+      type (field2DInteger), pointer :: fieldCursor, fieldCursor2
+      type (mpas_exchange_list), pointer :: exchListPtr
+      type (mpas_communication_list), pointer :: sendList, recvList, commListPtr, commListPtr2
+      integer :: mpi_ierr
+      integer :: nHaloLayers, iHalo, i, j
+      integer :: bufferOffset, nAdded
+      integer, dimension(:), pointer :: haloLayers
 
-      n = de-ds+1
+      logical comm_list_found
 
-      if (n &gt; nBuffer) then
-         write(0,*) 'packSendBuf2dReal: Not enough space in buffer', &amp;
-          ' to fit a single slice.'
-         return
+      dminfo =&gt; field % block % domain % dminfo
+
+      if(present(haloLayersIn)) then
+        nHaloLayers = size(haloLayersIn)
+        allocate(haloLayers(nHaloLayers))
+        do iHalo = 1, nHaloLayers
+          haloLayers(iHalo) = haloLayersIn(iHalo)
+        end do
+      else
+        nHaloLayers = size(field % sendList)
+        allocate(haloLayers(nHaloLayers))
+        do iHalo = 1, nHaloLayers
+          haloLayers(iHalo) = iHalo
+        end do
       end if
 
-      nPacked = 0
-      do i=startPackIdx, sendList % nlist
-         nPacked = nPacked + n
-         if (nPacked &gt; nBuffer) then
-            nPacked = nPacked - n
-            lastPackedIdx = i - 1
-            return
-         end if
-         buffer(nPacked-n+1:nPacked) = field(ds:de,sendList % list(i))
-      end do
-      lastPackedIdx = sendList % nlist
+#ifdef _MPI
+      allocate(sendList)
+      nullify(sendList % next)
+      sendList % procID = -1
 
-   end subroutine mpas_pack_send_buf2d_real!}}}
+      allocate(recvList)
+      nullify(recvList % next)
+      recvList % procID = -1
 
-   subroutine mpas_pack_send_buf3d_real(d1s, d1e, d2s, d2e, nField, field, sendList, startPackIdx, nBuffer, buffer, nPacked, lastPackedIdx)!{{{
+      dminfo   = field % block % domain % dminfo
 
-      implicit none
+      ! Determine size of buffers for communication lists
+      fieldCursor =&gt; field
+      do while(associated(fieldCursor))
 
-      integer, intent(in) :: d1s, d1e, d2s, d2e, nField, nBuffer, startPackIdx
-      real (kind=RKIND), dimension(d1s:d1e,d2s:d2e,*), intent(in) :: field
-      type (exchange_list), intent(in) :: sendList
-      real (kind=RKIND), dimension(nBuffer), intent(out) :: buffer
-      integer, intent(inout) :: nPacked, lastPackedIdx
+        ! Need to aggregate across halo layers
+        do iHalo = 1, nHaloLayers
+          
+          ! Determine size from send lists
+          exchListPtr =&gt; fieldCursor % sendList(haloLayers(iHalo))
+          do while(associated(exchListPtr))
+            comm_list_found = .false.
 
-      integer :: i, j, k, n
+            commListPtr =&gt; sendList
+            do while(associated(commListPtr))
+              if(commListPtr % procID == exchListPtr % endPointId) then
+                comm_list_found = .true.
+                commListPtr % nList = commListPtr % nList + exchListPtr % nList * fieldCursor % dimSizes(1)
+                exit
+              end if
 
-      n = (d1e-d1s+1) * (d2e-d2s+1)
+              commListPtr =&gt; commListPtr % next
+            end do
 
-      if (n &gt; nBuffer) then
-         write(0,*) 'packSendBuf3dReal: Not enough space in buffer', &amp;
-          ' to fit a single slice.'
-         return
-      end if
+            if(.not. comm_list_found) then
+              commListPtr =&gt; sendList
+              commListPtr2 =&gt; commListPtr % next
+              do while(associated(commListPtr2))
+                commListPtr =&gt; commListPtr % next
+                commListPtr2 =&gt; commListPtr % next
+              end do
 
-      nPacked = 0
-      do i=startPackIdx, sendList % nlist
-         nPacked = nPacked + n
-         if (nPacked &gt; nBuffer) then
-            nPacked = nPacked - n
-            lastPackedIdx = i - 1
-            return
-         end if
-         k = nPacked-n+1
-         do j=d2s,d2e
-            buffer(k:k+d1e-d1s) = field(d1s:d1e,j,sendList % list(i))
-            k = k + d1e-d1s+1
-         end do
-      end do
-      lastPackedIdx = sendList % nlist
+              allocate(commListPtr % next)
+              commListPtr =&gt; commListPtr % next
+              nullify(commListPtr % next)
+              commListPtr % procID = exchListPtr % endPointID
+              commListPtr % nList = exchListPtr % nList * fieldCursor % dimSizes(1)
+            end if
 
-   end subroutine mpas_pack_send_buf3d_real!}}}
+            exchListPtr =&gt; exchListPtr % next
+          end do
 
-   subroutine mpas_unpack_recv_buf1d_integer(nField, field, recvList, startUnpackIdx, nBuffer, buffer, nUnpacked, lastUnpackedIdx)!{{{
+          ! Determine size from recv lists
+          exchListPtr =&gt; fieldCursor % recvList(haloLayers(iHalo))
+          do while(associated(exchListPtr))
+            comm_list_found = .false.
 
-      implicit none
+            commListPtr =&gt; recvList
+            do while(associated(commListPtr))
+              if(commListPtr % procID == exchListPtr % endPointId) then
+                comm_list_found = .true.
+                commListPtr % nList = commListPtr % nList + exchListPtr % nList * fieldCursor % dimSizes(1)
+                exit
+              end if
 
-      integer, intent(in) :: nField, nBuffer, startUnpackIdx
-      integer, dimension(*), intent(inout) :: field
-      type (exchange_list), intent(in) :: recvList
-      integer, dimension(nBuffer), intent(in) :: buffer
-      integer, intent(inout) :: nUnpacked, lastUnpackedIdx
+              commListPtr =&gt; commListPtr % next
+            end do
 
-      integer :: i
+            if(.not. comm_list_found) then
+              commListPtr =&gt; recvList
+              commListPtr2 =&gt; commListPtr % next
+              do while(associated(commListPtr2))
+                commListPtr =&gt; commListPtr % next
+                commListPtr2 =&gt; commListPtr % next
+              end do
 
-      nUnpacked = 0
-      do i=startUnpackIdx, recvList % nlist
-         nUnpacked = nUnpacked + 1
-         if (nUnpacked &gt; nBuffer) then
-            nUnpacked = nUnpacked - 1
-            lastUnpackedIdx = i - 1
-            return
-         end if
-         field(recvList % list(i)) = buffer(nUnpacked)
+              allocate(commListPtr % next)
+              commListPtr =&gt; commListPtr % next
+              nullify(commListPtr % next)
+              commListPtr % procID = exchListPtr % endPointID
+              commListPtr % nList = exchListPtr % nList * fieldCursor % dimSizes(1)
+            end if
+
+            exchListPtr =&gt; exchListPtr % next
+          end do
+        end do
+
+        fieldCursor =&gt; fieldCursor % next
       end do
-      lastUnpackedIdx = recvList % nlist
 
-   end subroutine mpas_unpack_recv_buf1d_integer!}}}
+      ! Remove the dead head pointer on send and recv list
+      commListPtr =&gt; sendList
+      sendList =&gt; sendList % next
+      deallocate(commListPtr)
 
-   subroutine mpas_unpack_recv_buf2d_integer(ds, de, nField, field, recvList, startUnpackIdx, nBuffer, buffer, nUnpacked, lastUnpackedIdx)!{{{
+      commListPtr =&gt; recvList
+      recvList =&gt; recvList % next
+      deallocate(commListPtr)
 
-      implicit none
+      ! Allocate space in recv lists, and initiate mpi_irecv calls
+      commListPtr =&gt; recvList
+      do while(associated(commListPtr))
+        allocate(commListPtr % ibuffer(commListPtr % nList))
+        call MPI_Irecv(commListPtr % ibuffer, commListPtr % nList, MPI_INTEGERKIND, commListPtr % procID, commListPtr % procID, dminfo % comm, commListPtr % reqID, mpi_ierr)
 
-      integer, intent(in) :: ds, de, nField, nBuffer, startUnpackIdx
-      integer, dimension(ds:de,*), intent(inout) :: field
-      type (exchange_list), intent(in) :: recvList
-      integer, dimension(nBuffer), intent(in) :: buffer
-      integer, intent(inout) :: nUnpacked, lastUnpackedIdx
+        commListPtr =&gt; commListPtr % next
+      end do
 
-      integer :: i, n
+      ! Allocate space in send lists, copy data into buffer, and initiate mpi_isend calls
+      commListPtr =&gt; sendList
+      do while(associated(commListPtr))
+        allocate(commListPtr % ibuffer(commListPtr % nList))
+        bufferOffset = 0
+        do iHalo = 1, nHaloLayers
+          nAdded = 0
+          fieldCursor =&gt; field
+          do while(associated(fieldCursor))
+            exchListPtr =&gt; fieldCursor % sendList(haloLayers(iHalo))
+            do while(associated(exchListPtr))
+              if(exchListPtr % endPointID == commListPtr % procID) then
+                do  i = 1, exchListPtr % nList
+                  do j = 1, fieldCursor % dimSizes(1)
+                    commListPtr % ibuffer((exchListPtr % destList(i)-1) * fieldCursor % dimSizes(1) + j + bufferOffset) = fieldCursor % array(j, exchListPtr % srcList(i))
+                    nAdded = nAdded + 1
+                  end do
+                end do
+              end if
 
-      n = de-ds+1
+              exchListPtr =&gt; exchListPtr % next
+            end do
 
-      nUnpacked = 0
-      do i=startUnpackIdx, recvList % nlist
-         nUnpacked = nUnpacked + n
-         if (nUnpacked &gt; nBuffer) then
-            nUnpacked = nUnpacked - n
-            lastUnpackedIdx = i - 1
-            return
-         end if
-         field(ds:de,recvList % list(i)) = buffer(nUnpacked-n+1:nUnpacked)
+            fieldCursor =&gt; fieldCursor % next
+          end do
+          bufferOffset = bufferOffset + nAdded
+        end do
+
+        call MPI_Isend(commListPtr % ibuffer, commListPtr % nList, MPI_INTEGERKIND, commListPtr % procID, dminfo % my_proc_id, dminfo % comm, commListPtr % reqID, mpi_ierr)
+        commListPtr =&gt; commListPtr % next
       end do
-      lastUnpackedIdx = recvList % nlist
+#endif
 
-   end subroutine mpas_unpack_recv_buf2d_integer!}}}
+      ! Handle local copy. If MPI is off, then only local copies are performed.
+      fieldCursor =&gt; field
+      do while(associated(field))
+        do iHalo = 1, nHaloLayers
+          exchListPtr =&gt; fieldCursor % copyList(haloLayers(iHalo))
 
-   subroutine mpas_unpack_recv_buf3d_integer(d1s, d1e, d2s, d2e, nField, field, recvList, startUnpackIdx, nBuffer, buffer, &amp;!{{{
-                                  nUnpacked, lastUnpackedIdx)
+          do while(associated(exchListPtr))
+            fieldCursor2 =&gt; field
+            do while(associated(fieldCursor2))
+              if(exchListPtr % endPointID == fieldCursor2 % block % localBlockID) then
+                do i = 1, exchListPtr % nList
+                  fieldCursor2 % array(:, exchListPtr % destList(i)) = fieldCursor % array(:, exchListPtr % srcList(i))
+                end do
+              end if
+              
+              fieldCursor2 =&gt; fieldCursor2 % next
+            end do
 
-      implicit none
+            exchListPtr =&gt; exchListPtr % next
+          end do
+        end do
 
-      integer, intent(in) :: d1s, d1e, d2s, d2e, nField, nBuffer, startUnpackIdx
-      integer, dimension(d1s:d1e,d2s:d2e,*), intent(inout) :: field
-      type (exchange_list), intent(in) :: recvList
-      integer, dimension(nBuffer), intent(in) :: buffer
-      integer, intent(inout) :: nUnpacked, lastUnpackedIdx
+        fieldCursor =&gt; fieldCursor % next
+      end do
 
-      integer :: i, j, k, n
+#ifdef _MPI
 
-      n = (d1e-d1s+1) * (d2e-d2s+1)
+      ! Wait for mpi_irecv to finish, and unpack data from buffer
+      commListPtr =&gt; recvList
+      do while(associated(commListPtr))
+        call MPI_Wait(commListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
+        bufferOffset = 0
+        do iHalo = 1, nHaloLayers
+          nAdded = 0
+          fieldCursor =&gt; field
+          do while(associated(fieldCursor))
+            exchListPtr =&gt; fieldCursor % recvList(iHalo)
+            do while(associated(exchListPtr))
+              if(exchListPtr % endPointID == commListPtr % procID) then
+                do i = 1, exchListPtr % nList
+                  do j = 1, fieldCursor % dimSizes(1)
+                    fieldCursor % array(j, exchListPtr % destList(i)) = commListPtr % ibuffer((exchListPtr % srcList(i)-1)*fieldCursor % dimSizeS(1) + j + bufferOffset)
+                    nAdded = nAdded + 1
+                  end do
+                end do
+              end if
+              exchListPtr =&gt; exchListPtr % next
+            end do
+            
+            fieldCursor =&gt; fieldCursor % next
+          end do
+          bufferOffset = bufferOffset + nAdded
+        end do
+        commListPtr =&gt; commListPtr % next
+      end do
 
-      nUnpacked = 0
-      do i=startUnpackIdx, recvList % nlist
-         nUnpacked = nUnpacked + n
-         if (nUnpacked &gt; nBuffer) then
-            nUnpacked = nUnpacked - n
-            lastUnpackedIdx = i - 1
-            return
-         end if
-         k = nUnpacked-n+1
-         do j=d2s,d2e
-            field(d1s:d1e,j,recvList % list(i)) = buffer(k:k+d1e-d1s)
-            k = k + d1e-d1s+1
-         end do
+      ! wait for mpi_isend to finish.
+      commListPtr =&gt; sendList
+      do while(associated(commListPtr))
+        call MPI_Wait(commListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
+        commListPtr =&gt; commListPtr % next
       end do
-      lastUnpackedIdx = recvList % nlist
 
-   end subroutine mpas_unpack_recv_buf3d_integer!}}}
+     ! Destroy commLists.
+     call mpas_dmpar_destroy_communication_list(sendList)
+     call mpas_dmpar_destroy_communication_list(recvList)
+#endif
 
-   subroutine mpas_dmpar_exch_halo_field1d_integer(field, haloLayers)!{{{
+   end subroutine mpas_dmpar_exch_halo_field2d_integer!}}}
 
+   subroutine mpas_dmpar_exch_halo_field3d_integer(field, haloLayersIn)!{{{
+
       implicit none
 
-      type (field1DInteger), intent(inout) :: field
-      integer, dimension(:), intent(in), optional :: haloLayers
+      type (field3DInteger), pointer :: field
+      integer, dimension(:), intent(in), optional :: haloLayersIn
 
-      type (dm_info) :: dminfo
-      type (exchange_list), pointer :: sendList, recvList
-      type (exchange_list), pointer :: sendListPtr, recvListPtr
-      integer :: lastPackedIdx, lastUnpackedIdx, nPacked, nUnpacked
+      type (dm_info), pointer :: dminfo
+      type (field3DInteger), pointer :: fieldCursor, fieldCursor2
+      type (mpas_exchange_list), pointer :: exchListPtr
+      type (mpas_communication_list), pointer :: sendList, recvList, commListPtr, commListPtr2
       integer :: mpi_ierr
-      integer, dimension(size(field % dimSizes)) :: dims
+      integer :: nHaloLayers, iHalo, i, j, k
+      integer :: bufferOffset, nAdded
+      integer, dimension(:), pointer :: haloLayers
 
+      logical comm_list_found
+
+      dminfo =&gt; field % block % domain % dminfo
+
+      if(present(haloLayersIn)) then
+        nHaloLayers = size(haloLayersIn)
+        allocate(haloLayers(nHaloLayers))
+        do iHalo = 1, nHaloLayers
+          haloLayers(iHalo) = haloLayersIn(iHalo)
+        end do
+      else
+        nHaloLayers = size(field % sendList)
+        allocate(haloLayers(nHaloLayers))
+        do iHalo = 1, nHaloLayers
+          haloLayers(iHalo) = iHalo
+        end do
+      end if
+
 #ifdef _MPI
+      allocate(sendList)
+      nullify(sendList % next)
+      sendList % procID = -1
 
+      allocate(recvList)
+      nullify(recvList % next)
+      recvList % procID = -1
+
       dminfo   = field % block % domain % dminfo
-      dims = field % dimSizes
 
-      call mpas_aggregate_exchange_lists(dminfo % my_proc_id, haloLayers, field % sendList, field % recvList, sendList, recvList)
+      ! Determine size of buffers for communication lists
+      fieldCursor =&gt; field
+      do while(associated(fieldCursor))
 
-      recvListPtr =&gt; recvList
-      do while (associated(recvListPtr))
-         if (recvListPtr % procID /= dminfo % my_proc_id) then
-            allocate(recvListPtr % ibuffer(recvListPtr % nlist))
-            call MPI_Irecv(recvListPtr % ibuffer, recvListPtr % nlist, MPI_INTEGERKIND, &amp;
-                           recvListPtr % procID, recvListPtr % procID, dminfo % comm, recvListPtr % reqID, mpi_ierr)
-         end if
-         recvListPtr =&gt; recvListPtr % next
-      end do
-      
-      sendListPtr =&gt; sendList
-      do while (associated(sendListPtr))
-         if (sendListPtr % procID /= dminfo % my_proc_id) then
-            allocate(sendListPtr % ibuffer(sendListPtr % nlist))
-            call mpas_pack_send_buf1d_integer(dims(1), field % array, sendListPtr, 1, sendListPtr % nlist, sendListPtr % ibuffer, nPacked, lastPackedIdx)
-            call MPI_Isend(sendListPtr % ibuffer, sendListPtr % nlist, MPI_INTEGERKIND, &amp;
-                           sendListPtr % procID, dminfo % my_proc_id, dminfo % comm, sendListPtr % reqID, mpi_ierr)
-         end if
-         sendListPtr =&gt; sendListPtr % next
-      end do
+        ! Need to aggregate across halo layers
+        do iHalo = 1, nHaloLayers
+          
+          ! Determine size from send lists
+          exchListPtr =&gt; fieldCursor % sendList(haloLayers(iHalo))
+          do while(associated(exchListPtr))
+            comm_list_found = .false.
 
-      recvListPtr =&gt; recvList
-      do while (associated(recvListPtr))
-         if (recvListPtr % procID /= dminfo % my_proc_id) then
-            call MPI_Wait(recvListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
-            call mpas_unpack_recv_buf1d_integer(dims(1), field % array, recvListPtr, 1, recvListPtr % nlist, recvListPtr % ibuffer, nUnpacked, lastUnpackedIdx)
-            deallocate(recvListPtr % ibuffer)
-         end if
-         recvListPtr =&gt; recvListPtr % next
-      end do
-      
-      sendListPtr =&gt; sendList
-      do while (associated(sendListPtr))
-         if (sendListPtr % procID /= dminfo % my_proc_id) then
-            call MPI_Wait(sendListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
-            deallocate(sendListPtr % ibuffer)
-         end if
-         sendListPtr =&gt; sendListPtr % next
-      end do
+            commListPtr =&gt; sendList
+            do while(associated(commListPtr))
+              if(commListPtr % procID == exchListPtr % endPointId) then
+                comm_list_found = .true.
+                commListPtr % nList = commListPtr % nList + exchListPtr % nList * fieldCursor % dimSizes(1) * fieldCursor % dimSizes(2)
+                exit
+              end if
 
-      call mpas_destroy_exchange_list(sendList)
-      call mpas_destroy_exchange_list(recvList)
+              commListPtr =&gt; commListPtr % next
+            end do
 
-#endif
+            if(.not. comm_list_found) then
+              commListPtr =&gt; sendList
+              commListPtr2 =&gt; commListPtr % next
+              do while(associated(commListPtr2))
+                commListPtr =&gt; commListPtr % next
+                commListPtr2 =&gt; commListPtr % next
+              end do
 
-   end subroutine mpas_dmpar_exch_halo_field1d_integer!}}}
+              allocate(commListPtr % next)
+              commListPtr =&gt; commListPtr % next
+              nullify(commListPtr % next)
+              commListPtr % procID = exchListPtr % endPointID
+              commListPtr % nList = exchListPtr % nList * fieldCursor % dimSizes(1) * fieldCursor % dimSizes(2)
+            end if
 
-   subroutine mpas_dmpar_exch_halo_field2d_integer(field, haloLayers)!{{{
+            exchListPtr =&gt; exchListPtr % next
+          end do
 
-      implicit none
+          ! Determine size from recv lists
+          exchListPtr =&gt; fieldCursor % recvList(haloLayers(iHalo))
+          do while(associated(exchListPtr))
+            comm_list_found = .false.
 
-      type (field2DInteger), intent(inout) :: field
-      integer, dimension(:), intent(in), optional :: haloLayers
+            commListPtr =&gt; recvList
+            do while(associated(commListPtr))
+              if(commListPtr % procID == exchListPtr % endPointId) then
+                comm_list_found = .true.
+                commListPtr % nList = commListPtr % nList + exchListPtr % nList * fieldCursor % dimSizes(1) * fieldCursor % dimSizes(2)
+                exit
+              end if
 
-      type (dm_info) :: dminfo
-      type (exchange_list), pointer :: sendList, recvList
-      type (exchange_list), pointer :: sendListPtr, recvListPtr
-      integer :: lastPackedIdx, lastUnpackedIdx, nPacked, nUnpacked
-      integer :: mpi_ierr
-      integer :: d2
-      integer, dimension(size(field % dimSizes)) :: dims
+              commListPtr =&gt; commListPtr % next
+            end do
 
-#ifdef _MPI
+            if(.not. comm_list_found) then
+              commListPtr =&gt; recvList
+              commListPtr2 =&gt; commListPtr % next
+              do while(associated(commListPtr2))
+                commListPtr =&gt; commListPtr % next
+                commListPtr2 =&gt; commListPtr % next
+              end do
 
-      dminfo   = field % block % domain % dminfo
-      dims = field % dimSizes
+              allocate(commListPtr % next)
+              commListPtr =&gt; commListPtr % next
+              nullify(commListPtr % next)
+              commListPtr % procID = exchListPtr % endPointID
+              commListPtr % nList = exchListPtr % nList * fieldCursor % dimSizes(1) * fieldCursor % dimSizes(2)
+            end if
 
-      call mpas_aggregate_exchange_lists(dminfo % my_proc_id, haloLayers, field % sendList, field % recvList, sendList, recvList)
+            exchListPtr =&gt; exchListPtr % next
+          end do
+        end do
 
-      recvListPtr =&gt; recvList
-      do while (associated(recvListPtr))
-         if (recvListPtr % procID /= dminfo % my_proc_id) then
-            d2 = dims(1) * recvListPtr % nlist
-            allocate(recvListPtr % ibuffer(d2))
-            call MPI_Irecv(recvListPtr % ibuffer, d2, MPI_INTEGERKIND, &amp;
-                           recvListPtr % procID, recvListPtr % procID, dminfo % comm, recvListPtr % reqID, mpi_ierr)
-         end if
-         recvListPtr =&gt; recvListPtr % next
+        fieldCursor =&gt; fieldCursor % next
       end do
-      
-      sendListPtr =&gt; sendList
-      do while (associated(sendListPtr))
-         if (sendListPtr % procID /= dminfo % my_proc_id) then
-            d2 = dims(1) * sendListPtr % nlist
-            allocate(sendListPtr % ibuffer(d2))
-            call mpas_pack_send_buf2d_integer(1, dims(1), dims(2), field % array, sendListPtr, 1, d2, sendListPtr % ibuffer, nPacked, lastPackedIdx)
-            call MPI_Isend(sendListPtr % ibuffer, d2, MPI_INTEGERKIND, &amp;
-                           sendListPtr % procID, dminfo % my_proc_id, dminfo % comm, sendListPtr % reqID, mpi_ierr)
-         end if
-         sendListPtr =&gt; sendListPtr % next
-      end do
 
-      recvListPtr =&gt; recvList
-      do while (associated(recvListPtr))
-         if (recvListPtr % procID /= dminfo % my_proc_id) then
-            call MPI_Wait(recvListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
-            d2 = dims(1) * recvListPtr % nlist
-            call mpas_unpack_recv_buf2d_integer(1, dims(1), dims(2), field % array, recvListPtr, 1, d2, recvListPtr % ibuffer, nUnpacked, lastUnpackedIdx)
-            deallocate(recvListPtr % ibuffer)
-         end if
-         recvListPtr =&gt; recvListPtr % next
-      end do
-      
-      sendListPtr =&gt; sendList
-      do while (associated(sendListPtr))
-         if (sendListPtr % procID /= dminfo % my_proc_id) then
-            call MPI_Wait(sendListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
-            deallocate(sendListPtr % ibuffer)
-         end if
-         sendListPtr =&gt; sendListPtr % next
-      end do
+      ! Remove the dead head pointer on send and recv list
+      commListPtr =&gt; sendList
+      sendList =&gt; sendList % next
+      deallocate(commListPtr)
 
-      call mpas_destroy_exchange_list(sendList)
-      call mpas_destroy_exchange_list(recvList)
+      commListPtr =&gt; recvList
+      recvList =&gt; recvList % next
+      deallocate(commListPtr)
 
-#endif
+      ! Allocate space in recv lists, and initiate mpi_irecv calls
+      commListPtr =&gt; recvList
+      do while(associated(commListPtr))
+        allocate(commListPtr % ibuffer(commListPtr % nList))
+        call MPI_Irecv(commListPtr % ibuffer, commListPtr % nList, MPI_INTEGERKIND, commListPtr % procID, commListPtr % procID, dminfo % comm, commListPtr % reqID, mpi_ierr)
 
-   end subroutine mpas_dmpar_exch_halo_field2d_integer!}}}
+        commListPtr =&gt; commListPtr % next
+      end do
 
-   subroutine mpas_dmpar_exch_halo_field3d_integer(field, haloLayers)!{{{
+      ! Allocate space in send lists, copy data into buffer, and initiate mpi_isend calls
+      commListPtr =&gt; sendList
+      do while(associated(commListPtr))
+        allocate(commListPtr % ibuffer(commListPtr % nList))
+        bufferOffset = 0
+        do iHalo = 1, nHaloLayers
+          nAdded = 0
+          fieldCursor =&gt; field
+          do while(associated(fieldCursor))
+            exchListPtr =&gt; fieldCursor % sendList(haloLayers(iHalo))
+            do while(associated(exchListPtr))
+              if(exchListPtr % endPointID == commListPtr % procID) then
+                do  i = 1, exchListPtr % nList
+                  do j = 1, fieldCursor % dimSizes(2)
+                    do k = 1, fieldCursor % dimSizes(1)
+                      commListPtr % ibuffer((exchListPtr % destList(i)-1) * fieldCursor % dimSizes(1) * fieldCursor % dimSizes(2) &amp;
+                          + (j-1) * fieldCursor % dimSizes(1) + k  + bufferOffset) = fieldCursor % array(k, j, exchListPtr % srcList(i))
+                      nAdded = nAdded + 1
+                    end do
+                  end do
+                end do
+              end if
 
-      implicit none
+              exchListPtr =&gt; exchListPtr % next
+            end do
 
-      type (field3DInteger), intent(inout) :: field
-      integer, dimension(:), intent(in), optional :: haloLayers
+            fieldCursor =&gt; fieldCursor % next
+          end do
+          bufferOffset = bufferOffset + nAdded
+        end do
 
-      type (dm_info) :: dminfo
-      type (exchange_list), pointer :: sendList, recvList
-      type (exchange_list), pointer :: sendListPtr, recvListPtr
-      integer :: lastPackedIdx, lastUnpackedIdx, nPacked, nUnpacked
-      integer :: mpi_ierr
-      integer :: d3
-      integer, dimension(size(field % dimSizes)) :: dims
+        call MPI_Isend(commListPtr % ibuffer, commListPtr % nList, MPI_INTEGERKIND, commListPtr % procID, dminfo % my_proc_id, dminfo % comm, commListPtr % reqID, mpi_ierr)
+        commListPtr =&gt; commListPtr % next
+      end do
+#endif
 
-#ifdef _MPI
+      ! Handle local copy. If MPI is off, then only local copies are performed.
+      fieldCursor =&gt; field
+      do while(associated(field))
+        do iHalo = 1, nHaloLayers
+          exchListPtr =&gt; fieldCursor % copyList(haloLayers(iHalo))
 
-      dminfo   = field % block % domain % dminfo
-      dims = field % dimSizes
+          do while(associated(exchListPtr))
+            fieldCursor2 =&gt; field
+            do while(associated(fieldCursor2))
+              if(exchListPtr % endPointID == fieldCursor2 % block % localBlockID) then
+                do i = 1, exchListPtr % nList
+                  fieldCursor2 % array(:, :, exchListPtr % destList(i)) = fieldCursor % array(:, :, exchListPtr % srcList(i))
+                end do
+              end if
+              
+              fieldCursor2 =&gt; fieldCursor2 % next
+            end do
 
-      call mpas_aggregate_exchange_lists(dminfo % my_proc_id, haloLayers, field % sendList, field % recvList, sendList, recvList)
+            exchListPtr =&gt; exchListPtr % next
+          end do
+        end do
 
-      recvListPtr =&gt; recvList
-      do while (associated(recvListPtr))
-         if (recvListPtr % procID /= dminfo % my_proc_id) then
-            d3 = dims(1) * dims(2) * recvListPtr % nlist
-            allocate(recvListPtr % ibuffer(d3))
-            call MPI_Irecv(recvListPtr % ibuffer, d3, MPI_INTEGERKIND, &amp;
-                           recvListPtr % procID, recvListPtr % procID, dminfo % comm, recvListPtr % reqID, mpi_ierr)
-         end if
-         recvListPtr =&gt; recvListPtr % next
+        fieldCursor =&gt; fieldCursor % next
       end do
 
-      sendListPtr =&gt; sendList
-      do while (associated(sendListPtr))
-         if (sendListPtr % procID /= dminfo % my_proc_id) then
-            d3 = dims(1) * dims(2) * sendListPtr % nlist
-            allocate(sendListPtr % ibuffer(d3))
-            call mpas_pack_send_buf3d_integer(1, dims(1), 1, dims(2), dims(3), field % array, sendListPtr, 1, d3, &amp;
-                                   sendListPtr % ibuffer, nPacked, lastPackedIdx)
-            call MPI_Isend(sendListPtr % ibuffer, d3, MPI_INTEGERKIND, &amp;
-                           sendListPtr % procID, dminfo % my_proc_id, dminfo % comm, sendListPtr % reqID, mpi_ierr)
-         end if
-         sendListPtr =&gt; sendListPtr % next
-      end do
+#ifdef _MPI
 
-      recvListPtr =&gt; recvList
-      do while (associated(recvListPtr))
-         if (recvListPtr % procID /= dminfo % my_proc_id) then
-            call MPI_Wait(recvListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
-            d3 = dims(1) * dims(2) * recvListPtr % nlist
-            call mpas_unpack_recv_buf3d_integer(1, dims(1), 1, dims(2), dims(3), field % array, recvListPtr, 1, d3, &amp;
-                                     recvListPtr % ibuffer, nUnpacked, lastUnpackedIdx)
-            deallocate(recvListPtr % ibuffer)
-         end if
-         recvListPtr =&gt; recvListPtr % next
+      ! Wait for mpi_irecv to finish, and unpack data from buffer
+      commListPtr =&gt; recvList
+      do while(associated(commListPtr))
+        call MPI_Wait(commListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
+        bufferOffset = 0
+        do iHalo = 1, nHaloLayers
+          nAdded = 0
+          fieldCursor =&gt; field
+          do while(associated(fieldCursor))
+            exchListPtr =&gt; fieldCursor % recvList(iHalo)
+            do while(associated(exchListPtr))
+              if(exchListPtr % endPointID == commListPtr % procID) then
+                do i = 1, exchListPtr % nList
+                  do j = 1, fieldCursor % dimSizes(2)
+                    do k = 1, fieldCursor % dimSizes(1)
+                      fieldCursor % array(k, j, exchListPtr % destList(i)) = commListPtr % ibuffer((exchListPtr % srcList(i)-1)*fieldCursor % dimSizes(1) * fieldCursor % dimSizes(2) &amp;
+                                                                           + (j-1)*fieldCursor % dimSizes(1) + k + bufferOffset)
+                      nAdded = nAdded + 1
+                    end do
+                  end do
+                end do
+              end if
+              exchListPtr =&gt; exchListPtr % next
+            end do
+            
+            fieldCursor =&gt; fieldCursor % next
+          end do
+          bufferOffset = bufferOffset + nAdded
+        end do
+        commListPtr =&gt; commListPtr % next
       end do
 
-      sendListPtr =&gt; sendList
-      do while (associated(sendListPtr))
-         if (sendListPtr % procID /= dminfo % my_proc_id) then
-            call MPI_Wait(sendListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
-            deallocate(sendListPtr % ibuffer)
-         end if
-         sendListPtr =&gt; sendListPtr % next
+      ! wait for mpi_isend to finish.
+      commListPtr =&gt; sendList
+      do while(associated(commListPtr))
+        call MPI_Wait(commListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
+        commListPtr =&gt; commListPtr % next
       end do
 
-      call mpas_destroy_exchange_list(sendList)
-      call mpas_destroy_exchange_list(recvList)
-
+     ! Destroy commLists.
+     call mpas_dmpar_destroy_communication_list(sendList)
+     call mpas_dmpar_destroy_communication_list(recvList)
 #endif
 
    end subroutine mpas_dmpar_exch_halo_field3d_integer!}}}
-  
-   subroutine mpas_unpack_recv_buf1d_real(nField, field, recvList, startUnpackIdx, nBuffer, buffer, nUnpacked, lastUnpackedIdx)!{{{
 
+   subroutine mpas_dmpar_exch_halo_field1d_real(field, haloLayersIn)!{{{
+
       implicit none
 
-      integer, intent(in) :: nField, nBuffer, startUnpackIdx
-      real (kind=RKIND), dimension(*), intent(inout) :: field
-      type (exchange_list), intent(in) :: recvList
-      real (kind=RKIND), dimension(nBuffer), intent(in) :: buffer
-      integer, intent(inout) :: nUnpacked, lastUnpackedIdx
+      type (field1dReal), pointer :: field
+      integer, dimension(:), intent(in), optional :: haloLayersIn
 
-      integer :: i
+      type (dm_info), pointer :: dminfo
+      type (field1dReal), pointer :: fieldCursor, fieldCursor2
+      type (mpas_exchange_list), pointer :: exchListPtr
+      type (mpas_communication_list), pointer :: sendList, recvList, commListPtr, commListPtr2
+      integer :: mpi_ierr
+      integer :: nHaloLayers, iHalo, i
+      integer :: bufferOffset, nAdded
+      integer, dimension(:), pointer :: haloLayers
 
-      nUnpacked = 0
-      do i=startUnpackIdx, recvList % nlist
-         nUnpacked = nUnpacked + 1
-         if (nUnpacked &gt; nBuffer) then
-            nUnpacked = nUnpacked - 1
-            lastUnpackedIdx = i - 1
-            return
-         end if
-         field(recvList % list(i)) = buffer(nUnpacked)
-      end do
-      lastUnpackedIdx = recvList % nlist
+      logical comm_list_found
 
-   end subroutine mpas_unpack_recv_buf1d_real!}}}
+      dminfo =&gt; field % block % domain % dminfo
 
-   subroutine mpas_unpack_recv_buf2d_real(ds, de, nField, field, recvList, startUnpackIdx, nBuffer, buffer, nUnpacked, lastUnpackedIdx)!{{{
+      if(present(haloLayersIn)) then
+        nHaloLayers = size(haloLayersIn)
+        allocate(haloLayers(nHaloLayers))
+        do iHalo = 1, nHaloLayers
+          haloLayers(iHalo) = haloLayersIn(iHalo)
+        end do
+      else
+        nHaloLayers = size(field % sendList)
+        allocate(haloLayers(nHaloLayers))
+        do iHalo = 1, nHaloLayers
+          haloLayers(iHalo) = iHalo
+        end do
+      end if
 
-      implicit none
+#ifdef _MPI
+      allocate(sendList)
+      nullify(sendList % next)
+      sendList % procID = -1
 
-      integer, intent(in) :: ds, de, nField, nBuffer, startUnpackIdx
-      real (kind=RKIND), dimension(ds:de,*), intent(inout) :: field
-      type (exchange_list), intent(in) :: recvList
-      real (kind=RKIND), dimension(nBuffer), intent(in) :: buffer
-      integer, intent(inout) :: nUnpacked, lastUnpackedIdx
+      allocate(recvList)
+      nullify(recvList % next)
+      recvList % procID = -1
 
-      integer :: i, n
+      dminfo   = field % block % domain % dminfo
 
-      n = de-ds+1
+      ! Determine size of buffers for communication lists
+      fieldCursor =&gt; field
+      do while(associated(fieldCursor))
 
-      nUnpacked = 0
-      do i=startUnpackIdx, recvList % nlist
-         nUnpacked = nUnpacked + n
-         if (nUnpacked &gt; nBuffer) then
-            nUnpacked = nUnpacked - n
-            lastUnpackedIdx = i - 1
-            return
-         end if
-         field(ds:de,recvList % list(i)) = buffer(nUnpacked-n+1:nUnpacked)
-      end do
-      lastUnpackedIdx = recvList % nlist
+        ! Need to aggregate across halo layers
+        do iHalo = 1, nHaloLayers
+          
+          ! Determine size from send lists
+          exchListPtr =&gt; fieldCursor % sendList(haloLayers(iHalo))
+          do while(associated(exchListPtr))
+            comm_list_found = .false.
 
-   end subroutine mpas_unpack_recv_buf2d_real!}}}
+            commListPtr =&gt; sendList
+            do while(associated(commListPtr))
+              if(commListPtr % procID == exchListPtr % endPointId) then
+                comm_list_found = .true.
+                commListPtr % nList = commListPtr % nList + exchListPtr % nList
+                exit
+              end if
 
-   subroutine mpas_unpack_recv_buf3d_real(d1s, d1e, d2s, d2e, nField, field, recvList, startUnpackIdx, nBuffer, buffer, &amp;!{{{
-                                  nUnpacked, lastUnpackedIdx)
+              commListPtr =&gt; commListPtr % next
+            end do
 
-      implicit none
+            if(.not. comm_list_found) then
+              commListPtr =&gt; sendList
+              commListPtr2 =&gt; commListPtr % next
+              do while(associated(commListPtr2))
+                commListPtr =&gt; commListPtr % next
+                commListPtr2 =&gt; commListPtr % next
+              end do
 
-      integer, intent(in) :: d1s, d1e, d2s, d2e, nField, nBuffer, startUnpackIdx
-      real (kind=RKIND), dimension(d1s:d1e,d2s:d2e,*), intent(inout) :: field
-      type (exchange_list), intent(in) :: recvList
-      real (kind=RKIND), dimension(nBuffer), intent(in) :: buffer
-      integer, intent(inout) :: nUnpacked, lastUnpackedIdx
+              allocate(commListPtr % next)
+              commListPtr =&gt; commListPtr % next
+              nullify(commListPtr % next)
+              commListPtr % procID = exchListPtr % endPointID
+              commListPtr % nList = exchListPtr % nList
+            end if
 
-      integer :: i, j, k, n
+            exchListPtr =&gt; exchListPtr % next
+          end do
 
-      n = (d1e-d1s+1) * (d2e-d2s+1)
+          ! Determine size from recv lists
+          exchListPtr =&gt; fieldCursor % recvList(haloLayers(iHalo))
+          do while(associated(exchListPtr))
+            comm_list_found = .false.
 
-      nUnpacked = 0
-      do i=startUnpackIdx, recvList % nlist
-         nUnpacked = nUnpacked + n
-         if (nUnpacked &gt; nBuffer) then
-            nUnpacked = nUnpacked - n
-            lastUnpackedIdx = i - 1
-            return
-         end if
-         k = nUnpacked-n+1
-         do j=d2s,d2e
-            field(d1s:d1e,j,recvList % list(i)) = buffer(k:k+d1e-d1s)
-            k = k + d1e-d1s+1
-         end do
-      end do
-      lastUnpackedIdx = recvList % nlist
+            commListPtr =&gt; recvList
+            do while(associated(commListPtr))
+              if(commListPtr % procID == exchListPtr % endPointId) then
+                comm_list_found = .true.
+                commListPtr % nList = commListPtr % nList + exchListPtr % nList
+                exit
+              end if
 
-   end subroutine mpas_unpack_recv_buf3d_real!}}}
+              commListPtr =&gt; commListPtr % next
+            end do
 
-   subroutine mpas_dmpar_exch_halo_field1d_real(field, haloLayers)!{{{
+            if(.not. comm_list_found) then
+              commListPtr =&gt; recvList
+              commListPtr2 =&gt; commListPtr % next
+              do while(associated(commListPtr2))
+                commListPtr =&gt; commListPtr % next
+                commListPtr2 =&gt; commListPtr % next
+              end do
 
-      implicit none
+              allocate(commListPtr % next)
+              commListPtr =&gt; commListPtr % next
+              nullify(commListPtr % next)
+              commListPtr % procID = exchListPtr % endPointID
+              commListPtr % nList = exchListPtr % nList
+            end if
 
-      type (field1DReal), intent(inout) :: field
-      integer, dimension(:), intent(in), optional :: haloLayers
+            exchListPtr =&gt; exchListPtr % next
+          end do
+        end do
 
-      type (dm_info) :: dminfo
-      type (exchange_list), pointer :: sendList, recvList
-      type (exchange_list), pointer :: sendListPtr, recvListPtr
-      integer :: lastPackedIdx, lastUnpackedIdx, nPacked, nUnpacked
-      integer :: mpi_ierr
-      integer, dimension(size(field % dimSizes)) :: dims
+        fieldCursor =&gt; fieldCursor % next
+      end do
 
-#ifdef _MPI
+      ! Remove the dead head pointer on send and recv list
+      commListPtr =&gt; sendList
+      sendList =&gt; sendList % next
+      deallocate(commListPtr)
 
-      dminfo   = field % block % domain % dminfo
-      dims = field % dimSizes
+      commListPtr =&gt; recvList
+      recvList =&gt; recvList % next
+      deallocate(commListPtr)
 
-      call mpas_aggregate_exchange_lists(dminfo % my_proc_id, haloLayers, field % sendList, field % recvList, sendList, recvList)
+      ! Allocate space in recv lists, and initiate mpi_irecv calls
+      commListPtr =&gt; recvList
+      do while(associated(commListPtr))
+        allocate(commListPtr % rbuffer(commListPtr % nList))
+        call MPI_Irecv(commListPtr % rbuffer, commListPtr % nList, MPI_REALKIND, commListPtr % procID, commListPtr % procID, dminfo % comm, commListPtr % reqID, mpi_ierr)
 
-      recvListPtr =&gt; recvList
-      do while (associated(recvListPtr))
-         if (recvListPtr % procID /= dminfo % my_proc_id) then
-            allocate(recvListPtr % rbuffer(recvListPtr % nlist))
-            call MPI_Irecv(recvListPtr % rbuffer, recvListPtr % nlist, MPI_REALKIND, &amp;
-                           recvListPtr % procID, recvListPtr % procID, dminfo % comm, recvListPtr % reqID, mpi_ierr)
-         end if
-         recvListPtr =&gt; recvListPtr % next
+        commListPtr =&gt; commListPtr % next
       end do
 
-      sendListPtr =&gt; sendList
-      do while (associated(sendListPtr))
-         if (sendListPtr % procID /= dminfo % my_proc_id) then
-            allocate(sendListPtr % rbuffer(sendListPtr % nlist))
-            call mpas_pack_send_buf1d_real(dims(1), field % array, sendListPtr, 1, sendListPtr % nlist, sendListPtr % rbuffer, nPacked, lastPackedIdx)
-            call MPI_Isend(sendListPtr % rbuffer, sendListPtr % nlist, MPI_REALKIND, &amp;
-                           sendListPtr % procID, dminfo % my_proc_id, dminfo % comm, sendListPtr % reqID, mpi_ierr)
-         end if
-         sendListPtr =&gt; sendListPtr % next
+      ! Allocate space in send lists, copy data into buffer, and initiate mpi_isend calls
+      commListPtr =&gt; sendList
+      do while(associated(commListPtr))
+        allocate(commListPtr % rbuffer(commListPtr % nList))
+        bufferOffset = 0
+        do iHalo = 1, nHaloLayers
+          nAdded = 0
+          fieldCursor =&gt; field
+          do while(associated(fieldCursor))
+            exchListPtr =&gt; fieldCursor % sendList(haloLayers(iHalo))
+            do while(associated(exchListPtr))
+              if(exchListPtr % endPointID == commListPtr % procID) then
+                do  i = 1, exchListPtr % nList
+                  commListPtr % rbuffer(exchListPtr % destList(i) + bufferOffset) = fieldCursor % array(exchListPtr % srcList(i))
+                  nAdded = nAdded + 1
+                end do
+              end if
+
+              exchListPtr =&gt; exchListPtr % next
+            end do
+
+            fieldCursor =&gt; fieldCursor % next
+          end do
+          bufferOffset = bufferOffset + nAdded
+        end do
+
+        call MPI_Isend(commListPtr % rbuffer, commListPtr % nList, MPI_REALKIND, commListPtr % procID, dminfo % my_proc_id, dminfo % comm, commListPtr % reqID, mpi_ierr)
+        commListPtr =&gt; commListPtr % next
       end do
+#endif
 
-      recvListPtr =&gt; recvList
-      do while (associated(recvListPtr))
-         if (recvListPtr % procID /= dminfo % my_proc_id) then
-            call MPI_Wait(recvListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
-            call mpas_unpack_recv_buf1d_real(dims(1), field % array, recvListPtr, 1, recvListPtr % nlist, recvListPtr % rbuffer, nUnpacked, lastUnpackedIdx)
-            deallocate(recvListPtr % rbuffer)
-         end if
-         recvListPtr =&gt; recvListPtr % next
+      ! Handle local copy. If MPI is off, then only local copies are performed.
+      fieldCursor =&gt; field
+      do while(associated(field))
+        do iHalo = 1, nHaloLayers
+          exchListPtr =&gt; fieldCursor % copyList(haloLayers(iHalo))
+
+          do while(associated(exchListPtr))
+            fieldCursor2 =&gt; field
+            do while(associated(fieldCursor2))
+              if(exchListPtr % endPointID == fieldCursor2 % block % localBlockID) then
+                do i = 1, exchListPtr % nList
+                  fieldCursor2 % array(exchListPtr % destList(i)) = fieldCursor % array(exchListPtr % srcList(i))
+                end do
+              end if
+              
+              fieldCursor2 =&gt; fieldCursor2 % next
+            end do
+
+            exchListPtr =&gt; exchListPtr % next
+          end do
+        end do
+
+        fieldCursor =&gt; fieldCursor % next
       end do
-      
-      sendListPtr =&gt; sendList
-      do while (associated(sendListPtr))
-         if (sendListPtr % procID /= dminfo % my_proc_id) then
-            call MPI_Wait(sendListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
-            deallocate(sendListPtr % rbuffer)
-         end if
-         sendListPtr =&gt; sendListPtr % next
+
+#ifdef _MPI
+
+      ! Wait for mpi_irecv to finish, and unpack data from buffer
+      commListPtr =&gt; recvList
+      do while(associated(commListPtr))
+        call MPI_Wait(commListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
+        bufferOffset = 0
+        do iHalo = 1, nHaloLayers
+          nAdded = 0
+          fieldCursor =&gt; field
+          do while(associated(fieldCursor))
+            exchListPtr =&gt; fieldCursor % recvList(iHalo)
+            do while(associated(exchListPtr))
+              if(exchListPtr % endPointID == commListPtr % procID) then
+                do i = 1, exchListPtr % nList
+                  fieldCursor % array(exchListPtr % destList(i)) = commListPtr % rbuffer(exchListPtr % srcList(i) + bufferOffset)
+                  nAdded = nAdded + 1
+                end do
+              end if
+              exchListPtr =&gt; exchListPtr % next
+            end do
+            
+            fieldCursor =&gt; fieldCursor % next
+          end do
+          bufferOffset = bufferOffset + nAdded
+        end do
+        commListPtr =&gt; commListPtr % next
       end do
 
-      call mpas_destroy_exchange_list(sendList)
-      call mpas_destroy_exchange_list(recvList)
+      ! wait for mpi_isend to finish.
+      commListPtr =&gt; sendList
+      do while(associated(commListPtr))
+        call MPI_Wait(commListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
+        commListPtr =&gt; commListPtr % next
+      end do
 
+     ! Destroy commLists.
+     call mpas_dmpar_destroy_communication_list(sendList)
+     call mpas_dmpar_destroy_communication_list(recvList)
 #endif
 
    end subroutine mpas_dmpar_exch_halo_field1d_real!}}}
 
-   subroutine mpas_dmpar_exch_halo_field2d_real(field, haloLayers)!{{{
+   subroutine mpas_dmpar_exch_halo_field2d_real(field, haloLayersIn)!{{{
 
       implicit none
 
-      type (field2DReal), intent(inout) :: field
-      integer, dimension(:), intent(in), optional :: haloLayers
+      type (field2dReal), pointer :: field
+      integer, dimension(:), intent(in), optional :: haloLayersIn
 
-      type (dm_info) :: dminfo
-      type (exchange_list), pointer :: sendList, recvList
-      type (exchange_list), pointer :: sendListPtr, recvListPtr
-      integer :: lastPackedIdx, lastUnpackedIdx, nPacked, nUnpacked
+      type (dm_info), pointer :: dminfo
+      type (field2dReal), pointer :: fieldCursor, fieldCursor2
+      type (mpas_exchange_list), pointer :: exchListPtr
+      type (mpas_communication_list), pointer :: sendList, recvList, commListPtr, commListPtr2
       integer :: mpi_ierr
-      integer :: d2
-      integer, dimension(size(field % dimSizes)) :: dims
+      integer :: nHaloLayers, iHalo, i, j
+      integer :: bufferOffset, nAdded
+      integer, dimension(:), pointer :: haloLayers
 
+      logical comm_list_found
 
+      dminfo =&gt; field % block % domain % dminfo
+
+      if(present(haloLayersIn)) then
+        nHaloLayers = size(haloLayersIn)
+        allocate(haloLayers(nHaloLayers))
+        do iHalo = 1, nHaloLayers
+          haloLayers(iHalo) = haloLayersIn(iHalo)
+        end do
+      else
+        nHaloLayers = size(field % sendList)
+        allocate(haloLayers(nHaloLayers))
+        do iHalo = 1, nHaloLayers
+          haloLayers(iHalo) = iHalo
+        end do
+      end if
+
 #ifdef _MPI
+      allocate(sendList)
+      nullify(sendList % next)
+      sendList % procID = -1
 
+      allocate(recvList)
+      nullify(recvList % next)
+      recvList % procID = -1
+
       dminfo   = field % block % domain % dminfo
-      dims = field % dimSizes
 
-      call mpas_aggregate_exchange_lists(dminfo % my_proc_id, haloLayers, field % sendList, field % recvList, sendList, recvList)
+      ! Determine size of buffers for communication lists
+      fieldCursor =&gt; field
+      do while(associated(fieldCursor))
 
-      recvListPtr =&gt; recvList
-      do while (associated(recvListPtr))
-         if (recvListPtr % procID /= dminfo % my_proc_id) then
-            d2 = dims(1) * recvListPtr % nlist
-            allocate(recvListPtr % rbuffer(d2))
-            call MPI_Irecv(recvListPtr % rbuffer, d2, MPI_REALKIND, &amp;
-                           recvListPtr % procID, recvListPtr % procID, dminfo % comm, recvListPtr % reqID, mpi_ierr)
-         end if
-         recvListPtr =&gt; recvListPtr % next
-      end do
+        ! Need to aggregate across halo layers
+        do iHalo = 1, nHaloLayers
+          
+          ! Determine size from send lists
+          exchListPtr =&gt; fieldCursor % sendList(haloLayers(iHalo))
+          do while(associated(exchListPtr))
+            comm_list_found = .false.
 
-      sendListPtr =&gt; sendList
-      do while (associated(sendListPtr))
-         if (sendListPtr % procID /= dminfo % my_proc_id) then
-            d2 = dims(1) * sendListPtr % nlist
-            allocate(sendListPtr % rbuffer(d2))
-            call mpas_pack_send_buf2d_real(1, dims(1), dims(2), field % array, sendListPtr, 1, d2, sendListPtr % rbuffer, nPacked, lastPackedIdx)
-            call MPI_Isend(sendListPtr % rbuffer, d2, MPI_REALKIND, &amp;
-                           sendListPtr % procID, dminfo % my_proc_id, dminfo % comm, sendListPtr % reqID, mpi_ierr)
-         end if
-         sendListPtr =&gt; sendListPtr % next
-      end do
+            commListPtr =&gt; sendList
+            do while(associated(commListPtr))
+              if(commListPtr % procID == exchListPtr % endPointId) then
+                comm_list_found = .true.
+                commListPtr % nList = commListPtr % nList + exchListPtr % nList * fieldCursor % dimSizes(1)
+                exit
+              end if
 
-      recvListPtr =&gt; recvList
-      do while (associated(recvListPtr))
-         if (recvListPtr % procID /= dminfo % my_proc_id) then
-            call MPI_Wait(recvListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
-            d2 = dims(1) * recvListPtr % nlist
-            call mpas_unpack_recv_buf2d_real(1, dims(1), dims(2), field % array, recvListPtr, 1, d2, recvListPtr % rbuffer, nUnpacked, lastUnpackedIdx)
-            deallocate(recvListPtr % rbuffer)
-         end if
-         recvListPtr =&gt; recvListPtr % next
-      end do
+              commListPtr =&gt; commListPtr % next
+            end do
 
-      sendListPtr =&gt; sendList
-      do while (associated(sendListPtr))
-         if (sendListPtr % procID /= dminfo % my_proc_id) then
-            call MPI_Wait(sendListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
-            deallocate(sendListPtr % rbuffer)
-         end if
-         sendListPtr =&gt; sendListPtr % next
-      end do
+            if(.not. comm_list_found) then
+              commListPtr =&gt; sendList
+              commListPtr2 =&gt; commListPtr % next
+              do while(associated(commListPtr2))
+                commListPtr =&gt; commListPtr % next
+                commListPtr2 =&gt; commListPtr % next
+              end do
 
-      call mpas_destroy_exchange_list(sendList)
-      call mpas_destroy_exchange_list(recvList)
+              allocate(commListPtr % next)
+              commListPtr =&gt; commListPtr % next
+              nullify(commListPtr % next)
+              commListPtr % procID = exchListPtr % endPointID
+              commListPtr % nList = exchListPtr % nList * fieldCursor % dimSizes(1)
+            end if
 
-#endif
+            exchListPtr =&gt; exchListPtr % next
+          end do
 
-   end subroutine mpas_dmpar_exch_halo_field2d_real!}}}
+          ! Determine size from recv lists
+          exchListPtr =&gt; fieldCursor % recvList(haloLayers(iHalo))
+          do while(associated(exchListPtr))
+            comm_list_found = .false.
 
-   subroutine mpas_dmpar_exch_halo_field3d_real(field, haloLayers)!{{{
+            commListPtr =&gt; recvList
+            do while(associated(commListPtr))
+              if(commListPtr % procID == exchListPtr % endPointId) then
+                comm_list_found = .true.
+                commListPtr % nList = commListPtr % nList + exchListPtr % nList * fieldCursor % dimSizes(1)
+                exit
+              end if
 
-      implicit none
+              commListPtr =&gt; commListPtr % next
+            end do
 
-      type (field3DReal), intent(inout) :: field
-      integer, dimension(:), intent(in), optional :: haloLayers
+            if(.not. comm_list_found) then
+              commListPtr =&gt; recvList
+              commListPtr2 =&gt; commListPtr % next
+              do while(associated(commListPtr2))
+                commListPtr =&gt; commListPtr % next
+                commListPtr2 =&gt; commListPtr % next
+              end do
 
-      type (dm_info) :: dminfo
-      type (exchange_list), pointer :: sendList, recvList
-      type (exchange_list), pointer :: sendListPtr, recvListPtr
-      integer :: lastPackedIdx, lastUnpackedIdx, nPacked, nUnpacked
-      integer :: mpi_ierr
-      integer :: d3
-      integer, dimension(size(field % dimSizes)) :: dims
+              allocate(commListPtr % next)
+              commListPtr =&gt; commListPtr % next
+              nullify(commListPtr % next)
+              commListPtr % procID = exchListPtr % endPointID
+              commListPtr % nList = exchListPtr % nList * fieldCursor % dimSizes(1)
+            end if
 
-#ifdef _MPI
+            exchListPtr =&gt; exchListPtr % next
+          end do
+        end do
 
-      dminfo   = field % block % domain % dminfo
-      dims = field % dimSizes
+        fieldCursor =&gt; fieldCursor % next
+      end do
 
-      call mpas_aggregate_exchange_lists(dminfo % my_proc_id, haloLayers, field % sendList, field % recvList, sendList, recvList)
+      ! Remove the dead head pointer on send and recv list
+      commListPtr =&gt; sendList
+      sendList =&gt; sendList % next
+      deallocate(commListPtr)
 
-      recvListPtr =&gt; recvList
-      do while (associated(recvListPtr))
-         if (recvListPtr % procID /= dminfo % my_proc_id) then
-            d3 = dims(1) * dims(2) * recvListPtr % nlist
-            allocate(recvListPtr % rbuffer(d3))
-            call MPI_Irecv(recvListPtr % rbuffer, d3, MPI_REALKIND, &amp;
-                           recvListPtr % procID, recvListPtr % procID, dminfo % comm, recvListPtr % reqID, mpi_ierr)
-         end if
-         recvListPtr =&gt; recvListPtr % next
+      commListPtr =&gt; recvList
+      recvList =&gt; recvList % next
+      deallocate(commListPtr)
+
+      ! Allocate space in recv lists, and initiate mpi_irecv calls
+      commListPtr =&gt; recvList
+      do while(associated(commListPtr))
+        allocate(commListPtr % rbuffer(commListPtr % nList))
+        call MPI_Irecv(commListPtr % rbuffer, commListPtr % nList, MPI_REALKIND, commListPtr % procID, commListPtr % procID, dminfo % comm, commListPtr % reqID, mpi_ierr)
+
+        commListPtr =&gt; commListPtr % next
       end do
 
-      sendListPtr =&gt; sendList
-      do while (associated(sendListPtr))
-         if (sendListPtr % procID /= dminfo % my_proc_id) then
-            d3 = dims(1) * dims(2) * sendListPtr % nlist
-            allocate(sendListPtr % rbuffer(d3))
-            call mpas_pack_send_buf3d_real(1, dims(1), 1, dims(2), dims(3), field % array, sendListPtr, 1, d3, &amp;
-                                   sendListPtr % rbuffer, nPacked, lastPackedIdx)
-            call MPI_Isend(sendListPtr % rbuffer, d3, MPI_REALKIND, &amp;
-                           sendListPtr % procID, dminfo % my_proc_id, dminfo % comm, sendListPtr % reqID, mpi_ierr)
-         end if
-         sendListPtr =&gt; sendListPtr % next
+      ! Allocate space in send lists, copy data into buffer, and initiate mpi_isend calls
+      commListPtr =&gt; sendList
+      do while(associated(commListPtr))
+        allocate(commListPtr % rbuffer(commListPtr % nList))
+        bufferOffset = 0
+        do iHalo = 1, nHaloLayers
+          nAdded = 0
+          fieldCursor =&gt; field
+          do while(associated(fieldCursor))
+            exchListPtr =&gt; fieldCursor % sendList(haloLayers(iHalo))
+            do while(associated(exchListPtr))
+              if(exchListPtr % endPointID == commListPtr % procID) then
+                do  i = 1, exchListPtr % nList
+                  do j = 1, fieldCursor % dimSizes(1)
+                    commListPtr % rbuffer((exchListPtr % destList(i)-1) * fieldCursor % dimSizes(1) + j + bufferOffset) = fieldCursor % array(j, exchListPtr % srcList(i))
+                    nAdded = nAdded + 1
+                  end do
+                end do
+              end if
+
+              exchListPtr =&gt; exchListPtr % next
+            end do
+
+            fieldCursor =&gt; fieldCursor % next
+          end do
+          bufferOffset = bufferOffset + nAdded
+        end do
+
+        call MPI_Isend(commListPtr % rbuffer, commListPtr % nList, MPI_REALKIND, commListPtr % procID, dminfo % my_proc_id, dminfo % comm, commListPtr % reqID, mpi_ierr)
+        commListPtr =&gt; commListPtr % next
       end do
+#endif
 
-      recvListPtr =&gt; recvList
-      do while (associated(recvListPtr))
-         if (recvListPtr % procID /= dminfo % my_proc_id) then
-            call MPI_Wait(recvListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
-            d3 = dims(1) * dims(2) * recvListPtr % nlist
-            call mpas_unpack_recv_buf3d_real(1, dims(1), 1, dims(2), dims(3), field % array, recvListPtr, 1, d3, &amp;
-                                     recvListPtr % rbuffer, nUnpacked, lastUnpackedIdx)
-            deallocate(recvListPtr % rbuffer)
-         end if
-         recvListPtr =&gt; recvListPtr % next
+      ! Handle local copy. If MPI is off, then only local copies are performed.
+      fieldCursor =&gt; field
+      do while(associated(field))
+        do iHalo = 1, nHaloLayers
+          exchListPtr =&gt; fieldCursor % copyList(haloLayers(iHalo))
+
+          do while(associated(exchListPtr))
+            fieldCursor2 =&gt; field
+            do while(associated(fieldCursor2))
+              if(exchListPtr % endPointID == fieldCursor2 % block % localBlockID) then
+                do i = 1, exchListPtr % nList
+                  fieldCursor2 % array(:, exchListPtr % destList(i)) = fieldCursor % array(:, exchListPtr % srcList(i))
+                end do
+              end if
+              
+              fieldCursor2 =&gt; fieldCursor2 % next
+            end do
+
+            exchListPtr =&gt; exchListPtr % next
+          end do
+        end do
+
+        fieldCursor =&gt; fieldCursor % next
       end do
 
-      sendListPtr =&gt; sendList
-      do while (associated(sendListPtr))
-         if (sendListPtr % procID /= dminfo % my_proc_id) then
-            call MPI_Wait(sendListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
-            deallocate(sendListPtr % rbuffer)
-         end if
-         sendListPtr =&gt; sendListPtr % next
+#ifdef _MPI
+
+      ! Wait for mpi_irecv to finish, and unpack data from buffer
+      commListPtr =&gt; recvList
+      do while(associated(commListPtr))
+        call MPI_Wait(commListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
+        bufferOffset = 0
+        do iHalo = 1, nHaloLayers
+          nAdded = 0
+          fieldCursor =&gt; field
+          do while(associated(fieldCursor))
+            exchListPtr =&gt; fieldCursor % recvList(iHalo)
+            do while(associated(exchListPtr))
+              if(exchListPtr % endPointID == commListPtr % procID) then
+                do i = 1, exchListPtr % nList
+                  do j = 1, fieldCursor % dimSizes(1)
+                    fieldCursor % array(j, exchListPtr % destList(i)) = commListPtr % rbuffer((exchListPtr % srcList(i)-1)*fieldCursor % dimSizeS(1) + j + bufferOffset)
+                    nAdded = nAdded + 1
+                  end do
+                end do
+              end if
+              exchListPtr =&gt; exchListPtr % next
+            end do
+            
+            fieldCursor =&gt; fieldCursor % next
+          end do
+          bufferOffset = bufferOffset + nAdded
+        end do
+        commListPtr =&gt; commListPtr % next
       end do
 
-      call mpas_destroy_exchange_list(sendList)
-      call mpas_destroy_exchange_list(recvList)
+      ! wait for mpi_isend to finish.
+      commListPtr =&gt; sendList
+      do while(associated(commListPtr))
+        call MPI_Wait(commListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
+        commListPtr =&gt; commListPtr % next
+      end do
 
+     ! Destroy commLists.
+     call mpas_dmpar_destroy_communication_list(sendList)
+     call mpas_dmpar_destroy_communication_list(recvList)
 #endif
 
-   end subroutine mpas_dmpar_exch_halo_field3d_real!}}}
+   end subroutine mpas_dmpar_exch_halo_field2d_real!}}}
 
-   subroutine mpas_aggregate_exchange_lists(myProcID, haloLayersIn, sendListArray, recvListArray, aggregateSendList, aggregateRecvList)!{{{
+   subroutine mpas_dmpar_exch_halo_field3d_real(field, haloLayersIn)!{{{
 
       implicit none
 
-      !--- in variables ---!
-      integer, intent(in) :: myProcID
-      integer, dimension(:), intent(in), target, optional :: haloLayersIn
-      type (exchange_list), dimension(:), pointer :: sendListArray, recvListArray
-      
-      !--- out variabls ---!
-      type (exchange_list), pointer :: aggregateSendList, aggregateRecvList
+      type (field3dReal), pointer :: field
+      integer, dimension(:), intent(in), optional :: haloLayersIn
 
-      !--- local variables ---!
-      integer :: i, j
+      type (dm_info), pointer :: dminfo
+      type (field3dReal), pointer :: fieldCursor, fieldCursor2
+      type (mpas_exchange_list), pointer :: exchListPtr
+      type (mpas_communication_list), pointer :: sendList, recvList, commListPtr, commListPtr2
+      integer :: mpi_ierr
+      integer :: nHaloLayers, iHalo, i, j, k
+      integer :: bufferOffset, nAdded
       integer, dimension(:), pointer :: haloLayers
-      type (exchange_list), pointer :: inListPtr, aggListPtr
-      logical :: blockAdded
-      logical :: listInitilized
 
-      if (present(haloLayersIn)) then
-         haloLayers =&gt; haloLayersIn
+      logical comm_list_found
+
+      dminfo =&gt; field % block % domain % dminfo
+
+      if(present(haloLayersIn)) then
+        nHaloLayers = size(haloLayersIn)
+        allocate(haloLayers(nHaloLayers))
+        do iHalo = 1, nHaloLayers
+          haloLayers(iHalo) = haloLayersIn(iHalo)
+        end do
       else
-         allocate(haloLayers(size(sendListArray)))
-         do i=1, size(haloLayers)
-            haloLayers(i) = i
-         end do
+        nHaloLayers = size(field % sendList)
+        allocate(haloLayers(nHaloLayers))
+        do iHalo = 1, nHaloLayers
+          haloLayers(iHalo) = iHalo
+        end do
       end if
 
-      nullify(aggregateSendList)
-      nullify(aggregateRecvList)
+#ifdef _MPI
+      allocate(sendList)
+      nullify(sendList % next)
+      sendList % procID = -1
 
-      do i=1, size(haloLayers)
+      allocate(recvList)
+      nullify(recvList % next)
+      recvList % procID = -1
 
-         inListPtr =&gt; sendListArray(haloLayers(i)) % next
-         do while(associated(inListPtr))
+      dminfo   = field % block % domain % dminfo
 
-            blockAdded = .false.
-            aggListPtr =&gt; aggregateSendList
-            
-            do while(associated(aggListPtr))
-               if(inListPtr % blockID == aggListPtr % blockID) then
-                  if(inListPtr % procID .ne. myProcID) then
-                     call mpas_merge_integer_arrays(aggListPtr % list, aggListPtr % nlist, inListPtr % list)
-                  end if
-                  blockAdded = .true.
-                  exit
-               end if
-               aggListPtr =&gt; aggListPtr % next
+      ! Determine size of buffers for communication lists
+      fieldCursor =&gt; field
+      do while(associated(fieldCursor))
+
+        ! Need to aggregate across halo layers
+        do iHalo = 1, nHaloLayers
+          
+          ! Determine size from send lists
+          exchListPtr =&gt; fieldCursor % sendList(haloLayers(iHalo))
+          do while(associated(exchListPtr))
+            comm_list_found = .false.
+
+            commListPtr =&gt; sendList
+            do while(associated(commListPtr))
+              if(commListPtr % procID == exchListPtr % endPointId) then
+                comm_list_found = .true.
+                commListPtr % nList = commListPtr % nList + exchListPtr % nList * fieldCursor % dimSizes(1) * fieldCursor % dimSizes(2)
+                exit
+              end if
+
+              commListPtr =&gt; commListPtr % next
             end do
 
-            if(.not. blockAdded) then
-               
-               if (.not. associated(aggregateSendList)) then
-                  allocate(aggregateSendList)
-                  nullify(aggregateSendList % next)
-                  aggListPtr =&gt; aggregateSendList
-               else
-                  aggListPtr =&gt; aggregateSendList
-                  do while(associated(aggListPtr % next))
-                     aggListPtr =&gt; aggListPtr % next
-                  end do
-                  allocate(aggListPtr % next)
-                  aggListPtr =&gt; aggListPtr % next
-               end if
+            if(.not. comm_list_found) then
+              commListPtr =&gt; sendList
+              commListPtr2 =&gt; commListPtr % next
+              do while(associated(commListPtr2))
+                commListPtr =&gt; commListPtr % next
+                commListPtr2 =&gt; commListPtr % next
+              end do
 
-               nullify(aggListPtr % next)
-               aggListPtr % procID  = inListPtr % procID
-               aggListPtr % blockID = inListPtr % blockID
-               aggListPtr % nlist   = inListPtr % nlist
-               allocate(aggListPtr % list(inListPtr % nlist)) 
-               aggListPtr % list    = inListPtr % list
-               aggListPtr % reqID   = inListPtr % reqID
-
+              allocate(commListPtr % next)
+              commListPtr =&gt; commListPtr % next
+              nullify(commListPtr % next)
+              commListPtr % procID = exchListPtr % endPointID
+              commListPtr % nList = exchListPtr % nList * fieldCursor % dimSizes(1) * fieldCursor % dimSizes(2)
             end if
 
-            inListPtr =&gt; inListPtr % next
-         end do
+            exchListPtr =&gt; exchListPtr % next
+          end do
 
+          ! Determine size from recv lists
+          exchListPtr =&gt; fieldCursor % recvList(haloLayers(iHalo))
+          do while(associated(exchListPtr))
+            comm_list_found = .false.
 
-         inListPtr =&gt; recvListArray(haloLayers(i)) % next
-         do while(associated(inListPtr))
+            commListPtr =&gt; recvList
+            do while(associated(commListPtr))
+              if(commListPtr % procID == exchListPtr % endPointId) then
+                comm_list_found = .true.
+                commListPtr % nList = commListPtr % nList + exchListPtr % nList * fieldCursor % dimSizes(1) * fieldCursor % dimSizes(2)
+                exit
+              end if
 
-            blockAdded = .false.
-            aggListPtr =&gt; aggregateRecvList
-            do while(associated(aggListPtr))
-               if(inListPtr % blockID == aggListPtr % blockID) then
-                  if(inListPtr % procID .ne. myProcID) then
-                     call mpas_merge_integer_arrays(aggListPtr % list, aggListPtr % nlist, inListPtr % list)
-                  end if
-                  blockAdded = .true.
-                  exit
-               end if
-               aggListPtr =&gt; aggListPtr % next
+              commListPtr =&gt; commListPtr % next
             end do
 
-            if(.not. blockAdded) then
+            if(.not. comm_list_found) then
+              commListPtr =&gt; recvList
+              commListPtr2 =&gt; commListPtr % next
+              do while(associated(commListPtr2))
+                commListPtr =&gt; commListPtr % next
+                commListPtr2 =&gt; commListPtr % next
+              end do
 
-               if (.not. associated(aggregateRecvList)) then
-                  allocate(aggregateRecvList)
-                  nullify(aggregateRecvList % next)
-                  aggListPtr =&gt; aggregateRecvList
-               else
-                  aggListPtr =&gt; aggregateRecvList
-                  do while(associated(aggListPtr % next))
-                     aggListPtr =&gt; aggListPtr % next
-                  end do
+              allocate(commListPtr % next)
+              commListPtr =&gt; commListPtr % next
+              nullify(commListPtr % next)
+              commListPtr % procID = exchListPtr % endPointID
+              commListPtr % nList = exchListPtr % nList * fieldCursor % dimSizes(1) * fieldCursor % dimSizes(2)
+            end if
 
-                  allocate(aggListPtr % next)
-                  aggListPtr =&gt; aggListPtr % next
-                  nullify(aggListPtr % next)
-               end if
-             
-               aggListPtr % procID  = inListPtr % procID
-               aggListPtr % blockID = inListPtr % blockID
-               aggListPtr % nlist   = inListPtr % nlist
-               allocate(aggListPtr % list(inListPtr % nlist)) 
-               aggListPtr % list    = inListPtr % list
-               aggListPtr % reqID   = inListPtr % reqID
+            exchListPtr =&gt; exchListPtr % next
+          end do
+        end do
 
-            end if
+        fieldCursor =&gt; fieldCursor % next
+      end do
 
-            inListPtr =&gt; inListPtr % next            
-         end do
+      ! Remove the dead head pointer on send and recv list
+      commListPtr =&gt; sendList
+      sendList =&gt; sendList % next
+      deallocate(commListPtr)
 
+      commListPtr =&gt; recvList
+      recvList =&gt; recvList % next
+      deallocate(commListPtr)
+
+      ! Allocate space in recv lists, and initiate mpi_irecv calls
+      commListPtr =&gt; recvList
+      do while(associated(commListPtr))
+        allocate(commListPtr % rbuffer(commListPtr % nList))
+        call MPI_Irecv(commListPtr % rbuffer, commListPtr % nList, MPI_REALKIND, commListPtr % procID, commListPtr % procID, dminfo % comm, commListPtr % reqID, mpi_ierr)
+
+        commListPtr =&gt; commListPtr % next
       end do
 
-      if (.not. present(haloLayersIn)) then
-         deallocate(haloLayers)
-      end if
+      ! Allocate space in send lists, copy data into buffer, and initiate mpi_isend calls
+      commListPtr =&gt; sendList
+      do while(associated(commListPtr))
+        allocate(commListPtr % rbuffer(commListPtr % nList))
+        bufferOffset = 0
+        do iHalo = 1, nHaloLayers
+          nAdded = 0
+          fieldCursor =&gt; field
+          do while(associated(fieldCursor))
+            exchListPtr =&gt; fieldCursor % sendList(haloLayers(iHalo))
+            do while(associated(exchListPtr))
+              if(exchListPtr % endPointID == commListPtr % procID) then
+                do  i = 1, exchListPtr % nList
+                  do j = 1, fieldCursor % dimSizes(2)
+                    do k = 1, fieldCursor % dimSizes(1)
+                      commListPtr % rbuffer((exchListPtr % destList(i)-1) * fieldCursor % dimSizes(1) * fieldCursor % dimSizes(2) &amp;
+                          + (j-1) * fieldCursor % dimSizes(1) + k  + bufferOffset) = fieldCursor % array(k, j, exchListPtr % srcList(i))
+                      nAdded = nAdded + 1
+                    end do
+                  end do
+                end do
+              end if
 
-   end subroutine mpas_aggregate_exchange_lists!}}}
+              exchListPtr =&gt; exchListPtr % next
+            end do
 
-   subroutine mpas_destroy_exchange_list(exchangeList)!{{{
+            fieldCursor =&gt; fieldCursor % next
+          end do
+          bufferOffset = bufferOffset + nAdded
+        end do
 
-      implicit none
+        call MPI_Isend(commListPtr % rbuffer, commListPtr % nList, MPI_REALKIND, commListPtr % procID, dminfo % my_proc_id, dminfo % comm, commListPtr % reqID, mpi_ierr)
+        commListPtr =&gt; commListPtr % next
+      end do
+#endif
 
-      !--- in variables ---!
-      type (exchange_list), pointer :: exchangeList
+      ! Handle local copy. If MPI is off, then only local copies are performed.
+      fieldCursor =&gt; field
+      do while(associated(field))
+        do iHalo = 1, nHaloLayers
+          exchListPtr =&gt; fieldCursor % copyList(haloLayers(iHalo))
 
-      !--- local variables ---!
-      type (exchange_list), pointer :: exchangeListPtr
+          do while(associated(exchListPtr))
+            fieldCursor2 =&gt; field
+            do while(associated(fieldCursor2))
+              if(exchListPtr % endPointID == fieldCursor2 % block % localBlockID) then
+                do i = 1, exchListPtr % nList
+                  fieldCursor2 % array(:, :, exchListPtr % destList(i)) = fieldCursor % array(:, :, exchListPtr % srcList(i))
+                end do
+              end if
+              
+              fieldCursor2 =&gt; fieldCursor2 % next
+            end do
 
-      do while (associated(exchangeList))
-         exchangeListPtr =&gt; exchangeList % next
+            exchListPtr =&gt; exchListPtr % next
+          end do
+        end do
 
-         deallocate(exchangeList % list)
-         deallocate(exchangeList)
-         exchangeList =&gt; exchangeListPtr
+        fieldCursor =&gt; fieldCursor % next
       end do
 
-   end subroutine mpas_destroy_exchange_list!}}}
+#ifdef _MPI
 
-   subroutine mpas_merge_integer_arrays(mergeArray, nMergeArray, dataToAppend)!{{{
+      ! Wait for mpi_irecv to finish, and unpack data from buffer
+      commListPtr =&gt; recvList
+      do while(associated(commListPtr))
+        call MPI_Wait(commListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
+        bufferOffset = 0
+        do iHalo = 1, nHaloLayers
+          nAdded = 0
+          fieldCursor =&gt; field
+          do while(associated(fieldCursor))
+            exchListPtr =&gt; fieldCursor % recvList(iHalo)
+            do while(associated(exchListPtr))
+              if(exchListPtr % endPointID == commListPtr % procID) then
+                do i = 1, exchListPtr % nList
+                  do j = 1, fieldCursor % dimSizes(2)
+                    do k = 1, fieldCursor % dimSizes(1)
+                      fieldCursor % array(k, j, exchListPtr % destList(i)) = commListPtr % rbuffer((exchListPtr % srcList(i)-1)*fieldCursor % dimSizes(1) * fieldCursor % dimSizes(2) &amp;
+                                                                           + (j-1)*fieldCursor % dimSizes(1) + k + bufferOffset)
+                      nAdded = nAdded + 1
+                    end do
+                  end do
+                end do
+              end if
+              exchListPtr =&gt; exchListPtr % next
+            end do
+            
+            fieldCursor =&gt; fieldCursor % next
+          end do
+          bufferOffset = bufferOffset + nAdded
+        end do
+        commListPtr =&gt; commListPtr % next
+      end do
 
-      implicit none
+      ! wait for mpi_isend to finish.
+      commListPtr =&gt; sendList
+      do while(associated(commListPtr))
+        call MPI_Wait(commListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
+        commListPtr =&gt; commListPtr % next
+      end do
 
-      !--- inout variables ---!
-      integer, dimension(:), pointer  :: mergeArray
-      integer, intent(inout)          :: nMergeArray
+     ! Destroy commLists.
+     call mpas_dmpar_destroy_communication_list(sendList)
+     call mpas_dmpar_destroy_communication_list(recvList)
+#endif
 
-      !--- in variables ---!
-      integer, dimension(:), pointer :: dataToAppend
+   end subroutine mpas_dmpar_exch_halo_field3d_real!}}}
 
-      !--- local variables ---!
-      integer :: nDataToAppend, newSize
-      integer, dimension(nMergeArray) :: mergeArrayCopy
-     
-    
-      nDataToAppend = size(dataToAppend)
-      newSize = nMergeArray + nDataToAppend
-      mergeArrayCopy = mergeArray
-      deallocate(mergeArray)
-      allocate(mergeArray(newSize))
-      mergeArray(1:nMergeArray) = mergeArrayCopy 
-      mergeArray(nMergeArray+1:newSize) = dataToAppend 
-      nMergeArray = newSize
+   subroutine mpas_dmpar_destroy_communication_list(commList)!{{{
+     type (mpas_communication_list), pointer :: commList
+     type (mpas_communication_list), pointer :: commListPtr
 
-   end subroutine mpas_merge_integer_arrays!}}}
+     commListPtr =&gt; commList
+     do while(associated(commList))
+       if(associated(commList)) then
+         commList =&gt; commList % next
+       else
+         nullify(commList)
+       end if
 
+       if(allocated(commListPtr % ibuffer)) then
+         deallocate(commListPtr % ibuffer)
+       end if
+
+       if(allocated(commListPtr % rbuffer)) then
+         deallocate(commListPtr % rbuffer)
+       end if
+       deallocate(commListPtr)
+       commListPtr =&gt; recvList
+     end do
+   end subroutine mpas_dmpar_destroy_communication_list!}}}
+
+   subroutine mpas_dmpar_destroy_exchange_list(exchList)!{{{
+     type (mpas_exchange_list), pointer :: exchList
+     type (mpas_exchange_list), pointer :: exchListPtr
+
+     exchListPtr =&gt; exchList
+     do while(associated(exchList))
+       if(associated(exchList % next)) then
+         exchList =&gt; exchList % next
+       else
+         nullify(exchList)
+       end if
+
+       if(allocated(exchListPtr % srcList)) then
+         deallocate(exchListPtr % srcList)
+       end if
+
+       if(allocated(exchListPtr % destList)) then
+         deallocate(exchListPtr % destList)
+       end if
+
+       deallocate(exchListPtr)
+       exchListPtr =&gt; exchList
+     end do
+
+   end subroutine mpas_dmpar_destroy_exchange_list!}}}
+
 end module mpas_dmpar

</font>
</pre>