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

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

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

revision 1.4 by molod, Wed Nov 17 16:28:12 2004 UTC revision 1.5 by jmc, Fri Nov 19 02:36:17 2004 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2  C $Name$  C $Name$
3    
       subroutine exch2_uv_agrid_xyz_RX(component1,component2,withSigns,  
      .                                                         myThid )  
4  #include "CPP_EEOPTIONS.h"  #include "CPP_EEOPTIONS.h"
5        implicit none  
6          SUBROUTINE EXCH2_UV_AGRID_XYZ_RX(
7         U                                 component1, component2,
8         I                                 withSigns, myThid )
9    
10  C*=====================================================================*  C*=====================================================================*
11  C  Purpose: subroutine exch2_uv_agrid_xyz_rx will  C  Purpose: SUBROUTINE exch2_uv_agrid_xyz_RX will
12  C      handle exchanges for a 3D vector field on an A-grid.    C      handle exchanges for a 3D vector field on an A-grid.  
13  C  C
14  C  Input: component1(lon,lat,levs,bi,bj) - first component of vector  C  Input: component1(lon,lat,levs,bi,bj) - first component of vector
15  C         component2(lon,lat,levs,bi,bj) - second component of vector  C         component2(lon,lat,levs,bi,bj) - second component of vector
16  C         withSigns (logical)            - true to use sign of components  C         withSigns (logical)            - true to use sign of components
17  C         myThid                         - tile number  C         myThid                         - Thread number
18  C  C
19  C  Output: component1 and component2 are updated (halo regions filled)  C  Output: component1 and component2 are updated (halo regions filled)
20  C  C
21  C  Calls: exch (exch2_xyz_rx ) - twice, once  C  Calls: exch (exch2_xyz_rx ) - twice, once for the first-component,
22  C         for the first-component, once for second.  C                                       once for second.
23  C  C
24  C*=====================================================================*  C*=====================================================================*
25    
26          IMPLICIT NONE
27    
28  #include "SIZE.h"  #include "SIZE.h"
29  #include "EEPARAMS.h"  #include "EEPARAMS.h"
30  #include "EESUPPORT.h"  #include "EESUPPORT.h"
# Line 29  C*====================================== Line 32  C*======================================
32  #include "W2_EXCH2_PARAMS.h"  #include "W2_EXCH2_PARAMS.h"
33    
34  C     == Argument list variables ==  C     == Argument list variables ==
35        _RX component1(1-OLx:sNx+OLx,1-OLy:sNy+OLy,1:Nr,nSx,nSy)        _RX component1(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
36        _RX component2(1-OLx:sNx+OLx,1-OLy:sNy+OLy,1:Nr,nSx,nSy)        _RX component2(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
37        LOGICAL withSigns        LOGICAL withSigns
38        INTEGER myThid        INTEGER myThid
39    
40  C     == Local variables ==  C     == Local variables ==
41  C     i,j,L,bi,bj  are do indices.  C     i,j,k,bi,bj  are DO indices.
42  C     OL[wens] - Overlap extents in west, east, north, south.  C     OL[wens] - Overlap extents in west, east, north, south.
43  C     exchWidth[XY] - Extent of regions that will be exchanged.  C     exchWidth[XY] - Extent of regions that will be exchanged.
44  C     dummy[12] - copies of the vector components with haloes filled.  C     dummy[12] - copies of the vector components with haloes filled.
 C     b[nsew] - indices of the [nswe] neighboring faces for each face.  
45    
46        integer i,j,L,bi,bj        INTEGER i,j,k,bi,bj
47        integer OLw, OLe, OLn, OLs, exchWidthX, exchWidthY, myNz        INTEGER OLw, OLe, OLn, OLs, exchWidthX, exchWidthY, myNz
48        _RX dummy1(1-OLx:sNx+OLx,1-OLy:sNy+OLy,1:Nr,nSx,nSy)        _RX dummy1(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
49        _RX dummy2(1-OLx:sNx+OLx,1-OLy:sNy+OLy,1:Nr,nSx,nSy)        _RX dummy2(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
50        integer mytile, myface        INTEGER mytile, myface
51    
52        OLw        = OLx        OLw        = OLx
53        OLe        = OLx        OLe        = OLx
# Line 55  C     b[nsew] - indices of the [nswe] ne Line 57  C     b[nsew] - indices of the [nswe] ne
57        exchWidthY = OLy        exchWidthY = OLy
58        myNz       = Nr        myNz       = Nr
59    
60  C First call the exchanges for the two components        IF ( useCubedSphereExchange ) THEN
61    
62    C First CALL the exchanges for the two components
63    
64        if (useCubedSphereExchange) then         CALL EXCH2_XYZ_RX( component1, myThid )
65         call exch2_xyz_RX( component1, myThid )         CALL EXCH2_XYZ_RX( component2, myThid )
        call exch2_xyz_RX( component2, myThid )  
       else  
 c      call exch_RX( component1,  
 c    .            OLw, OLe, OLs, OLn, myNz,  
 c    .            exchWidthX, exchWidthY,  
 c    .            FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )  
 c      call exch_RX( component2,  
 c    .            OLw, OLe, OLs, OLn, myNz,  
 c    .            exchWidthX, exchWidthY,  
 c    .            FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )  
        _EXCH_XYZ_RL( component1, myThid )  
        _EXCH_XYZ_RL( component2, myThid )  
       endif  
66    
67  C Then if we are on the sphere we may need to switch u and v components  C Then if we are on the sphere we may need to switch u and v components
68  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.
69    
70        if (useCubedSphereExchange) then  C--    Loops on tile and level indices:
71           DO bj = myByLo(myThid), myByHi(myThid)
72         do bj = myByLo(myThid), myByHi(myThid)          DO bi = myBxLo(myThid), myBxHi(myThid)
73         do bi = myBxLo(myThid), myBxHi(myThid)           DO k = 1,Nr
74    
75  C First we need to copy the component info into dummy arrays  C First we need to copy the component info into dummy arrays
76         do L = 1,Nr            DO j = 1-OLy,sNy+OLy
77         do j = 1-OLy,sNy+OLy             DO i = 1-OLx,sNx+OLx
78         do i = 1-OLx,sNx+OLx               dummy1(i,j) = component1(i,j,k,bi,bj)
79          dummy1(i,j,L,bi,bj) = component1(i,j,L,bi,bj)               dummy2(i,j) = component2(i,j,k,bi,bj)
80          dummy2(i,j,L,bi,bj) = component2(i,j,L,bi,bj)             ENDDO
81         enddo            ENDDO
        enddo  
        enddo  
82    
83  C Now choose what to do at each edge of the halo based on which face  C Now choose what to DO at each edge of the halo based on which face
84  C    (we assume that bj is always=1)  C    (we assume that bj is always=1)
85    
86         mytile = W2_myTilelist(bi)            mytile = W2_myTileList(bi)
87         myface = exch2_myFace(mytile)            myface = exch2_myFace(mytile)
88  C odd faces share disposition of all sections of the halo  C odd faces share disposition of all sections of the halo
89         if ( mod(myface,2).eq.1 ) then            IF ( MOD(myface,2).EQ.1 ) THEN
90          do L = 1,Nr  C east (nothing to change)
91           do j = 1,sNy  c          IF (exch2_isEedge(mytile).EQ.1) THEN
92  C east  c            DO j = 1,sNy
93            if(exch2_isEedge(mytile).eq.1) then  c             DO i = 1,exchWidthX
94             do i = 1,exchWidthX  c              component1(sNx+i,j,k,bi,bj) = dummy1(sNx+i,j)
95              component1(sNx+i,j,L,bi,bj) = dummy1(sNx+i,j,L,bi,bj)  c              component2(sNx+i,j,k,bi,bj) = dummy2(sNx+i,j)
96              component2(sNx+i,j,L,bi,bj) = dummy2(sNx+i,j,L,bi,bj)  c             ENDDO
97             enddo  c            ENDDO
98            endif  c          ENDIF
99  C west  C west
100            if(exch2_isWedge(mytile).eq.1) then             IF (exch2_isWedge(mytile).EQ.1) THEN
101             do i = 1,exchWidthX              IF (withSigns) THEN
102              component1(i-OLx,j,L,bi,bj) = dummy2(i-OLx,j,L,bi,bj)               DO j = 1,sNy
103              component2(i-OLx,j,L,bi,bj) = -dummy1(i-OLx,j,L,bi,bj)                DO i = 1,exchWidthX
104             enddo                 component1(i-OLx,j,k,bi,bj) =  dummy2(i-OLx,j)
105            endif                 component2(i-OLx,j,k,bi,bj) = -dummy1(i-OLx,j)
106                  ENDDO
107                 ENDDO
108                ELSE
109                 DO j = 1,sNy
110                  DO i = 1,exchWidthX
111                   component1(i-OLx,j,k,bi,bj) =  dummy2(i-OLx,j)
112                   component2(i-OLx,j,k,bi,bj) =  dummy1(i-OLx,j)
113                  ENDDO
114                 ENDDO
115                ENDIF
116               ENDIF
117  C north  C north
118            if(exch2_isNedge(mytile).eq.1) then             IF (exch2_isNedge(mytile).EQ.1) THEN
119             do i = 1,exchWidthX              IF (withSigns) THEN
120              component1(j,sNy+i,L,bi,bj) = -dummy2(j,sNy+i,L,bi,bj)               DO j = 1,exchWidthY
121              component2(j,sNy+i,L,bi,bj) = dummy1(j,sNy+i,L,bi,bj)                DO i = 1,sNx
122             enddo                 component1(i,sNy+j,k,bi,bj) = -dummy2(i,sNy+j)
123            endif                 component2(i,sNy+j,k,bi,bj) =  dummy1(i,sNy+j)
124  C south                ENDDO
125            if(exch2_isSedge(mytile).eq.1) then               ENDDO
126             do i = 1,exchWidthX              ELSE
127              component1(j,i-OLx,L,bi,bj) = dummy1(j,i-OLx,L,bi,bj)               DO j = 1,exchWidthY
128              component2(j,i-OLx,L,bi,bj) = dummy2(j,i-OLx,L,bi,bj)                DO i = 1,sNx
129             enddo                 component1(i,sNy+j,k,bi,bj) =  dummy2(i,sNy+j)
130            endif                 component2(i,sNy+j,k,bi,bj) =  dummy1(i,sNy+j)
131           enddo                ENDDO
132          enddo               ENDDO
133                ENDIF
134               ENDIF
135    C south (nothing to change)
136    c          IF (exch2_isSedge(mytile).EQ.1) THEN
137    c            DO j = 1,exchWidthY
138    c             DO i = 1,sNx
139    c              component1(i,j-OLx,k,bi,bj) = dummy1(i,j-OLx)
140    c              component2(i,j-OLx,k,bi,bj) = dummy2(i,j-OLx)
141    c             ENDDO
142    c            ENDDO
143    c          ENDIF
144    
145              ELSE
146  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)
147         elseif ( mod(myface,2).eq.0 ) then  
         do L = 1,Nr  
          do j = 1,sNy  
148  C east  C east
149            if(exch2_isEedge(mytile).eq.1) then             IF (exch2_isEedge(mytile).EQ.1) THEN
150             do i = 1,exchWidthX              IF (withSigns) THEN
151              component1(sNx+i,j,L,bi,bj) = dummy2(sNx+i,j,L,bi,bj)               DO j = 1,sNy
152              component2(sNx+i,j,L,bi,bj) = -dummy1(sNx+i,j,L,bi,bj)                DO i = 1,exchWidthX
153             enddo                 component1(sNx+i,j,k,bi,bj) =  dummy2(sNx+i,j)
154            endif                 component2(sNx+i,j,k,bi,bj) = -dummy1(sNx+i,j)
155  C west                ENDDO
156            if(exch2_isWedge(mytile).eq.1) then               ENDDO
157             do i = 1,exchWidthX              ELSE
158              component1(i-OLx,j,L,bi,bj) = dummy1(i-OLx,j,L,bi,bj)               DO j = 1,sNy
159              component2(i-OLx,j,L,bi,bj) = dummy2(i-OLx,j,L,bi,bj)                DO i = 1,exchWidthX
160             enddo                 component1(sNx+i,j,k,bi,bj) =  dummy2(sNx+i,j)
161            endif                 component2(sNx+i,j,k,bi,bj) =  dummy1(sNx+i,j)
162  C north                ENDDO
163            if(exch2_isNedge(mytile).eq.1) then               ENDDO
164             do i = 1,exchWidthX              ENDIF
165              component1(j,sNy+i,L,bi,bj) = dummy1(j,sNy+i,L,bi,bj)             ENDIF
166              component2(j,sNy+i,L,bi,bj) = dummy2(j,sNy+i,L,bi,bj)  C west (nothing to change)
167             enddo  c          IF (exch2_isWedge(mytile).EQ.1) THEN
168            endif  c            DO j = 1,sNy
169    c             DO i = 1,exchWidthX
170    c              component1(i-OLx,j,k,bi,bj) = dummy1(i-OLx,j)
171    c              component2(i-OLx,j,k,bi,bj) = dummy2(i-OLx,j)
172    c             ENDDO
173    c            ENDDO
174    c          ENDIF
175    C north (nothing to change)
176    c          IF (exch2_isNedge(mytile).EQ.1) THEN
177    c            DO j = 1,exchWidthY
178    c             DO i = 1,sNx
179    c              component1(i,sNy+j,k,bi,bj) = dummy1(i,sNy+j)
180    c              component2(i,sNy+j,k,bi,bj) = dummy2(i,sNy+j)
181    c             ENDDO
182    c            ENDDO
183    c          ENDIF
184  C south  C south
185            if(exch2_isSedge(mytile).eq.1) then             IF (exch2_isSedge(mytile).EQ.1) THEN
186             do i = 1,exchWidthX              IF (withSigns) THEN
187              component1(j,i-OLy,L,bi,bj) = -dummy2(j,i-OLy,L,bi,bj)               DO j = 1,exchWidthY
188              component2(j,i-OLy,L,bi,bj) = dummy1(j,i-OLy,L,bi,bj)                DO i = 1,sNx
189             enddo                 component1(i,j-OLy,k,bi,bj) = -dummy2(i,j-OLy)
190            endif                 component2(i,j-OLy,k,bi,bj) =  dummy1(i,j-OLy)
191           enddo                ENDDO
192          enddo               ENDDO
193         endif              ELSE
194                 DO j = 1,exchWidthY
195         enddo                DO i = 1,sNx
196         enddo                 component1(i,j-OLy,k,bi,bj) =  dummy2(i,j-OLy)
197                   component2(i,j-OLy,k,bi,bj) =  dummy1(i,j-OLy)
198                  ENDDO
199                 ENDDO
200                ENDIF
201               ENDIF
202    
203    C end odd / even faces
204              ENDIF
205    
206    C--    end of Loops on tile and level indices (k,bi,bj).
207             ENDDO
208            ENDDO
209           ENDDO
210    
211          ELSE
212    
213    c      CALL EXCH_RX( component1,
214    c    I            OLw, OLe, OLs, OLn, myNz,
215    c    I            exchWidthX, exchWidthY,
216    c    I            FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
217    c      CALL EXCH_RX( component2,
218    c    I            OLw, OLe, OLs, OLn, myNz,
219    c    I            exchWidthX, exchWidthY,
220    c    I            FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
221    C_jmc: for JAM compatibility, replace the 2 CALLs above by the 2 CPP_MACROs:
222           _EXCH_XYZ_RX( component1, myThid )
223           _EXCH_XYZ_RX( component2, myThid )
224    
225        endif        ENDIF
226    
227        RETURN        RETURN
228        END        END
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5
  ViewVC Help
Powered by ViewVC 1.1.22