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

! ABSTRACT:   DISTRIBUTES DATA FROM TASK 0

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

! USAGE:  CALL DIST(A,B)

!   INPUT ARGUMENT LIST:
!     A - ARRAY TO BE DISTRIBUTED

!   OUTPUT ARGUMENT LIST:
!     B - DISTRIBUTED DATA

!   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, jm )
    real :: b ( im, my_jsd:my_jed )
    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

    !        send to everyone else
    
        do ii = 1, num_procs - 1
            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
                        buf ( iii ) = a ( i, j )
                    end do
                end do
            end do
            call mpi_send(buf,iii,MPI_REAL,ii, &
            ii,MPI_COMM_COMP,ierr)
        end do
    else
        call mpi_recv(buf,im*jm,MPI_REAL,0, &
        me,MPI_COMM_COMP,status,ierr)
        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
                    b ( i, j ) = buf ( iii )
                end do
            end do
        end do
    
    end if
    END SUBROUTINE DIST