pkg/exch2/exch2_uv_agrid_xyz.rx.template

      subroutine exch2_uv_agrid_xyz_RX( component1,component2, myThid )
#include "CPP_EEOPTIONS.h"
      implicit none

C*=====================================================================*
C  Purpose: subroutine exch2_uv_agrid_xyz_rx will
C      handle exchanges for a 3D vector field on an A-grid.  
C
C  Input: component1(lon,lat,levs,bi,bj) - first component of vector
C         component2(lon,lat,levs,bi,bj) - second component of vector
C         myThid                           - tile number
C
C  Output: component1 and component2 are updated (halo regions filled)
C
C  Calls: exch (exch2_xyz_rx ) - twice, once
C         for the first-component, once for second.
C
C*=====================================================================*

#include "SIZE.h"
#include "EEPARAMS.h"
#include "EESUPPORT.h"
#include "W2_EXCH2_TOPOLOGY.h"
#include "W2_EXCH2_PARAMS.h"

C     == Argument list variables ==
      _RX component1(1-OLx:sNx+OLx,1-OLy:sNy+OLy,1:Nr,nSx,nSy)
      _RX component2(1-OLx:sNx+OLx,1-OLy:sNy+OLy,1:Nr,nSx,nSy)
      INTEGER myThid

C     == Local variables ==
C     i,j,L,bi,bj  are do indices.
C     OL[wens] - Overlap extents in west, east, north, south.
C     exchWidth[XY] - Extent of regions that will be exchanged.
C     dummy[12] - copies of the vector components with haloes filled.
C     b[nsew] - indices of the [nswe] neighboring faces for each face.

      integer i,j,L,bi,bj
      integer OLw, OLe, OLn, OLs, exchWidthX, exchWidthY, myNz
      _RX dummy1(1-OLx:sNx+OLx,1-OLy:sNy+OLy,1:Nr,nSx,nSy)
      _RX dummy2(1-OLx:sNx+OLx,1-OLy:sNy+OLy,1:Nr,nSx,nSy)
      integer mytile, myface

      OLw        = OLx
      OLe        = OLx
      OLn        = OLy
      OLs        = OLy
      exchWidthX = OLx
      exchWidthY = OLy
      myNz       = Nr

