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

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

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

revision 1.2 by adcroft, Tue May 29 14:01:36 2001 UTC revision 1.6 by jmc, Sat May 15 02:18:52 2010 UTC
# Line 3  C $Name$ Line 3  C $Name$
3    
4  #include "CPP_EEOPTIONS.h"  #include "CPP_EEOPTIONS.h"
5    
6         SUBROUTINE EXCH_RX(  CBOP
7    
8    C      !ROUTINE: EXCH_RX
9    
10    C      !INTERFACE:
11           SUBROUTINE EXCH_RX(
12       U            array,       U            array,
13       I            myOLw, myOLe, myOLs, myOLn, myNz,       I            myOLw, myOLe, myOLs, myOLn, myNz,
14       I            exchWidthX, exchWidthY,       I            exchWidthX, exchWidthY,
15       I            simulationMode, cornerMode, myThid )       I            simulationMode, cornerMode, myThid )
 C     /==========================================================\  
 C     | SUBROUTINE EXCH_RX                                       |  
 C     | o Control edge exchanges for RX array.                   |  
 C     |==========================================================|  
 C     |                                                          |  
 C     | Controlling routine for exchange of XY edges of an array |  
 C     | distributed in X and Y. The routine interfaces to        |  
 C     | communication routines that can use messages passing     |  
 C     | exchanges, put type exchanges or get type exchanges.     |  
 C     |  This allows anything from MPI to raw memory channel to  |  
 C     | memmap segments to be used as a inter-process and/or     |  
 C     | inter-thread communiation and synchronisation            |  
 C     | mechanism.                                               |  
 C     | Notes --                                                 |  
 C     | 1. Some low-level mechanisms such as raw memory-channel  |  
 C     | or SGI/CRAY shmem put do not have direct Fortran bindings|  
 C     | and are invoked through C stub routines.                 |  
 C     | 2. Although this routine is fairly general but it does   |  
 C     | require nSx and nSy are the same for all innvocations.   |  
 C     | There are many common data structures ( myByLo,          |  
 C     | westCommunicationMode, mpiIdW etc... ) tied in with      |  
 C     | (nSx,nSy). To support arbitray nSx and nSy would require |  
 C     | general forms of these.                                  |  
 C     |                                                          |  
 C     \==========================================================/  
