1 | include(dom.inc)
   2 | 
   3 |       SUBROUTINE sendtoslaves
   4 | 
   5 | !       ================================================================!
   6 | !                                                                       !
   7 | !       sendtoslaves.F: Send all necessary vectors to the slave procs   !
   8 | !                       in function of the partitioning.                !
   9 | !                                                                       !
  10 | !       out           : Each slave will keep the local values of mu,    !
  11 | !                       eta, ksi, w.                                    !
  12 | !                                                                       !
  13 | !       author        : J. AMAYA (september 2007)                       !
  14 | !                                                                       !
  15 | !       ================================================================!
  16 | 
  17 |         USE mod_pmm
  18 |         USE mod_prissma
  19 |         USE mod_inout
  20 | 
  21 |         IMPLICIT NONE
  22 | 
  23 |         include 'pmm_constants.h'
  24 |         include 'dom_constants.h'
  25 | 
  26 | !       LOCAL
  27 |         DOM_INT :: iproc, ierr, id_buffersize
  28 |         DOM_INT :: l_ndir, ibeg, iend, i, j, k, n
  29 | 
  30 |         DOM_REAL, ALLOCATABLE, DIMENSION(:) :: d_buffer
  31 | 
  32 |         DO iproc=1,pmm_n_p
  33 | 
  34 | !         -----------------!
  35 | !         Allocate vectors !
  36 | !         -----------------!
  37 | 
  38 |           l_ndir = dir_f(iproc) - dir_d(iproc) + 1
  39 | 
  40 |           IF (ALLOCATED(d_buffer))    DEALLOCATE(d_buffer)
  41 | 
  42 |           id_buffersize = 4*l_ndir
  43 | 
  44 |           ALLOCATE(d_buffer(id_buffersize))
  45 | 
  46 | !         --------------------------!
  47 | !         Fill the buffer with data !
  48 | !         --------------------------!
  49 | 
  50 |           d_buffer(1         :  l_ndir) = mu (dir_d(iproc):dir_f(iproc))
  51 |           d_buffer(l_ndir+1  :2*l_ndir) = eta(dir_d(iproc):dir_f(iproc))
  52 |           d_buffer(2*l_ndir+1:3*l_ndir) = ksi(dir_d(iproc):dir_f(iproc))
  53 |           d_buffer(3*l_ndir+1:4*l_ndir) = w  (dir_d(iproc):dir_f(iproc))
  54 | 
  55 | !         -----------------------!
  56 | !         Send vectors to slaves !
  57 | !         -----------------------!
  58 | 
  59 |           CALL pmm_sendvectors(d_buffer, id_buffersize, iproc)
  60 | 
  61 |           DEALLOCATE(d_buffer)
  62 | 
  63 |         ENDDO
  64 | 
  65 |       END SUBROUTINE sendtoslaves