pkg/exch2/w2_print_e2setup.F

017b6b2289 Jean*0001 #include "CPP_EEOPTIONS.h"
                0002 #include "W2_OPTIONS.h"
                0003
                0004 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0005 CBOP 0
                0006 C !ROUTINE: W2_PRINT_E2SETUP
                0007
                0008 C !INTERFACE:
                0009       SUBROUTINE W2_PRINT_E2SETUP( myThid )
                0010
                0011 C     !DESCRIPTION:
                0012 C     Print out Wrapper-Exch2 Set-Up as defined by matlab generated source
                0013 C     files (W2_EXCH2_SIZE.h & W2_E2SETUP). Allows a direct comparison
                0014 C     with standard Fortran src generated topology.
                0015
                0016 C     !USES:
                0017       IMPLICIT NONE
                0018
d6ea3164dc Jean*0019 C      Tile topology settings data structures
017b6b2289 Jean*0020 #include "SIZE.h"
                0021 #include "EEPARAMS.h"
                0022 #include "W2_EXCH2_SIZE.h"
                0023 #include "W2_EXCH2_PARAMS.h"
                0024 #include "W2_EXCH2_TOPOLOGY.h"
                0025
                0026 C     !INPUT PARAMETERS:
                0027 C     myThid  :: my Thread Id number
                0028 C               (Note: not relevant since threading has not yet started)
                0029       INTEGER myThid
                0030
                0031 C     !LOCAL VARIABLES:
                0032 C     === Local variables ===
d6ea3164dc Jean*0033 C     msgBuf     :: Informational/error message buffer
017b6b2289 Jean*0034       CHARACTER*(MAX_LEN_MBUF) msgBuf
756bd0d959 Jean*0035       CHARACTER*1 edge(0:4)
017b6b2289 Jean*0036       INTEGER tNx, tNy, fNx, fNy
                0037       INTEGER nbTx, nbTy
                0038       INTEGER ip(4), np(4)
                0039       INTEGER i, j, js, jp, jt, ii, is, it, ns, nt, k, tx, ty
                0040       LOGICAL prtFlag
                0041 CEOP
756bd0d959 Jean*0042       DATA edge / '?' , 'N' , 'S' , 'E' , 'W' /
017b6b2289 Jean*0043
                0044       tNx = sNx
                0045       tNy = sNy
                0046       prtFlag = ABS(W2_printMsg).GE.2
                0047      &       .OR. ( W2_printMsg .NE.0 .AND. myProcId.EQ.0 )
                0048
                0049 C=================== from W2_SET_F2F_INDEX :
                0050 c     WRITE(msgBuf,'(2A)') 'W2_SET_F2F_INDEX:',
                0051       WRITE(msgBuf,'(2A)') 'W2_PRINT_E2SETUP:',
                0052      &       ' index matrix for connected Facet-Edges:'
                0053       CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid )
                0054
                0055       jp = 0
                0056       IF ( prtFlag ) THEN
71f938ee99 Jean*0057        DO is=1,exch2_nTiles
017b6b2289 Jean*0058         js  = exch2_myFace(is)
                0059         IF ( js.NE.0 ) THEN
                0060 C--     tile is is active
                0061          fNx = exch2_mydNx(is)
                0062          fNy = exch2_mydNy(is)
                0063          nbTx = fNx/tNx
                0064          nbTy = fNy/tNy
                0065          IF ( js.NE.jp ) THEN
                0066            IF ( jp.NE.0 ) THEN
                0067 C---     write
                0068          DO i=1,4
                0069           IF ( ip(i).NE.0 ) THEN
                0070             j  = exch2_myFace(ip(i))
                0071             it = exch2_neighbourId (np(i),ip(i))
                0072             nt = exch2_opposingSend(np(i),ip(i))
                0073             jt = exch2_myFace(it)
                0074             ii = 0
                0075             IF ( exch2_jLo(nt,it).EQ.exch2_jHi(nt,it) )
                0076      &        ii = 2 - MIN(1,exch2_jHi(nt,it))
                0077             IF ( exch2_iLo(nt,it).EQ.exch2_iHi(nt,it) )
                0078      &        ii = 4 - MIN(1,exch2_iHi(nt,it))
                0079             WRITE(W2_oUnit,'(2(3A,I3),A,4I3,A,2I6)')
                0080      &      '  ', edge(i), '.Edge Facet', j, ' <-- ',
