1 | include(dom.inc)
   2 | 
   3 |       SUBROUTINE slave_vectors(d_buffer,d_buffersize)
   4 | 
   5 | !       ================================================================!
   6 | !                                                                       !
   7 | !       slave_vectors.F : Fills global vectors on slave processes.      !
   8 | !                         slave processes.                              !
   9 | !                                                                       !
  10 | !       out             : Global vectors and values for slave processes !  
  11 | !                                                                       !
  12 | !       author          : J. AMAYA (october 2007)                       !
  13 | !                                                                       !
  14 | !       ================================================================!
  15 | 
  16 |         USE mod_pmm
  17 |         USE mod_inout
  18 |         USE mod_slave
  19 | 
  20 |         IMPLICIT NONE
  21 | 
  22 |         INCLUDE 'pmm_constants.h'
  23 |         INCLUDE 'dom_constants.h'
  24 | 
  25 | !       IN
  26 |         DOM_INT :: d_buffersize
  27 |         DOM_REAL, DIMENSION(d_buffersize) :: d_buffer
  28 | 
  29 | !       LOCAL
  30 |         DOM_INT :: i, j, k, n, iend, ibeg
  31 | 
  32 | !       ----------------!
  33 | !       Allocate vetors !
  34 | !       ----------------!
  35 | 
  36 |         IF (ALLOCATED(s_mu))        DEALLOCATE(s_mu)
  37 |         IF (ALLOCATED(s_eta))       DEALLOCATE(s_eta)
  38 |         IF (ALLOCATED(s_ksi))       DEALLOCATE(s_ksi)
  39 |         IF (ALLOCATED(s_w))         DEALLOCATE(s_w)
  40 |         IF (ALLOCATED(s_maxlen))    DEALLOCATE(s_maxlen)
  41 |         IF (ALLOCATED(s_ss))        DEALLOCATE(s_ss)
  42 | 
  43 |         ALLOCATE(s_mu(is_ndir))
  44 |         ALLOCATE(s_eta(is_ndir))
  45 |         ALLOCATE(s_ksi(is_ndir))
  46 |         ALLOCATE(s_w(is_ndir))
  47 | 
  48 | !       -------------------!
  49 | !       Write real vectors !
  50 | !       -------------------!
  51 | 
  52 |         IF (spascheme.eq.EXPON) then
  53 |           ALLOCATE(s_maxlen(is_ncells,is_ndir))
  54 |           ALLOCATE(s_ss(is_nfacesmax,is_ncells,is_ndir))
  55 |         ENDIF
  56 | 
  57 |         s_mu   (1:is_ndir) = d_buffer(1:is_ndir)
  58 |         s_eta  (1:is_ndir) = d_buffer(is_ndir+1:2*is_ndir)
  59 |         s_ksi  (1:is_ndir) = d_buffer(2*is_ndir+1:3*is_ndir)
  60 |         s_w    (1:is_ndir) = d_buffer(3*is_ndir+1:4*is_ndir)
  61 | 
  62 | !       print*," (",pmm_rank,") is_ndir: ", is_ndir
  63 | !       print*," (",pmm_rank,") Directions:"
  64 | !       DO i=1,is_ndir
  65 | !         print*," (",pmm_rank,")   ",i,":",s_mu(i),s_eta(i),s_ksi(i)
  66 | !       ENDDO
  67 | 
  68 |         IF (spascheme.eq.EXPON) then
  69 |           ibeg = 4*is_ndir
  70 |           iend = ibeg+is_ndir*is_ncells
  71 |           DO j=1,is_ndir
  72 |             DO i=1,is_ncells
  73 |               n = (j-1)*is_ncells+i
  74 |               s_maxlen(i,j) = d_buffer(ibeg+n)
  75 |             ENDDO
  76 |           ENDDO
  77 | 
  78 |           ibeg = iend
  79 |           iend = ibeg+is_ndir*is_ncells*is_nfacesmax
  80 |           DO k=1,is_ndir
  81 |             DO j=1,is_ncells
  82 |               DO i=1, is_nfacesmax
  83 |                 n = (k-1)*is_ncells*is_nfacesmax + (j-1)*is_nfacesmax +i
  84 |                 s_ss(i,j,k) = d_buffer(ibeg+n)
  85 |               ENDDO
  86 |             ENDDO
  87 |           ENDDO
  88 |         ENDIF
  89 | 
  90 |       END SUBROUTINE slave_vectors