/[MITgcm]/MITgcm/eesupp/src/gather_2d.F
ViewVC logotype

Diff of /MITgcm/eesupp/src/gather_2d.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.1 by dimitri, Wed Feb 5 07:12:59 2003 UTC revision 1.2 by dimitri, Tue Feb 18 05:33:53 2003 UTC
# Line 0  Line 1 
1    #include "CPP_OPTIONS.h"
2    
3          SUBROUTINE GATHER_2D( global, local, myThid )
4    C     Gather elements of a 2-D array from all mpi processes to process 0.
5          IMPLICIT NONE
6    #include "SIZE.h"
7    #include "EEPARAMS.h"
8    #include "EESUPPORT.h"
9    C     mythid - thread number for this instance of the routine.
10    C     global,local - working arrays used to transfer 2-D fields
11          INTEGER mythid
12          Real*8  global(Nx,Ny)
13          _RL     local(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
14    
15    #ifdef ALLOW_USE_MPI
16          COMMON /GlobalLo/ mpi_myXGlobalLo, mpi_myYGlobalLo
17          INTEGER mpi_myXGlobalLo(nPx*nPy)
18          INTEGER mpi_myYGlobalLo(nPx*nPy)
19    
20          _RL     temp(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
21          INTEGER istatus(MPI_STATUS_SIZE), ierr
22          INTEGER idest, itag, npe, ready_to_receive
23          INTEGER iP, jP, iG,jG, i, j, bi, bj, lbuff
24    
25    C--   Make everyone wait except for master thread.
26          _BARRIER
27          _BEGIN_MASTER( myThid )
28          lbuff = (sNx+2*OLx)*nSx*(sNy+2*OLy)*nSy
29          idest = 0
30          itag  = 0
31          ready_to_receive = 0
32    
33          IF( mpiMyId .EQ. 0 ) THEN
34    
35    C--   Process 0 fills-in its local data
36             npe = 0
37             DO bj=1,nSy
38                DO bi=1,nSx
39                   DO j=1,sNy
40                      DO i=1,sNx
41                         iP = (bi-1)*sNx+i
42                         jP = (bj-1)*sNy+j
43                         iG = mpi_myXGlobalLo(npe+1)-1+(bi-1)*sNx+i
44                         jG = mpi_myYGlobalLo(npe+1)-1+(bj-1)*sNy+j
45                         global(iG,jG) = local(i,j,bi,bj)
46                      ENDDO
47                   ENDDO
48                ENDDO
49             ENDDO
50    
51    C--   Process 0 polls and receives data from each process in turn
52             DO npe = 1, numberOfProcs-1
53                CALL MPI_SEND (ready_to_receive, 1, MPI_INTEGER,
54         &           npe, itag, MPI_COMM_MODEL, ierr)
55                CALL MPI_RECV (temp, lbuff, MPI_DOUBLE_PRECISION,
56         &           npe, itag, MPI_COMM_MODEL, istatus, ierr)
57    
58    C--   Process 0 gathers the local arrays into a global array.
59                DO bj=1,nSy
60                   DO bi=1,nSx
61                      DO j=1,sNy
62                         DO i=1,sNx
63                            iP = (bi-1)*sNx+i
64                            jP = (bj-1)*sNy+j
65                            iG = mpi_myXGlobalLo(npe+1)-1+(bi-1)*sNx+i
66                            jG = mpi_myYGlobalLo(npe+1)-1+(bj-1)*sNy+j
67                            global(iG,jG) = temp(i,j,bi,bj)
68                         ENDDO
69                      ENDDO
70                   ENDDO
71                ENDDO
72             ENDDO
73    
74          ELSE
75    
76    C--   All proceses except 0 wait to be polled then send local array
77             CALL MPI_RECV (ready_to_receive, 1, MPI_INTEGER,
78         &        idest, itag, MPI_COMM_MODEL, istatus, ierr)
79             CALL MPI_SEND (local, lbuff, MPI_DOUBLE_PRECISION,
80         &        idest, itag, MPI_COMM_MODEL, ierr)
81    
82          ENDIF
83    
84          _END_MASTER( myThid )
85          _BARRIER
86    
87    #endif /* ALLOW_USE_MPI */
88          RETURN
89          END
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
  ViewVC Help
Powered by ViewVC 1.1.22