1 | include(dom.inc)
   2 | 
   3 |       SUBROUTINE GATHER(vect, vect_cell, ndata)
   4 | 
   5 |       USE mod_pmm
   6 |       USE mod_slave
   7 | #ifdef USEPALM
   8 |       USE palmlib
   9 | #endif
  10 | 
  11 |       IMPLICIT NONE
  12 | 
  13 | !     IN
  14 |       DOM_INT                              :: ndata
  15 |       DOM_REAL,DIMENSION(ndata,is_nnodes)  :: vect
  16 | 
  17 | !     LOCAL
  18 |       DOM_INT :: j, inode, k !, ierr
  19 |       DOM_REAL, DIMENSION(ndata,is_ncells) :: local_vect_cell
  20 | 
  21 | !     OUT
  22 |       DOM_REAL, DIMENSION(ndata,is_ncells) :: vect_cell
  23 | 
  24 | 
  25 |       vect_cell  = 0.
  26 | 
  27 | !     -----------------------------!
  28 | !     Initializing local cell data !
  29 | !     -----------------------------!
  30 | 
  31 |       local_vect_cell  = 0.
  32 | 
  33 | !$OMP PARALLEL DO                                                       &
  34 | !$OMP&  PRIVATE(k,inode)                                                &
  35 | !$OMP&  SHARED(local_vect_cell)
  36 | 
  37 |        DO j= 1, is_ncells !is_cellb, is_cellf
  38 |           DO inode=1,is_cnodes(j)
  39 |             k = is_cnnode(inode,j)
  40 |             local_vect_cell(:,j) = local_vect_cell(:,j)  + vect(:,k)
  41 |           ENDDO
  42 |         local_vect_cell(:,j) = local_vect_cell(:,j)/ real(is_cnodes(j))
  43 | 
  44 |       ENDDO
  45 | 
  46 | !$OMP END PARALLEL DO
  47 | 
  48 | !     CALL MPI_ALLREDUCE(local_vect_cell, vect_cell, is_ncells*ndata,   &
  49 | !    &                   MPI_DOUBLE_PRECISION,MPI_SUM, SUB_COMM ,       &
  50 | !    &                   ierr)
  51 | 
  52 |       vect_cell = local_vect_cell
  53 | 
  54 |       END SUBROUTINE GATHER