!
!##################################################################
!##################################################################
!###### ######
!###### 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