C $Id: exch.F,v 1.2 2006/05/12 22:22:11 ce107 Exp $ SUBROUTINE EXCH_XY_R8( arr ) C == Global variables == #include "SIZE.h" #include "EEPARAMS.h" #include "EXCH.h" #ifdef ALLOW_MPI #include "mpif.h" #include "MPI_INFO.h" #endif #include "JAM_INFO.h" C == Routine arguments == Real arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy) C == Local variables == INTEGER I, J INTEGER northProc, southProc #ifdef DECOMP2D INTEGER eastProc, westProc #endif INTEGER farProc1, farProc2 INTEGER toPid, fromPid INTEGER rc INTEGER myFourWayRank, exchangePhase #ifdef ALLOW_MPI INTEGER mpiReq(8) INTEGER mpiStat(MPI_STATUS_SIZE,8) INTEGER mpiStatus(MPI_STATUS_SIZE) #endif #ifndef DECOMP2D C East-west halo update (without corners) DO J=1,sNy DO I=1,OLx arr(1-I ,J) = arr(sNx-I+1,J) arr(sNx+I,J) = arr(1+I-1 ,J) ENDDO ENDDO #endif C Phase 1 pairing C | 0 | ---> | 1 | C | 0 | <--- | 1 | C | 2 | ---> | 3 | C | 2 | <--- | 3 | C | 4 | ---> | 5 | C | 4 | <--- | 5 | C etc ... C #ifdef USE_MPI_EXCH #ifdef DECOMP2D C East-West exchanges #ifdef USE_SNDRCV C Send West, receive from East CALL MPI_Sendrecv(arr(1,1), 1, ewslice, mpi_westId, 100, $ arr(sNx+1,1), 1, ewslice, mpi_eastId, 100, comm_use, $ mpiStatus, rc) C Send East, receive from West CALL MPI_Sendrecv(arr(sNx-OLx+1,1), 1, ewslice, mpi_eastId, 200, $ arr(1-OLx,1), 1, ewslice, mpi_westId, 200, comm_use, $ mpiStatus,rc) C North-South exchanges C Send South, receive from North CALL MPI_Sendrecv(arr(1,1), 1, nsslice, mpi_southId, 300, $ arr(1,sNy+1), 1, nsslice, mpi_northId, 300, comm_use, $ mpiStatus, rc) C Send North, receive from South CALL MPI_Sendrecv(arr(1,sNy-OLy+1), 1, nsslice, mpi_northId, 400, $ arr(1,1-OLy), 1, nsslice, mpi_southId, 400, comm_use, $ mpiStatus,rc) #else C Send West, receive from East CALL MPI_Isend(arr(1,1), 1, ewslice, mpi_westId, 100, $ comm_use, mpiReq(1), rc) CALL MPI_Irecv(arr(sNx+1,1), 1, ewslice, mpi_eastId, 100, $ comm_use, mpiReq(2), rc) C Send East, receive from West CALL MPI_Isend(arr(sNx-OLx+1,1), 1, ewslice, mpi_eastId, 200, $ comm_use, mpiReq(3), rc) CALL MPI_Irecv(arr(1-OLx,1), 1, ewslice, mpi_westId, 200, $ comm_use, mpiReq(4),rc) C North-South exchanges C Send South, receive from North CALL MPI_Isend(arr(1,1), 1, nsslice, mpi_southId, 300, $ comm_use, mpiReq(5), rc) CALL MPI_Irecv(arr(1,sNy+1), 1, nsslice, mpi_northId, 300, $ comm_use, mpiReq(6), rc) C Send North, receive from South CALL MPI_Isend(arr(1,sNy-OLy+1), 1, nsslice, mpi_northId, 400, $ comm_use, mpiReq(7), rc) CALL MPI_Irecv(arr(1,1-OLy), 1, nsslice, mpi_southId, 400, $ comm_use, mpiReq(8),rc) CALL MPI_Waitall(8, mpiReq, mpiStat, rc) #endif #else C North-south halo update (without corners) C Put my edges into a buffers IF ( MOD(myProcId,2) .EQ. 0 ) THEN DO I=1,sNx exchBuf1(I) = arr(I,sNy) exchBuf2(I) = arr(I,1 ) ENDDO ELSE DO I=1,sNx exchBuf1(I) = arr(I,1 ) exchBuf2(I) = arr(I,sNy) ENDDO ENDIF C Exchange the buffers northProc = mpi_northId southProc = mpi_southId IF ( MOD(myProcId,2) .EQ. 0 ) THEN farProc1 = northProc farProc2 = southProc ELSE farProc1 = southProc farProc2 = northProc ENDIF C Even-odd pairs IF ( farProc1 .NE. myProcId ) THEN CALL MPI_Sendrecv_replace(exchBuf1,sNx,_MPI_TYPE_REAL, & farProc1,0, & farProc1,MPI_ANY_TAG, & comm_use,mpiStatus, & rc) ENDIF C Odd-even pairs IF ( farProc2 .NE. myProcId ) THEN CALL MPI_Sendrecv_replace(exchBuf2,sNx,_MPI_TYPE_REAL, & farProc2,0, & farProc2,MPI_ANY_TAG, & comm_use,mpiStatus, & rc) ENDIF #endif #endif #ifdef USE_JAM_EXCH myFourWayRank = MOD(myProcId,4) northProc = jam_northId southProc = jam_southId IF ( MOD(myProcId,2) .EQ. 0 ) THEN C sendBuf1 = &arr(I,sNy ) C recvBuf1 = &arr(I,sNy+1) C sendBuf2 = &arr(I,1 ) C recvBuf2 = &arr(I,0 ) farProc1 = northProc farProc2 = southProc IF ( farProc1 .NE. myProcId ) THEN CALL JAM_EXCHANGE(farProc1,arr(I,sNy),arr(I,sNy+1),sNx*8 $ ,jam_exchKey) jam_exchKey = jam_exchKey+1 ENDIF 10 CONTINUE CALL JAM_EXCHANGE_TEST( exchangePhase ) IF ( myFourWayRank .EQ. 0 ) THEN IF ( exchangePhase .EQ. 0 ) GOTO 11 ELSE IF ( exchangePhase .EQ. 1 ) GOTO 11 ENDIF GOTO 10 11 CONTINUE IF ( farProc2 .NE. myProcId ) THEN CALL JAM_EXCHANGE(farProc2,arr(I,1),arr(I,0),sNx*8,jam_exchKey) jam_exchKey = jam_exchKey+1 ENDIF CALL JAM_EXCHANGE_MARK ELSE C sendBuf1 = &arr(I,1 ) C recvBuf1 = &arr(I,0 ) C sendBuf2 = &arr(I,sNy ) C recvBuf2 = &arr(I,sNy+1) farProc1 = southProc farProc2 = northProc IF ( farProc1 .NE. myProcId ) THEN CALL JAM_EXCHANGE(farProc1,arr(I,1),arr(I,0),sNx*8,jam_exchKey) jam_exchKey = jam_exchKey+1 ENDIF 20 CONTINUE CALL JAM_EXCHANGE_TEST( exchangePhase ) IF ( myFourWayRank .EQ. 3 ) THEN IF ( exchangePhase .EQ. 0 ) GOTO 21 ELSE IF ( exchangePhase .EQ. 1 ) GOTO 21 ENDIF GOTO 20 21 CONTINUE IF ( farProc2 .NE. myProcId ) THEN CALL JAM_EXCHANGE(farProc2,arr(I,sNy),arr(I,sNy+1),sNx*8 $ ,jam_exchKey) jam_exchKey = jam_exchKey+1 ENDIF CALL JAM_EXCHANGE_MARK ENDIF #endif #if defined(USE_MPI_EXCH) && !defined(DECOMP2D) C Fill overlap regions from the buffers IF ( MOD(myProcId,2) .EQ. 0 ) THEN DO I=1,sNx arr(I,sNy+1) = exchBuf1(I) arr(I,0 ) = exchBuf2(I) ENDDO ELSE DO I=1,sNx arr(I,sNy+1) = exchBuf2(I) arr(I,0 ) = exchBuf1(I) ENDDO ENDIF #endif IF ( numberOfProcs .EQ. 1 ) THEN DO I=1,sNx arr(I,sNy+1) = arr(I,1 ) arr(I,0 ) = arr(I,sNy) ENDDO ENDIF RETURN END