/[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.5 by cnh, Mon Nov 7 18:21:11 2005 UTC revision 1.6 by jmc, Sat May 15 02:18:52 2010 UTC
# Line 8  CBOP Line 8  CBOP
8  C      !ROUTINE: EXCH_RX  C      !ROUTINE: EXCH_RX
9    
10  C      !INTERFACE:  C      !INTERFACE:
11         SUBROUTINE EXCH_RX(         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,
# Line 17  C      !INTERFACE: Line 17  C      !INTERFACE:
17    
18  C     !DESCRIPTION:  C     !DESCRIPTION:
19  C     *==========================================================*  C     *==========================================================*
20  C     | SUBROUTINE EXCH_RX                                          C     | SUBROUTINE EXCH_RX
21  C     | o Control edge exchanges for RX array.                      C     | o Control edge exchanges for RX array.
22  C     *==========================================================*  C     *==========================================================*
23  C     |                                                            C     |
24  C     | Controlling routine for exchange of XY edges of an array    C     | Controlling routine for exchange of XY edges of an array
25  C     | distributed in X and Y. The routine interfaces to          C     | distributed in X and Y. The routine interfaces to
26  C     | communication routines that can use messages passing        C     | communication routines that can use messages passing
27  C     | exchanges, put type exchanges or get type exchanges.        C     | exchanges, put type exchanges or get type exchanges.
28  C     |  This allows anything from MPI to raw memory channel to    C     |  This allows anything from MPI to raw memory channel to
29  C     | memmap segments to be used as a inter-process and/or        C     | memmap segments to be used as a inter-process and/or
30  C     | inter-thread communiation and synchronisation              C     | inter-thread communiation and synchronisation
31  C     | mechanism.                                                  C     | mechanism.
32  C     | Notes --                                                    C     | Notes --
33  C     | 1. Some low-level mechanisms such as raw memory-channel    C     | 1. Some low-level mechanisms such as raw memory-channel
34  C     | or SGI/CRAY shmem put do not have direct Fortran bindings  C     | or SGI/CRAY shmem put do not have direct Fortran bindings
35  C     | and are invoked through C stub routines.                    C     | and are invoked through C stub routines.
36  C     | 2. Although this routine is fairly general but it does      C     | 2. Although this routine is fairly general but it does
37  C     | require nSx and nSy are the same for all innvocations.      C     | require nSx and nSy are the same for all innvocations.
38  C     | There are many common data structures ( myByLo,            C     | There are many common data structures ( myByLo,
39  C     | westCommunicationMode, mpiIdW etc... ) tied in with        C     | westCommunicationMode, mpiIdW etc... ) tied in with
40  C     | (nSx,nSy). To support arbitray nSx and nSy would require    C     | (nSx,nSy). To support arbitray nSx and nSy would require
41  C     | general forms of these.                                    C     | general forms of these.
42  C     | 3. RX arrays are used to generate code for both _RL and  C     | 3. RX arrays are used to generate code for both _RL and
43  C     | _RS forms.                                                  C     | _RS forms.
44  C     *==========================================================*  C     *==========================================================*
45    
46  C      !USES:  C      !USES:
# Line 59  C      myOLn Line 59  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
# Line 83  C      myThid         :: Thread number o Line 83  C      myThid         :: Thread number o
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:  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  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  CEOP
98    
99         _BARRIER         _BARRIER
# Line 102  CEOP Line 102  CEOP
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 130  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 195  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    
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  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 ( Nx .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(1,J,K,bi,bj)               ENDDO
267              ENDDO              ENDDO
268             ENDDO             ENDDO
269            ENDDO            ENDDO
270           ENDDO           ENDDO
271          ENDDO          ENDIF
272         ENDIF  
273            IF ( Ny .EQ. 1 ) THEN
274  C      Special case for X-slice domain i.e. case where Ny == 1  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  C      In this case a forward mode exchange simply sets array to
276  C      the j=1 value for all j.  C      the j=1 value for all j.
277         IF ( Ny .EQ. 1 ) THEN           DO bj=myByLo(myThid),myByHi(myThid)
278          DO bj=myByLo(myThid),myByHi(myThid)            DO bi=myBxLo(myThid),myBxHi(myThid)
279           DO bi=myBxLo(myThid),myBxHi(myThid)             DO k = 1,myNz
280            DO K = 1,myNz              DO j = 1-myOLs,sNy+myOLn
281             DO J = 1-myOLs,sNy+myOLn               DO i = 1-myOLw,sNx+myOLe
282              DO I = 1-myOLw,sNx+myOLe                array(i,j,k,bi,bj) = array(i,1,k,bi,bj)
283               array(I,J,K,bi,bj) = array(I,1,K,bi,bj)               ENDDO
284              ENDDO              ENDDO
285             ENDDO             ENDDO
286            ENDDO            ENDDO
287           ENDDO           ENDDO
288          ENDDO          ENDIF
289    
290    C--    end of special cases of forward exch
291         ENDIF         ENDIF
292    
293         RETURN         RETURN
Legend:
Removed from v.1.5  
changed lines
  Added in v.1.6
  ViewVC Help
Powered by ViewVC 1.1.22