5 |
#include "W2_OPTIONS.h" |
#include "W2_OPTIONS.h" |
6 |
|
|
7 |
SUBROUTINE EXCH2_RECV_RX2( |
SUBROUTINE EXCH2_RECV_RX2( |
8 |
I tIlo, tIhi, tiStride, |
I tIlo1, tIhi1, tIlo2, tIhi2, tiStride, |
9 |
I tJlo, tJhi, tjStride, |
I tJlo1, tJhi1, tJlo2, tJhi2, tjStride, |
10 |
I tKlo, tKhi, tkStride, |
I tKlo, tKhi, tkStride, |
11 |
I thisTile, thisI, nN, |
I thisTile, thisI, nN, |
12 |
I e2Bufr1_RX, e2Bufr2_RX, e2BufrRecSize, |
I e2Bufr1_RX, e2Bufr2_RX, e2BufrRecSize, |
24 |
#include "SIZE.h" |
#include "SIZE.h" |
25 |
#include "EEPARAMS.h" |
#include "EEPARAMS.h" |
26 |
#include "EESUPPORT.h" |
#include "EESUPPORT.h" |
27 |
|
#include "W2_EXCH2_SIZE.h" |
28 |
#include "W2_EXCH2_TOPOLOGY.h" |
#include "W2_EXCH2_TOPOLOGY.h" |
29 |
|
|
30 |
C === Routine arguments === |
C === Routine arguments === |
31 |
C tIlo, tIhi, tIstride :: index range in I that will be filled in target "array" |
C tIlo1,tIhi1,tIstride :: index range in I that will be filled in target "array1" |
32 |
C tJlo, tJhi, tJstride :: index range in J that will be filled in target "array" |
C tIlo2,tIhi2,tIstride :: index range in I that will be filled in target "array2" |
33 |
C tKlo, tKhi, tKstride :: index range in K that will be filled in target "array" |
C tJlo1,tJhi1,tJstride :: index range in J that will be filled in target "array1" |
34 |
|
C tJlo2,tJhi2,tJstride :: index range in J that will be filled in target "array2" |
35 |
|
C tKlo, tKhi, tKstride :: index range in K that will be filled in target arrays |
36 |
C thisTile :: Rank of the receiveing tile |
C thisTile :: Rank of the receiveing tile |
37 |
C thisI :: Index of the receiving tile within this process (used |
C thisI :: Index of the receiving tile within this process (used |
38 |
C :: to select buffer slots that are allowed). |
C :: to select buffer slots that are allowed). |
59 |
C :: This is done in routine after receives. |
C :: This is done in routine after receives. |
60 |
C myTiles :: List of nt tiles that this process owns. |
C myTiles :: List of nt tiles that this process owns. |
61 |
C commSetting :: Mode of communication used to exchnage with this neighbor |
C commSetting :: Mode of communication used to exchnage with this neighbor |
62 |
C myThid :: Thread number of this instance of EXCH2_RECV_RX1 |
C myThid :: Thread number of this instance of EXCH2_RECV_RX2 |
63 |
C |
|
64 |
INTEGER tILo, tIHi, tiStride |
INTEGER tIlo1, tIhi1, tIlo2, tIhi2, tiStride |
65 |
INTEGER tJLo, tJHi, tjStride |
INTEGER tJlo1, tJhi1, tJlo2, tJhi2, tjStride |
66 |
INTEGER tKLo, tKHi, tkStride |
INTEGER tKlo, tKhi, tkStride |
67 |
INTEGER i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi |
INTEGER i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi |
68 |
INTEGER i2Lo, i2Hi, j2Lo, j2Hi, k2Lo, k2Hi |
INTEGER i2Lo, i2Hi, j2Lo, j2Hi, k2Lo, k2Hi |
69 |
INTEGER thisTile, nN, thisI |
INTEGER thisTile, nN, thisI |
81 |
C == Local variables == |
C == Local variables == |
82 |
C itl, jtl, ktl :: Loop counters |
C itl, jtl, ktl :: Loop counters |
83 |
C :: itl etc... target local |
C :: itl etc... target local |
|
C :: itc etc... target canonical |
|
|
C :: isl etc... source local |
|
|
C :: isc etc... source canonical |
|
84 |
INTEGER itl, jtl, ktl |
INTEGER itl, jtl, ktl |
|
c INTEGER itc, jtc, ktc |
|
|
c INTEGER isc, jsc, ksc |
|
|
c INTEGER isl, jsl, ksl |
|
85 |
C tt :: Target tile |
C tt :: Target tile |
86 |
C iBufr1 :: Buffer counter |
C iBufr1 :: Buffer counter |
87 |
C iBufr2 :: |
C iBufr2 :: |
94 |
INTEGER oN |
INTEGER oN |
95 |
C Loop counters |
C Loop counters |
96 |
INTEGER I |
INTEGER I |
|
INTEGER itl1reduce, jtl1reduce |
|
|
INTEGER itl2reduce, jtl2reduce |
|
97 |
|
|
98 |
C MPI setup |
C MPI setup |
99 |
#ifdef ALLOW_USE_MPI |
#ifdef ALLOW_USE_MPI |
100 |
INTEGER nri1, nrj1, nrk1 |
INTEGER nri1, nrj1, nrk1 |
101 |
INTEGER nri2, nrj2, nrk2 |
INTEGER nri2, nrj2, nrk2 |
102 |
INTEGER theTag1, theTag2, theType |
INTEGER theTag1, theTag2, theType |
|
c INTEGER theSize1, theSize2 |
|
103 |
INTEGER sProc, tProc |
INTEGER sProc, tProc |
104 |
INTEGER mpiStatus(MPI_STATUS_SIZE), mpiRc |
INTEGER mpiStatus(MPI_STATUS_SIZE), mpiRc |
105 |
#ifdef W2_E2_DEBUG_ON |
#ifdef W2_E2_DEBUG_ON |
109 |
|
|
110 |
tt=exch2_neighbourId(nN, thisTile ) |
tt=exch2_neighbourId(nN, thisTile ) |
111 |
oN=exch2_opposingSend(nN, thisTile ) |
oN=exch2_opposingSend(nN, thisTile ) |
|
itl1reduce=0 |
|
|
jtl1reduce=0 |
|
|
itl2reduce=0 |
|
|
jtl2reduce=0 |
|
|
IF ( exch2_pij(1,oN,tt) .EQ. -1 ) itl1reduce=1 |
|
|
IF ( exch2_pij(3,oN,tt) .EQ. -1 ) itl1reduce=1 |
|
|
IF ( exch2_pij(2,oN,tt) .EQ. -1 ) jtl2reduce=1 |
|
|
IF ( exch2_pij(4,oN,tt) .EQ. -1 ) jtl2reduce=1 |
|
112 |
|
|
113 |
C Handle receive end data transport according to communication mechanism between |
C Handle receive end data transport according to communication mechanism between |
114 |
C source and target tile |
C source and target tile |
132 |
nb = thisI |
nb = thisI |
133 |
mb = nN |
mb = nN |
134 |
ir = 2 |
ir = 2 |
135 |
theTag1 = (tt-1)*MAX_NEIGHBOURS*2 + oN-1 |
theTag1 = (tt-1)*W2_maxNeighbours*2 + oN-1 |
136 |
& + 10000*( |
theTag2 = (tt-1)*W2_maxNeighbours*2 + W2_maxNeighbours + oN-1 |
|
& (thisTile-1)*MAX_NEIGHBOURS*2 + oN-1 |
|
|
& ) |
|
|
theTag2 = (tt-1)*MAX_NEIGHBOURS*2 + MAX_NEIGHBOURS + oN-1 |
|
|
& + 10000*( |
|
|
& (thisTile-1)*MAX_NEIGHBOURS*2 + MAX_NEIGHBOURS + oN-1 |
|
|
& ) |
|
137 |
tProc = exch2_tProc(thisTile)-1 |
tProc = exch2_tProc(thisTile)-1 |
138 |
sProc = exch2_tProc(tt)-1 |
sProc = exch2_tProc(tt)-1 |
139 |
theType = MPI_REAL8 |
theType = _MPI_TYPE_RX |
140 |
nri1 = (tIhi-tIlo+1-itl1reduce)/tiStride |
nri1 = (tIhi1-tIlo1+1)/tiStride |
141 |
nrj1 = (tJhi-tJlo+1-jtl1reduce)/tjStride |
nrj1 = (tJhi1-tJlo1+1)/tjStride |
142 |
nrk1 = (tKhi-tKlo+1)/tkStride |
nrk1 = (tKhi-tKlo+1)/tkStride |
143 |
iBufr1 = nri1*nrj1*nrk1 |
iBufr1 = nri1*nrj1*nrk1 |
144 |
nri2 = (tIhi-tIlo+1-itl2reduce)/tiStride |
nri2 = (tIhi2-tIlo2+1)/tiStride |
145 |
nrj2 = (tJhi-tJlo+1-jtl2reduce)/tjStride |
nrj2 = (tJhi2-tJlo2+1)/tjStride |
146 |
nrk2 = (tKhi-tKlo+1)/tkStride |
nrk2 = (tKhi-tKlo+1)/tkStride |
147 |
iBufr2 = nri2*nrj2*nrk2 |
iBufr2 = nri2*nrj2*nrk2 |
148 |
CALL MPI_Recv( e2Bufr1_RX(1,mb,nb,ir), iBufr1, theType, sProc, |
CALL MPI_Recv( e2Bufr1_RX(1,mb,nb,ir), iBufr1, theType, sProc, |
155 |
CALL PRINT_MESSAGE(messageBuffer, |
CALL PRINT_MESSAGE(messageBuffer, |
156 |
I standardMessageUnit,SQUEEZE_RIGHT, |
I standardMessageUnit,SQUEEZE_RIGHT, |
157 |
I myThid) |
I myThid) |
158 |
WRITE(messageBuffer,'(A,I4,A,I4,A)') ' INTO TILE=', thisTile, |
WRITE(messageBuffer,'(A,I4,A,I4,A)') ' INTO TILE=',thisTile, |
159 |
& ' (proc = ',tProc,')' |
& ' (proc = ',tProc,')' |
160 |
CALL PRINT_MESSAGE(messageBuffer, |
CALL PRINT_MESSAGE(messageBuffer, |
161 |
I standardMessageUnit,SQUEEZE_RIGHT, |
I standardMessageUnit,SQUEEZE_RIGHT, |
186 |
ENDIF |
ENDIF |
187 |
|
|
188 |
iBufr1=0 |
iBufr1=0 |
189 |
DO ktl=tKlo,tKhi,tKStride |
DO ktl=tKlo,tKhi,tkStride |
190 |
DO jtl=tJLo+jtl1reduce, tJHi, tjStride |
DO jtl=tJLo1, tJHi1, tjStride |
191 |
DO itl=tILo+itl1reduce, tIHi, tiStride |
DO itl=tILo1, tIHi1, tiStride |
192 |
C Read from e2Bufr1_RX(iBufr,mb,nb) |
C Read from e2Bufr1_RX(iBufr,mb,nb) |
193 |
iBufr1=iBufr1+1 |
iBufr1=iBufr1+1 |
194 |
array1(itl,jtl,ktl)=e2Bufr1_RX(iBufr1,mb,nb,ir) |
array1(itl,jtl,ktl)=e2Bufr1_RX(iBufr1,mb,nb,ir) |
197 |
ENDDO |
ENDDO |
198 |
|
|
199 |
iBufr2=0 |
iBufr2=0 |
200 |
DO ktl=tKlo,tKhi,tKStride |
DO ktl=tKlo,tKhi,tkStride |
201 |
DO jtl=tJLo+jtl2reduce, tJHi, tjStride |
DO jtl=tJLo2, tJHi2, tjStride |
202 |
DO itl=tILo+itl2reduce, tIHi, tiStride |
DO itl=tILo2, tIHi2, tiStride |
203 |
C Read from e2Bufr1_RX(iBufr,mb,nb) |
C Read from e2Bufr1_RX(iBufr,mb,nb) |
204 |
iBufr2=iBufr2+1 |
iBufr2=iBufr2+1 |
205 |
array2(itl,jtl,ktl)=e2Bufr2_RX(iBufr2,mb,nb,ir) |
array2(itl,jtl,ktl)=e2Bufr2_RX(iBufr2,mb,nb,ir) |