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

Annotation of /MITgcm/pkg/exch2/w2_print_e2setup.F

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


Revision 1.4 - (hide annotations) (download)
Sat Jul 9 21:53:35 2011 UTC (12 years, 10 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint64y, checkpoint64x, checkpoint64z, checkpoint64q, checkpoint64p, checkpoint64s, checkpoint64r, checkpoint64u, checkpoint64t, checkpoint64w, checkpoint64v, checkpoint64i, checkpoint64h, checkpoint64k, checkpoint64j, checkpoint64m, checkpoint64l, checkpoint64o, checkpoint64n, checkpoint64a, checkpoint64c, checkpoint64b, checkpoint64e, checkpoint64d, checkpoint64g, checkpoint64f, checkpoint63p, checkpoint63q, checkpoint63r, checkpoint63s, checkpoint63l, checkpoint63m, checkpoint63n, checkpoint63o, checkpoint63h, checkpoint63i, checkpoint63j, checkpoint63k, checkpoint63d, checkpoint63e, checkpoint63f, checkpoint63g, checkpoint63a, checkpoint63b, checkpoint63c, checkpoint64, checkpoint65, checkpoint63, checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65j, checkpoint65k, checkpoint65h, checkpoint65i, checkpoint65n, checkpoint65o, checkpoint65l, checkpoint65m, checkpoint65b, checkpoint65c, checkpoint65a, checkpoint65f, checkpoint65g, checkpoint65d, checkpoint65e, HEAD
Changes since 1.3: +4 -4 lines
rename + move: nTiles in W2_EXCH2_PARAMS.h --> exch2_nTiles in W2_EXCH2_TOPOLOGY.h

1 jmc 1.4 C $Header: /u/gcmpack/MITgcm/pkg/exch2/w2_print_e2setup.F,v 1.3 2010/04/23 20:21:06 jmc Exp $
2 jmc 1.1 C $Name: $
3    
4     #include "CPP_EEOPTIONS.h"
5     #include "W2_OPTIONS.h"
6    
7     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
8     CBOP 0
9     C !ROUTINE: W2_PRINT_E2SETUP
10    
11     C !INTERFACE:
12     SUBROUTINE W2_PRINT_E2SETUP( myThid )
13    
14     C !DESCRIPTION:
15     C Print out Wrapper-Exch2 Set-Up as defined by matlab generated source
16     C files (W2_EXCH2_SIZE.h & W2_E2SETUP). Allows a direct comparison
17     C with standard Fortran src generated topology.
18    
19     C !USES:
20     IMPLICIT NONE
21    
22 jmc 1.3 C Tile topology settings data structures
23 jmc 1.1 #include "SIZE.h"
24     #include "EEPARAMS.h"
25     #include "W2_EXCH2_SIZE.h"
26     #include "W2_EXCH2_PARAMS.h"
27     #include "W2_EXCH2_TOPOLOGY.h"
28    
29     C !INPUT PARAMETERS:
30     C myThid :: my Thread Id number
31     C (Note: not relevant since threading has not yet started)
32     INTEGER myThid
33    
34     C !LOCAL VARIABLES:
35     C === Local variables ===
36 jmc 1.3 C msgBuf :: Informational/error message buffer
37 jmc 1.1 CHARACTER*(MAX_LEN_MBUF) msgBuf
38 jmc 1.2 CHARACTER*1 edge(0:4)
39 jmc 1.1 INTEGER tNx, tNy, fNx, fNy
40     INTEGER nbTx, nbTy
41     INTEGER ip(4), np(4)
42     INTEGER i, j, js, jp, jt, ii, is, it, ns, nt, k, tx, ty
43     LOGICAL prtFlag
44     CEOP
45 jmc 1.2 DATA edge / '?' , 'N' , 'S' , 'E' , 'W' /
46 jmc 1.1
47     tNx = sNx
48     tNy = sNy
49     prtFlag = ABS(W2_printMsg).GE.2
50     & .OR. ( W2_printMsg .NE.0 .AND. myProcId.EQ.0 )
51    
52     C=================== from W2_SET_F2F_INDEX :
53     c WRITE(msgBuf,'(2A)') 'W2_SET_F2F_INDEX:',
54     WRITE(msgBuf,'(2A)') 'W2_PRINT_E2SETUP:',
55     & ' index matrix for connected Facet-Edges:'
56     CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid )
57    
58     jp = 0
59     IF ( prtFlag ) THEN
60 jmc 1.4 DO is=1,exch2_nTiles
61 jmc 1.1 js = exch2_myFace(is)
62     IF ( js.NE.0 ) THEN
63     C-- tile is is active
64     fNx = exch2_mydNx(is)
65     fNy = exch2_mydNy(is)
66     nbTx = fNx/tNx
67     nbTy = fNy/tNy
68     IF ( js.NE.jp ) THEN
69     IF ( jp.NE.0 ) THEN
70     C--- write
71     DO i=1,4
72     IF ( ip(i).NE.0 ) THEN
73     j = exch2_myFace(ip(i))
74     it = exch2_neighbourId (np(i),ip(i))
75     nt = exch2_opposingSend(np(i),ip(i))
76     jt = exch2_myFace(it)
77     ii = 0
78     IF ( exch2_jLo(nt,it).EQ.exch2_jHi(nt,it) )
79     & ii = 2 - MIN(1,exch2_jHi(nt,it))
80     IF ( exch2_iLo(nt,it).EQ.exch2_iHi(nt,it) )
81     & ii = 4 - MIN(1,exch2_iHi(nt,it))
82     WRITE(W2_oUnit,'(2(3A,I3),A,4I3,A,2I6)')
83     & ' ', edge(i), '.Edge Facet', j, ' <-- ',
84 jmc 1.2 & edge(ii), '.Edge Facet', jt,
85 jmc 1.1 & ' : pij=', (exch2_pij(k,np(i),ip(i)),k=1,4),
86     & ' ; oi,oj=',exch2_oi(np(i),ip(i)),exch2_oj(np(i),ip(i))
87     ENDIF
88     ENDDO
89     C---
90     ENDIF
91     jp = js
92     DO i=1,4
93     ip(i) = 0
94     np(i) = 0
95     ENDDO
96     ENDIF
97     DO ns=1,exch2_nNeighbours(is)
98     IF ( ip(1).EQ.0 .AND. exch2_isNedge(is).EQ.1
99     & .AND. exch2_jLo(ns,is).EQ.(tNy+1)
100     & .AND. exch2_jHi(ns,is).EQ.(tNy+1) ) THEN
101     ip(1) = is
102     np(1) = ns
103     ENDIF
104     IF ( ip(2).EQ.0 .AND. exch2_isSedge(is).EQ.1
105     & .AND. exch2_jLo(ns,is).EQ. 0
106     & .AND. exch2_jHi(ns,is).EQ. 0 ) THEN
107     ip(2) = is
108     np(2) = ns
109     ENDIF
110     IF ( ip(3).EQ.0 .AND. exch2_isEedge(is).EQ.1
111     & .AND. exch2_iLo(ns,is).EQ.(tNx+1)
112     & .AND. exch2_iHi(ns,is).EQ.(tNx+1) ) THEN
113     ip(3) = is
114     np(3) = ns
115     ENDIF
116     IF ( ip(4).EQ.0 .AND. exch2_isWedge(is).EQ.1
117     & .AND. exch2_iLo(ns,is).EQ. 0
118     & .AND. exch2_iHi(ns,is).EQ. 0 ) THEN
119     ip(4) = is
120     np(4) = ns
121     ENDIF
122     ENDDO
123    
124     C-- end if active tile
125     ENDIF
126     ENDDO
127     C--- write the last one:
128     DO i=1,4
129     IF ( ip(i).NE.0 ) THEN
130     j = exch2_myFace(ip(i))
131     it = exch2_neighbourId (np(i),ip(i))
132     nt = exch2_opposingSend(np(i),ip(i))
133     jt = exch2_myFace(it)
134     ii = 0
135     IF ( exch2_jLo(nt,it).EQ.exch2_jHi(nt,it) )
136     & ii = 2 - MIN(1,exch2_jHi(nt,it))
137     IF ( exch2_iLo(nt,it).EQ.exch2_iHi(nt,it) )
138     & ii = 4 - MIN(1,exch2_iHi(nt,it))
139     WRITE(W2_oUnit,'(2(3A,I3),A,4I3,A,2I6)')
140     & ' ', edge(i), '.Edge Facet', j, ' <-- ',
141 jmc 1.2 & edge(ii), '.Edge Facet', jt,
142 jmc 1.1 & ' : pij=', (exch2_pij(k,np(i),ip(i)),k=1,4),
143     & ' ; oi,oj=',exch2_oi(np(i),ip(i)),exch2_oj(np(i),ip(i))
144     ENDIF
145     ENDDO
146     C---
147     ENDIF
148    
149     C=================== from W2_SET_MAP_TILES :
150    
151     C Set-up tiles mapping and IO global mapping
152     c WRITE(msgBuf,'(2A)') 'W2_SET_MAP_TILES:',
153     WRITE(msgBuf,'(2A)') 'W2_PRINT_E2SETUP:',
154     & ' tile mapping within facet and global Map:'
155     CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid )
156    
157 jmc 1.3 C-- Check that tile dims divide facet dims
158 jmc 1.1 C-- Check that domain size and (SIZE.h + blankList) match:
159     C-- Compact IO map (mostly in Y dir): search for Greatest Common Divisor
160     C of all x-size (faster to apply GCD to Nb of Tiles in X):
161    
162     WRITE(msgBuf,'(A,2(A,I8))') ' Global Map (IO):',
163     & ' X-size=', exch2_global_Nx, ' , Y-size=', exch2_global_Ny
164     CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid )
165    
166     C-- Set tiles mapping within facet (sub-domain) and within Global Map
167     c WRITE(msgBuf,'(2A)') 'W2_SET_MAP_TILES:',
168     WRITE(msgBuf,'(2A)') 'W2_PRINT_E2SETUP:',
169     & ' tile offset within facet and global Map:'
170     CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid )
171     jp = 0
172 jmc 1.4 DO is=1,exch2_nTiles
173 jmc 1.1 js = exch2_myFace(is)
174     IF ( js.NE.0 ) THEN
175     fNx = exch2_mydNx(is)
176     fNy = exch2_mydNy(is)
177     nbTx = fNx/tNx
178     nbTy = fNy/tNy
179     IF ( js .NE. jp )
180     & WRITE(W2_oUnit,'(A,I3,2(A,I6),A,I5,2(A,I4),A)')
181     & '- facet', js, ' : X-size=', fNx, ' , Y-size=', fNy,
182     & ' ;', nbTx*nbTy, ' tiles (Tx,Ty=', nbTx,',',nbTy,')'
183     jp = js
184     IF ( prtFlag ) THEN
185     tx = 1 + exch2_tBasex(is)/tNx
186     ty = 1 + exch2_tBasey(is)/tNy
187     WRITE(W2_oUnit,'(A,I5,3(A,I3),2A,2I5,2A,2I8)') ' tile',is,
188     & ' on facet', exch2_myFace(is),' (',tx,',',ty,'):',
189     & ' offset=', exch2_tBasex(is), exch2_tBasey(is),' ;',
190     & ' on Glob.Map=', exch2_txGlobalo(is),exch2_tyGlobalo(is)
191     ENDIF
192     ENDIF
193     ENDDO
194    
195     C=================== from W2_SET_TILE2TILES :
196     c WRITE(msgBuf,'(2A)') 'W2_SET_TILE2TILES:',
197     WRITE(msgBuf,'(2A)') 'W2_PRINT_E2SETUP:',
198     & ' tile neighbours and index connection:'
199     CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid )
200    
201     it = 1
202 jmc 1.4 DO is=1,exch2_nTiles
203 jmc 1.1 js = exch2_myFace(is)
204     IF ( js.NE.0 ) THEN
205     IF ( exch2_nNeighbours(is).GT.exch2_nNeighbours(it) ) it = is
206     IF ( prtFlag ) THEN
207     WRITE(W2_oUnit,'(A,I5,A,I3,A,4(A,I2))') 'Tile',is,
208     & ' : nbNeighb=',exch2_nNeighbours(is),' ; is-at-Facet-Edge:',
209     & ' N=', exch2_isNedge(is), ' , S=', exch2_isSedge(is),
210     & ' , E=', exch2_isEedge(is), ' , W=', exch2_isWedge(is)
211     DO ns=1,exch2_nNeighbours(is)
212     WRITE(W2_oUnit,'(A,I3,A,I5,2(A,2I6),A,4I3,A,2I6,A)')
213     & ' ns:',ns,' it=',exch2_neighbourId(ns,is),
214     & ', iLo,iHi=', exch2_iLo(ns,is), exch2_iHi(ns,is),
215     & ', jLo,jHi=', exch2_jLo(ns,is), exch2_jHi(ns,is)
216     c & , ' (pij=',(exch2_pij(k,ns,is),k=1,4),
217     c & ', oi,oj=', exch2_oi(ns,is), exch2_oj(ns,is),')'
218     ENDDO
219     ENDIF
220     ENDIF
221     ENDDO
222     IF ( it.NE.0 ) THEN
223     WRITE(msgBuf,'(A,I5,A,I3)')
224     & 'current Max.Nb.Neighbours (e.g., on tile',it,
225     & ' ) =', exch2_nNeighbours(it)
226     CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid )
227     ENDIF
228    
229    
230     RETURN
231     END

  ViewVC Help
Powered by ViewVC 1.1.22