/[MITgcm]/MITgcm/eesupp/src/exch_rx.template
ViewVC logotype

Annotation of /MITgcm/eesupp/src/exch_rx.template

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


Revision 1.6 - (hide annotations) (download)
Sat May 15 02:18:52 2010 UTC (15 years, 2 months ago) by jmc
Branch: MAIN
Changes since 1.5: +121 -59 lines
fix AD code for 2-D domain special cases (Nx=1 or Ny=1)

1 jmc 1.6 C $Header: /u/gcmpack/MITgcm/eesupp/src/exch_rx.template,v 1.5 2005/11/07 18:21:11 cnh Exp $
2 cnh 1.3 C $Name: $
3 adcroft 1.2
4     #include "CPP_EEOPTIONS.h"
5    
6 cnh 1.3 CBOP
7    
8     C !ROUTINE: EXCH_RX
9    
10     C !INTERFACE:
11 jmc 1.6 SUBROUTINE EXCH_RX(
12 adcroft 1.2 U array,
13     I myOLw, myOLe, myOLs, myOLn, myNz,
14     I exchWidthX, exchWidthY,
15     I simulationMode, cornerMode, myThid )
16     IMPLICIT NONE
17    
18 cnh 1.3 C !DESCRIPTION:
19     C *==========================================================*
20 jmc 1.6 C | SUBROUTINE EXCH_RX
21     C | o Control edge exchanges for RX array.
22 cnh 1.3 C *==========================================================*
23 jmc 1.6 C |
24     C | Controlling routine for exchange of XY edges of an array
25     C | distributed in X and Y. The routine interfaces to
26     C | communication routines that can use messages passing
27     C | exchanges, put type exchanges or get type exchanges.
28     C | This allows anything from MPI to raw memory channel to
29     C | memmap segments to be used as a inter-process and/or
30     C | inter-thread communiation and synchronisation
31     C | mechanism.
32     C | Notes --
33     C | 1. Some low-level mechanisms such as raw memory-channel
34     C | or SGI/CRAY shmem put do not have direct Fortran bindings
35     C | and are invoked through C stub routines.
36     C | 2. Although this routine is fairly general but it does
37     C | require nSx and nSy are the same for all innvocations.
38     C | There are many common data structures ( myByLo,
39     C | westCommunicationMode, mpiIdW etc... ) tied in with
40     C | (nSx,nSy). To support arbitray nSx and nSy would require
41     C | general forms of these.
42 cnh 1.3 C | 3. RX arrays are used to generate code for both _RL and
43 jmc 1.6 C | _RS forms.
44 cnh 1.3 C *==========================================================*
45    
46     C !USES:
47 adcroft 1.2 C == Global data ==
48     #include "SIZE.h"
49     #include "EEPARAMS.h"
50     #include "EESUPPORT.h"
51     #include "EXCH.h"
52    
53 cnh 1.3 C !INPUT/OUTPUT PARAMETERS:
54 adcroft 1.2 C == Routine arguments ==
55 cnh 1.3 C array :: Array with edges to exchange.
56     C myOLw :: West, East, North and South overlap region sizes.
57 adcroft 1.2 C myOLe
58     C myOLn
59     C myOLs
60 cnh 1.3 C exchWidthX :: Width of data region exchanged in X.
61     C exchWidthY :: Width of data region exchanged in Y.
62 jmc 1.6 C Note --
63 cnh 1.3 C 1. In theory one could have a send width and
64     C a receive width for each face of each tile. The only
65     C restriction woul be that the send width of one
66     C face should equal the receive width of the sent to
67 jmc 1.6 C tile face. Dont know if this would be useful. I
68     C have left it out for now as it requires additional
69 cnh 1.3 C bookeeping.
70 jmc 1.6 C simulationMode :: Forward or reverse mode exchange ( provides
71 cnh 1.3 C support for adjoint integration of code. )
72 jmc 1.6 C cornerMode :: Flag indicating whether corner updates are
73 cnh 1.3 C needed.
74     C myThid :: Thread number of this instance of S/R EXCH...
75 adcroft 1.2 INTEGER myOLw
76     INTEGER myOLe
77     INTEGER myOLs
78     INTEGER myOLn
79     INTEGER myNz
80     INTEGER exchWidthX
81     INTEGER exchWidthY
82     INTEGER simulationMode
83     INTEGER cornerMode
84     INTEGER myThid
85     _RX array(1-myOLw:sNx+myOLe,
86 jmc 1.6 & 1-myOLs:sNy+myOLn,
87 adcroft 1.2 & myNZ, nSx, nSy)
88    
89 cnh 1.3 C !LOCAL VARIABLES:
90 adcroft 1.2 C == Local variables ==
91 cnh 1.3 C theSimulationMode :: Holds working copy of simulation mode
92     C theCornerMode :: Holds working copy of corner mode
93 jmc 1.6 C i,j,k,bi,bj :: Loop counters
94 adcroft 1.2 INTEGER theSimulationMode
95     INTEGER theCornerMode
96 jmc 1.6 INTEGER i,j,k,bi,bj
97 cnh 1.3 CEOP
98 adcroft 1.2
99 cnh 1.5 _BARRIER
100    
101 adcroft 1.2 theSimulationMode = simulationMode
102     theCornerMode = cornerMode
103    
104     C-- Error checks
105 jmc 1.6 IF ( exchWidthX .GT. myOLw )
106 adcroft 1.2 & STOP ' S/R EXCH_RX: exchWidthX .GT. myOLw'
107 jmc 1.6 IF ( exchWidthX .GT. myOLe )
108 adcroft 1.2 & STOP ' S/R EXCH_RX: exchWidthX .GT. myOLe'
109 jmc 1.6 IF ( exchWidthY .GT. myOLs )
110 adcroft 1.2 & STOP ' S/R EXCH_RX: exchWidthY .GT. myOLs'
111 jmc 1.6 IF ( exchWidthY .GT. myOLn )
112 adcroft 1.2 & STOP ' S/R EXCH_RX: exchWidthY .GT. myOLn'
113 jmc 1.6 IF ( myOLw .GT. MAX_OLX_EXCH )
114 adcroft 1.2 & STOP ' S/R EXCH_RX: myOLw .GT. MAX_OLX_EXCH'
115 jmc 1.6 IF ( myOLe .GT. MAX_OLX_EXCH )
116 adcroft 1.2 & STOP ' S/R EXCH_RX: myOLe .GT. MAX_OLX_EXCH'
117 jmc 1.6 IF ( myOLn .GT. MAX_OLX_EXCH )
118 adcroft 1.2 & STOP ' S/R EXCH_RX: myOLn .GT. MAX_OLY_EXCH'
119 jmc 1.6 IF ( myOLs .GT. MAX_OLY_EXCH )
120 adcroft 1.2 & STOP ' S/R EXCH_RX: myOLs .GT. MAX_OLY_EXCH'
121 jmc 1.6 IF ( myNZ .GT. MAX_NR_EXCH )
122 adcroft 1.2 & STOP ' S/R EXCH_RX: myNZ .GT. MAX_NR_EXCH '
123     IF ( theSimulationMode .NE. FORWARD_SIMULATION
124     & .AND. theSimulationMode .NE. REVERSE_SIMULATION
125     & ) STOP ' S/R EXCH_RX: Unrecognised simulationMode '
126     IF ( theCornerMode .NE. EXCH_IGNORE_CORNERS
127     & .AND. theCornerMode .NE. EXCH_UPDATE_CORNERS
128     & ) STOP ' S/R EXCH_RX: Unrecognised cornerMode '
129    
130     C-- Cycle edge buffer level
131     CALL EXCH_CYCLE_EBL( myThid )
132    
133 jmc 1.6 IF ( theSimulationMode .EQ. REVERSE_SIMULATION ) THEN
134    
135     IF ( Nx .EQ. 1 ) THEN
136     C Special case for zonal average model i.e. case where Nx == 1
137     C In this case a reverse mode exchange simply add values from all i <> 1
138     C to i=1 element and reset to zero.
139     DO bj=myByLo(myThid),myByHi(myThid)
140     DO bi=myBxLo(myThid),myBxHi(myThid)
141     DO k = 1,myNz
142     DO j = 1-myOLs,sNy+myOLn
143     DO i = 1-myOLw,0
144     array(1,j,k,bi,bj) = array(1,j,k,bi,bj)
145     & + array(i,j,k,bi,bj)
146     array(i,j,k,bi,bj) = 0.
147     ENDDO
148     DO i = sNx+1,sNx+myOLe
149     array(1,j,k,bi,bj) = array(1,j,k,bi,bj)
150     & + array(i,j,k,bi,bj)
151     array(i,j,k,bi,bj) = 0.
152     ENDDO
153     ENDDO
154     ENDDO
155     ENDDO
156     ENDDO
157     ENDIF
158    
159     IF ( Ny .EQ. 1 ) THEN
160     C Special case for X-slice domain i.e. case where Ny == 1
161     C In this case a reverse mode exchange simply add values from all j <> 1
162     C to j=1 element and reset to zero.
163     DO bj=myByLo(myThid),myByHi(myThid)
164     DO bi=myBxLo(myThid),myBxHi(myThid)
165     DO k = 1,myNz
166     DO j = 1-myOLs,0
167     DO i = 1-myOLw,sNx+myOLe
168     array(i,1,k,bi,bj) = array(i,1,k,bi,bj)
169     & + array(i,j,k,bi,bj)
170     array(i,j,k,bi,bj) = 0.
171     ENDDO
172     ENDDO
173     DO j = sNy+1,sNy+myOLn
174     DO i = 1-myOLw,sNx+myOLe
175     array(i,1,k,bi,bj) = array(i,1,k,bi,bj)
176     & + array(i,j,k,bi,bj)
177     array(i,j,k,bi,bj) = 0.
178     ENDDO
179     ENDDO
180     ENDDO
181     ENDDO
182     ENDDO
183     ENDIF
184    
185     C-- end of special cases of forward exch
186     ENDIF
187    
188 adcroft 1.2 IF ( theSimulationMode .EQ. FORWARD_SIMULATION ) THEN
189     C-- "Put" east and west edges.
190     CALL EXCH_RX_SEND_PUT_X( array,
191     I myOLw, myOLe, myOLs, myOLn, myNz,
192     I exchWidthX, exchWidthY,
193     I theSimulationMode, theCornerMode, myThid )
194 jmc 1.6 C-- If corners are important then sync and update east and west edges
195 adcroft 1.2 C-- before doing north and south exchanges.
196     IF ( theCornerMode .EQ. EXCH_UPDATE_CORNERS ) THEN
197     CALL EXCH_RX_RECV_GET_X( array,
198     I myOLw, myOLe, myOLs, myOLn, myNz,
199     I exchWidthX, exchWidthY,
200     I theSimulationMode, theCornerMode, myThid )
201     ENDIF
202     C "Put" north and south edges.
203     CALL EXCH_RX_SEND_PUT_Y( array,
204     I myOLw, myOLe, myOLs, myOLn, myNz,
205     I exchWidthX, exchWidthY,
206     I theSimulationMode, theCornerMode, myThid )
207     C-- Sync and update north, south (and east, west if corner updating
208     C-- not active).
209     IF ( theCornerMode .NE. EXCH_UPDATE_CORNERS ) THEN
210     CALL EXCH_RX_RECV_GET_X( array,
211     I myOLw, myOLe, myOLs, myOLn, myNz,
212     I exchWidthX, exchWidthY,
213     I theSimulationMode, theCornerMode, myThid )
214     ENDIF
215     CALL EXCH_RX_RECV_GET_Y( array,
216     I myOLw, myOLe, myOLs, myOLn, myNz,
217     I exchWidthX, exchWidthY,
218     I theSimulationMode, theCornerMode, myThid )
219     ENDIF
220    
221     IF ( theSimulationMode .EQ. REVERSE_SIMULATION ) THEN
222     C "Put" north and south edges.
223     CALL EXCH_RX_SEND_PUT_Y( array,
224     I myOLw, myOLe, myOLs, myOLn, myNz,
225     I exchWidthX, exchWidthY,
226     I theSimulationMode, theCornerMode, myThid )
227     C-- If corners are important then sync and update east and west edges
228     C-- before doing north and south exchanges.
229     IF ( theCornerMode .EQ. EXCH_UPDATE_CORNERS ) THEN
230     CALL EXCH_RX_RECV_GET_Y( array,
231     I myOLw, myOLe, myOLs, myOLn, myNz,
232     I exchWidthX, exchWidthY,
233     I theSimulationMode, theCornerMode, myThid )
234     ENDIF
235     C-- "Put" east and west edges.
236     CALL EXCH_RX_SEND_PUT_X( array,
237     I myOLw, myOLe, myOLs, myOLn, myNz,
238     I exchWidthX, exchWidthY,
239     I theSimulationMode, theCornerMode, myThid )
240     C-- Sync and update east, west (and north, south if corner updating
241     C-- not active).
242     IF ( theCornerMode .NE. EXCH_UPDATE_CORNERS ) THEN
243     CALL EXCH_RX_RECV_GET_Y( array,
244     I myOLw, myOLe, myOLs, myOLn, myNz,
245     I exchWidthX, exchWidthY,
246     I theSimulationMode, theCornerMode, myThid )
247     ENDIF
248     CALL EXCH_RX_RECV_GET_X( array,
249     I myOLw, myOLe, myOLs, myOLn, myNz,
250     I exchWidthX, exchWidthY,
251     I theSimulationMode, theCornerMode, myThid )
252     ENDIF
253 jmc 1.6
254     IF ( theSimulationMode .EQ. FORWARD_SIMULATION ) THEN
255    
256     IF ( Nx .EQ. 1 ) THEN
257 jmc 1.4 C Special case for zonal average model i.e. case where Nx == 1
258 adcroft 1.2 C In this case a forward mode exchange simply sets array to
259     C the i=1 value for all i.
260 jmc 1.6 DO bj=myByLo(myThid),myByHi(myThid)
261     DO bi=myBxLo(myThid),myBxHi(myThid)
262     DO k = 1,myNz
263     DO j = 1-myOLs,sNy+myOLn
264     DO i = 1-myOLw,sNx+myOLe
265     array(i,j,k,bi,bj) = array(1,j,k,bi,bj)
266     ENDDO
267 jmc 1.4 ENDDO
268     ENDDO
269     ENDDO
270     ENDDO
271 jmc 1.6 ENDIF
272    
273     IF ( Ny .EQ. 1 ) THEN
274 jmc 1.4 C Special case for X-slice domain i.e. case where Ny == 1
275     C In this case a forward mode exchange simply sets array to
276     C the j=1 value for all j.
277 jmc 1.6 DO bj=myByLo(myThid),myByHi(myThid)
278     DO bi=myBxLo(myThid),myBxHi(myThid)
279     DO k = 1,myNz
280     DO j = 1-myOLs,sNy+myOLn
281     DO i = 1-myOLw,sNx+myOLe
282     array(i,j,k,bi,bj) = array(i,1,k,bi,bj)
283     ENDDO
284 adcroft 1.2 ENDDO
285     ENDDO
286     ENDDO
287     ENDDO
288 jmc 1.6 ENDIF
289    
290     C-- end of special cases of forward exch
291 adcroft 1.2 ENDIF
292    
293     RETURN
294     END

  ViewVC Help
Powered by ViewVC 1.1.22