copyright (C) 2001  MSC-RPN COMM  %%%MC2%%%

      subroutine blkcol2 (f2rc,nis,njs, 1
     $                    f2cc,lminx,lmaxx,lminy,lmaxy, ofi,ofj,nk_out )
      implicit none
*
      integer nis,njs,lminx,lmaxx,lminy,lmaxy,ofi,ofj,nk_out
      real f2rc(nis,njs,nk_out), f2cc(lminx:lmaxx,lminy:lmaxy,nk_out)
*
#include "partopo.cdk"
#include "lcldim.cdk"
*
      integer i, j, k, iproc, tag, err, status
      integer si,sj,loindx,hiindx,loindy,hiindy
      integer len,l_id,l_if,l_jd,l_jf,procid,offi,offj
      common /gatherit/ len,l_id,l_if,l_jd,l_jf,procid
      real buf (dim2d*nk_out)
      data tag /210/
*
*----------------------------------------------------------------------
*
      l_id = lminx
      l_if = lmaxx
      l_jd = lminy
      l_jf = lmaxy
      len = (l_if-l_id+1)*(l_jf-l_jd+1)*nk_out
*
      if (blocme.eq.0) then
*
* Copy local data (LD) segment
*
         do k = 1, nk_out
         do j = l_jd, l_jf
         do i = l_id, l_if
            f2rc(i-ofi+1,j-ofj+1,k) = f2cc(i,j,k)
         enddo
         enddo
         enddo
*
* Receive local data (LD) segments from other processors of mybloc
*
         do iproc = 1, numpe_perb-1
*
            call RPN_COMM_recv ( len, 6, 'MPI_INTEGER', iproc,
     $                                     tag, 'BLOC', status, err )
            if (len.gt.0) then
               call RPN_COMM_recv ( buf, len, 'MPI_REAL', iproc,
     $                                 tag, 'BLOC', status, err )
               len  = 0
               do k = 1, nk_out
               do j = l_jd, l_jf
               do i = l_id, l_if
                  len = len + 1
                  f2rc(i-ofi+1,j-ofj+1,k) = buf(len)
               end do
               end do
               end do 
            endif
*
         enddo 
*
      else
*
* Send local data (LD) segment to processor 0 of mybloc
*
         procid = myproc
         call RPN_COMM_send ( len, 6, 'MPI_INTEGER', 0, tag,'BLOC',err )
         if (len.gt.0)
     $   call RPN_COMM_send (f2cc, len,  'MPI_REAL', 0, tag,'BLOC',err )
*
      endif	
*
*----------------------------------------------------------------------
      return
      end
*