/[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.1.2.1 by adcroft, Wed Mar 28 19:48:51 2001 UTC revision 1.8 by jmc, Wed May 19 01:56:54 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         theSimulationMode = simulationMode         theSimulationMode = simulationMode
100         theCornerMode     = cornerMode         theCornerMode     = cornerMode
101    
102  C--    Error checks  C--    Error checks
103         IF ( exchWidthX .GT. myOLw   )         IF ( exchWidthX .GT. myOLw   )
104       &  STOP ' S/R EXCH_RX: exchWidthX .GT. myOLw'       &  STOP ' S/R EXCH_RX: exchWidthX .GT. myOLw'
105         IF ( exchWidthX .GT. myOLe   )         IF ( exchWidthX .GT. myOLe   )
106       &  STOP ' S/R EXCH_RX: exchWidthX .GT. myOLe'       &  STOP ' S/R EXCH_RX: exchWidthX .GT. myOLe'
107         IF ( exchWidthY .GT. myOLs   )         IF ( exchWidthY .GT. myOLs   )
108       &  STOP ' S/R EXCH_RX: exchWidthY .GT. myOLs'       &  STOP ' S/R EXCH_RX: exchWidthY .GT. myOLs'
109         IF ( exchWidthY .GT. myOLn   )         IF ( exchWidthY .GT. myOLn   )
110       &  STOP ' S/R EXCH_RX: exchWidthY .GT. myOLn'       &  STOP ' S/R EXCH_RX: exchWidthY .GT. myOLn'
111         IF ( myOLw      .GT. MAX_OLX_EXCH )         IF ( myOLw      .GT. MAX_OLX_EXCH )
112       &  STOP ' S/R EXCH_RX: myOLw .GT. MAX_OLX_EXCH'       &  STOP ' S/R EXCH_RX: myOLw .GT. MAX_OLX_EXCH'
113         IF ( myOLe      .GT. MAX_OLX_EXCH )         IF ( myOLe      .GT. MAX_OLX_EXCH )
114       &  STOP ' S/R EXCH_RX: myOLe .GT. MAX_OLX_EXCH'       &  STOP ' S/R EXCH_RX: myOLe .GT. MAX_OLX_EXCH'
115         IF ( myOLn      .GT. MAX_OLX_EXCH )         IF ( myOLn      .GT. MAX_OLX_EXCH )
116       &  STOP ' S/R EXCH_RX: myOLn .GT. MAX_OLY_EXCH'       &  STOP ' S/R EXCH_RX: myOLn .GT. MAX_OLY_EXCH'
117         IF ( myOLs      .GT. MAX_OLY_EXCH )         IF ( myOLs      .GT. MAX_OLY_EXCH )
118       &  STOP ' S/R EXCH_RX: myOLs .GT. MAX_OLY_EXCH'       &  STOP ' S/R EXCH_RX: myOLs .GT. MAX_OLY_EXCH'
119         IF ( myNZ       .GT. MAX_NR_EXCH  )         IF ( myNZ       .GT. MAX_NR_EXCH  )
120       &  STOP ' S/R EXCH_RX: myNZ  .GT. MAX_NR_EXCH '       &  STOP ' S/R EXCH_RX: myNZ  .GT. MAX_NR_EXCH '
121         IF (       theSimulationMode .NE. FORWARD_SIMULATION         IF (       theSimulationMode .NE. FORWARD_SIMULATION
122       &      .AND. theSimulationMode .NE. REVERSE_SIMULATION       &      .AND. theSimulationMode .NE. REVERSE_SIMULATION
# Line 115  C--    Error checks Line 128  C--    Error checks
128  C--    Cycle edge buffer level  C--    Cycle edge buffer level
129         CALL EXCH_CYCLE_EBL( myThid )         CALL EXCH_CYCLE_EBL( myThid )
130    
131           IF ( theSimulationMode .EQ. REVERSE_SIMULATION ) THEN
132    
133            IF ( Nx .EQ. 1 ) THEN
134    C      Special case for zonal average model i.e. case where Nx == 1
135    C      In this case a reverse mode exchange simply add values from all i <> 1
136    C      to i=1 element and reset to zero.
137             DO bj=myByLo(myThid),myByHi(myThid)
138              DO bi=myBxLo(myThid),myBxHi(myThid)
139               DO k = 1,myNz
140                DO j = 1-myOLs,sNy+myOLn
141                 DO i = 1-myOLw,0
142                  array(1,j,k,bi,bj) = array(1,j,k,bi,bj)
143         &                           + array(i,j,k,bi,bj)
144                  array(i,j,k,bi,bj) = 0.
145                 ENDDO
146                 DO i = sNx+1,sNx+myOLe
147                  array(1,j,k,bi,bj) = array(1,j,k,bi,bj)
148         &                           + array(i,j,k,bi,bj)
149                  array(i,j,k,bi,bj) = 0.
150                 ENDDO
151                ENDDO
152               ENDDO
153              ENDDO
154             ENDDO
155            ENDIF
156    
157            IF ( Ny .EQ. 1 ) THEN
158    C      Special case for X-slice domain i.e. case where Ny == 1
159    C      In this case a reverse mode exchange simply add values from all j <> 1
160    C      to j=1 element and reset to zero.
161             DO bj=myByLo(myThid),myByHi(myThid)
162              DO bi=myBxLo(myThid),myBxHi(myThid)
163               DO k = 1,myNz
164                DO j = 1-myOLs,0
165                 DO i = 1-myOLw,sNx+myOLe
166                  array(i,1,k,bi,bj) = array(i,1,k,bi,bj)
167         &                           + array(i,j,k,bi,bj)
168                  array(i,j,k,bi,bj) = 0.
169                 ENDDO
170                ENDDO
171                DO j = sNy+1,sNy+myOLn
172                 DO i = 1-myOLw,sNx+myOLe
173                  array(i,1,k,bi,bj) = array(i,1,k,bi,bj)
174         &                           + array(i,j,k,bi,bj)
175                  array(i,j,k,bi,bj) = 0.
176                 ENDDO
177                ENDDO
178               ENDDO
179              ENDDO
180             ENDDO
181            ENDIF
182    
183    C--    end of special cases of forward exch
184           ENDIF
185    
186         IF ( theSimulationMode .EQ. FORWARD_SIMULATION ) THEN         IF ( theSimulationMode .EQ. FORWARD_SIMULATION ) THEN
187  C--     "Put" east and west edges.  C--     "Put" east and west edges.
188          CALL EXCH_RX_SEND_PUT_X( array,          CALL EXCH_RX_SEND_PUT_X( array,
189       I              myOLw, myOLe, myOLs, myOLn, myNz,       I              myOLw, myOLe, myOLs, myOLn, myNz,
190       I              exchWidthX, exchWidthY,       I              exchWidthX, exchWidthY,
191       I              theSimulationMode, theCornerMode, myThid )       I              theSimulationMode, theCornerMode, myThid )
192  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
193  C--     before doing north and south exchanges.  C--     before doing north and south exchanges.
194          IF ( theCornerMode .EQ. EXCH_UPDATE_CORNERS ) THEN          IF ( theCornerMode .EQ. EXCH_UPDATE_CORNERS ) THEN
195           CALL EXCH_RX_RECV_GET_X( array,           CALL EXCH_RX_RECV_GET_X( array,
# Line 180  C--     not active). Line 248  C--     not active).
248       I             exchWidthX, exchWidthY,       I             exchWidthX, exchWidthY,
249       I             theSimulationMode, theCornerMode, myThid )       I             theSimulationMode, theCornerMode, myThid )
250         ENDIF         ENDIF
251  C      Special case for zonal average model i.e. case where sNx == 1  
252           IF ( theSimulationMode .EQ. FORWARD_SIMULATION ) THEN
253    
254            IF ( Nx .EQ. 1 ) THEN
255    C      Special case for zonal average model i.e. case where Nx == 1
256  C      In this case a forward mode exchange simply sets array to  C      In this case a forward mode exchange simply sets array to
257  C      the i=1 value for all i.  C      the i=1 value for all i.
258         IF ( sNx .EQ. 1 ) THEN           DO bj=myByLo(myThid),myByHi(myThid)
259          DO bj=myByLo(myThid),myByHi(myThid)            DO bi=myBxLo(myThid),myBxHi(myThid)
260           DO bi=myBxLo(myThid),myBxHi(myThid)             DO k = 1,myNz
261            DO K = 1,myNz              DO j = 1-myOLs,sNy+myOLn
262             DO J = 1-myOLs,sNy+myOLn               DO i = 1-myOLw,sNx+myOLe
263              DO I = 1-myOLw,sNx+myOLe                array(i,j,k,bi,bj) = array(1,j,k,bi,bj)
264               array(I,J,K,bi,bj) = array(sNx,J,K,bi,bj)               ENDDO
265                ENDDO
266               ENDDO
267              ENDDO
268             ENDDO
269            ENDIF
270    
271            IF ( Ny .EQ. 1 ) THEN
272    C      Special case for X-slice domain i.e. case where Ny == 1
273    C      In this case a forward mode exchange simply sets array to
274    C      the j=1 value for all j.
275             DO bj=myByLo(myThid),myByHi(myThid)
276              DO bi=myBxLo(myThid),myBxHi(myThid)
277               DO k = 1,myNz
278                DO j = 1-myOLs,sNy+myOLn
279                 DO i = 1-myOLw,sNx+myOLe
280                  array(i,j,k,bi,bj) = array(i,1,k,bi,bj)
281                 ENDDO
282              ENDDO              ENDDO
283             ENDDO             ENDDO
284            ENDDO            ENDDO
285           ENDDO           ENDDO
286          ENDDO          ENDIF
287    
288    C--    end of special cases of forward exch
289         ENDIF         ENDIF
290    
291         RETURN         RETURN
Legend:
Removed from v.1.1.2.1  
changed lines
  Added in v.1.8
  ViewVC Help
Powered by ViewVC 1.1.22