pack_and_send_float2D Subroutine

private subroutine pack_and_send_float2D(vm, bufsize, recvPets, rootPet, buffer, outbuffer, dims)

Arguments

Type IntentOptional Attributes Name
type(ESMF_VM) :: vm
integer :: bufsize(:)
integer :: recvPets
integer :: rootPet
real(kind=ESMF_KIND_R8) :: buffer(:,:)
real(kind=ESMF_KIND_R8) :: outbuffer(:,:)
integer :: dims(:)

Source Code

subroutine pack_and_send_float2D(vm, bufsize, recvPets, rootPet, buffer, &
                               outbuffer, dims)

  type(ESMF_VM) :: vm
  integer :: bufsize(:)
  integer :: recvPets
  integer :: rootPet
  real(ESMF_KIND_R8) :: buffer(:,:)
  real(ESMF_KIND_R8) :: outbuffer(:,:)
  integer :: dims(:)

  integer :: xdim, start
  integer :: lbnd(2), ubnd(2)
  integer :: i,j,k,ii
  real(ESMF_KIND_R8), pointer :: sendbuf(:)
  integer :: localrc

  ! fill my own pointer first
  lbnd = lbound(outbuffer)
  ubnd = ubound(outbuffer)
  xdim = ubnd(1)-lbnd(1)+1
  bufsize(2)=ubnd(2)-lbnd(2)+1
  outbuffer = buffer(1:xdim,1:bufsize(2))
  if (recvPets > 1) then
    allocate(sendbuf(dims(1)*bufsize(2)))
    start=xdim
    do k = 1, recvPets-1
      if (k>1) then
       if (dims(k) /= dims(k-1)) then
         deallocate(sendbuf)
         allocate(sendbuf(dims(k)*bufsize(2)))
       endif
      endif
      ii = 1
      do j = 1, bufsize(2)
         do i = start+1, start+dims(k)
            sendbuf(ii) = buffer(i,j)
            ii=ii+1
         enddo
      enddo
      call ESMF_VMSend(vm, sendbuf, dims(k)*bufsize(2), rootPet+k, rc=localrc)
      start = start+dims(k)
    enddo
    deallocate(sendbuf)
  endif
end subroutine pack_and_send_float2D