756bd0d959 Jean*0081      &           edge(ii), '.Edge Facet', jt,
017b6b2289 Jean*0082      &      ' : pij=', (exch2_pij(k,np(i),ip(i)),k=1,4),
                0083      &      ' ; oi,oj=',exch2_oi(np(i),ip(i)),exch2_oj(np(i),ip(i))
                0084           ENDIF
                0085          ENDDO
                0086 C---
                0087            ENDIF
                0088            jp = js
                0089            DO i=1,4
                0090             ip(i) = 0
                0091             np(i) = 0
                0092            ENDDO
                0093          ENDIF
                0094          DO ns=1,exch2_nNeighbours(is)
                0095           IF ( ip(1).EQ.0 .AND. exch2_isNedge(is).EQ.1
                0096      &                    .AND. exch2_jLo(ns,is).EQ.(tNy+1)
                0097      &                    .AND. exch2_jHi(ns,is).EQ.(tNy+1) ) THEN
                0098             ip(1) = is
                0099             np(1) = ns
                0100           ENDIF
                0101           IF ( ip(2).EQ.0 .AND. exch2_isSedge(is).EQ.1
                0102      &                    .AND. exch2_jLo(ns,is).EQ. 0
                0103      &                    .AND. exch2_jHi(ns,is).EQ. 0 ) THEN
                0104             ip(2) = is
                0105             np(2) = ns
                0106           ENDIF
                0107           IF ( ip(3).EQ.0 .AND. exch2_isEedge(is).EQ.1
                0108      &                    .AND. exch2_iLo(ns,is).EQ.(tNx+1)
                0109      &                    .AND. exch2_iHi(ns,is).EQ.(tNx+1) ) THEN
                0110             ip(3) = is
                0111             np(3) = ns
                0112           ENDIF
                0113           IF ( ip(4).EQ.0 .AND. exch2_isWedge(is).EQ.1
                0114      &                    .AND. exch2_iLo(ns,is).EQ. 0
                0115      &                    .AND. exch2_iHi(ns,is).EQ. 0 ) THEN
                0116             ip(4) = is
                0117             np(4) = ns
                0118           ENDIF
                0119          ENDDO
                0120
                0121 C--     end if active tile
                0122         ENDIF
                0123        ENDDO
                0124 C---   write the last one:
                0125          DO i=1,4
                0126           IF ( ip(i).NE.0 ) THEN
                0127             j  = exch2_myFace(ip(i))
                0128             it = exch2_neighbourId (np(i),ip(i))
                0129             nt = exch2_opposingSend(np(i),ip(i))
                0130             jt = exch2_myFace(it)
                0131             ii = 0
                0132             IF ( exch2_jLo(nt,it).EQ.exch2_jHi(nt,it) )
                0133      &        ii = 2 - MIN(1,exch2_jHi(nt,it))
                0134             IF ( exch2_iLo(nt,it).EQ.exch2_iHi(nt,it) )
                0135      &        ii = 4 - MIN(1,exch2_iHi(nt,it))
                0136             WRITE(W2_oUnit,'(2(3A,I3),A,4I3,A,2I6)')
                0137      &      '  ', edge(i), '.Edge Facet', j, ' <-- ',
756bd0d959 Jean*0138      &           edge(ii), '.Edge Facet', jt,
017b6b2289 Jean*0139      &      ' : pij=', (exch2_pij(k,np(i),ip(i)),k=1,4),
                0140      &      ' ; oi,oj=',exch2_oi(np(i),ip(i)),exch2_oj(np(i),ip(i))
                0141           ENDIF
                0142          ENDDO
                0143 C---
                0144       ENDIF
                0145
                0146 C=================== from W2_SET_MAP_TILES :
                0147
                0148 C     Set-up tiles mapping and IO global mapping
                0149 c     WRITE(msgBuf,'(2A)') 'W2_SET_MAP_TILES:',
                0150       WRITE(msgBuf,'(2A)') 'W2_PRINT_E2SETUP:',
                0151      &       ' tile mapping within facet and global Map:'
                0152       CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid )
                0153
