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

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

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

revision 1.1 by afe, Fri Jan 9 20:46:09 2004 UTC revision 1.8 by cnh, Tue Aug 5 18:31:55 2008 UTC
# Line 1  Line 1 
1  #include "CPP_OPTIONS.h"  C $Header$
2    C $Name$
3    
4    #include "CPP_EEOPTIONS.h"
5    #include "W2_OPTIONS.h"
6    
7        SUBROUTINE EXCH2_SEND_RX2 (        SUBROUTINE EXCH2_SEND_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, nN,       I       thisTile, nN, oIs1, oJs1, oIs2, oJs2,
12       I       e2Bufr1_RX, e2BufrRecSize,       O       e2Bufr1_RX, e2Bufr2_RX,
13       I       e2Bufr2_RX,       I       e2BufrRecSize,
14       I       array1,       I       array1,
15       I       i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi,       I       i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi,
16       I       array2,       I       array2,
# Line 20  C     bufr2 along +j axis in target tile Line 24  C     bufr2 along +j axis in target tile
24    
25        IMPLICIT NONE        IMPLICIT NONE
26    
27  C  #include "SIZE.h"
28  #include "W2_OPTIONS.h"  #include "EEPARAMS.h"
29    #include "EESUPPORT.h"
30  #include "W2_EXCH2_TOPOLOGY.h"  #include "W2_EXCH2_TOPOLOGY.h"
 #define  W2_USE_E2_SAFEMODE  
31    
 #include "EEPARAMS.h"  
       CHARACTER*(MAX_LEN_MBUF) messageBuffer  
 C  
32  C     === Routine arguments ===  C     === Routine arguments ===
33        INTEGER tILo, tIHi, tiStride        INTEGER tIlo1, tIhi1, tIlo2, tIhi2, tiStride
34        INTEGER tJLo, tJHi, tjStride        INTEGER tJlo1, tJhi1, tJlo2, tJhi2, tjStride
35        INTEGER tKLo, tKHi, tkStride        INTEGER tKlo, tKhi, tkStride
36        INTEGER i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi        INTEGER i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi
37        INTEGER i2Lo, i2Hi, j2Lo, j2Hi, k2Lo, k2Hi        INTEGER i2Lo, i2Hi, j2Lo, j2Hi, k2Lo, k2Hi
38        INTEGER thisTile, nN        INTEGER thisTile, nN
39        INTEGER e2BufrRecSize        INTEGER oIs1, oJs1, oIs2, oJs2
40          INTEGER e2BufrRecSize
41        _RX     e2Bufr1_RX( e2BufrRecSize )        _RX     e2Bufr1_RX( e2BufrRecSize )
42        _RX     e2Bufr2_RX( e2BufrRecSize )        _RX     e2Bufr2_RX( e2BufrRecSize )
43        _RX     array1(i1Lo:i1Hi,j1Lo:j1Hi,k1Lo:k1Hi)        _RX     array1(i1Lo:i1Hi,j1Lo:j1Hi,k1Lo:k1Hi)
# Line 53  C                    :: itc etc... targe Line 55  C                    :: itc etc... targe
55  C                    :: isl etc... source local  C                    :: isl etc... source local
56  C                    :: isc etc... source canonical  C                    :: isc etc... source canonical
57        INTEGER itl, jtl, ktl        INTEGER itl, jtl, ktl
58        INTEGER itc, jtc, ktc        INTEGER itc, jtc
59        INTEGER isc, jsc, ksc        INTEGER isc, jsc
60        INTEGER isl, jsl, ksl        INTEGER isl, jsl
61  C     tt         :: Target tile  C     tt         :: Target tile
62  C     itb, jtb   :: Target local to canonical offsets  C     itb, jtb   :: Target local to canonical offsets
63  C  C
64        INTEGER  tt        INTEGER  tt
65        INTEGER itb, jtb        INTEGER itb, jtb
66        INTEGER isb, jsb        INTEGER isb, jsb
67        INTEGER pi(2), pj(2), oi, oj, oi_c, oi_f, oj_c, oj_f        INTEGER pi(2), pj(2)
68        _RX     sa1, sa2, val1, val2        _RX     sa1, sa2, val1, val2
69        INTEGER iBufr1, iBufr2        INTEGER iBufr1, iBufr2
       INTEGER itlreduce  
       INTEGER jtlreduce  
70    
71  C     MPI setup  C     MPI setup
72  #include "SIZE.h"  #ifdef ALLOW_USE_MPI
 #include "EESUPPORT.h"  
73        INTEGER theTag1, theTag2, theType, theHandle1, theHandle2        INTEGER theTag1, theTag2, theType, theHandle1, theHandle2
74        INTEGER sProc, tProc, mpiRc        INTEGER sProc, tProc, mpiRc
75    #endif
76          CHARACTER*(MAX_LEN_MBUF) messageBuffer
77    
78        IF     ( commSetting .EQ. 'P' ) THEN        IF     ( commSetting .EQ. 'P' ) THEN
79  C      Need to check that buffer synchronisation token is decremented  C      Need to check that buffer synchronisation token is decremented
80  C      before filling buffer. This is needed for parallel processing  C      before filling buffer. This is needed for parallel processing
81  C      shared memory modes only.  C      shared memory modes only.
82        ENDIF        ENDIF
83    
84        tt=exch2_neighbourId(nN, thisTile )        tt=exch2_neighbourId(nN, thisTile )
85        itb=exch2_tbasex(tt)        itb=exch2_tBasex(tt)
86        jtb=exch2_tbasey(tt)        jtb=exch2_tBasey(tt)
87        isb=exch2_tbasex(thisTile)        isb=exch2_tBasex(thisTile)
88        jsb=exch2_tbasey(thisTile)        jsb=exch2_tBasey(thisTile)
89        pi(1)=exch2_pi(1,nN,thisTile)        pi(1)=exch2_pij(1,nN,thisTile)
90        pi(2)=exch2_pi(2,nN,thisTile)        pi(2)=exch2_pij(2,nN,thisTile)
91        pj(1)=exch2_pj(1,nN,thisTile)        pj(1)=exch2_pij(3,nN,thisTile)
92        pj(2)=exch2_pj(2,nN,thisTile)        pj(2)=exch2_pij(4,nN,thisTile)
93    
94  C     Extract into bufr1 (target i-index array)  C     Extract into bufr1 (target i-index array)
95  C     if pi(1) is  1 then +i in target <=> +i in source so bufr1 should get +array1  C     if pi(1) is  1 then +i in target <=> +i in source so bufr1 should get +array1
# Line 101  C     if pj(1) is -1 then +i in target < Line 102  C     if pj(1) is -1 then +i in target <
102         sa1 = ABS(sa1)         sa1 = ABS(sa1)
103         sa2 = ABS(sa2)         sa2 = ABS(sa2)
104        ENDIF        ENDIF
       oi_c=exch2_oi(nN,thisTile)  
       oi_f=exch2_oi_f(nN,thisTile)  
       oi=oi_c  
       oj_c=exch2_oj(nN,thisTile)  
       oj_f=exch2_oj_f(nN,thisTile)  
       oj=oj_c  
105  C     if pi(1) is 1 then +i in source aligns with +i in target  C     if pi(1) is 1 then +i in source aligns with +i in target
106  C     if pj(1) is 1 then +i in source aligns with +j in target  C     if pj(1) is 1 then +i in source aligns with +j in target
       itlreduce=0  
       jtlreduce=0  
       IF ( pi(1) .EQ. -1 ) THEN  
        oi=oi_f  
        itlreduce=1  
       ENDIF  
       IF ( pj(1) .EQ. -1 ) THEN  
        oj=oj_f  
        itlreduce=1  
       ENDIF  
107        iBufr1=0        iBufr1=0
108  #ifdef W2_E2_DEBUG_ON  #ifdef W2_E2_DEBUG_ON
109        WRITE(messageBuffer,'(A,I4,A,I4)') 'EXCH2_SEND_RX2 sourceTile= ',        WRITE(messageBuffer,'(A,I4,A,I4)') 'EXCH2_SEND_RX2 sourceTile= ',
110       &                                   thisTile,       &                                   thisTile,
111       &                                   ' targetTile= ',tt       &                                   ' targetTile= ',tt
112        CALL PRINT_MESSAGE(messageBuffer,        CALL PRINT_MESSAGE(messageBuffer,
113       I      standardMessageUnit,SQUEEZE_BOTH,       I      standardMessageUnit,SQUEEZE_BOTH,
114       I      myThid)       I      myThid)
115  #endif /* W2_E2_DEBUG_ON */  #endif /* W2_E2_DEBUG_ON */
116        DO ktl=tKlo,tKhi,tKStride        DO ktl=tKlo,tKhi,tkStride
117         DO jtl=tJLo+jtlreduce, tJHi, tjStride         DO jtl=tJlo1, tJhi1, tjStride
118          DO itl=tILo+itlreduce, tIHi, tiStride          DO itl=tIlo1, tIhi1, tiStride
 C      DO jtl=1,32,31  
 C       DO itl=1,32,31  
119           iBufr1=iBufr1+1           iBufr1=iBufr1+1
120           itc=itl+itb           itc=itl+itb
121           jtc=jtl+jtb           jtc=jtl+jtb
122           isc=pi(1)*itc+pi(2)*jtc+oi           isc=pi(1)*itc+pi(2)*jtc+oIs1
123           jsc=pj(1)*itc+pj(2)*jtc+oj           jsc=pj(1)*itc+pj(2)*jtc+oJs1
124           isl=isc-isb           isl=isc-isb
125           jsl=jsc-jsb           jsl=jsc-jsb
126           val1=sa1*array1(isl,jsl,ktl)           val1=sa1*array1(isl,jsl,ktl)
127       &       +sa2*array2(isl,jsl,ktl)       &       +sa2*array2(isl,jsl,ktl)
128           e2Bufr1_RX(iBufr1)=val1           e2Bufr1_RX(iBufr1)=val1
129  #ifdef W2_E2_DEBUG_ON  #ifdef W2_E2_DEBUG_ON
130           WRITE(messageBuffer,'(A,2I4)') 'EXCH2_SEND_RX2 target  u(itl, jtl) = ', itl, jtl           WRITE(messageBuffer,'(A,2I4)')
131         &           'EXCH2_SEND_RX2 target  u(itl, jtl) = ', itl, jtl
132           CALL PRINT_MESSAGE(messageBuffer,           CALL PRINT_MESSAGE(messageBuffer,
133       I         standardMessageUnit,SQUEEZE_RIGHT,       I         standardMessageUnit,SQUEEZE_RIGHT,
134       I         myThid)       I         myThid)
135           IF (     pi(1) .EQ. 1 ) THEN           IF (     pi(1) .EQ. 1 ) THEN
136  C         i index aligns  C         i index aligns
137            WRITE(messageBuffer,'(A,2I4)') '               source +u(isl, jsl) = ', isl, jsl            WRITE(messageBuffer,'(A,2I4)')
138         &           '               source +u(isl, jsl) = ', isl, jsl
139           ELSEIF ( pi(1) .EQ. -1 ) THEN           ELSEIF ( pi(1) .EQ. -1 ) THEN
140  C         reversed i index aligns  C         reversed i index aligns
141            WRITE(messageBuffer,'(A,2I4)') '               source -u(isl, jsl) = ', isl, jsl            WRITE(messageBuffer,'(A,2I4)')
142         &            '               source -u(isl, jsl) = ', isl, jsl
143           ELSEIF ( pj(1) .EQ.  1 ) THEN           ELSEIF ( pj(1) .EQ.  1 ) THEN
144            WRITE(messageBuffer,'(A,2I4)') '               source +v(isl, jsl) = ', isl, jsl            WRITE(messageBuffer,'(A,2I4)')
145         &            '               source +v(isl, jsl) = ', isl, jsl
146           ELSEIF ( pj(1) .EQ. -1 ) THEN           ELSEIF ( pj(1) .EQ. -1 ) THEN
147            WRITE(messageBuffer,'(A,2I4)') '               source -v(isl, jsl) = ', isl, jsl            WRITE(messageBuffer,'(A,2I4)')
148         &            '               source -v(isl, jsl) = ', isl, jsl
149           ENDIF           ENDIF
150           CALL PRINT_MESSAGE(messageBuffer,           CALL PRINT_MESSAGE(messageBuffer,
151       I         standardMessageUnit,SQUEEZE_RIGHT,       I         standardMessageUnit,SQUEEZE_RIGHT,
152       I         myThid)       I         myThid)
153           IF ( isl .LT. i1Lo .OR. isl .GT. i1Hi ) THEN           IF ( isl .LT. i1Lo .OR. isl .GT. i1Hi ) THEN
154            WRITE(messageBuffer,'(A,2I4)') '               *** isl is out of bounds '            WRITE(messageBuffer,'(A,2I4)')
155         &           '               *** isl is out of bounds '
156            CALL PRINT_MESSAGE(messageBuffer,            CALL PRINT_MESSAGE(messageBuffer,
157       I     standardMessageUnit,SQUEEZE_RIGHT,       I     standardMessageUnit,SQUEEZE_RIGHT,
158       I     myThid)       I     myThid)
159           ENDIF           ENDIF
160           IF ( jsl .LT. j1Lo .OR. jsl .GT. j1Hi ) THEN           IF ( jsl .LT. j1Lo .OR. jsl .GT. j1Hi ) THEN
161            WRITE(messageBuffer,'(A,2I4)') '               *** jsl is out of bounds '            WRITE(messageBuffer,'(A,2I4)')
162         &           '               *** jsl is out of bounds '
163            CALL PRINT_MESSAGE(messageBuffer,            CALL PRINT_MESSAGE(messageBuffer,
164       I     standardMessageUnit,SQUEEZE_RIGHT,       I     standardMessageUnit,SQUEEZE_RIGHT,
165       I     myThid)       I     myThid)
# Line 183  C         Ran off end of buffer. This sh Line 173  C         Ran off end of buffer. This sh
173           IF ( isl .LT. i1Lo .OR. isl .GT. i1Hi ) THEN           IF ( isl .LT. i1Lo .OR. isl .GT. i1Hi ) THEN
174  C         Forward mode send getting from points outside of the  C         Forward mode send getting from points outside of the
175  C         tiles exclusive domain bounds in X. This should not happen  C         tiles exclusive domain bounds in X. This should not happen
176            WRITE(messageBuffer,'(A,I4,I4)')            WRITE(messageBuffer,'(A,I4,I4)')
177       &     'EXCH2_SEND_RX2 tIlo, tIhi =', tIlo, tIhi       &     'EXCH2_SEND_RX2 tIlo1,tIhi1=', tIlo1, tIhi1
178            CALL PRINT_MESSAGE(messageBuffer,            CALL PRINT_MESSAGE(messageBuffer,
179       I     standardMessageUnit,SQUEEZE_BOTH,       I     standardMessageUnit,SQUEEZE_BOTH,
180       I     myThid)       I     myThid)
181            WRITE(messageBuffer,'(A,3I4)')            WRITE(messageBuffer,'(A,3I4)')
182       &     'EXCH2_SEND_RX2 itl, jtl, isl =', itl, jtl, isl       &     'EXCH2_SEND_RX2 itl, jtl, isl =', itl, jtl, isl
183            CALL PRINT_MESSAGE(messageBuffer,            CALL PRINT_MESSAGE(messageBuffer,
184       I     standardMessageUnit,SQUEEZE_BOTH,       I     standardMessageUnit,SQUEEZE_BOTH,
# Line 198  C         tiles exclusive domain bounds Line 188  C         tiles exclusive domain bounds
188           IF ( jsl .LT. j1Lo .OR. jsl .GT. j1Hi ) THEN           IF ( jsl .LT. j1Lo .OR. jsl .GT. j1Hi ) THEN
189  C         Forward mode send getting from points outside of the  C         Forward mode send getting from points outside of the
190  C         tiles exclusive domain bounds in Y. This should not happen  C         tiles exclusive domain bounds in Y. This should not happen
191            WRITE(messageBuffer,'(A,I4,I4)')            WRITE(messageBuffer,'(A,I4,I4)')
192       &     'EXCH2_SEND_RX2 tJlo, tJhi =', tJlo, tJhi       &     'EXCH2_SEND_RX2 tJlo1,tJhi1=', tJlo1, tJhi1
193            CALL PRINT_MESSAGE(messageBuffer,            CALL PRINT_MESSAGE(messageBuffer,
194       I     standardMessageUnit,SQUEEZE_BOTH,       I     standardMessageUnit,SQUEEZE_BOTH,
195       I     myThid)       I     myThid)
196            WRITE(messageBuffer,'(A,2I4)')            WRITE(messageBuffer,'(A,2I4)')
197       &     'EXCH2_SEND_RX2 itl, jtl =', itl, jtl       &     'EXCH2_SEND_RX2 itl, jtl =', itl, jtl
198            CALL PRINT_MESSAGE(messageBuffer,            CALL PRINT_MESSAGE(messageBuffer,
199       I     standardMessageUnit,SQUEEZE_BOTH,       I     standardMessageUnit,SQUEEZE_BOTH,
200       I     myThid)       I     myThid)
201            WRITE(messageBuffer,'(A,2I4)')            WRITE(messageBuffer,'(A,2I4)')
202       &     'EXCH2_SEND_RX2 isl, jsl =', isl, jsl           &     'EXCH2_SEND_RX2 isl, jsl =', isl, jsl
203            CALL PRINT_MESSAGE(messageBuffer,            CALL PRINT_MESSAGE(messageBuffer,
204       I     standardMessageUnit,SQUEEZE_BOTH,       I     standardMessageUnit,SQUEEZE_BOTH,
205       I     myThid)       I     myThid)
# Line 232  C     if pj(2) is -1 then +j in target < Line 222  C     if pj(2) is -1 then +j in target <
222         sa1 = ABS(sa1)         sa1 = ABS(sa1)
223         sa2 = ABS(sa2)         sa2 = ABS(sa2)
224        ENDIF        ENDIF
       oi_c=exch2_oi(nN,thisTile)  
       oi_f=exch2_oi_f(nN,thisTile)  
       oi=oi_c  
       oj_c=exch2_oj(nN,thisTile)  
       oj_f=exch2_oj_f(nN,thisTile)  
       oj=oj_c  
 C     if pi(2) is 1 then +i in source aligns with +j in target  
 C     if pj(2) is 1 then +j in source aligns with +j in target  
       itlreduce=0  
       jtlreduce=0  
       IF ( pi(2) .EQ. -1 ) THEN  
        jtlreduce=1  
        oi=oi_f  
       ENDIF  
       IF ( pj(2) .EQ. -1 ) THEN  
        jtlreduce=1  
        oj=oj_f  
       ENDIF  
225        iBufr2=0        iBufr2=0
226  #ifdef W2_E2_DEBUG_ON  #ifdef W2_E2_DEBUG_ON
227        WRITE(messageBuffer,'(A,I4,A,I4)') 'EXCH2_SEND_RX2 sourceTile= ',        WRITE(messageBuffer,'(A,I4,A,I4)') 'EXCH2_SEND_RX2 sourceTile= ',
228       &                                   thisTile,       &                                   thisTile,
229       &                                   ' targetTile= ',tt       &                                   ' targetTile= ',tt
230        CALL PRINT_MESSAGE(messageBuffer,        CALL PRINT_MESSAGE(messageBuffer,
231       I      standardMessageUnit,SQUEEZE_BOTH,       I      standardMessageUnit,SQUEEZE_BOTH,
232       I      myThid)       I      myThid)
233  #endif /* W2_E2_DEBUG_ON */  #endif /* W2_E2_DEBUG_ON */
234        DO ktl=tKlo,tKhi,tKStride        DO ktl=tKlo,tKhi,tkStride
235         DO jtl=tJLo+jtlreduce, tJHi, tjStride         DO jtl=tJlo2, tJhi2, tjStride
236          DO itl=tILo+itlreduce, tIHi, tiStride          DO itl=tIlo2, tIhi2, tiStride
 C      DO jtl=1,32,31  
 C       DO itl=1,32,31  
237           iBufr2=iBufr2+1           iBufr2=iBufr2+1
238           itc=itl+itb           itc=itl+itb
239           jtc=jtl+jtb           jtc=jtl+jtb
240           isc=pi(1)*itc+pi(2)*jtc+oi           isc=pi(1)*itc+pi(2)*jtc+oIs2
241           jsc=pj(1)*itc+pj(2)*jtc+oj           jsc=pj(1)*itc+pj(2)*jtc+oJs2
242           isl=isc-isb           isl=isc-isb
243           jsl=jsc-jsb           jsl=jsc-jsb
244           val2=sa1*array1(isl,jsl,ktl)           val2=sa1*array1(isl,jsl,ktl)
245       &       +sa2*array2(isl,jsl,ktl)       &       +sa2*array2(isl,jsl,ktl)
246           e2Bufr2_RX(iBufr2)=val2           e2Bufr2_RX(iBufr2)=val2
247  #ifdef W2_E2_DEBUG_ON  #ifdef W2_E2_DEBUG_ON
248           WRITE(messageBuffer,'(A,2I4)') 'EXCH2_SEND_RX2 target  v(itl, jtl) = ', itl, jtl           WRITE(messageBuffer,'(A,2I4)')
249         &            'EXCH2_SEND_RX2 target  v(itl, jtl) = ', itl, jtl
250           CALL PRINT_MESSAGE(messageBuffer,           CALL PRINT_MESSAGE(messageBuffer,
251       I         standardMessageUnit,SQUEEZE_RIGHT,       I         standardMessageUnit,SQUEEZE_RIGHT,
252       I         myThid)       I         myThid)
253           IF (     pi(2) .EQ. 1 ) THEN           IF (     pi(2) .EQ. 1 ) THEN
254  C         i index aligns  C         i index aligns
255            WRITE(messageBuffer,'(A,2I4)') '               source +u(isl, jsl) = ', isl, jsl            WRITE(messageBuffer,'(A,2I4)')
256         &          '               source +u(isl, jsl) = ', isl, jsl
257           ELSEIF ( pi(2) .EQ. -1 ) THEN           ELSEIF ( pi(2) .EQ. -1 ) THEN
258  C         reversed i index aligns  C         reversed i index aligns
259            WRITE(messageBuffer,'(A,2I4)') '               source -u(isl, jsl) = ', isl, jsl            WRITE(messageBuffer,'(A,2I4)')
260         &          '               source -u(isl, jsl) = ', isl, jsl
261           ELSEIF ( pj(2) .EQ.  1 ) THEN           ELSEIF ( pj(2) .EQ.  1 ) THEN
262            WRITE(messageBuffer,'(A,2I4)') '               source +v(isl, jsl) = ', isl, jsl            WRITE(messageBuffer,'(A,2I4)')
263         &          '               source +v(isl, jsl) = ', isl, jsl
264           ELSEIF ( pj(2) .EQ. -1 ) THEN           ELSEIF ( pj(2) .EQ. -1 ) THEN
265            WRITE(messageBuffer,'(A,2I4)') '               source -v(isl, jsl) = ', isl, jsl            WRITE(messageBuffer,'(A,2I4)')
266         &          '               source -v(isl, jsl) = ', isl, jsl
267           ENDIF           ENDIF
268           CALL PRINT_MESSAGE(messageBuffer,           CALL PRINT_MESSAGE(messageBuffer,
269       I         standardMessageUnit,SQUEEZE_RIGHT,       I         standardMessageUnit,SQUEEZE_RIGHT,
270       I         myThid)       I         myThid)
271           IF ( isl .LT. i1Lo .OR. isl .GT. i1Hi ) THEN           IF ( isl .LT. i1Lo .OR. isl .GT. i1Hi ) THEN
272            WRITE(messageBuffer,'(A,2I4)') '               *** isl is out of bounds '            WRITE(messageBuffer,'(A,2I4)')
273         &          '               *** isl is out of bounds '
274            CALL PRINT_MESSAGE(messageBuffer,            CALL PRINT_MESSAGE(messageBuffer,
275       I     standardMessageUnit,SQUEEZE_RIGHT,       I     standardMessageUnit,SQUEEZE_RIGHT,
276       I     myThid)       I     myThid)
277           ENDIF           ENDIF
278           IF ( jsl .LT. j1Lo .OR. jsl .GT. j1Hi ) THEN           IF ( jsl .LT. j1Lo .OR. jsl .GT. j1Hi ) THEN
279            WRITE(messageBuffer,'(A,2I4)') '               *** jsl is out of bounds '            WRITE(messageBuffer,'(A,2I4)')
280         &          '               *** jsl is out of bounds '
281            CALL PRINT_MESSAGE(messageBuffer,            CALL PRINT_MESSAGE(messageBuffer,
282       I     standardMessageUnit,SQUEEZE_RIGHT,       I     standardMessageUnit,SQUEEZE_RIGHT,
283       I     myThid)       I     myThid)
# Line 315  C         Ran off end of buffer. This sh Line 292  C         Ran off end of buffer. This sh
292           IF ( isl .LT. i1Lo .OR. isl .GT. i1Hi ) THEN           IF ( isl .LT. i1Lo .OR. isl .GT. i1Hi ) THEN
293  C         Forward mode send getting from points outside of the  C         Forward mode send getting from points outside of the
294  C         tiles exclusive domain bounds in X. This should not happen  C         tiles exclusive domain bounds in X. This should not happen
295            WRITE(messageBuffer,'(A,I4,I4)')            WRITE(messageBuffer,'(A,I4,I4)')
296       &     'EXCH2_SEND_RX2 tIlo, tIhi =', tIlo, tIhi       &     'EXCH2_SEND_RX2 tIlo2,tIhi2=', tIlo2, tIhi2
297            CALL PRINT_MESSAGE(messageBuffer,            CALL PRINT_MESSAGE(messageBuffer,
298       I     standardMessageUnit,SQUEEZE_BOTH,       I     standardMessageUnit,SQUEEZE_BOTH,
299       I     myThid)       I     myThid)
300            WRITE(messageBuffer,'(A,3I4)')            WRITE(messageBuffer,'(A,3I4)')
301       &     'EXCH2_SEND_RX2 itl, jtl, isl =', itl, jtl, isl       &     'EXCH2_SEND_RX2 itl, jtl, isl =', itl, jtl, isl
302            CALL PRINT_MESSAGE(messageBuffer,            CALL PRINT_MESSAGE(messageBuffer,
303       I     standardMessageUnit,SQUEEZE_BOTH,       I     standardMessageUnit,SQUEEZE_BOTH,
# Line 330  C         tiles exclusive domain bounds Line 307  C         tiles exclusive domain bounds
307           IF ( jsl .LT. j1Lo .OR. jsl .GT. j1Hi ) THEN           IF ( jsl .LT. j1Lo .OR. jsl .GT. j1Hi ) THEN
308  C         Forward mode send getting from points outside of the  C         Forward mode send getting from points outside of the
309  C         tiles exclusive domain bounds in Y. This should not happen  C         tiles exclusive domain bounds in Y. This should not happen
310            WRITE(messageBuffer,'(A,I4,I4)')            WRITE(messageBuffer,'(A,I4,I4)')
311       &     'EXCH2_SEND_RX2 tJlo, tJhi =', tJlo, tJhi       &     'EXCH2_SEND_RX2 tJlo2,tJhi2=', tJlo2, tJhi2
312            CALL PRINT_MESSAGE(messageBuffer,            CALL PRINT_MESSAGE(messageBuffer,
313       I     standardMessageUnit,SQUEEZE_BOTH,       I     standardMessageUnit,SQUEEZE_BOTH,
314       I     myThid)       I     myThid)
315            WRITE(messageBuffer,'(A,2I4)')            WRITE(messageBuffer,'(A,2I4)')
316       &     'EXCH2_SEND_RX2 itl, jtl =', itl, jtl       &     'EXCH2_SEND_RX2 itl, jtl =', itl, jtl
317            CALL PRINT_MESSAGE(messageBuffer,            CALL PRINT_MESSAGE(messageBuffer,
318       I     standardMessageUnit,SQUEEZE_BOTH,       I     standardMessageUnit,SQUEEZE_BOTH,
319       I     myThid)       I     myThid)
320            WRITE(messageBuffer,'(A,2I4)')            WRITE(messageBuffer,'(A,2I4)')
321       &     'EXCH2_SEND_RX2 isl, jsl =', isl, jsl           &     'EXCH2_SEND_RX2 isl, jsl =', isl, jsl
322            CALL PRINT_MESSAGE(messageBuffer,            CALL PRINT_MESSAGE(messageBuffer,
323       I     standardMessageUnit,SQUEEZE_BOTH,       I     standardMessageUnit,SQUEEZE_BOTH,
324       I     myThid)       I     myThid)
# Line 355  C         tiles exclusive domain bounds Line 332  C         tiles exclusive domain bounds
332    
333  C     Do data transport depending on communication mechanism between source and target tile  C     Do data transport depending on communication mechanism between source and target tile
334        IF     ( commSetting .EQ. 'P' ) THEN        IF     ( commSetting .EQ. 'P' ) THEN
335  C      Need to set data ready assertion (increment buffer  C      Need to set data ready assertion (increment buffer
336  C      synchronisation token) for multithreaded mode, for now do  C      synchronisation token) for multithreaded mode, for now do
337  C      nothing i.e. assume only one thread per process.  C      nothing i.e. assume only one thread per process.
338        ELSEIF ( commSetting .EQ. 'M' ) THEN        ELSEIF ( commSetting .EQ. 'M' ) THEN
339  #ifdef ALLOW_USE_MPI  #ifdef ALLOW_USE_MPI
340  C      Setup MPI stuff here  C      Setup MPI stuff here
341         theTag1 =  (thisTile-1)*MAX_NEIGHBOURS*2 + nN-1         theTag1 =  (thisTile-1)*MAX_NEIGHBOURS*2 + nN-1
      &           + 10000*(  
      &             (tt-1)*MAX_NEIGHBOURS*2 + nN-1  
      &            )  
342         theTag2 =  (thisTile-1)*MAX_NEIGHBOURS*2 + MAX_NEIGHBOURS + nN-1         theTag2 =  (thisTile-1)*MAX_NEIGHBOURS*2 + MAX_NEIGHBOURS + nN-1
      &           + 10000*(  
      &             (tt-1)*MAX_NEIGHBOURS*2 + MAX_NEIGHBOURS + nN-1  
      &            )  
343         tProc = exch2_tProc(tt)-1         tProc = exch2_tProc(tt)-1
344         sProc = exch2_tProc(thisTile)-1         sProc = exch2_tProc(thisTile)-1
345         theType = MPI_REAL8         theType = MPI_REAL8
346  #ifdef W2_E2_DEBUG_ON  #ifdef W2_E2_DEBUG_ON
347         WRITE(messageBuffer,'(A,I4,A,I4,A)') ' SEND FROM TILE=', thisTile,         WRITE(messageBuffer,'(A,I4,A,I4,A)') ' SEND FROM TILE=',thisTile,
348       &                                   ' (proc = ',sProc,')'       &                                   ' (proc = ',sProc,')'
349         CALL PRINT_MESSAGE(messageBuffer,         CALL PRINT_MESSAGE(messageBuffer,
350       I      standardMessageUnit,SQUEEZE_RIGHT,       I      standardMessageUnit,SQUEEZE_RIGHT,
# Line 401  C      Setup MPI stuff here Line 372  C      Setup MPI stuff here
372       I      myThid)       I      myThid)
373  #endif /* W2_E2_DEBUG_ON */  #endif /* W2_E2_DEBUG_ON */
374         CALL MPI_Isend( e2Bufr1_RX, iBufr1, theType,         CALL MPI_Isend( e2Bufr1_RX, iBufr1, theType,
375       I                 tProc, theTag1, MPI_COMM_MODEL,       I                 tProc, theTag1, MPI_COMM_MODEL,
376       O                 theHandle1, mpiRc )       O                 theHandle1, mpiRc )
377         CALL MPI_Isend( e2Bufr2_RX, iBufr2, theType,         CALL MPI_Isend( e2Bufr2_RX, iBufr2, theType,
378       I                 tProc, theTag2, MPI_COMM_MODEL,       I                 tProc, theTag2, MPI_COMM_MODEL,
379       O                 theHandle2, mpiRc )       O                 theHandle2, mpiRc )
380  C      Store MPI_Wait token in messageHandle.  C      Store MPI_Wait token in messageHandle.
381         e2_msgHandle1(1) = theHandle1         e2_msgHandle1(1) = theHandle1
# Line 413  C      Store MPI_Wait token in messageHa Line 384  C      Store MPI_Wait token in messageHa
384        ELSE        ELSE
385         STOP 'EXCH2_SEND_RX2:: commSetting VALUE IS INVALID'         STOP 'EXCH2_SEND_RX2:: commSetting VALUE IS INVALID'
386        ENDIF        ENDIF
387    
388        RETURN        RETURN
389        END        END
390    
391    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
392    
393    CEH3 ;;; Local Variables: ***
394    CEH3 ;;; mode:fortran ***
395    CEH3 ;;; End: ***
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.8
  ViewVC Help
Powered by ViewVC 1.1.22