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

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

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


Revision 1.4 - (show annotations) (download)
Sat Jul 9 21:53:35 2011 UTC (12 years, 9 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 C $Header: /u/gcmpack/MITgcm/pkg/exch2/w2_print_e2setup.F,v 1.3 2010/04/23 20:21:06 jmc Exp $
2 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 C Tile topology settings data structures
23 #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 C msgBuf :: Informational/error message buffer
37 CHARACTER*(MAX_LEN_MBUF) msgBuf
38 CHARACTER*1 edge(0:4)
39 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 DATA edge / '?' , 'N' , 'S' , 'E' , 'W' /
46
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 DO is=1,exch2_nTiles
61 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 & edge(ii), '.Edge Facet', jt,
85 & ' : 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 & edge(ii), '.Edge Facet', jt,
142 & ' : 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 C-- Check that tile dims divide facet dims
158 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 DO is=1,exch2_nTiles
173 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 DO is=1,exch2_nTiles
203 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