!
!##################################################################
!##################################################################
!######                                                      ######
!######                 SUBROUTINE VERIF_COLLECT             ######
!######                                                      ######
!######                     Developed by                     ######
!######     Center for Analysis and Prediction of Storms     ######
!######                University of Oklahoma                ######
!######                                                      ######
!##################################################################
!##################################################################
!


SUBROUTINE VERIF_COLLECT(model_data,obsrv_data,nhisfile),1
               
!
!-----------------------------------------------------------------------
!
!  PURPOSE:
!
!  Collect verification computations from other processors and merge it
!  into one data set.
!
!-----------------------------------------------------------------------
!
!  AUTHOR: Kevin W. Thomas
!
!  Original Coding: 08/02/05
!
!  MODIFICATION HISTORY:
!
!-----------------------------------------------------------------------
!
!  Variable Declarations:
!
!-----------------------------------------------------------------------
!
  IMPLICIT NONE
!
!-----------------------------------------------------------------------
!
!  Include files:
!
!-----------------------------------------------------------------------
!
  INCLUDE 'vericst.inc'
  INCLUDE 'mp.inc'
  INCLUDE 'mpif.h'

  INTEGER :: nhisfile

  REAL :: model_data(sfcmax,nhisfile,5)
  REAL :: obsrv_data(sfcmax,nhisfile,5)
  REAL :: tem1(sfcmax,nhisfile,5)               ! work array
  REAL :: tem2(sfcmax,nhisfile,5)               ! work array
  CHARACTER(LEN=4) :: sfcstid_tmp(sfcmax)       ! work array
  INTEGER :: sfcstn_lcl

  INTEGER, allocatable :: kount(:)
  INTEGER :: mpi_status(MPI_STATUS_SIZE)

!
!-----------------------------------------------------------------------
!
!  Misc. internal variables
!
!-----------------------------------------------------------------------
!
  INTEGER :: istat
  INTEGER :: i,j,k

!
!  Collect the number of data points and station lists for each processor.
!  The rest of the data will be collected last once the master list is
!  updated to remove stations that were outside of the domain.
!

  IF (myproc == 0) THEN

    ALLOCATE(kount(nprocs), STAT=istat)
    CALL check_alloc_status(istat,"verif_collect:kount")

!
!  Save processor 0 data.
!

    sfcstid_tmp(1:sfcstn) = sfcstid(1:sfcstn)

    kount(1) = sfcstn
    k = kount(1)

    DO i=1,nprocs-1

      CALL mpi_recv(kount(i+1),1,MPI_INTEGER,i,100+i,                       &
        MPI_COMM_WORLD,mpi_status,istat)

      CALL mpi_recv(sfcstid_tmp(k+1),kount(i+1)*4,MPI_CHARACTER,i,200+i,    &
        MPI_COMM_WORLD, mpi_status,istat)

      k = k + kount(i+1)

    END DO

!
!  Compute master list.  Output goes to "sfcstid", with "sfcstn" now
!  representing the global domain instead of the local domain.  The "master"
!  variables are not referenced after this point.
!

    sfcstn = 0

    DO j=1,sfcstn_master
      DO i=1,k
        IF (sfcstid_master(j) == sfcstid_tmp(i)) THEN
          sfcstn = sfcstn + 1
          sfcstid(sfcstn) = sfcstid_master(j)
          exit
        END IF
      END DO
   END DO

  ELSE

    CALL mpi_send(sfcstn,1,MPI_INTEGER,0,100+myproc,MPI_COMM_WORLD,istat)

    CALL mpi_send(sfcstid,sfcstn*4,MPI_CHARACTER,0,200+myproc,           &
      MPI_COMM_WORLD,istat)

  END IF


!
!  Collect the rest of the data.
!

  IF (myproc == 0) THEN

!
!  Copy what we've already computed so the data can be sorted.
!

    tem1(:,:,:) = model_data(:,:,:)
    tem2(:,:,:) = obsrv_data(:,:,:)

!
!  Sort what processor 0 has already saved.
!

     CALL verif_sort(model_data,obsrv_data,tem1,tem2,sfcmax,nhisfile,5,  &
        sfcstid,sfcstn,sfcstid_tmp,kount(1))
!    write(6,*)'user list:  ',(sfcstid_tmp(i),i=1,sfcstn)

    k = kount(1)

    DO i=1,nprocs-1

!
!  Receive the model data.
!

      CALL mpi_recv(tem1,sfcmax*nhisfile*5,MPI_REAL,i,300+i,             &
        MPI_COMM_WORLD,mpi_status,istat)

!
!  Receive the observations.
!

      CALL mpi_recv(tem2,sfcmax*nhisfile*5,MPI_REAL,i,400+i,              &
         MPI_COMM_WORLD,mpi_status,istat)

!
!  Put the data in our operational arrays.
!

!     write(6,*) 'test:  ',i,kount(i)+1,kount(i+1)
      CALL verif_sort(model_data,obsrv_data,tem1,tem2,sfcmax,nhisfile,5,   &
        sfcstid,sfcstn,sfcstid_tmp(k+1),kount(i+1))
!     write(6,*)'user list:  ',(sfcstid_tmp(j),j=1,sfcstn)

      k = k + kount(i+1)

    END DO

  ELSE

    CALL mpi_send(model_data,sfcmax*nhisfile*5,MPI_REAL,0,300+myproc, &
      MPI_COMM_WORLD,istat)

    CALL mpi_send(obsrv_data,sfcmax*nhisfile*5,MPI_REAL,0,400+myproc, &
       MPI_COMM_WORLD,istat)

  END IF

  IF (myproc == 0) THEN
    DEALLOCATE(kount)
  END IF

  RETURN
END SUBROUTINE verif_collect