1 | include(dom.inc)
   2 | 
   3 |       SUBROUTINE pmm_returnvectors(ncells, nfacemax)
   4 | 
   5 | !       ================================================================!
   6 | !                                                                       !
   7 | !       pmm_return.F  : Controls the reception of the solution vectors  !
   8 | !                                                                       !
   9 | !       out           :                                                 !
  10 | !                                                                       !
  11 | !       author        : J. AMAYA (october 2007)                         !
  12 | !                                                                       !
  13 | !       ================================================================!
  14 | 
  15 |         USE mod_pmm
  16 | 
  17 |         IMPLICIT NONE
  18 | 
  19 |         include 'pmm_constants.h'
  20 | 
  21 | !       IN
  22 |         DOM_INT    :: ncells, nfacemax
  23 | 
  24 | !       LOCAL
  25 |         DOM_INT    :: ierr, i, iproc
  26 |         DOM_INT    :: status(MPI_STATUS_SIZE)
  27 | 
  28 |         DOM_REAL,DIMENSION(3,ncells)          :: Q_rtot
  29 |         DOM_REAL,DIMENSION(ncells)            :: Gtot, Lbtot
  30 |         DOM_REAL,DIMENSION(nfacemax,ncells)   :: Lotot, Htot
  31 | 
  32 |         DO i=1, pmm_n_p-1
  33 | 
  34 | !         ---------------------------!
  35 | !         Capture the process number !
  36 | !         ---------------------------!
  37 | 
  38 | !         print*, " (",pmm_rank,") Waiting next message"
  39 |           CALL MPI_RECV(iproc, 1, MPI_INTEGER, MPI_ANY_SOURCE,          &
  40 |      &                  PMM_RETURN, MPI_COMM_WORLD, status, ierr)
  41 | 
  42 | !         print*, " (",pmm_rank,") Message received from ", iproc
  43 | !         ------------------------------!
  44 | !         Receive the resulting vectors !
  45 | !         ------------------------------!
  46 | 
  47 |           IF (iproc.ne.PMM_HOST) THEN
  48 |             CALL MPI_RECV(Gtot, ncells, MPI_DOUBLE_PRECISION, iproc,    &
  49 |      &                    PMM_RETURN, MPI_COMM_WORLD, status, ierr)
  50 |             CALL MPI_RECV(Htot, ncells*nfacemax, MPI_DOUBLE_PRECISION,  &
  51 |      &                    iproc, PMM_RETURN, MPI_COMM_WORLD, status,    &
  52 |      &                    ierr)
  53 |             CALL MPI_RECV(Lotot, ncells*nfacemax, MPI_DOUBLE_PRECISION, &
  54 |      &                    iproc, PMM_RETURN, MPI_COMM_WORLD, status,    &
  55 |      &                    ierr)
  56 |             CALL MPI_RECV(Lbtot, ncells, MPI_DOUBLE_PRECISION, iproc,   &
  57 |      &                    PMM_RETURN, MPI_COMM_WORLD, status, ierr)
  58 |             CALL MPI_RECV(Q_rtot, 3*ncells, MPI_DOUBLE_PRECISION,       &
  59 |      &                    iproc, PMM_RETURN, MPI_COMM_WORLD, status,    &
  60 |      &                    ierr)
  61 | 
  62 | !         ------------------------------------------!
  63 | !         Integrate all results in the main vectors !
  64 | !         ------------------------------------------!
  65 | 
  66 |             CALL master_integrate(Gtot, Htot, Lotot, Lbtot,             &
  67 |      &                            Q_rtot, iproc)
  68 | 
  69 |           ENDIF
  70 | 
  71 |         ENDDO
  72 |         
  73 |       END SUBROUTINE pmm_returnvectors