pkg/sphere/exch_all_2d_rl.F

0bed5b371d Patr*0001 #include "CPP_OPTIONS.h"
                0002
                0003       subroutine exch_allgather_2d_rl(
                0004      I       arr
                0005      O     , full
d85ace1852 Jean*0006      I     , myThid
0bed5b371d Patr*0007      &     )
                0008
                0009 c     ==================================================================
                0010 c     SUBROUTINE exch_allgather_2d_rl
                0011 c     ==================================================================
                0012 c
                0013 c     o exchange local domains of a distributed 2d field
                0014 c       so that every processor has the whole field
                0015 c
                0016 c     started: Ralf Giering Ralf.Giering@FastOpt.de 12-Jun-2001
                0017 c
                0018 c     ==================================================================
                0019 c     SUBROUTINE exch_allgather_2d_rl
                0020 c     ==================================================================
                0021       implicit none
                0022
                0023 c     == global variables ==
                0024
                0025 #include "EEPARAMS.h"
                0026 #include "SIZE.h"
                0027 #include "EESUPPORT.h"
                0028 #include "EXCH.h"
                0029
                0030 c     == routine arguments ==
                0031
                0032       _RL arr ( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy, nSx, nSy )
                0033       _RL full( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy, nSx, nSy, nPx, nPy )
d85ace1852 Jean*0034       integer myThid
0bed5b371d Patr*0035
                0036 c     == local variables ==
                0037 #ifdef ALLOW_USE_MPI
                0038       integer mpirc
                0039       integer mpicrd(2)
                0040       integer ipx, ipy
                0041
                0042       _RL recvbuf( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy, nSx, nSy, nPx*nPy )
                0043
                0044       integer    sendsize
                0045       parameter( sendsize = sNx*sNy*nSx*nSy )
                0046       integer    recvsize
                0047       parameter( recvsize = sNx*sNy*nSx*nSy )
                0048
                0049       integer iproc
                0050       integer bi, bj
                0051       integer i, j
                0052 #endif
                0053
                0054 C--   Can not start until everyone is ready
                0055       _BARRIER
                0056
                0057 c--   Only the master thread is doing communication
                0058       _BEGIN_MASTER( myThid )
                0059
                0060 #ifdef ALLOW_USE_MPI
                0061       IF ( usingMPI ) THEN
                0062
                0063       call MPI_Allgather(  arr    , sendsize, MPI_DOUBLE_PRECISION
                0064      &                   , recvbuf, recvsize, MPI_DOUBLE_PRECISION
                0065      &                   , MPI_COMM_MODEL, mpiRC
                0066      &                   )
                0067
                0068 c--   arrange array according to cartesian coordinates of processors
                0069       do iproc = 1, numberOfProcs
                0070
                0071 c--     get coordinates of processor (iporc-1)
                0072         call MPI_Cart_coords(
                0073      I          MPI_COMM_MODEL, iproc-1, 2, mpicrd
                0074      O        , mpirc
                0075      &        )
                0076
                0077         ipx = 1 + mpicrd(1)
                0078         ipy = 1 + mpicrd(2)
                0079
                0080         do bj = 1, nSy
                0081           do bi = 1, nSx
                0082             do j = 1, sNy
                0083               do i = 1, sNx
                0084                 full(i,j,bi,bj,ipx,ipy) = recvbuf(i,j,bi,bj,iproc)
                0085               enddo
                0086             enddo
                0087           enddo
                0088         enddo
                0089
                0090       enddo
                0091
7c7521a1da Jean*0092       ENDIF
0bed5b371d Patr*0093 #endif /* ALLOW_USE_MPI */
                0094
                0095 c--   end of master thread only computations
                0096       _END_MASTER( myThid )
                0097
                0098       _BARRIER
                0099
d85ace1852 Jean*0100       RETURN
                0101       END