/[MITgcm]/MITgcm/pkg/flt/flt_exch2.F
ViewVC logotype

Diff of /MITgcm/pkg/flt/flt_exch2.F

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

revision 1.2 by jahn, Wed Dec 22 21:25:18 2010 UTC revision 1.3 by jmc, Thu Sep 6 16:14:28 2012 UTC
# Line 3  C $Name$ Line 3  C $Name$
3    
4  #include "FLT_OPTIONS.h"  #include "FLT_OPTIONS.h"
5  #undef DBUG_EXCH_VEC  #undef DBUG_EXCH_VEC
 #define FLT_WITHOUT_X_PERIODICITY  
6    
7        SUBROUTINE FLT_EXCH2 (        SUBROUTINE FLT_EXCH2 (
8       I                       myTime, myIter, myThid )       I                       myTime, myIter, myThid )
# Line 31  C     == global variables == Line 30  C     == global variables ==
30  #include "W2_EXCH2_SIZE.h"  #include "W2_EXCH2_SIZE.h"
31  #include "W2_EXCH2_PARAMS.h"  #include "W2_EXCH2_PARAMS.h"
32  #include "W2_EXCH2_TOPOLOGY.h"  #include "W2_EXCH2_TOPOLOGY.h"
 #include "W2_EXCH2_BUFFER.h"  
33  #endif  #endif
34    
35  C     == routine arguments ==  C     == routine arguments ==
# Line 46  C     == local variables == Line 44  C     == local variables ==
44        INTEGER icountE, icountW, icountN, icountS        INTEGER icountE, icountW, icountN, icountS
45        INTEGER deleteList(max_npart_exch*2)        INTEGER deleteList(max_npart_exch*2)
46        INTEGER imax, imax2, m        INTEGER imax, imax2, m
47        INTEGER nT, ipass, myFace        INTEGER N, nT, ipass, myFace
48        INTEGER e2_msgHandles( 2, W2_maxNeighbours, nSx, nSy )        INTEGER e2_msgHandles( 2, W2_maxNeighbours, nSx, nSy )
49        _RL ilo, ihi, jlo, jhi, iNew, jNew        _RL ilo, ihi, jlo, jhi, iNew, jNew
50        PARAMETER(imax=9)        PARAMETER(imax=9)
51        PARAMETER(imax2=imax*max_npart_exch)        PARAMETER(imax2=imax*max_npart_exch)
52        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
 #ifdef ALLOW_USE_MPI  
 C     MPI stuff (should be in a routine call)  
       INTEGER mpiStatus(MPI_STATUS_SIZE)  
       INTEGER mpiRc  
       INTEGER wHandle  
       INTEGER nN, N, farTile  
 #endif  
53    
54    C     buffer for sending/receiving variables (4 levels <-> N,S,E,W)
 C     buffer for sending/receiving variables (E/W are also used for S/N)  
