UPP  001
 All Data Structures Files Functions Pages
AllGETHERV_GSD.f
1  SUBROUTINE allgetherv(GRID1)
2 !$$$ SUBPROGRAM DOCUMENTATION BLOCK
3 ! . . .
4 ! SUBPROGRAM: AllGETHERV VERT INTRP OF MODEL LVLS TO PRESSURE
5 ! PRGRMMR: MING HU ORG: GSD DATE: 2012-01-01
6 !
7 ! ABSTRACT:
8 ! .
9 !
10 ! PROGRAM HISTORY LOG:
11 !
12 
13  use ctlblk_mod, only : im,jm,num_procs,me,jsta,jend,mpi_comm_comp
14 
15  implicit none
16 
17  include "mpif.h"
18 
19 !
20  integer i,j,ij
21  integer ierr
22 
23  REAL grid1(im,jm)
24  REAL ibufrecv(im*jm)
25  REAL ibufsend(im*(jend-jsta+1))
26  integer sendcount,recvcounts(num_procs),displs(num_procs)
27 !
28 ! write(*,*) 'check mpi', im,jm,num_procs,me,jsta,jend
29  sendcount=im*(jend-jsta+1)
30  call mpi_allgather(sendcount, 1, mpi_integer, recvcounts,1 , &
31  mpi_integer, mpi_comm_comp, ierr)
32  displs(1)=0
33  do i=2,num_procs
34  displs(i)=displs(i-1)+recvcounts(i-1)
35  enddo
36 !
37 ! write(*,*) me,'RECVCOUNTS=',RECVCOUNTS
38 ! write(*,*) me,'DISPLS=',DISPLS
39 !
40  ij=0
41  ibufsend=0.0
42  do j=jsta,jend
43  do i=1,im
44  ij=ij+1
45  ibufsend(ij)=grid1(i,j)
46  enddo
47  enddo
48  if(ij /= recvcounts(me+1)) then
49  write(*,*) 'Error: send account is not equal to receive account',me,ij,recvcounts(me+1)
50  endif
51 
52  call mpi_allgatherv(ibufsend, ij, mpi_real, ibufrecv, recvcounts,displs, &
53  mpi_real, mpi_comm_comp, ierr)
54 
55  ij=0
56  do j=1,jm
57  do i=1,im
58  ij=ij+1
59  grid1(i,j)=ibufrecv(ij)
60  enddo
61  enddo
62 !
63 ! END OF ROUTINE.
64 !
65  RETURN
66  END