1 | include(dom.inc)
   2 | 
   3 |       SUBROUTINE master_integrate
   4 | !       ================================================================!
   5 | !                                                                       !
   6 | !       master_integrate.F: Copy resulting vectors to master            !
   7 | !                                                                       !
   8 | !       out               :                                             !
   9 | !                                                                       !
  10 | !       author            : D. Poitou (sept2011)                        !
  11 | !                                                                       !
  12 | !       ================================================================!
  13 | 
  14 |         USE mod_prissma
  15 |         USE mod_pmm
  16 |         USE mod_inout
  17 | 
  18 |         USE mod_slave
  19 | 
  20 |         IMPLICIT NONE
  21 | 
  22 |         include 'pmm_constants.h'
  23 | 
  24 |         DOM_INT  :: iproc, ipart, nnodes, iglobal, nbfaces, nprobes, i
  25 |         DOM_INT  :: ierr, ibeg
  26 |         DOM_INT  :: status(MPI_STATUS_SIZE)
  27 |         DOM_REAL :: Gmax, Gmin, Lmax, Lmin, Hmax, Hmin, s_Srvol
  28 | 
  29 | !       ------------------------------!
  30 | !       Result vectors initialization !
  31 | !       ------------------------------!
  32 | 
  33 |         IF (.not.ALLOCATED(Srtot))   ALLOCATE(Srtot(i_dom_nnodes))
  34 |         IF (.not.ALLOCATED(Gtot))    ALLOCATE(Gtot(i_dom_nnodes))
  35 |         IF (.not.ALLOCATED(Lbtot))   ALLOCATE(Lbtot(i_dom_nnodes))
  36 |         IF (.not.ALLOCATED(Htot))    ALLOCATE(Htot(i_dom_nbfaces))
  37 |         IF (.not.ALLOCATED(Qw))      ALLOCATE(Qw(i_dom_nbfaces))
  38 |         IF (.not.ALLOCATED(Q_rtot))  ALLOCATE(Q_rtot(3,i_dom_nnodes))
  39 |         IF (.not.ALLOCATED(Q_ptot))  ALLOCATE(Q_ptot(3,i_dom_nprobes))
  40 | 
  41 |         Lbtot  = 0.
  42 |         Gtot   = 0.
  43 |         Htot   = 0.
  44 |         Qw     = 0.
  45 |         Q_rtot = 0.
  46 |         Q_ptot = 0.
  47 |         Srvtot = 0.
  48 | 
  49 |         ibeg = 1
  50 | 
  51 |         DO ipart = 1, i_dom_npart
  52 |           iproc   = ip_proc1(ipart)
  53 |           nnodes  = ip_nnodes(ipart)
  54 |           nbfaces = ip_nbfaces(ipart)
  55 | 
  56 |           IF(iproc.ne.PMM_HOST) THEN
  57 | 
  58 |           ALLOCATE(s_Gtot (nnodes))
  59 |           ALLOCATE(s_Lbtot(nnodes))
  60 |           ALLOCATE(s_Qrtot(3,nnodes))
  61 |           ALLOCATE(s_Qw(nbfaces))
  62 |           ALLOCATE(s_Htot(nbfaces))
  63 |           ALLOCATE(s_Qptot(3,nprobes))
  64 | 
  65 |           CALL MPI_RECV(s_Gtot, nnodes, MPI_DOUBLE_PRECISION, iproc,    &
  66 |      &                  PMM_RETURN, COMM_PARA, status, ierr)
  67 | 
  68 |           CALL MPI_RECV(s_Lbtot, nnodes, MPI_DOUBLE_PRECISION, iproc,   &
  69 |      &                  PMM_RETURN, COMM_PARA, status, ierr)
  70 | 
  71 |           CALL MPI_RECV(s_Qrtot, 3*nnodes, MPI_DOUBLE_PRECISION, iproc, &
  72 |      &                  PMM_RETURN, COMM_PARA, status, ierr)
  73 | 
  74 |           CALL MPI_RECV(s_Qw, nbfaces, MPI_DOUBLE_PRECISION, iproc,     &
  75 |      &                  PMM_RETURN, COMM_PARA, status, ierr)
  76 | 
  77 |           CALL MPI_RECV(s_Htot, nbfaces, MPI_DOUBLE_PRECISION, iproc,   &
  78 |      &                  PMM_RETURN, COMM_PARA, status, ierr)
  79 | 
  80 |           CALL MPI_RECV(s_Srvol, 1, MPI_DOUBLE_PRECISION, iproc,        &
  81 |      &                  PMM_RETURN, COMM_PARA, status, ierr)
  82 | 
  83 |           CALL MPI_RECV(nprobes, 1, MPI_INTEGER, iproc, PMM_RETURN,     &
  84 |      &                  COMM_PARA, status, ierr)
  85 | 
  86 |           CALL MPI_RECV(s_Qptot, 3*nprobes, MPI_DOUBLE_PRECISION, iproc,&
  87 |      &                  PMM_RETURN, COMM_PARA, status, ierr)
  88 | 
  89 |           ELSE
  90 |             nprobes = is_nprobes
  91 |             s_Srvol  = Sr_vol
  92 |           ENDIF
  93 | 
  94 |             Srvtot = Srvtot + s_Srvol
  95 | 
  96 |             DO i = 1, nnodes
  97 |               iglobal = ip_logo_nodes(i,ipart)
  98 | 
  99 |               IF(Lbtot(iglobal).ne.0) THEN
 100 | 
 101 |                 Lbtot(iglobal)    = (Lbtot(iglobal) + s_Lbtot(i))*0.5
 102 |                 Gtot(iglobal)     = (Gtot(iglobal)  + s_Gtot(i) )*0.5
 103 |                 Q_rtot(:,iglobal) = (Q_rtot(:,iglobal) + s_Qrtot(:,i)) *0.5
 104 | 
 105 |               ELSE
 106 |                 Lbtot(iglobal)    = s_Lbtot(i)
 107 |                 Gtot(iglobal)     = s_Gtot(i)
 108 |                 Q_rtot(:,iglobal) = s_Qrtot(:,i)
 109 |               ENDIF
 110 | 
 111 |             ENDDO
 112 | 
 113 |             DO i= 1, nbfaces
 114 |               iglobal       = ip_logo_bfaces(i,ipart)
 115 | 
 116 |               IF(Htot(iglobal).ne.0) THEN
 117 |                 Htot(iglobal) = (Htot(iglobal) + s_Htot(i))*0.5
 118 |                 Qw(iglobal)   = (Qw(iglobal)   + s_Qw(i)  )*0.5
 119 |               ELSE
 120 |                 Htot(iglobal) = s_Htot(i)
 121 |                 Qw(iglobal)   = s_Qw(i)
 122 |               ENDIF
 123 |             ENDDO
 124 | 
 125 |             IF(i_dom_nprobes.gt.0) THEN
 126 |               Q_ptot(:,ibeg:ibeg+nprobes) = s_Qptot(:,1:nprobes)
 127 |               ibeg = ibeg + nprobes
 128 |             ENDIF
 129 | 
 130 |           DEALLOCATE(s_Gtot)
 131 |           DEALLOCATE(s_Lbtot)
 132 |           DEALLOCATE(s_Qrtot)
 133 |           DEALLOCATE(s_Qw)
 134 |           DEALLOCATE(s_Htot)
 135 |           DEALLOCATE(s_Qptot)
 136 | 
 137 |         ENDDO
 138 | 
 139 |         Srtot  = Lbtot - Gtot
 140 | 
 141 | 
 142 | !       --------------!
 143 | !       Printing data !
 144 | !       --------------!
 145 | 
 146 |         Gmax = MAXVAL(Gtot)
 147 |         Gmin = MINVAL(Gtot)
 148 |         Lmax = MAXVAL(Lbtot)
 149 |         Lmin = MINVAL(Lbtot)
 150 |         Hmax = MAXVAL(Htot)
 151 |         Hmin = MINVAL(Htot)
 152 | 
 153 | !       print*, " ---------------------"
 154 | !       print*, " Procesor: ", iproc
 155 | !       print*, " Gmax from (",iproc,") = ", Gmax
 156 | !       print*, " Gmin from (",iproc,") = ", Gmin
 157 | !       print*, " Lmax from (",iproc,") = ", Lmax
 158 | !       print*, " Lmin from (",iproc,") = ", Lmin
 159 | !       print*, " Hmax from (",iproc,") = ", Hmax
 160 | !       print*, " Hmin from (",iproc,") = ", Hmin
 161 | !       print*, " "
 162 | !       print*, " max Sr = ", MAXVAL(Srtot)
 163 | !       print*, " ---------------------"
 164 | 
 165 |       END SUBROUTINE master_integrate