SUBROUTINE COLLECT ( A, B )
!$$$  SUBPROGRAM DOCUMENTATION BLOCK
!                .      .    .
!   SUBROUTINE:  COLLECT     COLLECT UP DATA ON TASK 0
!   PRGRMMR: TUCCILLO        ORG:  IBM       DATE: 00-01-20

! ABSTRACT:  COLLECTS UP DATA ON TASK 0

! PROGRAM HISTORY LOG:
!   00-01-20  TUCCILLO - ORIGINATOR

! USAGE:  CALL COLLECT(A,B)

!   INPUT ARGUMENT LIST:
!     A - ARRAY TO BE COLLECTED FROM

!   OUTPUT ARGUMENT LIST:
!     B - RESULTS OF THE COLLECTION

!   INPUT FILES:  NONE

!   OUTPUT FILES:  NONE

!   SUBPROGRAMS CALLED:
!     UNIQUE:
!            MPI_SEND
!            MPI_RECV

!   EXIT STATES:
!     COND =   0 - NORMAL EXIT

! ATTRIBUTES:
!   LANGUAGE: FORTRAN 90
!   MACHINE : IBM SP

!$$$

    include "parmeta.f90"
    include "COMM_PARA.f90"
    include 'mpif.h'
    include "mpp.h"
    real :: a ( im, my_jsd:my_jed )
    real :: b ( im, jm )
    real :: buf ( im * jm )
    integer :: status(MPI_STATUS_SIZE)
    integer :: i, j
    integer :: ierr

    if ( me == 0 ) then
    
        do k = jsta(me), jend(me)
            do j =  my_js_glb_a(k), my_je_glb_a(k)
                do i =  my_is_glb_a(k), my_ie_glb_a(k)
                    b ( i, j ) = a ( i, j )
                end do
            end do
        end do

    !        receive from everyone else
    
        do ii = 1, num_procs - 1
            call mpi_send(ii,1,MPI_INTEGER,ii,0,MPI_COMM_COMP,ierr)
            call mpi_recv(buf,im*jm,MPI_REAL,ii, &
            ii,MPI_COMM_COMP,status,ierr)
            iii = 0
            do k = jsta(ii), jend(ii)
                do j =  my_js_glb_a(k), my_je_glb_a(k)
                    do i =  my_is_glb_a(k), my_ie_glb_a(k)
                        iii = iii + 1
                        b ( i, j ) = buf ( iii )
                    end do
                end do
            end do
        end do
    else
        iii = 0
        do k = jsta(me), jend(me)
            do j =  my_js_glb_a(k), my_je_glb_a(k)
                do i =  my_is_glb_a(k), my_ie_glb_a(k)
                    iii = iii + 1
                    buf ( iii ) = a ( i, j )
                end do
            end do
        end do
        call mpi_recv(ii,1,MPI_INTEGER,0,0,MPI_COMM_COMP,status,ierr)
        call mpi_send(buf,iii,MPI_REAL,0,me,MPI_COMM_COMP,ierr)
    
    end if
    END SUBROUTINE COLLECT