forked from altMITgcm/MITgcm
-
Notifications
You must be signed in to change notification settings - Fork 0
/
exch0_rx.template
246 lines (218 loc) · 7.51 KB
/
exch0_rx.template
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
C $Header: /u/gcmpack/MITgcm/eesupp/src/exch0_rx.template,v 1.1 2012/05/14 13:15:05 jmc Exp $
C $Name: $
#include "CPP_EEOPTIONS.h"
C-- File exch0_rx.template: to replace EXCH routines when using disconnected tiles
C-- Contents
C-- o EXCH0_RX
C-- o FILL_HALO_LOCAL_RX
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP
C !ROUTINE: EXCH0_RX
C !INTERFACE:
SUBROUTINE EXCH0_RX(
U array,
I myOLw, myOLe, myOLs, myOLn, myNr,
I exchWidthX, exchWidthY,
I cornerMode, myThid )
C !DESCRIPTION:
C *==========================================================*
C | SUBROUTINE EXCH0_RX
C | o Replace Exchange routines for the special case
C | where tiles are disconnected (no exchange between tiles,
C | just fill in edges of an array assuming locally periodic
C | subdomain)
C *==========================================================*
C | RX arrays are used to generate code for all 4 types
C | of arrays (R4, R8, RS and RL)
C *==========================================================*
C !USES:
IMPLICIT NONE
C == Global data ==
#include "SIZE.h"
#include "EEPARAMS.h"
C !INPUT/OUTPUT PARAMETERS:
C == Routine arguments ==
C array :: Array with edges to exchange.
C myOLw,myOLe :: West and East overlap region sizes.
C myOLs,myOLn :: South and North overlap region sizes.
C myNr :: array 3rd dimension
C exchWidthX :: Width of data region exchanged in X.
C exchWidthY :: Width of data region exchanged in Y.
C cornerMode :: Flag indicating whether corner updates are needed.
C myThid :: my Thread Id number
INTEGER myOLw, myOLe, myOLs, myOLn, myNr
_RX array( 1-myOLw:sNx+myOLe, 1-myOLs:sNy+myOLn,
& myNr, nSx, nSy )
INTEGER exchWidthX
INTEGER exchWidthY
INTEGER cornerMode
INTEGER myThid
#ifdef DISCONNECTED_TILES
C !LOCAL VARIABLES:
C == Local variables ==
C bi, bj :: tile indices
INTEGER bi, bj
CEOP
C-- Error checks
IF ( exchWidthX .GT. myOLw )
& STOP ' S/R EXCH0_RX: exchWidthX .GT. myOLw'
IF ( exchWidthX .GT. myOLe )
& STOP ' S/R EXCH0_RX: exchWidthX .GT. myOLe'
IF ( exchWidthY .GT. myOLs )
& STOP ' S/R EXCH0_RX: exchWidthY .GT. myOLs'
IF ( exchWidthY .GT. myOLn )
& STOP ' S/R EXCH0_RX: exchWidthY .GT. myOLn'
IF ( cornerMode .NE. EXCH_IGNORE_CORNERS
& .AND. cornerMode .NE. EXCH_UPDATE_CORNERS )
& STOP ' S/R EXCH0_RX: Unrecognised cornerMode '
C-- Over all tiles
DO bj = myByLo(myThid), myByHi(myThid)
DO bi = myBxLo(myThid), myBxHi(myThid)
CALL FILL_HALO_LOCAL_RX(
U array(1-myOLw,1-myOLs,1,bi,bj),
I myOLw, myOLe, myOLs, myOLn, myNr,
I cornerMode, bi, bj, myThid )
ENDDO
ENDDO
#else /* DISCONNECTED_TILES */
STOP 'ABNORMAL END: S/R EXCH0_RX is empty'
#endif /* DISCONNECTED_TILES */
RETURN
END
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP
C !ROUTINE: FILL_HALO_LOCAL_RX
C !INTERFACE:
SUBROUTINE FILL_HALO_LOCAL_RX(
U locFld,
I myOLw, myOLe, myOLs, myOLn, myNr,
c I exchWidthX, exchWidthY,
I cornerMode, bi, bj, myThid )
C !DESCRIPTION:
C *==========================================================*
C | SUBROUTINE FILL_HALO_LOCAL_RX
C | o Fill the halo region of a tile-local array assuming
C | disconnected tiles with locally periodic subdomain
C *==========================================================*
C !USES:
IMPLICIT NONE
C == Global variables ==
#include "SIZE.h"
#include "EEPARAMS.h"
C !INPUT/OUTPUT PARAMETERS:
C == Routine arguments ==
C locFld :: field local-array with edges to fill.
C myOLw,myOLe :: West and East overlap region sizes.
C myOLs,myOLn :: South and North overlap region sizes.
C myNr :: field local-array 3rd dimension
C exchWidthX :: Width of data region exchanged in X.
C exchWidthY :: Width of data region exchanged in Y.
C cornerMode :: Flag indicating whether corner updates are needed.
C myThid :: my Thread Id number
C bi, bj :: tile indices
C myThid :: thread number
INTEGER myOLw, myOLe, myOLs, myOLn, myNr
_RX locFld( 1-myOLw:sNx+myOLe, 1-myOLs:sNy+myOLn, myNr )
c INTEGER exchWidthX, exchWidthY
INTEGER cornerMode
INTEGER bi, bj
INTEGER myThid
#ifdef DISCONNECTED_TILES
C !LOCAL VARIABLES:
C == Local variables ==
C i,j,k :: loop indices
INTEGER i,j,k
INTEGER iMin,iMax,jMin,jMax
CEOP
IF ( cornerMode .EQ. EXCH_UPDATE_CORNERS ) THEN
iMin = 1 - myOLw
iMax = sNx + myOLe
jMin = 1 - myOLs
jMax = sNy + myOLn
ELSE
iMin = 1
iMax = sNx
jMin = 1
jMax = sNy
ENDIF
C-- Fill Edges in X direction :
IF ( sNx.EQ.1 ) THEN
C- Special case for Y-slice domain i.e. case where sNx=1 (faster than below)
DO k = 1,myNr
DO j = jMin,jMax
DO i = 1-myOLw,sNx+myOLe
locFld(i,j,k) = locFld(1,j,k)
ENDDO
ENDDO
ENDDO
ELSEIF ( sNx.LT.myOLw ) THEN
C- Special case if sNx<myOLw, e.g., for Y-slice domain case where sNx = 1
DO k = 1,myNr
DO j = jMin,jMax
C reverse loop index increment to stay valid even if sNx<myOLw;
C note: cannot vectorize both i loops
DO i = 0,1-myOLw,-1
locFld(i,j,k) = locFld(i+sNx,j,k)
ENDDO
DO i = 1,myOLe
locFld(i+sNx,j,k) = locFld(i,j,k)
ENDDO
ENDDO
ENDDO
ELSE
DO k = 1,myNr
DO j = jMin,jMax
DO i = 1-myOLw,0
locFld(i,j,k) = locFld(i+sNx,j,k)
ENDDO
DO i = 1,myOLe
locFld(i+sNx,j,k) = locFld(i,j,k)
ENDDO
ENDDO
ENDDO
ENDIF
C-- Fill Edges in Y direction :
IF ( sNy.EQ.1 ) THEN
C- Special case for X-slice domain i.e. case where sNy=1 (faster than below)
DO k = 1,myNr
DO j = 1-myOLs,sNy+myOLn
DO i = iMin,iMax
locFld(i,j,k) = locFld(i,1,k)
ENDDO
ENDDO
ENDDO
ELSEIF ( sNy.LT.myOLs ) THEN
C- Special case if sNy<myOLs, e.g., for X-slice domain case where sNy = 1
DO k = 1,myNr
C reverse loop index increment to stay valid even if sNy<myOLs;
C note: cannot vectorize both j loops
DO j = 0,1-myOLs,-1
DO i = iMin,iMax
locFld(i,j,k) = locFld(i,j+sNy,k)
ENDDO
ENDDO
DO j = 1,myOLn
DO i = iMin,iMax
locFld(i,j+sNy,k) = locFld(i,j,k)
ENDDO
ENDDO
ENDDO
ELSE
DO k = 1,myNr
DO j = 1-myOLs,0
DO i = iMin,iMax
locFld(i,j,k) = locFld(i,j+sNy,k)
ENDDO
ENDDO
DO j = 1,myOLn
DO i = iMin,iMax
locFld(i,j+sNy,k) = locFld(i,j,k)
ENDDO
ENDDO
ENDDO
ENDIF
#else /* DISCONNECTED_TILES */
STOP 'ABNORMAL END: S/R FILL_HALO_LOCAL_RX is empty'
#endif /* DISCONNECTED_TILES */
RETURN
END