pkg/exch2/w2_print_comm_sequence.F

046fd16d1c Andr*0001 #include "CPP_EEOPTIONS.h"
55ed3c7ce6 Jean*0002 #undef W2_PRINT_PREFIX
046fd16d1c Andr*0003
a9b4f0cd04 Jean*0004 CBOP
046fd16d1c Andr*0005 C     !ROUTINE: W2_PRINT_COMM_SEQUENCE
                0006
                0007 C     !INTERFACE:
017b6b2289 Jean*0008       SUBROUTINE W2_PRINT_COMM_SEQUENCE( myThid )
046fd16d1c Andr*0009
                0010 C     !DESCRIPTION:
                0011 C     *==========================================================*
a9b4f0cd04 Jean*0012 C     | SUBROUTINE W2_PRINT_COMM_SEQUENCE
                0013 C     | o Write communication sequence for a given WRAPPER2
55ed3c7ce6 Jean*0014 C     |   topology
046fd16d1c Andr*0015 C     *==========================================================*
55ed3c7ce6 Jean*0016
                0017 C     !USES:
                0018       IMPLICIT NONE
                0019 C     == Global data ==
046fd16d1c Andr*0020 #include "SIZE.h"
                0021 #include "EEPARAMS.h"
017b6b2289 Jean*0022 #include "W2_EXCH2_SIZE.h"
046fd16d1c Andr*0023 #include "W2_EXCH2_TOPOLOGY.h"
                0024 #include "W2_EXCH2_PARAMS.h"
                0025
55ed3c7ce6 Jean*0026 C     !INPUT/OUTPUT PARAMETERS:
                0027 C     W2_oUnit   :: fortran I/O unit
017b6b2289 Jean*0028 C     myThid     :: my Thread Id number
                0029 c     INTEGER W2_oUnit
                0030       INTEGER myThid
55ed3c7ce6 Jean*0031
                0032 #ifndef W2_PRINT_PREFIX
                0033 C     !FUNCTIONS:
                0034       INTEGER  ILNBLNK
                0035       EXTERNAL ILNBLNK
                0036 #endif
                0037
                0038 C     !LOCAL VARIABLES:
046fd16d1c Andr*0039 C     == Local variables ==
55ed3c7ce6 Jean*0040 C     bi         :: tile index
                0041 C     N          :: Neighbours index
                0042 C     nN         :: number of Neighbours
                0043 C     targetTile ::
                0044 C     sourceProc ::
046fd16d1c Andr*0045       INTEGER myTileId, nN
026642cc3c Jean*0046 c     INTEGER PI_TC2SC(2), PJ_TC2SC(2), O_TC2SC(2)
                0047 c     _RL     SXDIR_TX2CX(2), SYDIR_TX2CX(2)
046fd16d1c Andr*0048       INTEGER targetIlo, targetIhi, targetJlo, targetJhi
                0049       INTEGER sourceIlo, sourceIhi, sourceJlo, sourceJhi
55ed3c7ce6 Jean*0050       INTEGER targetTile, targetProc, sourceProc
8adbfea2f8 Jean*0051       INTEGER bi, bj, N
046fd16d1c Andr*0052       INTEGER iStride, jStride
                0053       INTEGER pi(2), pj(2), oi, oj, tN
a9b4f0cd04 Jean*0054       INTEGER itb, jtb, isb, jsb
55ed3c7ce6 Jean*0055       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0056 #ifndef W2_PRINT_PREFIX
                0057       INTEGER iLen
                0058 #endif
                0059 CEOP
046fd16d1c Andr*0060
                0061 C     Send loop for cell centered
8adbfea2f8 Jean*0062       DO bj=1,nSy
                0063        DO bi=1,nSx
                0064         myTileId=W2_myTileList(bi,bj)
                0065         nN=exch2_nNeighbours(myTileId)
0b153c4cea Jean*0066         sourceProc=W2_tileProc(myTileId)
8adbfea2f8 Jean*0067         DO N=1,nN
                0068          targetTile=exch2_neighbourId(N,myTileId)
0b153c4cea Jean*0069          targetProc=W2_tileProc(targetTile)
8adbfea2f8 Jean*0070          tN = exch2_opposingSend(N,myTileId)
                0071          pi(1)     =exch2_pij(1,N,myTileId)
                0072          pi(2)     =exch2_pij(2,N,myTileId)
                0073          pj(1)     =exch2_pij(3,N,myTileId)
                0074          pj(2)     =exch2_pij(4,N,myTileId)
                0075          oi        =exch2_oi(N,myTileId)
                0076          oj        =exch2_oj(N,myTileId)
                0077          CALL EXCH2_GET_SCAL_BOUNDS(
                0078      I              'T ', OLx, .TRUE.,
                0079      I              targetTile, tN,
                0080      O              targetIlo, targetIhi, targetJlo, targetJhi,
                0081      O              iStride, jStride,
                0082      I              myThid )