16        IMPLICIT NONE        IMPLICIT NONE
17    
18    C     !DESCRIPTION:
19    C     *==========================================================*
20    C     | SUBROUTINE EXCH_RX
21    C     | o Control edge exchanges for RX array.
22    C     *==========================================================*
23    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    C     | 3. RX arrays are used to generate code for both _RL and
43    C     | _RS forms.
44    C     *==========================================================*
45    
46    C      !USES:
47  C      == Global data ==  C      == Global data ==
48  #include "SIZE.h"  #include "SIZE.h"
49  #include "EEPARAMS.h"  #include "EEPARAMS.h"
50  #include "EESUPPORT.h"  #include "EESUPPORT.h"
51  #include "EXCH.h"  #include "EXCH.h"
52    
53    C      !INPUT/OUTPUT PARAMETERS:
54  C      == Routine arguments ==  C      == Routine arguments ==
55  C      array - Array with edges to exchange.  C      array :: Array with edges to exchange.
56  C      myOLw - West, East, North and South overlap region sizes.  C      myOLw :: West, East, North and South overlap region sizes.
57  C      myOLe  C      myOLe
58  C      myOLn  C      myOLn
59  C      myOLs  C      myOLs
60  C      exchWidthX - Width of data region exchanged in X.  C      exchWidthX :: Width of data region exchanged in X.
61  C      exchWidthY - Width of data region exchanged in Y.  C      exchWidthY :: Width of data region exchanged in Y.
62  C                   Note --  C                    Note --
63  C                   1. In theory one could have a send width and  C                    1. In theory one could have a send width and
64  C                   a receive width for each face of each tile. The only  C                    a receive width for each face of each tile. The only
65  C                   restriction woul be that the send width of one  C                    restriction woul be that the send width of one
66  C                   face should equal the receive width of the sent to  C                    face should equal the receive width of the sent to
67  C                   tile face. Dont know if this would be useful. I  C                    tile face. Dont know if this would be useful. I
68  C                   have left it out for now as it requires additional  C                    have left it out for now as it requires additional
69  C                   bookeeping.  C                     bookeeping.
70  C      simulationMode - Forward or reverse mode exchange ( provides  C      simulationMode :: Forward or reverse mode exchange ( provides
71  C                       support for adjoint integration of code. )  C                        support for adjoint integration of code. )
72  C      cornerMode     - Flag indicating whether corner updates are  C      cornerMode     :: Flag indicating whether corner updates are
73  C                       needed.  C                        needed.
74  C      myThid         - Thread number of this instance of S/R EXCH...  C      myThid         :: Thread number of this instance of S/R EXCH...
75         INTEGER myOLw         INTEGER myOLw
76         INTEGER myOLe         INTEGER myOLe
77         INTEGER myOLs         INTEGER myOLs
# Line 73  C      myThid         - Thread number of Line 83  C      myThid         - Thread number of
83         INTEGER cornerMode         INTEGER cornerMode
84         INTEGER myThid         INTEGER myThid
85         _RX array(1-myOLw:sNx+myOLe,         _RX array(1-myOLw:sNx+myOLe,
86       &           1-myOLs:sNy+myOLn,       &           1-myOLs:sNy+myOLn,
87       &           myNZ, nSx, nSy)       &           myNZ, nSx, nSy)
88    
89    C      !LOCAL VARIABLES:
90  C      == Local variables ==  C      == Local variables ==
91  C      theSimulationMode - Holds working copy of simulation mode  C      theSimulationMode :: Holds working copy of simulation mode
92  C      theCornerMode     - Holds working copy of corner mode  C      theCornerMode     :: Holds working copy of corner mode
93    C      i,j,k,bi,bj       :: Loop counters
94         INTEGER theSimulationMode         INTEGER theSimulationMode
95         INTEGER theCornerMode         INTEGER theCornerMode
96         INTEGER I,J,K,bi,bj         INTEGER i,j,k,bi,bj
97    CEOP
98    
99           _BARRIER
100    
101         theSimulationMode = simulationMode         theSimulationMode = simulationMode
102         theCornerMode     = cornerMode         theCornerMode     = cornerMode
103    
104  C--    Error checks  C--    Error checks
105         IF ( exchWidthX .GT. myOLw   )         IF ( exchWidthX .GT. myOLw   )
106       &  STOP ' S/R EXCH_RX: exchWidthX .GT. myOLw'       &  STOP ' S/R EXCH_RX: exchWidthX .GT. myOLw'
107         IF ( exchWidthX .GT. myOLe   )         IF ( exchWidthX .GT. myOLe   )
108       &  STOP ' S/R EXCH_RX: exchWidthX .GT. myOLe'       &  STOP ' S/R EXCH_RX: exchWidthX .GT. myOLe'
109         IF ( exchWidthY .GT. myOLs   )         IF ( exchWidthY .GT. myOLs   )
110       &  STOP ' S/R EXCH_RX: exchWidthY .GT. myOLs'       &  STOP ' S/R EXCH_RX: exchWidthY .GT. myOLs'
111         IF ( exchWidthY .GT. myOLn   )         IF ( exchWidthY .GT. myOLn   )
112       &  STOP ' S/R EXCH_RX: exchWidthY .GT. myOLn'       &  STOP ' S/R EXCH_RX: exchWidthY .GT. myOLn'
113         IF ( myOLw      .GT. MAX_OLX_EXCH )         IF ( myOLw      .GT. MAX_OLX_EXCH )
114       &  STOP ' S/R EXCH_RX: myOLw .GT. MAX_OLX_EXCH'       &  STOP ' S/R EXCH_RX: myOLw .GT. MAX_OLX_EXCH'
115         IF ( myOLe      .GT. MAX_OLX_EXCH )         IF ( myOLe      .GT. MAX_OLX_EXCH )
116       &  STOP ' S/R EXCH_RX: myOLe .GT. MAX_OLX_EXCH'       &  STOP ' S/R EXCH_RX: myOLe .GT. MAX_OLX_EXCH'
117         IF ( myOLn      .GT. MAX_OLX_EXCH )         IF ( myOLn      .GT. MAX_OLX_EXCH )
118       &  STOP ' S/R EXCH_RX: myOLn .GT. MAX_OLY_EXCH'       &  STOP ' S/R EXCH_RX: myOLn .GT. MAX_OLY_EXCH'
119         IF ( myOLs      .GT. MAX_OLY_EXCH )         IF ( myOLs      .GT. MAX_OLY_EXCH )
120       &  STOP ' S/R EXCH_RX: myOLs .GT. MAX_OLY_EXCH'       &  STOP ' S/R EXCH_RX: myOLs .GT. MAX_OLY_EXCH'
121         IF ( myNZ       .GT. MAX_NR_EXCH  )         IF ( myNZ       .GT. MAX_NR_EXCH  )
122       &  STOP ' S/R EXCH_RX: myNZ  .GT. MAX_NR_EXCH '       &  STOP ' S/R EXCH_RX: myNZ  .GT. MAX_NR_EXCH '
123         IF (       theSimulationMode .NE. FORWARD_SIMULATION         IF (       theSimulationMode .NE. FORWARD_SIMULATION
124       &      .AND. theSimulationMode .NE. REVERSE_SIMULATION       &      .AND. theSimulationMode .NE. REVERSE_SIMULATION
# Line 115  C--    Error checks Line 130  C--    Error checks
130  C--    Cycle edge buffer level  C--    Cycle edge buffer level
131         CALL EXCH_CYCLE_EBL( myThid )         CALL EXCH_CYCLE_EBL( myThid )
132    
133           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         IF ( theSimulationMode .EQ. FORWARD_SIMULATION ) THEN         IF ( theSimulationMode .EQ. FORWARD_SIMULATION ) THEN
189  C--     "Put" east and west edges.  C--     "Put" east and west edges.
190          CALL EXCH_RX_SEND_PUT_X( array,          CALL EXCH_RX_SEND_PUT_X( array,
191       I              myOLw, myOLe, myOLs, myOLn, myNz,       I              myOLw, myOLe, myOLs, myOLn, myNz,
192       I              exchWidthX, exchWidthY,       I              exchWidthX, exchWidthY,
193       I              theSimulationMode, theCornerMode, myThid )       I              theSimulationMode, theCornerMode, myThid )
194  C--     If corners are important then sync and update east and west edges  C--     If corners are important then sync and update east and west edges
195  C--     before doing north and south exchanges.  C--     before doing north and south exchanges.
196          IF ( theCornerMode .EQ. EXCH_UPDATE_CORNERS ) THEN          IF ( theCornerMode .EQ. EXCH_UPDATE_CORNERS ) THEN
197           CALL EXCH_RX_RECV_GET_X( array,           CALL EXCH_RX_RECV_GET_X( array,
# Line 180  C--     not active). Line 250  C--     not active).
250       I             exchWidthX, exchWidthY,       I             exchWidthX, exchWidthY,
251       I             theSimulationMode, theCornerMode, myThid )       I             theSimulationMode, theCornerMode, myThid )
252         ENDIF         ENDIF
253  C      Special case for zonal average model i.e. case where sNx == 1  
254           IF ( theSimulationMode .EQ. FORWARD_SIMULATION ) THEN
255    
256            IF ( Nx .EQ. 1 ) THEN
257    C      Special case for zonal average model i.e. case where Nx == 1
258  C      In this case a forward mode exchange simply sets array to  C      In this case a forward mode exchange simply sets array to
259  C      the i=1 value for all i.  C      the i=1 value for all i.
260         IF ( sNx .EQ. 1 ) THEN           DO bj=myByLo(myThid),myByHi(myThid)
261          DO bj=myByLo(myThid),myByHi(myThid)            DO bi=myBxLo(myThid),myBxHi(myThid)
262           DO bi=myBxLo(myThid),myBxHi(myThid)             DO k = 1,myNz
263            DO K = 1,myNz              DO j = 1-myOLs,sNy+myOLn
264             DO J = 1-myOLs,sNy+myOLn               DO i = 1-myOLw,sNx+myOLe
265              DO I = 1-myOLw,sNx+myOLe                array(i,j,k,bi,bj) = array(1,j,k,bi,bj)
266               array(I,J,K,bi,bj) = array(sNx,J,K,bi,bj)               ENDDO
267              ENDDO              ENDDO
268             ENDDO             ENDDO
269            ENDDO            ENDDO
270           ENDDO           ENDDO
271          ENDDO          ENDIF
272    
273            IF ( Ny .EQ. 1 ) THEN
274    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             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                ENDDO
285               ENDDO
286              ENDDO
287             ENDDO
288            ENDIF
289    
290    C--    end of special cases of forward exch
291         ENDIF         ENDIF
292    
293         RETURN         RETURN
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.6
  ViewVC Help
Powered by ViewVC 1.1.22