d6ea3164dc Jean*0154 C--   Check that tile dims divide facet dims
017b6b2289 Jean*0155 C--   Check that domain size and (SIZE.h + blankList) match:
                0156 C--   Compact IO map (mostly in Y dir): search for Greatest Common Divisor
                0157 C     of all x-size (faster to apply GCD to Nb of Tiles in X):
                0158
                0159       WRITE(msgBuf,'(A,2(A,I8))') ' Global Map (IO):',
                0160      &  ' X-size=', exch2_global_Nx, ' , Y-size=', exch2_global_Ny
                0161       CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid )
                0162
                0163 C--   Set tiles mapping within facet (sub-domain) and within Global Map
                0164 c     WRITE(msgBuf,'(2A)') 'W2_SET_MAP_TILES:',
                0165       WRITE(msgBuf,'(2A)') 'W2_PRINT_E2SETUP:',
                0166      &       ' tile offset within facet and global Map:'
                0167       CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid )
                0168       jp = 0
71f938ee99 Jean*0169       DO is=1,exch2_nTiles
017b6b2289 Jean*0170        js  = exch2_myFace(is)
                0171        IF ( js.NE.0 ) THEN
                0172          fNx = exch2_mydNx(is)
                0173          fNy = exch2_mydNy(is)
                0174          nbTx = fNx/tNx
                0175          nbTy = fNy/tNy
                0176          IF ( js .NE. jp )
                0177      &   WRITE(W2_oUnit,'(A,I3,2(A,I6),A,I5,2(A,I4),A)')
                0178      &    '- facet', js, ' : X-size=', fNx, ' , Y-size=', fNy,
                0179      &    ' ;', nbTx*nbTy, ' tiles (Tx,Ty=', nbTx,',',nbTy,')'
                0180          jp = js
                0181          IF ( prtFlag ) THEN
                0182            tx = 1 + exch2_tBasex(is)/tNx
                0183            ty = 1 + exch2_tBasey(is)/tNy
                0184           WRITE(W2_oUnit,'(A,I5,3(A,I3),2A,2I5,2A,2I8)') '  tile',is,
                0185      &    ' on facet', exch2_myFace(is),' (',tx,',',ty,'):',
                0186      &         ' offset=', exch2_tBasex(is), exch2_tBasey(is),' ;',
                0187      &    ' on Glob.Map=', exch2_txGlobalo(is),exch2_tyGlobalo(is)
                0188          ENDIF
                0189        ENDIF
                0190       ENDDO
                0191
                0192 C=================== from W2_SET_TILE2TILES :
                0193 c     WRITE(msgBuf,'(2A)') 'W2_SET_TILE2TILES:',
                0194       WRITE(msgBuf,'(2A)') 'W2_PRINT_E2SETUP:',
                0195      &       ' tile neighbours and index connection:'
                0196       CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid )
                0197
                0198       it = 1
71f938ee99 Jean*0199       DO is=1,exch2_nTiles
017b6b2289 Jean*0200        js  = exch2_myFace(is)
                0201        IF ( js.NE.0 ) THEN
                0202         IF ( exch2_nNeighbours(is).GT.exch2_nNeighbours(it) ) it = is
                0203         IF ( prtFlag ) THEN
b9dadda204 Mart*0204          WRITE(W2_oUnit,'(A,I8,A,I3,A,4(A,I2))') 'Tile',is,
017b6b2289 Jean*0205      &    ' : nbNeighb=',exch2_nNeighbours(is),' ; is-at-Facet-Edge:',
                0206      &        ' N=', exch2_isNedge(is), ' , S=', exch2_isSedge(is),
                0207      &      ' , E=', exch2_isEedge(is), ' , W=', exch2_isWedge(is)
                0208          DO ns=1,exch2_nNeighbours(is)
b9dadda204 Mart*0209           WRITE(W2_oUnit,'(A,I3,A,I8,2(A,2I6),A,4I3,A,2I6,A)')
017b6b2289 Jean*0210      &     ' ns:',ns,' it=',exch2_neighbourId(ns,is),
                0211      &     ', iLo,iHi=', exch2_iLo(ns,is), exch2_iHi(ns,is),
                0212      &     ', jLo,jHi=', exch2_jLo(ns,is), exch2_jHi(ns,is)
                0213 c    &     , ' (pij=',(exch2_pij(k,ns,is),k=1,4),
                0214 c    &     ', oi,oj=', exch2_oi(ns,is), exch2_oj(ns,is),')'
                0215          ENDDO
                0216         ENDIF
                0217        ENDIF
                0218       ENDDO
                0219       IF ( it.NE.0 ) THEN
                0220        WRITE(msgBuf,'(A,I5,A,I3)')
                0221      &  'current Max.Nb.Neighbours (e.g., on tile',it,
                0222      &  ' ) =', exch2_nNeighbours(it)
                0223        CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid )
                0224       ENDIF
                0225
                0226       RETURN
                0227       END