a9b4f0cd04 Jean*0083
8adbfea2f8 Jean*0084          itb = exch2_tBasex(targetTile)
                0085          jtb = exch2_tBasey(targetTile)
                0086          isb = exch2_tBasex(myTileId)
                0087          jsb = exch2_tBasey(myTileId)
                0088          sourceIlo=pi(1)*(targetIlo+itb)+pi(2)*(targetJlo+jtb)+oi-isb
                0089          sourceJlo=pj(1)*(targetIlo+itb)+pj(2)*(targetJlo+jtb)+oj-jsb
                0090          sourceIhi=pi(1)*(targetIhi+itb)+pi(2)*(targetJhi+jtb)+oi-isb
                0091          sourceJhi=pj(1)*(targetIhi+itb)+pj(2)*(targetJhi+jtb)+oj-jsb
                0092 C        Tile XX sends to points i=ilo:ihi,j=jlo:jhi in tile YY
b9dadda204 Mart*0093          WRITE(msgBuf,'(A,I8,A,I8,A,4(A,I4))')
8adbfea2f8 Jean*0094      &    'Tile', myTileId,' (pr=',sourceProc,')',
                0095      &    ' sends pts i=',sourceIlo,':',sourceIhi,
                0096      &             ', j=',sourceJlo,':',sourceJhi
55ed3c7ce6 Jean*0097 #ifdef W2_PRINT_PREFIX
8adbfea2f8 Jean*0098          CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid )
55ed3c7ce6 Jean*0099 #else
8adbfea2f8 Jean*0100          iLen = ILNBLNK(msgBuf)
                0101          WRITE(W2_oUnit,'(A)') msgBuf(1:iLen)
55ed3c7ce6 Jean*0102 #endif
b9dadda204 Mart*0103          WRITE(msgBuf,'(26X,4(A,I4),A,I8,A,I8,A)')
                0104      &    '    to pts i=',targetIlo,':',targetIhi,
                0105      &             ', j=',targetJlo,':',targetJhi,
                0106      &    ' in tile ',targetTile,' (pr=',targetProc,')'
55ed3c7ce6 Jean*0107 #ifdef W2_PRINT_PREFIX
8adbfea2f8 Jean*0108          CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid )
55ed3c7ce6 Jean*0109 #else
8adbfea2f8 Jean*0110          iLen = ILNBLNK(msgBuf)
                0111          WRITE(W2_oUnit,'(A)') msgBuf(1:iLen)
55ed3c7ce6 Jean*0112 #endif
8adbfea2f8 Jean*0113         ENDDO
046fd16d1c Andr*0114        ENDDO
                0115       ENDDO
                0116
                0117 C     Recv loop for cell centered
8adbfea2f8 Jean*0118       DO bj=1,nSy
                0119        DO bi=1,nSx
                0120         myTileId=W2_myTileList(bi,bj)
                0121         nN=exch2_nNeighbours(myTileId)
0b153c4cea Jean*0122         sourceProc=W2_tileProc(myTileId)
8adbfea2f8 Jean*0123         DO N=1,nN
                0124          targetTile=exch2_neighbourId(N,myTileId)
0b153c4cea Jean*0125          targetProc=W2_tileProc(targetTile)
8adbfea2f8 Jean*0126 C        Find entry for tile targetTile entry that sent to this edge.
                0127          tN=exch2_opposingSend(N,myTileId)
                0128 C        Get the range of points associated with that entry
                0129          CALL EXCH2_GET_SCAL_BOUNDS(
                0130      I              'T ', OLx, .TRUE.,
                0131      I              myTileId, N,
                0132      O              targetIlo, targetIhi, targetJlo, targetJhi,
                0133      O              iStride, jStride,
                0134      I              myThid )
                0135 C        Tile XX receives points i=ilo:ihi,j=jlo:jhi in tile YY
b9dadda204 Mart*0136          WRITE(msgBuf,'(A,I8,A,I8,A,4(A,I4),A,I8,A,I8,A)')
8adbfea2f8 Jean*0137      &    'Tile', myTileId,' (pr=',sourceProc,')',
                0138      &    ' recv pts i=',targetIlo,':',targetIhi,
                0139      &            ', j=',targetJlo, ':',targetJhi,
                0140      &    ' from tile',targetTile,' (pr=',targetProc,')'
55ed3c7ce6 Jean*0141 #ifdef W2_PRINT_PREFIX
8adbfea2f8 Jean*0142          CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid )
55ed3c7ce6 Jean*0143 #else
8adbfea2f8 Jean*0144          iLen = ILNBLNK(msgBuf)
                0145          WRITE(W2_oUnit,'(A)') msgBuf(1:iLen)
55ed3c7ce6 Jean*0146 #endif
8adbfea2f8 Jean*0147         ENDDO
046fd16d1c Andr*0148        ENDDO
                0149       ENDDO
                0150
                0151       RETURN
                0152       END