pkg/exch2/w2_map_procs.F

0acd686861 Jean*0001 #include "CPP_EEOPTIONS.h"
                0002
                0003 CBOP
                0004 C     !ROUTINE: W2_MAP_PROCS
                0005
                0006 C     !INTERFACE:
                0007       SUBROUTINE W2_MAP_PROCS( myThid )
                0008
                0009 C     !DESCRIPTION:
                0010 C     *==========================================================*
                0011 C     | SUBROUTINE W2_MAP_PROCS
                0012 C     | o Setup Mapping of W2-topology tiles to processes
                0013 C     *==========================================================*
                0014 C     | Set which process "own" which tiles
                0015 C     | and store the 2-way relation between, on one side,
                0016 C     |  tile Id from W2-topology and, on the other side,
                0017 C     |  process Id with local tile indices bi,bj.
                0018 C     *==========================================================*
                0019
                0020 C     !USES:
                0021       IMPLICIT NONE
                0022
                0023 #include "SIZE.h"
                0024 #include "EEPARAMS.h"
                0025 #include "W2_EXCH2_SIZE.h"
                0026 #include "W2_EXCH2_TOPOLOGY.h"
                0027 #include "W2_EXCH2_PARAMS.h"
                0028
                0029 C     !INPUT PARAMETERS:
                0030 C     myThid  :: my Thread Id number
                0031 C               (Note: not relevant since threading has not yet started)
                0032       INTEGER myThid
                0033 CEOP
                0034
                0035 C     !FUNCTIONS:
                0036
                0037 C     !LOCAL VARIABLES:
                0038       INTEGER thisProc
                0039       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0040       CHARACTER commFlag
                0041       INTEGER myTileId
                0042       INTEGER I, J
                0043       INTEGER np, ii, jj, bi, bj
                0044       INTEGER iErr, tNx, tNy
                0045
                0046 C--   Initialise common blocs W2_MAP_TILE2PROC & W2_EXCH2_COMMFLAG:
                0047       DO I = 1,W2_maxNbTiles
                0048         W2_tileProc(I)  = 0
a561475a37 Jean*0049         W2_tileIndex(I) = 0
0acd686861 Jean*0050 c       W2_tileRank(I)  = 0
                0051       ENDDO
                0052       DO bj=1,nSy
                0053        DO bi=1,nSx
                0054          W2_myTileList(bi,bj) = 0
                0055          DO np=1,nPx*nPy
                0056            W2_procTileList(bi,bj,np) = 0
                0057          ENDDO
                0058          DO J=1,W2_maxNeighbours
                0059            W2_myCommFlag(J,bi,bj) = ' '
                0060          ENDDO
                0061        ENDDO
                0062       ENDDO
                0063
                0064 C--   Decide which tiles this process handles - do this inline for now, but
                0065 C     should go in subroutine.
                0066 C     Set which rank processes "own" which tiles. This should probably
                0067 C     be queried as part of some hand-shaking but for now we use the
                0068 C     functional relationship that was used above.
                0069 C     Fill also W2_procTileList for Single-CPU-IO.
                0070
                0071 C     Number of tiles I handle is nSx*nSy
                0072       thisProc = 1 + myProcId
                0073       J = 0
                0074       DO I=1,exch2_nTiles
                0075        IF ( exch2_myFace(I) .NE. 0 ) THEN
                0076 C--   old ordering (makes no difference if nSy*nPy=1 )
                0077 c       np = 1 + J/(nSx*nSy)
                0078 c       jj = MOD(J,nSx*nSy)
                0079 c       bj = 1 + jj/nSx
                0080 c       bi = 1 + MOD(jj,nSx)
                0081 C--   new ordering: for single sub-domain (nFacets=1) case, match default setting
                0082         jj = J/(nSx*nPx)
                0083         ii = MOD(J,nSx*nPx)
                0084 C--   natural way to order processors:
                0085 c       np = 1 + ii/nSx + (jj/nSy)*nPx
                0086 C--   switch processor order to match MPI_CART set-up
                0087         np = 1 + jj/nSy + (ii/nSx)*nPy
                0088         bj = 1 + MOD(jj,nSy)
                0089         bi = 1 + MOD(ii,nSx)
                0090 C--
                0091         W2_tileProc(I) = np