C First call the exchanges for the two components

      if (useCubedSphereExchange) then
       call exch2_xyz_RX( component1,
     .            OLw, OLe, OLs, OLn, myNz,
     .            exchWidthX, exchWidthY,
     .            FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
       call exch2_xyz_RX( component2,
     .            OLw, OLe, OLs, OLn, myNz,
     .            exchWidthX, exchWidthY,
     .            FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, 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

C Then if we are on the sphere we may need to switch u and v components
C and/or the signs depending on which cube face we are located.

      if (useCubedSphereExchange) then

       do bj = myByLo(myThid), myByHi(myThid)
       do bi = myBxLo(myThid), myBxHi(myThid)

C First we need to copy the component info into dummy arrays
       do L = 1,Nr
       do j = 1-OLy,sNy+OLy
       do i = 1-OLx,sNx+OLx
        dummy1(i,j,L,bi,bj) = component1(i,j,L,bi,bj)
        dummy2(i,j,L,bi,bj) = component2(i,j,L,bi,bj)
       enddo
       enddo
       enddo

C Now choose what to do at each edge of the halo based on which face
C    (we assume that bj is always=1)

       mytile = W2_myTilelist(bi)
       myface = exch2_myFace(mytile)
C odd faces share disposition of all sections of the halo
       if ( mod(myface,2).eq.1 ) then
        do L = 1,Nr
         do j = 1,sNy
C east
          if(exch2_is_Eedge(mytile).eq.1) then
           do i = 1,exchWidthX
            component1(sNx+i,j,L,bi,bj) = dummy1(sNx+i,j,L,bi,bj)
            component2(sNx+i,j,L,bi,bj) = dummy2(sNx+i,j,L,bi,bj)
           enddo
          endif
C west
          if(exch2_is_Wedge(mytile).eq.1) then
           do i = 1,exchWidthX
            component1(i-OLx,j,L,bi,bj) = dummy2(i-OLx,j,L,bi,bj)
            component2(i-OLx,j,L,bi,bj) = -dummy1(i-OLx,j,L,bi,bj)
           enddo
          endif
C north
          if(exch2_is_Nedge(mytile).eq.1) then
           do i = 1,exchWidthX
            component1(j,sNy+i,L,bi,bj) = -dummy2(j,sNy+i,L,bi,bj)
            component2(j,sNy+i,L,bi,bj) = dummy1(j,sNy+i,L,bi,bj)
           enddo
          endif
C south
          if(exch2_is_Sedge(mytile).eq.1) then
           do i = 1,exchWidthX
            component1(j,i-OLx,L,bi,bj) = dummy1(j,i-OLx,L,bi,bj)
            component2(j,i-OLx,L,bi,bj) = dummy2(j,i-OLx,L,bi,bj)
           enddo
          endif
         enddo
        enddo
C now the even faces (share disposition of all sections of the halo)
       elseif ( mod(myface,2).eq.0 ) then
        do L = 1,Nr
         do j = 1,sNy
C east
          if(exch2_is_Eedge(mytile).eq.1) then
           do i = 1,exchWidthX
            component1(sNx+i,j,L,bi,bj) = dummy2(sNx+i,j,L,bi,bj)
            component2(sNx+i,j,L,bi,bj) = -dummy1(sNx+i,j,L,bi,bj)
           enddo
          endif
C west
          if(exch2_is_Wedge(mytile).eq.1) then
           do i = 1,exchWidthX
            component1(i-OLx,j,L,bi,bj) = dummy1(i-OLx,j,L,bi,bj)
            component2(i-OLx,j,L,bi,bj) = dummy2(i-OLx,j,L,bi,bj)
           enddo
          endif
C north
          if(exch2_is_Nedge(mytile).eq.1) then
           do i = 1,exchWidthX
            component1(j,sNy+i,L,bi,bj) = dummy1(j,sNy+i,L,bi,bj)
            component2(j,sNy+i,L,bi,bj) = dummy2(j,sNy+i,L,bi,bj)
           enddo
          endif
C south
          if(exch2_is_Sedge(mytile).eq.1) then
           do i = 1,exchWidthX
            component1(j,i-OLy,L,bi,bj) = -dummy2(j,i-OLy,L,bi,bj)
            component2(j,i-OLy,L,bi,bj) = dummy1(j,i-OLy,L,bi,bj)
           enddo
          endif
         enddo
        enddo
       endif

       enddo
       enddo

      endif

      RETURN
      END
1	subroutine exch2_uv_agrid_xyz_RX( component1,component2, myThid )
2	#include "CPP_EEOPTIONS.h"
3	implicit none
4
5	C=====================================================================
6	C Purpose: subroutine exch2_uv_agrid_xyz_rx will
7	C handle exchanges for a 3D vector field on an A-grid.
8	C
9	C Input: component1(lon,lat,levs,bi,bj) - first component of vector
10	C component2(lon,lat,levs,bi,bj) - second component of vector
11	C myThid - tile number
12	C
13	C Output: component1 and component2 are updated (halo regions filled)
14	C
15	C Calls: exch (exch2_xyz_rx ) - twice, once
16	C for the first-component, once for second.
17	C
18	C=====================================================================
19
20	#include "SIZE.h"
21	#include "EEPARAMS.h"
22	#include "EESUPPORT.h"
23	#include "W2_EXCH2_TOPOLOGY.h"
24	#include "W2_EXCH2_PARAMS.h"
25
26	C == Argument list variables ==
27	_RX component1(1-OLx:sNx+OLx,1-OLy:sNy+OLy,1:Nr,nSx,nSy)
28	_RX component2(1-OLx:sNx+OLx,1-OLy:sNy+OLy,1:Nr,nSx,nSy)
29	INTEGER myThid
30
31	C == Local variables ==
32	C i,j,L,bi,bj are do indices.
33	C OL[wens] - Overlap extents in west, east, north, south.
34	C exchWidth[XY] - Extent of regions that will be exchanged.
35	C dummy[12] - copies of the vector components with haloes filled.
36	C b[nsew] - indices of the [nswe] neighboring faces for each face.
37
38	integer i,j,L,bi,bj
39	integer OLw, OLe, OLn, OLs, exchWidthX, exchWidthY, myNz
40	_RX dummy1(1-OLx:sNx+OLx,1-OLy:sNy+OLy,1:Nr,nSx,nSy)
41	_RX dummy2(1-OLx:sNx+OLx,1-OLy:sNy+OLy,1:Nr,nSx,nSy)
42	integer mytile, myface
43
44	OLw = OLx
45	OLe = OLx
46	OLn = OLy
47	OLs = OLy
48	exchWidthX = OLx
49	exchWidthY = OLy
50	myNz = Nr
51
52	C First call the exchanges for the two components
53
54	if (useCubedSphereExchange) then
55	call exch2_xyz_RX( component1,
56	. OLw, OLe, OLs, OLn, myNz,
57	. exchWidthX, exchWidthY,
58	. FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
59	call exch2_xyz_RX( component2,
60	. OLw, OLe, OLs, OLn, myNz,
61	. exchWidthX, exchWidthY,
62	. FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
63	else
64	c call exch_RX( component1,
65	c . OLw, OLe, OLs, OLn, myNz,
66	c . exchWidthX, exchWidthY,
67	c . FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
68	c call exch_RX( component2,
69	c . OLw, OLe, OLs, OLn, myNz,
70	c . exchWidthX, exchWidthY,
71	c . FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
72	_EXCH_XYZ_RL( component1, myThid )
73	_EXCH_XYZ_RL( component2, myThid )
74	endif
75
76	C Then if we are on the sphere we may need to switch u and v components
77	C and/or the signs depending on which cube face we are located.
78
79	if (useCubedSphereExchange) then
80
81	do bj = myByLo(myThid), myByHi(myThid)
82	do bi = myBxLo(myThid), myBxHi(myThid)
83
84	C First we need to copy the component info into dummy arrays
85	do L = 1,Nr
86	do j = 1-OLy,sNy+OLy
87	do i = 1-OLx,sNx+OLx
88	dummy1(i,j,L,bi,bj) = component1(i,j,L,bi,bj)
89	dummy2(i,j,L,bi,bj) = component2(i,j,L,bi,bj)
90	enddo
91	enddo
92	enddo
93
94	C Now choose what to do at each edge of the halo based on which face
95	C (we assume that bj is always=1)
96
97	mytile = W2_myTilelist(bi)
98	myface = exch2_myFace(mytile)
99	C odd faces share disposition of all sections of the halo
100	if ( mod(myface,2).eq.1 ) then
101	do L = 1,Nr
102	do j = 1,sNy
103	C east
104	if(exch2_is_Eedge(mytile).eq.1) then
105	do i = 1,exchWidthX
106	component1(sNx+i,j,L,bi,bj) = dummy1(sNx+i,j,L,bi,bj)
107	component2(sNx+i,j,L,bi,bj) = dummy2(sNx+i,j,L,bi,bj)
108	enddo
109	endif
110	C west
111	if(exch2_is_Wedge(mytile).eq.1) then
112	do i = 1,exchWidthX
113	component1(i-OLx,j,L,bi,bj) = dummy2(i-OLx,j,L,bi,bj)
114	component2(i-OLx,j,L,bi,bj) = -dummy1(i-OLx,j,L,bi,bj)
115	enddo
116	endif
117	C north
118	if(exch2_is_Nedge(mytile).eq.1) then
119	do i = 1,exchWidthX
120	component1(j,sNy+i,L,bi,bj) = -dummy2(j,sNy+i,L,bi,bj)
121	component2(j,sNy+i,L,bi,bj) = dummy1(j,sNy+i,L,bi,bj)
122	enddo
123	endif
124	C south
125	if(exch2_is_Sedge(mytile).eq.1) then
126	do i = 1,exchWidthX
127	component1(j,i-OLx,L,bi,bj) = dummy1(j,i-OLx,L,bi,bj)
128	component2(j,i-OLx,L,bi,bj) = dummy2(j,i-OLx,L,bi,bj)
129	enddo
130	endif
131	enddo
132	enddo
133	C now the even faces (share disposition of all sections of the halo)
134	elseif ( mod(myface,2).eq.0 ) then
135	do L = 1,Nr
136	do j = 1,sNy
137	C east
138	if(exch2_is_Eedge(mytile).eq.1) then
139	do i = 1,exchWidthX
140	component1(sNx+i,j,L,bi,bj) = dummy2(sNx+i,j,L,bi,bj)
141	component2(sNx+i,j,L,bi,bj) = -dummy1(sNx+i,j,L,bi,bj)
142	enddo
143	endif
144	C west
145	if(exch2_is_Wedge(mytile).eq.1) then
146	do i = 1,exchWidthX
147	component1(i-OLx,j,L,bi,bj) = dummy1(i-OLx,j,L,bi,bj)
148	component2(i-OLx,j,L,bi,bj) = dummy2(i-OLx,j,L,bi,bj)
149	enddo
150	endif
151	C north
152	if(exch2_is_Nedge(mytile).eq.1) then
153	do i = 1,exchWidthX
154	component1(j,sNy+i,L,bi,bj) = dummy1(j,sNy+i,L,bi,bj)
155	component2(j,sNy+i,L,bi,bj) = dummy2(j,sNy+i,L,bi,bj)
156	enddo
157	endif
158	C south
159	if(exch2_is_Sedge(mytile).eq.1) then
160	do i = 1,exchWidthX
161	component1(j,i-OLy,L,bi,bj) = -dummy2(j,i-OLy,L,bi,bj)
162	component2(j,i-OLy,L,bi,bj) = dummy1(j,i-OLy,L,bi,bj)
163	enddo
164	endif
165	enddo
166	enddo
167	endif
168
169	enddo
170	enddo
171
172	endif
173
174	RETURN
175	END