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, pathway, maxlen and s_s.           !
  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 |           IF (spascheme.eq.EXPON) then
  44 |             id_buffersize = id_buffersize + (l_ndir*i_dom_ncells) +     &
  45 |      &                    (l_ndir*i_dom_ncells*2*i_dom_nfacesmax)
  46 |           ENDIF
  47 | 
  48 |           ALLOCATE(d_buffer(id_buffersize))
  49 | 
  50 | !         --------------------------!
  51 | !         Fill the buffer with data !
  52 | !         --------------------------!
  53 | 
  54 |           d_buffer(1         :  l_ndir) = mu (dir_d(iproc):dir_f(iproc))
  55 |           d_buffer(l_ndir+1  :2*l_ndir) = eta(dir_d(iproc):dir_f(iproc))
  56 |           d_buffer(2*l_ndir+1:3*l_ndir) = ksi(dir_d(iproc):dir_f(iproc))
  57 |           d_buffer(3*l_ndir+1:4*l_ndir) = w  (dir_d(iproc):dir_f(iproc))
  58 | 
  59 |           IF (spascheme.eq.EXPON) then
  60 |             ibeg = 4*l_ndir
  61 |             iend = ibeg+l_ndir*i_dom_ncells
  62 |             DO j=1,l_ndir
  63 |               DO i=1,i_dom_ncells
  64 |                 n = (j-1)*i_dom_ncells+i
  65 |                 d_buffer(ibeg+n) = maxlen(i,j)
  66 |               ENDDO
  67 |             ENDDO
  68 | 
  69 |             ibeg = iend
  70 |             iend = ibeg+l_ndir*i_dom_ncells*i_dom_nfacesmax
  71 |             DO k=1,l_ndir
  72 |               DO j=1,i_dom_ncells
  73 |                 DO i=1, i_dom_nfacesmax
  74 |                   n = (k-1)*i_dom_ncells*i_dom_nfacesmax +              &
  75 |      &                (j-1)*i_dom_nfacesmax + i
  76 |                   d_buffer(ibeg+n) = s_s(i,j,k)
  77 |                 ENDDO
  78 |               ENDDO
  79 |             ENDDO
  80 |           ENDIF
  81 | 
  82 | !         -----------------------!
  83 | !         Send vectors to slaves !
  84 | !         -----------------------!
  85 | 
  86 |           CALL pmm_sendvectors(d_buffer, id_buffersize, iproc)
  87 | 
  88 |           DEALLOCATE(d_buffer)
  89 | 
  90 |         ENDDO
  91 | 
  92 |       END SUBROUTINE sendtoslaves