/[MITgcm]/MITgcm/pkg/exch2/w2_set_tile2tiles.F
ViewVC logotype

Diff of /MITgcm/pkg/exch2/w2_set_tile2tiles.F

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

revision 1.1 by jmc, Tue May 12 19:40:33 2009 UTC revision 1.2 by jmc, Fri Jun 19 03:01:24 2009 UTC
# Line 31  C               (Note: not relevant sinc Line 31  C               (Note: not relevant sinc
31    
32  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
33  C     === Local variables ===  C     === Local variables ===
34  C     msgBuf     :: Informational/error meesage buffer  C     msgBuf  :: Informational/error meesage buffer
35    C     tile_edge2edge(nId,tId) :: Tile edge to edge connection (of tile "tId"
36    C                                and neighbour "nId"):
37    C                1rst digit gives local tile Edge (10,20,30,40 <==> N,S,E,W)
38    C                2nd  digit gives remote tile Edge (1,2,3,4 <==> N,S,E,W)
39    C                corresponding to this neighbour connection.
40          INTEGER tile_edge2edge( W2_maxNeighbours, W2_maxNbTiles )
41        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
42        INTEGER tNx, tNy, nbTx, nbNeighb        INTEGER tNx, tNy, nbTx, nbNeighb
43        INTEGER i, k, ii, is, js, ns, it, jt, nt, tx, ty        INTEGER i, k, ii, nn
44          INTEGER is, js, ns, it, jt, nt, tx, ty
45        INTEGER iLo, iHi, jLo, jHi        INTEGER iLo, iHi, jLo, jHi
46        INTEGER ii1, ii2, jj1, jj2, ddi, ddj        INTEGER ii1, ii2, jj1, jj2, ddi, ddj
47        INTEGER ibnd1, ibnd2, jbnd1, jbnd2        INTEGER ibnd1, ibnd2, jbnd1, jbnd2
# Line 51  CEOP Line 58  CEOP
58        prtFlag = ABS(W2_printMsg).GE.2        prtFlag = ABS(W2_printMsg).GE.2
59       &       .OR. ( W2_printMsg .NE.0 .AND. myProcId.EQ.0 )       &       .OR. ( W2_printMsg .NE.0 .AND. myProcId.EQ.0 )
60    
61    C--   Initialise local arrays
62          DO is=1,W2_maxNbTiles
63           DO ns=1,W2_maxNeighbours
64            tile_edge2edge(ns,is) = 0
65           ENDDO
66          ENDDO
67    
68        tNx = sNx        tNx = sNx
69        tNy = sNy        tNy = sNy
70        DO is=1,nTiles        DO is=1,nTiles
# Line 99  C--   Western Edge: [iLo,jLo:jHi] Line 113  C--   Western Edge: [iLo,jLo:jHi]
113    
114           IF ( internConnect ) THEN           IF ( internConnect ) THEN
115  C---  Internal (from the same facet)  C---  Internal (from the same facet)
116    C-    N(i=1) -> S(ii=2); S(i=2) -> N(ii=1); E(i=3) -> W(ii=4); W(i=4) -> E(ii=3)
117    C-    get tile neighbour Id "it":
118              nbTx = facet_dims(2*js-1)/tNx              nbTx = facet_dims(2*js-1)/tNx
119                ii = 1 + MOD(i,2)
120                it = 2*ii - 3
121              IF ( i.LE.2 ) THEN              IF ( i.LE.2 ) THEN
122                 it = is + (3-2*i)*nbTx                 it = is + it*nbTx
123              ELSE              ELSE
124                 it = is + (7-2*i)                 it = is + it
125                   ii = ii + 2
126              ENDIF              ENDIF
127              IF ( exch2_myFace(it).NE.0 ) THEN              IF ( exch2_myFace(it).NE.0 ) THEN
128                 nbNeighb = nbNeighb + 1                 nbNeighb = nbNeighb + 1
129                 ns = MIN(nbNeighb,W2_maxNeighbours)                 ns = MIN(nbNeighb,W2_maxNeighbours)
130                 exch2_neighbourId(ns,is) = it                 exch2_neighbourId(ns,is) = it
131                   tile_edge2edge(ns,is) = 10*i + ii
132                 exch2_pij(1,ns,is) = 1                 exch2_pij(1,ns,is) = 1
133                 exch2_pij(2,ns,is) = 0                 exch2_pij(2,ns,is) = 0
134                 exch2_pij(3,ns,is) = 0                 exch2_pij(3,ns,is) = 0
# Line 161  C-    Save to common block this neighbou Line 181  C-    Save to common block this neighbou
181                 nbNeighb = nbNeighb + 1                 nbNeighb = nbNeighb + 1
182                 ns = MIN(nbNeighb,W2_maxNeighbours)                 ns = MIN(nbNeighb,W2_maxNeighbours)
183                 exch2_neighbourId(ns,is)  = it                 exch2_neighbourId(ns,is)  = it
184                   tile_edge2edge(ns,is) = 10*i + ii
185                 DO k=1,4                 DO k=1,4
186                   exch2_pij(k,ns,is) = facet_pij(k,i,js)                   exch2_pij(k,ns,is) = facet_pij(k,i,js)
187                 ENDDO                 ENDDO
# Line 243  C-  Check nbNeighb =< W2_maxNeighbours Line 264  C-  Check nbNeighb =< W2_maxNeighbours
264    
265  C-    Set exch2_opposingSend(ns,is) = Neighbour Id (in list of neighbours  C-    Set exch2_opposingSend(ns,is) = Neighbour Id (in list of neighbours
266  C     of tile exch2_neighbourId(ns,is)) which is connected to tile "is"  C     of tile exch2_neighbourId(ns,is)) which is connected to tile "is"
267  C     neighbour Id "ns" : go through the list  C     neighbour Id "ns" with matching edge <-> edge connection (ii==i).
268        errCnt = 0        errCnt = 0
269        DO is=1,nTiles        DO is=1,nTiles
270         DO ns=1,exch2_nNeighbours(is)         DO ns=1,exch2_nNeighbours(is)
271            i  = tile_edge2edge(ns,is)/10
272    c       ii = MOD(tile_edge2edge(ns,is),10)
273          it = exch2_neighbourId(ns,is)          it = exch2_neighbourId(ns,is)
274          DO nt=1,exch2_nNeighbours(it)          DO nt=1,exch2_nNeighbours(it)
275            IF ( exch2_neighbourId(nt,it).EQ.is ) THEN  c         i  = tile_edge2edge(nt,it)/10
276              ii = MOD(tile_edge2edge(nt,it),10)
277              IF ( exch2_neighbourId(nt,it).EQ.is .AND. ii.EQ.i ) THEN
278             IF ( exch2_opposingSend(ns,is).EQ.0 ) THEN             IF ( exch2_opposingSend(ns,is).EQ.0 ) THEN
279              exch2_opposingSend(ns,is) = nt              exch2_opposingSend(ns,is) = nt
280             ELSE             ELSE
281              WRITE(msgBuf,'(A,I5,A,I3,A)')              nn = exch2_opposingSend(ns,is)
282       &       'Tile',is,' neighb:',ns,' has multiple connection'              WRITE(msgBuf,'(A,I5,2(A,I3),A,I5)') 'Tile',is,' neighb:',
283         &      ns,' (',tile_edge2edge(ns,is),' ) has multiple connection'
284              CALL PRINT_ERROR( msgBuf, myThid )              CALL PRINT_ERROR( msgBuf, myThid )
285              WRITE(msgBuf,'(A,I5,A,2I3)')              WRITE(msgBuf,'(A,I5,5(A,I3))') ' with tile', it, ' :',
286       &       'with tile',it,' :',exch2_opposingSend(ns,is),nt       &      nn,' (',tile_edge2edge(nn,it),' ) and',
287         &      nt,' (',tile_edge2edge(nt,it),' )'
288              CALL PRINT_ERROR( msgBuf, myThid )              CALL PRINT_ERROR( msgBuf, myThid )
289              errCnt = errCnt + 1              errCnt = errCnt + 1
290             ENDIF             ENDIF
291            ENDIF            ENDIF
292          ENDDO          ENDDO
293          IF ( exch2_opposingSend(ns,is).EQ.0 ) THEN          IF ( exch2_opposingSend(ns,is).EQ.0 ) THEN
294              WRITE(msgBuf,'(A,I5,A,I3,A,I5)')              WRITE(msgBuf,'(A,I5,2(A,I3),A,I5)') 'Tile',is,' neighb:',
295       &       'Tile',is,' neighb:',ns,' no connection from',it       &      ns,' (',tile_edge2edge(ns,is),' ) no connection from',it
296              CALL PRINT_ERROR( msgBuf, myThid )              CALL PRINT_ERROR( msgBuf, myThid )
297              errCnt = errCnt + 1              errCnt = errCnt + 1
298          ENDIF          ENDIF
# Line 279  C     neighbour Id "ns" : go through the Line 305  C     neighbour Id "ns" : go through the
305          CALL PRINT_ERROR( msgBuf, myThid )          CALL PRINT_ERROR( msgBuf, myThid )
306          STOP 'ABNORMAL END: S/R W2_SET_TILE2TILES (tile connection)'          STOP 'ABNORMAL END: S/R W2_SET_TILE2TILES (tile connection)'
307        ENDIF        ENDIF
308    C--  Check opposingSend reciprocity:
309          errCnt = 0
310          DO is=1,nTiles
311           DO ns=1,exch2_nNeighbours(is)
312            it = exch2_neighbourId(ns,is)
313            nt = exch2_opposingSend(ns,is)
314            ii = exch2_neighbourId(nt,it)
315            nn = exch2_opposingSend(nt,it)
316            IF ( ii.NE.is .OR. nn.NE.ns ) THEN
317              WRITE(msgBuf,'(A,I5,2(A,I3),A)') 'Tile',is,' neighb:',
318         &      ns,' (',tile_edge2edge(ns,is),' ) connected'
319              CALL PRINT_ERROR( msgBuf, myThid )
320              WRITE(msgBuf,'(A,I5,5(A,I3))') ' with tile', it, ' :',
321         &      nt,' (',tile_edge2edge(nt,it),' )'
322              CALL PRINT_ERROR( msgBuf, myThid )
323              WRITE(msgBuf,'(A,I5,2(A,I3),A)') ' but',it,' neighb:',
324         &      nt,' (',tile_edge2edge(nt,it),' ) connected'
325              CALL PRINT_ERROR( msgBuf, myThid )
326              WRITE(msgBuf,'(A,I5,3(A,I3))') ' with tile', ii, ' :',
327         &      nn,' (',tile_edge2edge(nn,ii),' )'
328              CALL PRINT_ERROR( msgBuf, myThid )
329              errCnt = errCnt + 1
330            ENDIF
331           ENDDO
332          ENDDO
333          IF ( errCnt.GT.0 ) THEN
334            WRITE(msgBuf,'(A,I3,A)')
335         &   ' W2_SET_TILE2TILES: found', errCnt, ' opposingSend error'
336            CALL PRINT_ERROR( msgBuf, myThid )
337            STOP 'ABNORMAL END: S/R W2_SET_TILE2TILES (opposingSend)'
338          ENDIF
339    
340        RETURN        RETURN
341        END        END
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
  ViewVC Help
Powered by ViewVC 1.1.22