Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(ESMF_VM) | :: | vm | ||||
integer | :: | bufsize(:) | ||||
integer | :: | recvPets | ||||
integer | :: | rootPet | ||||
real(kind=ESMF_KIND_R4) | :: | buffer(:) | ||||
real(kind=ESMF_KIND_R4) | :: | outbuffer(:,:) | ||||
integer | :: | dims(:) |
subroutine pack_and_send_floatR4(vm, bufsize, recvPets, rootPet, buffer, & outbuffer, dims) type(ESMF_VM) :: vm integer :: bufsize(:) integer :: recvPets integer :: rootPet real(ESMF_KIND_R4) :: buffer(:) real(ESMF_KIND_R4) :: outbuffer(:,:) integer :: dims(:) integer :: xdim, start integer :: lbnd(2), ubnd(2) integer :: i,j,k,ii real(ESMF_KIND_R4), 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 do i=1,bufsize(2) outbuffer(:, lbnd(2)+i-1) = buffer((i-1)*bufsize(1)+1 : (i-1)*bufsize(1)+xdim) enddo 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((j-1)*bufsize(1)+i) 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_floatR4