a561475a37 Jean*0092         W2_tileIndex(I)= bi + (bj-1)*nSx
0acd686861 Jean*0093         W2_procTileList(bi,bj,np) = I
                0094         IF ( np.EQ.thisProc ) W2_myTileList(bi,bj) = I
                0095         J = J + 1
                0096 c       W2_tileRank(I) = J
                0097        ENDIF
                0098       ENDDO
                0099       IF ( J .NE. nSx*nSy*nPx*nPy ) THEN
                0100        STOP
                0101      & 'ERROR W2_MAP_PROCS: number of active tiles not =nPx*nSx*nPy*nSy'
                0102       ENDIF
                0103
                0104 C--   Check tile sizes
                0105       iErr = 0
                0106       DO bj=1,nSy
                0107        DO bi=1,nSx
                0108         myTileId = W2_myTileList(bi,bj)
                0109         tNx = exch2_tNx(myTileId)
                0110         tNy = exch2_tNy(myTileId)
                0111         IF ( tNx .NE. sNx ) THEN
b9dadda204 Mart*0112          WRITE(msgBuf,'(A,I8,2(A,I5))')
0acd686861 Jean*0113      &   'ERROR: S/R W2_MAP_PROCS Topology for tile', myTileId,
                0114      &   'tNx=', tNx, ' is not equal to subgrid size sNx=', sNx
                0115          CALL PRINT_MESSAGE(msgBuf,
                0116      &        errorMessageUnit, SQUEEZE_RIGHT, 1 )
                0117          iErr = iErr+1
                0118         ENDIF
                0119         IF ( tNy .NE. sNy ) THEN
b9dadda204 Mart*0120          WRITE(msgBuf,'(A,I8,2(A,I5))')
0acd686861 Jean*0121      &   'ERROR: S/R W2_MAP_PROCS Topology for tile', myTileId,
                0122      &   'tNy=', tNy, ' is not equal to subgrid size sNy=', sNy
                0123          CALL PRINT_MESSAGE(msgBuf,
                0124      &        errorMessageUnit, SQUEEZE_RIGHT, 1 )
                0125          iErr = iErr+1
                0126         ENDIF
                0127        ENDDO
                0128       ENDDO
                0129       IF ( iErr .NE. 0 ) THEN
                0130        STOP 'ABNORMAL END: W2_MAP_PROCS'
                0131       ENDIF
                0132
                0133 C--   Print tiles connection for this process and set myCommonFlag :
                0134       WRITE(msgBuf,'(A)') '===== W2 TILE TOPOLOGY ====='
                0135       CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_BOTH, myThid )
                0136       DO bj=1,nSy
                0137        DO bi=1,nSx
                0138         myTileId = W2_myTileList(bi,bj)
a561475a37 Jean*0139         WRITE(msgBuf,'(A,I5,A,2I4,2A,I3)')
                0140      &       ' TILE: ', myTileId,' (bi,bj=', bi, bj, ' )',
                0141      &       ', Nb of Neighbours =', exch2_nNeighbours(myTileId)
0acd686861 Jean*0142 c       WRITE(msgBuf,'(2(A,I5),A,I3)') ' TILE: ', myTileId,
                0143 c    &       ' , rank=', W2_tileRank(myTileId),
                0144 c    &       ' , Nb of Neighbours =', exch2_nNeighbours(myTileId)
                0145         CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid )
                0146         DO J=1,exch2_nNeighbours(myTileId)
                0147          commFlag = 'M'
a561475a37 Jean*0148          jj = exch2_neighbourId(J,myTileId)
                0149          IF ( W2_tileProc(jj).EQ.thisProc ) commFlag = 'P'
0acd686861 Jean*0150          IF ( commFlag .EQ. 'M' ) THEN
b9dadda204 Mart*0151           WRITE(msgBuf,'(A,I3,A,I8,A,I3,2A,I8,A)')
0acd686861 Jean*0152      &    '    NEIGHBOUR',J,' = TILE', exch2_neighbourId(J,myTileId),
                0153      &    ' (n=', exch2_opposingSend(J,myTileId), ') Comm = MSG',
                0154      &    ' (PROC=',W2_tileProc(exch2_neighbourId(J,myTileId)),')'
                0155           CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid )
                0156          ENDIF
                0157          IF ( commFlag .EQ. 'P' ) THEN
b9dadda204 Mart*0158           WRITE(msgBuf,'(A,I3,A,I8,A,I3,2A,I8,A)')
0acd686861 Jean*0159      &    '    NEIGHBOUR',J,' = TILE', exch2_neighbourId(J,myTileId),
                0160      &    ' (n=', exch2_opposingSend(J,myTileId), ') Comm = PUT',
                0161      &    ' (PROC=',W2_tileProc(exch2_neighbourId(J,myTileId)),')'
                0162           CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid )
                0163          ENDIF
                0164          W2_myCommFlag(J,bi,bj) = commFlag
                0165         ENDDO
                0166        ENDDO
                0167       ENDDO
                0168
                0169       RETURN
                0170       END