/[MITgcm]/MITgcm/pkg/exch2/exch2_uv_agrid_3d_rx.template
ViewVC logotype

Diff of /MITgcm/pkg/exch2/exch2_uv_agrid_3d_rx.template

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

revision 1.2 by heimbach, Sat Nov 18 01:09:00 2006 UTC revision 1.3 by jmc, Wed Jul 25 21:13:20 2007 UTC
# Line 9  C     !ROUTINE: EXCH2_UV_AGRID_3D_RX Line 9  C     !ROUTINE: EXCH2_UV_AGRID_3D_RX
9    
10  C     !INTERFACE:  C     !INTERFACE:
11        SUBROUTINE EXCH2_UV_AGRID_3D_RX(        SUBROUTINE EXCH2_UV_AGRID_3D_RX(
12       U                                 Uphi, Vphi,       U                                 uPhi, vPhi,
13       I                                 withSigns, myNz, myThid )       I                                 withSigns, myNz, myThid )
14    
15  C     !DESCRIPTION:  C     !DESCRIPTION:
# Line 17  C*====================================== Line 17  C*======================================
17  C  Purpose: SUBROUTINE EXCH2_UV_AGRID_3D_RX  C  Purpose: SUBROUTINE EXCH2_UV_AGRID_3D_RX
18  C      handle exchanges for a 3D vector field on an A-grid.  C      handle exchanges for a 3D vector field on an A-grid.
19  C  C
20  C  Input:  C  Input:
21  C    Uphi(lon,lat,levs,bi,bj) :: first component of vector  C    uPhi(lon,lat,levs,bi,bj) :: first component of vector
22  C    Vphi(lon,lat,levs,bi,bj) :: second component of vector  C    vPhi(lon,lat,levs,bi,bj) :: second component of vector
23  C    withSigns (logical)      :: true to use sign of components  C    withSigns (logical)      :: true to use sign of components
24  C    myNz                     :: 3rd dimension of input arrays Uphi,Vphi  C    myNz                     :: 3rd dimension of input arrays uPhi,vPhi
25  C    myThid                   :: my Thread Id number  C    myThid                   :: my Thread Id number
26  C  C
27  C  Output: Uphi and Vphi are updated (halo regions filled)  C  Output: uPhi and vPhi are updated (halo regions filled)
28  C  C
29  C  Calls: exch_RX (exch2_RX1_cube) - for each component  C  Calls: exch_RX (exch2_RX1_cube) - for each component
30  C  C
# Line 42  C     !USES: Line 42  C     !USES:
42  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
43  C     == Argument list variables ==  C     == Argument list variables ==
44        INTEGER myNz        INTEGER myNz
45        _RX Uphi(1-OLx:sNx+OLx,1-OLy:sNy+OLy,myNz,nSx,nSy)        _RX uPhi(1-OLx:sNx+OLx,1-OLy:sNy+OLy,myNz,nSx,nSy)
46        _RX Vphi(1-OLx:sNx+OLx,1-OLy:sNy+OLy,myNz,nSx,nSy)        _RX vPhi(1-OLx:sNx+OLx,1-OLy:sNy+OLy,myNz,nSx,nSy)
47        LOGICAL withSigns        LOGICAL withSigns
48        INTEGER myThid        INTEGER myThid
49    
# Line 51  C     !LOCAL VARIABLES: Line 51  C     !LOCAL VARIABLES:
51  C     == Local variables ==  C     == Local variables ==
52  C     i,j,k,bi,bj   :: loop indices.  C     i,j,k,bi,bj   :: loop indices.
53  C     OL[wens]      :: Overlap extents in west, east, north, south.  C     OL[wens]      :: Overlap extents in west, east, north, south.
54  C     exchWidth[XY] :: - Extent of regions that will be exchanged.  C     exchWidth[XY] :: Extent of regions that will be exchanged.
55  C     dummy[12]     :: - copies of the vector components with haloes filled.  C     uLoc,vLoc     :: copies of the vector components with haloes filled.
56    
57        INTEGER i,j,k,bi,bj        INTEGER i,j,k,bi,bj
58        INTEGER OLw, OLe, OLn, OLs, exchWidthX, exchWidthY        INTEGER OLw, OLe, OLn, OLs, exchWidthX, exchWidthY
59        _RX dummy1(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RX uLoc(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
60        _RX dummy2(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RX vLoc(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
61        _RX negOne        _RX negOne
62        INTEGER mytile, myface        INTEGER myTile, myFace
63  CEOP  CEOP
64    
65        OLw        = OLx        OLw        = OLx
# Line 74  CEOP Line 74  CEOP
74        IF ( useCubedSphereExchange ) THEN        IF ( useCubedSphereExchange ) THEN
75  C---  using CubedSphereExchange:  C---  using CubedSphereExchange:
76    
77  C First CALL the exchanges for the two components  C--   First call the exchanges for the two components
78    
79         CALL EXCH2_RX1_CUBE( Uphi, 'T ',         CALL EXCH2_RX1_CUBE( uPhi, 'T ',
80       I            OLw, OLe, OLs, OLn, myNz,       I            OLw, OLe, OLs, OLn, myNz,
81       I            exchWidthX, exchWidthY,       I            exchWidthX, exchWidthY,
82       I            FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )       I            FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
83         CALL EXCH2_RX1_CUBE( Uphi, 'T ',         CALL EXCH2_RX1_CUBE( uPhi, 'T ',
84       I            OLw, OLe, OLs, OLn, myNz,       I            OLw, OLe, OLs, OLn, myNz,
85       I            exchWidthX, exchWidthY,       I            exchWidthX, exchWidthY,
86       I            FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )       I            FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
87    
88         CALL EXCH2_RX1_CUBE( Vphi, 'T ',         CALL EXCH2_RX1_CUBE( vPhi, 'T ',
89       I            OLw, OLe, OLs, OLn, myNz,       I            OLw, OLe, OLs, OLn, myNz,
90       I            exchWidthX, exchWidthY,       I            exchWidthX, exchWidthY,
91       I            FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )       I            FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
92         CALL EXCH2_RX1_CUBE( Vphi, 'T ',         CALL EXCH2_RX1_CUBE( vPhi, 'T ',
93       I            OLw, OLe, OLs, OLn, myNz,       I            OLw, OLe, OLs, OLn, myNz,
94       I            exchWidthX, exchWidthY,       I            exchWidthX, exchWidthY,
95       I            FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )       I            FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
96    
97  C- note: can substitute the low-level S/R calls above with:  C- note: can substitute the low-level S/R calls above with:
98  c      CALL EXCH2_3D_RX( Uphi, myNz, myThid )  c      CALL EXCH2_3D_RX( uPhi, myNz, myThid )
99  c      CALL EXCH2_3D_RX( Vphi, myNz, myThid )  c      CALL EXCH2_3D_RX( vPhi, myNz, myThid )
100    
101  C Then if we are on the cube we may need to switch u and v components  C--   Then we may need to switch u and v components
102  C and/or the signs depending on which cube face we are located.  C     and/or the signs depending on which cube face we are located.
103    
104  C--    Loops on tile and level indices:  C--   Loops on tile indices:
105         DO bj = myByLo(myThid), myByHi(myThid)         DO bj = myByLo(myThid), myByHi(myThid)
106          DO bi = myBxLo(myThid), myBxHi(myThid)          DO bi = myBxLo(myThid), myBxHi(myThid)
107    
108    C-    Now choose what to do at each edge of the halo based on which face
109    C     (we assume that bj is always=1)
110             myTile = W2_myTileList(bi)
111             myFace = exch2_myFace(myTile)
112    
113    C--   Loops on level index:
114           DO k = 1,myNz           DO k = 1,myNz
115    
116  C First we need to copy the component info into dummy arrays  C-    First we copy the component info into local dummy arrays
117            DO j = 1-OLy,sNy+OLy            DO j = 1-OLy,sNy+OLy
118             DO i = 1-OLx,sNx+OLx             DO i = 1-OLx,sNx+OLx
119               dummy1(i,j) = Uphi(i,j,k,bi,bj)               uLoc(i,j) = uPhi(i,j,k,bi,bj)
120               dummy2(i,j) = Vphi(i,j,k,bi,bj)               vLoc(i,j) = vPhi(i,j,k,bi,bj)
121             ENDDO             ENDDO
122            ENDDO            ENDDO
123    
124  C Now choose what to do at each edge of the halo based on which face  C-    odd faces share disposition of all sections of the halo
125  C    (we assume that bj is always=1)            IF ( MOD(myFace,2).EQ.1 ) THEN
126            mytile = W2_myTileList(bi)  C-    North:
127            myface = exch2_myFace(mytile)             IF (exch2_isNedge(myTile).EQ.1) THEN
   
 C odd faces share disposition of all sections of the halo  
           IF ( MOD(myface,2).EQ.1 ) THEN  
 C east (nothing to change)  
 c          IF (exch2_isEedge(mytile).EQ.1) THEN  
 c            DO j = 1-OLy,sNy+OLy  
 c             DO i = 1,exchWidthX  
 c              Uphi(sNx+i,j,k,bi,bj) = dummy1(sNx+i,j)  
 c              Vphi(sNx+i,j,k,bi,bj) = dummy2(sNx+i,j)  
 c             ENDDO  
 c            ENDDO  
 c          ENDIF  
 C west  
            IF (exch2_isWedge(mytile).EQ.1) THEN  
              DO j = 1-OLy,sNy+OLy  
               DO i = 1,exchWidthX  
                Uphi(1-i,j,k,bi,bj) = dummy2(1-i,j)  
                Vphi(1-i,j,k,bi,bj) = dummy1(1-i,j)*negOne  
               ENDDO  
              ENDDO  
            ENDIF  
 C north  
            IF (exch2_isNedge(mytile).EQ.1) THEN  
128               DO j = 1,exchWidthY               DO j = 1,exchWidthY
129                DO i = 1-OLx,sNx+OLx                DO i = 1-OLx,sNx+OLx
130                 Uphi(i,sNy+j,k,bi,bj) = dummy2(i,sNy+j)*negOne                 uPhi(i,sNy+j,k,bi,bj) = vLoc(i,sNy+j)*negOne
131                 Vphi(i,sNy+j,k,bi,bj) = dummy1(i,sNy+j)                 vPhi(i,sNy+j,k,bi,bj) = uLoc(i,sNy+j)
132                ENDDO                ENDDO
133               ENDDO               ENDDO
134             ENDIF             ENDIF
135  C south (nothing to change)  C-    South: (nothing to change)
136  c          IF (exch2_isSedge(mytile).EQ.1) THEN  c          IF (exch2_isSedge(myTile).EQ.1) THEN
137  c            DO j = 1,exchWidthY  c            DO j = 1,exchWidthY
138  c             DO i = 1-OLx,sNx+OLx  c             DO i = 1-OLx,sNx+OLx
139  c              Uphi(i,1-j,k,bi,bj) = dummy1(i,1-j)  c              uPhi(i,1-j,k,bi,bj) = uLoc(i,1-j)
140  c              Vphi(i,1-j,k,bi,bj) = dummy2(i,1-j)  c              vPhi(i,1-j,k,bi,bj) = vLoc(i,1-j)
141    c             ENDDO
142    c            ENDDO
143    c          ENDIF
144    C-    East: (nothing to change)
145    c          IF (exch2_isEedge(myTile).EQ.1) THEN
146    c            DO j = 1-OLy,sNy+OLy
147    c             DO i = 1,exchWidthX
148    c              uPhi(sNx+i,j,k,bi,bj) = uLoc(sNx+i,j)
149    c              vPhi(sNx+i,j,k,bi,bj) = vLoc(sNx+i,j)
150  c             ENDDO  c             ENDDO
151  c            ENDDO  c            ENDDO
152  c          ENDIF  c          ENDIF
153    C-    West:
154               IF (exch2_isWedge(myTile).EQ.1) THEN
155                 DO j = 1-OLy,sNy+OLy
156                  DO i = 1,exchWidthX
157                   uPhi(1-i,j,k,bi,bj) = vLoc(1-i,j)
158                   vPhi(1-i,j,k,bi,bj) = uLoc(1-i,j)*negOne
159                  ENDDO
160                 ENDDO
161               ENDIF
162    
163            ELSE            ELSE
164  C now the even faces (share disposition of all sections of the halo)  C-    Now the even faces (share disposition of all sections of the halo)
165    
166  C east  C-    East:
167             IF (exch2_isEedge(mytile).EQ.1) THEN             IF (exch2_isEedge(myTile).EQ.1) THEN
168               DO j = 1-OLy,sNy+OLy               DO j = 1-OLy,sNy+OLy
169                DO i = 1,exchWidthX                DO i = 1,exchWidthX
170                 Uphi(sNx+i,j,k,bi,bj) = dummy2(sNx+i,j)                 uPhi(sNx+i,j,k,bi,bj) = vLoc(sNx+i,j)
171                 Vphi(sNx+i,j,k,bi,bj) = dummy1(sNx+i,j)*negOne                 vPhi(sNx+i,j,k,bi,bj) = uLoc(sNx+i,j)*negOne
172                ENDDO                ENDDO
173               ENDDO               ENDDO
174             ENDIF             ENDIF
175  C west (nothing to change)  C-    West: (nothing to change)
176  c          IF (exch2_isWedge(mytile).EQ.1) THEN  c          IF (exch2_isWedge(myTile).EQ.1) THEN
177  c            DO j = 1-OLy,sNy+OLy  c            DO j = 1-OLy,sNy+OLy
178  c             DO i = 1,exchWidthX  c             DO i = 1,exchWidthX
179  c              Uphi(1-i,j,k,bi,bj) = dummy1(1-i,j)  c              uPhi(1-i,j,k,bi,bj) = uLoc(1-i,j)
180  c              Vphi(1-i,j,k,bi,bj) = dummy2(1-i,j)  c              vPhi(1-i,j,k,bi,bj) = vLoc(1-i,j)
181  c             ENDDO  c             ENDDO
182  c            ENDDO  c            ENDDO
183  c          ENDIF  c          ENDIF
184  C north (nothing to change)  C-    North: (nothing to change)
185  c          IF (exch2_isNedge(mytile).EQ.1) THEN  c          IF (exch2_isNedge(myTile).EQ.1) THEN
186  c            DO j = 1,exchWidthY  c            DO j = 1,exchWidthY
187  c             DO i = 1-OLx,sNx+OLx  c             DO i = 1-OLx,sNx+OLx
188  c              Uphi(i,sNy+j,k,bi,bj) = dummy1(i,sNy+j)  c              uPhi(i,sNy+j,k,bi,bj) = uLoc(i,sNy+j)
189  c              Vphi(i,sNy+j,k,bi,bj) = dummy2(i,sNy+j)  c              vPhi(i,sNy+j,k,bi,bj) = vLoc(i,sNy+j)
190  c             ENDDO  c             ENDDO
191  c            ENDDO  c            ENDDO
192  c          ENDIF  c          ENDIF
193  C south  C-    South:
194             IF (exch2_isSedge(mytile).EQ.1) THEN             IF (exch2_isSedge(myTile).EQ.1) THEN
195               DO j = 1,exchWidthY               DO j = 1,exchWidthY
196                DO i = 1-OLx,sNx+OLx                DO i = 1-OLx,sNx+OLx
197                 Uphi(i,1-j,k,bi,bj) = dummy2(i,1-j)*negOne                 uPhi(i,1-j,k,bi,bj) = vLoc(i,1-j)*negOne
198                 Vphi(i,1-j,k,bi,bj) = dummy1(i,1-j)                 vPhi(i,1-j,k,bi,bj) = uLoc(i,1-j)
199                ENDDO                ENDDO
200               ENDDO               ENDDO
201             ENDIF             ENDIF
# Line 210  C--    end of Loops on tile and level in Line 212  C--    end of Loops on tile and level in
212  C---  not using CubedSphereExchange:  C---  not using CubedSphereExchange:
213    
214  #ifndef AUTODIFF_EXCH2  #ifndef AUTODIFF_EXCH2
215         CALL EXCH_RX( Uphi,         CALL EXCH_RX( uPhi,
216       I            OLw, OLe, OLs, OLn, myNz,       I            OLw, OLe, OLs, OLn, myNz,
217       I            exchWidthX, exchWidthY,       I            exchWidthX, exchWidthY,
218       I            FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )       I            FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
219         CALL EXCH_RX( Vphi,         CALL EXCH_RX( vPhi,
220       I            OLw, OLe, OLs, OLn, myNz,       I            OLw, OLe, OLs, OLn, myNz,
221       I            exchWidthX, exchWidthY,       I            exchWidthX, exchWidthY,
222       I            FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )       I            FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3
  ViewVC Help
Powered by ViewVC 1.1.22