1 |
C $Header: /u/gcmpack/MITgcm/pkg/ex3/ex3_xy_rx.template,v 1.1 2005/10/16 06:55:48 edhill Exp $ |
2 |
C $Name: $ |
3 |
|
4 |
#include "EX3_OPTIONS.h" |
5 |
|
6 |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
7 |
CBOP 0 |
8 |
C !ROUTINE: EX3_XY_RX |
9 |
|
10 |
C !INTERFACE: |
11 |
SUBROUTINE EX3_XY_RX( |
12 |
I gtype, |
13 |
B phi, |
14 |
I myThid ) |
15 |
|
16 |
C !DESCRIPTION: |
17 |
C Perform an exchange for 2D scalars located at either Arakawa mass |
18 |
C [M|T] or vorticity [Z|V] points. |
19 |
|
20 |
C !USES: |
21 |
IMPLICIT NONE |
22 |
#include "SIZE.h" |
23 |
#include "EEPARAMS.h" |
24 |
#include "EESUPPORT.h" |
25 |
#include "EX3_SIZE.h" |
26 |
#include "EX3_PARAMS.h" |
27 |
#include "EX3_TOPOLOGY.h" |
28 |
|
29 |
C !INPUT PARAMETERS: |
30 |
C gtype :: grid type: [M|T]=mass point, [Z|V]=vorticity point |
31 |
C phi :: Array with overlap regions to be exchanged |
32 |
C myThid :: My thread id. |
33 |
CHARACTER*(*) gtype |
34 |
_RX phi(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) |
35 |
INTEGER myThid |
36 |
CEOP |
37 |
|
38 |
C !LOCAL VARIABLES: |
39 |
INTEGER iloc,in,nN |
40 |
CHARACTER*(MAX_LEN_MBUF) msgbuf |
41 |
C |
42 |
INTEGER |
43 |
I bufftag, sendProc, recvProc, |
44 |
I il,ih,is, jl,jh,js, kl,kh,ks, |
45 |
I io1,jo1,ko1, |
46 |
I idl1,idh1, jdl1,jdh1, kdl1,kdh1 |
47 |
INTEGER |
48 |
I i_sendtile, i_recvtile |
49 |
LOGICAL along_i |
50 |
CHARACTER*(1) commType |
51 |
INTEGER msgID(nSx*nSy) |
52 |
C |
53 |
#ifdef ALLOW_USE_MPI |
54 |
INTEGER mpiStatus(MPI_STATUS_SIZE) |
55 |
INTEGER mpiRc |
56 |
INTEGER wHandle |
57 |
#endif |
58 |
|
59 |
idl1 = 1-OLx |
60 |
idh1 = sNx+OLx |
61 |
jdl1 = 1-OLy |
62 |
jdh1 = sNy+OLy |
63 |
kdl1 = 1 |
64 |
kdh1 = 1 |
65 |
kl = 1 |
66 |
kh = 1 |
67 |
ks = 1 |
68 |
|
69 |
commType(1:1) = 'P' |
70 |
#ifdef ALLOW_USE_MPI |
71 |
commType(1:1) = 'M' |
72 |
#endif |
73 |
|
74 |
C As with EXCH2, tile<->tile communication is synchronized through |
75 |
C thread 1. |
76 |
CALL BAR2(myThid) |
77 |
|
78 |
IF (gtype(1:1) .EQ. 'M' .OR. gtype(1:1) .EQ. 'T') THEN |
79 |
|
80 |
C phi is a scalar located at Arakawa mass (cell-center) points |
81 |
|
82 |
C First send |
83 |
DO iloc = myBxLo(myThid), myBxHi(myThid) |
84 |
i_sendtile = ex3_p_itile(iloc) |
85 |
nN = ex3_e_n(i_sendtile) |
86 |
DO in = 1,nN |
87 |
i_recvtile = ex3_e_iopt(in,i_sendtile) |
88 |
CALL EX3_GET_BUFFTAG( |
89 |
I i_sendtile, i_recvtile, in, |
90 |
O bufftag, |
91 |
I myThid ) |
92 |
recvProc = ex3_t_iproc(i_recvtile) |
93 |
|
94 |
C ===== I direction ===== |
95 |
il = ex3_e_dat(2,1,in,i_sendtile) |
96 |
IF ( ex3_e_dat(1,1,in,i_sendtile) .EQ. 0 ) THEN |
97 |
along_i = .FALSE. |
98 |
ih = ex3_e_dat(3,1,in,i_sendtile) |
99 |
ELSE |
100 |
C Here, "along" means the i dimension is perpendicular to |
101 |
C the "seam" between the two tiles |
102 |
along_i = .TRUE. |
103 |
IF (IABS(ex3_e_dat(1,1,in,i_sendtile)) .EQ. 1) THEN |
104 |
ih = il + ex3_e_dat(1,1,in,i_sendtile) * OLx |
105 |
ELSE |
106 |
ih = il + ex3_e_dat(3,1,in,i_sendtile) |
107 |
ENDIF |
108 |
ENDIF |
109 |
is = 1 |
110 |
IF (il .GT. ih) is = -1 |
111 |
|
112 |
C ===== J direction ===== |
113 |
jl = ex3_e_dat(2,2,in,i_sendtile) |
114 |
IF ( ex3_e_dat(1,2,in,i_sendtile) .EQ. 0 ) THEN |
115 |
jh = ex3_e_dat(3,2,in,i_sendtile) |
116 |
ELSE |
117 |
IF (IABS(ex3_e_dat(1,2,in,i_sendtile)) .EQ. 1) THEN |
118 |
jh = jl + ex3_e_dat(1,2,in,i_sendtile) * OLy |
119 |
ELSE |
120 |
jh = jl + ex3_e_dat(3,2,in,i_sendtile) |
121 |
ENDIF |
122 |
ENDIF |
123 |
js = 1 |
124 |
IF (jl .GT. jh) js = -1 |
125 |
|
126 |
io1 = 0 |
127 |
jo1 = 0 |
128 |
ko1 = 0 |
129 |
CALL EX3_SEND_RX1( |
130 |
I bufftag, recvProc, |
131 |
I along_i, |
132 |
I il,ih,is, jl,jh,js, kl,kh,ks, |
133 |
I io1,jo1,ko1, |
134 |
I idl1,idh1, jdl1,jdh1, kdl1,kdh1, |
135 |
I phi, |
136 |
C B buff, n_buff, msgID, |
137 |
B EX3_B_RX(1,in,iloc), EX3_MAX_BL, msgID(iloc), |
138 |
I commType, |
139 |
I myThid ) |
140 |
ENDDO |
141 |
ENDDO |
142 |
|
143 |
C Then receive |
144 |
DO iloc = myBxLo(myThid), myBxHi(myThid) |
145 |
i_recvtile = ex3_p_itile(iloc) |
146 |
nN = ex3_e_n(i_recvtile) |
147 |
DO in = 1,nN |
148 |
i_sendtile = ex3_e_iopt(in,i_sendtile) |
149 |
CALL EX3_GET_BUFFTAG( |
150 |
I i_sendtile, i_recvtile, in, |
151 |
O bufftag, |
152 |
I myThid ) |
153 |
sendProc = ex3_t_iproc(i_sendtile) |
154 |
|
155 |
C ===== I direction ===== |
156 |
il = ex3_e_dat(2,1,in,i_sendtile) |
157 |
IF ( ex3_e_dat(1,1,in,i_sendtile) .EQ. 0 ) THEN |
158 |
along_i = .FALSE. |
159 |
ih = ex3_e_dat(3,1,in,i_sendtile) |
160 |
ELSE |
161 |
C Here, "along" means the i dimension is perpendicular to |
162 |
C the "seam" between the two tiles |
163 |
along_i = .TRUE. |
164 |
IF (IABS(ex3_e_dat(1,1,in,i_sendtile)) .EQ. 1) THEN |
165 |
ih = il + ex3_e_dat(1,1,in,i_sendtile) * OLx |
166 |
ELSE |
167 |
ih = il + ex3_e_dat(3,1,in,i_sendtile) |
168 |
ENDIF |
169 |
ENDIF |
170 |
is = 1 |
171 |
IF (il .GT. ih) is = -1 |
172 |
|
173 |
C ===== J direction ===== |
174 |
jl = ex3_e_dat(2,2,in,i_sendtile) |
175 |
IF ( ex3_e_dat(1,2,in,i_sendtile) .EQ. 0 ) THEN |
176 |
jh = ex3_e_dat(3,2,in,i_sendtile) |
177 |
ELSE |
178 |
IF (IABS(ex3_e_dat(1,2,in,i_sendtile)) .EQ. 1) THEN |
179 |
jh = jl + ex3_e_dat(1,2,in,i_sendtile) * OLy |
180 |
ELSE |
181 |
jh = jl + ex3_e_dat(3,2,in,i_sendtile) |
182 |
ENDIF |
183 |
ENDIF |
184 |
js = 1 |
185 |
IF (jl .GT. jh) js = -1 |
186 |
|
187 |
CALL EX3_RECV_RX1( |
188 |
I bufftag, sendProc, |
189 |
I along_i, |
190 |
I il,ih,is, jl,jh,js, kl,kh,ks, |
191 |
I idl1,idh1, jdl1,jdh1, kdl1,kdh1, |
192 |
I phi, |
193 |
C B buff, n_buff, |
194 |
B EX3_B_RX(1,in,iloc), EX3_MAX_BL, |
195 |
I commType, |
196 |
I myThid ) |
197 |
ENDDO |
198 |
ENDDO |
199 |
|
200 |
ELSEIF (gtype(1:1) .EQ. 'Z' .OR. gtype(1:1) .EQ. 'V') THEN |
201 |
|
202 |
C phi is a scalar located at Arakawa vorticity (cell-corner) |
203 |
C points |
204 |
|
205 |
ELSE |
206 |
WRITE(msgbuf,'(3a)') |
207 |
& 'EX3_XY_RX ERROR: grid type ''', gtype(1:1), |
208 |
& ''' is invalid -- please use one of [MTZV]' |
209 |
CALL print_error(msgbuf, mythid) |
210 |
STOP 'ABNORMAL END: S/R EX3_XY_RX' |
211 |
ENDIF |
212 |
|
213 |
CALL BAR2(myThid) |
214 |
|
215 |
RETURN |
216 |
END |
217 |
|
218 |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
219 |
|
220 |
CEH3 ;;; Local Variables: *** |
221 |
CEH3 ;;; mode:fortran *** |
222 |
CEH3 ;;; End: *** |