55        COMMON/FLTBUF/fltbuf_send,fltbuf_recv        COMMON/FLTBUF/fltbuf_send,fltbuf_recv
56        _RL fltbuf_send(imax2,nSx,nSy,4)        _RL fltbuf_send(imax2,nSx,nSy,4)
57        _RL fltbuf_recv(imax2,nSx,nSy,4)        _RL fltbuf_recv(imax2,nSx,nSy,4)
# Line 74  C have to do 2 passes to get into tiles Line 64  C have to do 2 passes to get into tiles
64        DO ipass=1,2        DO ipass=1,2
65    
66  C     Prevent anyone to access shared buffer while an other thread modifies it  C     Prevent anyone to access shared buffer while an other thread modifies it
67          CALL BAR2( myThid )  C--   not needed here since send buffer is different fron recv buffer
68    C     (which is not the case for usual 3-D field exch in EXCH2)
69    c       CALL BAR2( myThid )
70    
71  C--   Choose floats that have to exchanged with eastern and western tiles  C--   Choose floats that have to exchanged with eastern and western tiles
72  C     and pack to arrays  C     and pack to arrays
# Line 86  C     and pack to arrays Line 78  C     and pack to arrays
78    
79  C initialize buffers  C initialize buffers
80             DO N=1,4             DO N=1,4
81             DO m=1,imax2              DO m=1,imax2
82               fltbuf_send(m,bi,bj,N) = 0.               fltbuf_send(m,bi,bj,N) = 0.
83               fltbuf_recv(m,bi,bj,N) = 0.               fltbuf_recv(m,bi,bj,N) = 0.
84             ENDDO              ENDDO
85             ENDDO             ENDDO
86    
87             icountE=0             icountE=0
# Line 98  C initialize buffers Line 90  C initialize buffers
90    
91             ilo = 0.5 _d 0             ilo = 0.5 _d 0
92             ihi = 0.5 _d 0 + DFLOAT(sNx)             ihi = 0.5 _d 0 + DFLOAT(sNx)
93             wSide=exch2_isWedge(nT).AND.facet_link(W2_WEST,myFace).EQ.0.             wSide = exch2_isWedge(nT).EQ.1
94             eSide=exch2_isEedge(nT).AND.facet_link(W2_EAST,myFace).EQ.0.       &       .AND. facet_link(W2_WEST,myFace).EQ.0.
95               eSide = exch2_isEedge(nT).EQ.1
96         &       .AND. facet_link(W2_EAST,myFace).EQ.0.
97             flt_stopped = -2.             flt_stopped = -2.
98             flt_stopped = MIN( baseTime, flt_stopped )             flt_stopped = MIN( baseTime, flt_stopped )
99    
# Line 211  C        copy: ip <-- jp Line 205  C        copy: ip <-- jp
205    
206             jlo = 0.5 _d 0             jlo = 0.5 _d 0
207             jhi = 0.5 _d 0 + DFLOAT(sNy)             jhi = 0.5 _d 0 + DFLOAT(sNy)
208             sSide=exch2_isSedge(nT).AND.facet_link(W2_SOUTH,myFace).EQ.0.             sSide = exch2_isSedge(nT).EQ.1
209             nSide=exch2_isNedge(nT).AND.facet_link(W2_NORTH,myFace).EQ.0.       &       .AND. facet_link(W2_SOUTH,myFace).EQ.0.
210               nSide = exch2_isNedge(nT).EQ.1
211         &       .AND. facet_link(W2_NORTH,myFace).EQ.0.
212             flt_stopped = -2.             flt_stopped = -2.
213             flt_stopped = MIN( baseTime, flt_stopped )             flt_stopped = MIN( baseTime, flt_stopped )
214    
# Line 335  C        copy: ip <-- jp Line 331  C        copy: ip <-- jp
331           ENDDO           ENDDO
332          ENDDO          ENDDO
333    
334    C     Prevent anyone to access shared buffer while an other thread modifies it
335            _BARRIER
336    
337  C--   Send or Put east and west edges.  C--   Send or Put east and west edges.
338    
339  #ifdef DBUG_EXCH_VEC  #ifdef DBUG_EXCH_VEC
340          WRITE(errorMessageUnit,'(A,I8)') 'FLT_EXCH: 0x', myIter          WRITE(errorMessageUnit,'(A,I8)') 'FLT_EXCH: 0x', myIter
341  #endif  #endif
342          CALL EXCH2_RL_SEND_PUT_VEC(          CALL EXCH2_SEND_PUT_VEC_RL(
343       I                               fltbuf_send, fltbuf_recv,       I                               fltbuf_send,
344         O                               fltbuf_recv,
345       O                               e2_msgHandles(1,1,1,1),       O                               e2_msgHandles(1,1,1,1),
346       I                               imax2, myThid )       I                               imax2, myThid )
347  #ifdef DBUG_EXCH_VEC  #ifdef DBUG_EXCH_VEC
348          WRITE(errorMessageUnit,'(A,I8)') 'FLT_EXCH2: 1x', myIter          WRITE(errorMessageUnit,'(A,I8)') 'FLT_EXCH2: 1x', myIter
349  #endif  #endif
350    
351    #ifdef ALLOW_USE_MPI
352            IF ( usingMPI ) THEN
353  C--   Receive east/west arrays  C--   Receive east/west arrays
354          CALL EXCH2_RL_RECV_GET_VEC(           CALL EXCH2_RECV_GET_VEC_RL(
355       U                               fltbuf_recv,       U                               fltbuf_recv,
356         I                               e2_msgHandles(1,1,1,1),
357       I                               imax2, myThid )       I                               imax2, myThid )
358  #ifdef DBUG_EXCH_VEC  #ifdef DBUG_EXCH_VEC
359          WRITE(errorMessageUnit,'(A,I8)') 'FLT_EXCH2: 2x', myIter           WRITE(errorMessageUnit,'(A,I8)') 'FLT_EXCH2: 2x', myIter
360  #endif  #endif
361            ENDIF
362    #endif /* ALLOW_USE_MPI */
363    
364  #ifdef ALLOW_USE_MPI  C--   need to sync threads after master has received data ;
365  C--   Clear message handles/locks  C     (done after mpi waitall in case waitall is really needed)
366          DO bj=1,nSy          _BARRIER
          DO bi=1,nSx  
           nT=W2_myTileList(bi,bj)  
           nN=exch2_nNeighbours(nT)  
           DO N=1,nN  
 C       Note: In a between process tile-tile data transport using  
 C             MPI the sender needs to clear an Isend wait handle here.  
 C             In a within process tile-tile data transport using true  
 C             shared address space/or direct transfer through commonly  
 C             addressable memory blocks the receiver needs to assert  
 C             that he has consumed the buffer the sender filled here.  
            farTile=exch2_neighbourId(N,nT)  
            IF     ( W2_myCommFlag(N,bi,bj) .EQ. 'M' ) THEN  
             wHandle = e2_msgHandles(1,N,bi,bj)  
             CALL MPI_Wait( wHandle, mpiStatus, mpiRc )  
            ELSEIF ( W2_myCommFlag(N,bi,bj) .EQ. 'P' ) THEN  
            ELSE  
            ENDIF  
           ENDDO  
          ENDDO  
         ENDDO  
 #endif  
367    
368  C--   Unpack arrays on new tiles  C--   Unpack arrays on new tiles
369    
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3
  ViewVC Help
Powered by ViewVC 1.1.22