16 SUBROUTINE collect_loc ( A, B )
19 use ctlblk_mod, only: num_procs, jsta, icnt, idsp, mpi_comm_comp, im,&
20 jsta_2l, jend_2u, jm, me, &
21 buff,ista_2l,iend_2u,jexa,iexa,jsxa,isxa,ista,iend
27 real,
dimension(ista_2l:iend_2u,jsta_2l:jend_2u),
intent(in) :: a
28 real,
dimension(im,jm),
intent(out) :: b
30 real,
allocatable :: rbufs(:)
32 jj=( jexa(me)-jsxa(me)+1) * (iexa(me)-isxa(me)+1)
33 allocate( rbufs(( jexa(me)-jsxa(me)+1) * (iexa(me)-isxa(me)+1)) )
35 if ( num_procs <= 1 )
then
42 do jj=jsxa(me),jexa(me)
43 do ii=isxa(me),iexa(me)
44 if(isum .gt. im*jm .or. ii .gt. im .or. ii .lt. 1 .or. jj .gt. jm .or. jj.lt. 1) &
45 write(*,901)
' BOUNDS2 FAIL in reshape ',isum,ii,jj,im*jm,im,im*jm
53 call mpi_gatherv(rbufs,icnt(me),mpi_real, buff,icnt,idsp,mpi_real,0,mpi_comm_world, ierr )
62 if(isum .gt. im*jm .or. ii .gt. im .or. ii .lt. 1 .or. jj .gt. jm .or. jj .lt. 1) &
63 write(*,901)
' BOUNDS FAIL in reshape ',isum,ii,jj,im*jm,im,im*jm
82 SUBROUTINE collect_all ( A, B )
84 use ctlblk_mod, only: num_procs, jsta, icnt, idsp, mpi_comm_comp, im,&
85 jsta_2l, jend_2u, jm, me, &
86 buff,ista_2l,iend_2u,jexa,iexa,jsxa,isxa,ista,iend,jend
92 real,
dimension(ista:iend,jsta:jend),
intent(in) :: a
93 real,
dimension(im,jm),
intent(out) :: b
95 real,
allocatable :: rbufs(:)
97 jj=( jexa(me)-jsxa(me)+1) * (iexa(me)-isxa(me)+1)
98 allocate( rbufs(( jexa(me)-jsxa(me)+1) * (iexa(me)-isxa(me)+1)) )
100 if ( num_procs <= 1 )
then
106 do jj=jsxa(me),jexa(me)
107 do ii=isxa(me),iexa(me)
108 if(isum .gt. im*jm .or. ii .gt. im .or. ii .lt. 1 .or. jj .gt. jm .or. jj.lt. 1) &
109 write(*,901)
' BOUNDS2 FAIL in reshape',isum,ii,jj,im*jm,im,im*jm
116 call mpi_allgatherv(rbufs,icnt(me),mpi_real,buff,icnt,idsp,mpi_real, mpi_comm_comp, ierr )
117 call mpi_barrier(mpi_comm_comp,ierr)
122 do jj=jsxa(n),jexa(n)
123 do ii=isxa(n),iexa(n)
124 if(isum .gt. im*jm .or. ii .gt. im .or. ii .lt. 1 .or. jj .gt. jm .or. jj .lt. 1) &
125 write(*,901)
' BOUNDS FAIL in reshape',isum,ii,jj,im*jm,im,im*jm
134 901
format(a30,10i10)