UPP (develop)
Loading...
Searching...
No Matches
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! 21-09-02 Bo Cui - Decompose UPP in X direction
13
14 use ctlblk_mod, only : im,jm,num_procs,me,jsta,jend,ista,iend,mpi_comm_comp
15
16 implicit none
17
18 include "mpif.h"
19
20!
21 integer i,j,ij
22 integer ierr
23
24 REAL GRID1(IM,JM)
25 REAL ibufrecv(IM*JM)
26 REAL ibufsend((iend-ista+1)*(jend-jsta+1))
27 integer SENDCOUNT,RECVCOUNTS(num_procs),DISPLS(num_procs)
28!
29! write(*,*) 'check mpi', im,jm,num_procs,me,jsta,jend
30 SENDCOUNT=(iend-ista+1)*(jend-jsta+1)
31 call mpi_allgather(sendcount, 1, mpi_integer, recvcounts,1 , &
32 mpi_integer, mpi_comm_comp, ierr)
33 displs(1)=0
34 do i=2,num_procs
35 displs(i)=displs(i-1)+recvcounts(i-1)
36 enddo
37!
38! write(*,*) me,'RECVCOUNTS=',RECVCOUNTS
39! write(*,*) me,'DISPLS=',DISPLS
40!
41 ij=0
42 ibufsend=0.0
43 do j=jsta,jend
44 do i=ista,iend
45 ij=ij+1
46 ibufsend(ij)=grid1(i,j)
47 enddo
48 enddo
49 if(ij /= recvcounts(me+1)) then
50 write(*,*) 'Error: send account is not equal to receive account',me,ij,recvcounts(me+1)
51 endif
52
53 call mpi_allgatherv(ibufsend, ij, mpi_real, ibufrecv, recvcounts,displs, &
54 mpi_real, mpi_comm_comp, ierr)
55
56 ij=0
57 do j=1,jm
58 do i=1,im
59 ij=ij+1
60 grid1(i,j)=ibufrecv(ij)
61 enddo
62 enddo
63!
64! END OF ROUTINE.
65!
66 RETURN
67 END