/[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.6 by jmc, Tue Jul 29 20:25:23 2008 UTC revision 1.7 by jmc, Fri Aug 1 00:45:16 2008 UTC
# Line 5  C $Name$ Line 5  C $Name$
5  #include "W2_OPTIONS.h"  #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       O       e2Bufr1_RX, e2BufrRecSize,       O       e2Bufr1_RX, e2Bufr2_RX,
13       O       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 30  C     bufr2 along +j axis in target tile Line 30  C     bufr2 along +j axis in target tile
30  #include "W2_EXCH2_TOPOLOGY.h"  #include "W2_EXCH2_TOPOLOGY.h"
31    
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 oIs1, oJs1, oIs2, oJs2
40        INTEGER e2BufrRecSize        INTEGER e2BufrRecSize
41        _RX     e2Bufr1_RX( e2BufrRecSize )        _RX     e2Bufr1_RX( e2BufrRecSize )
42        _RX     e2Bufr2_RX( e2BufrRecSize )        _RX     e2Bufr2_RX( e2BufrRecSize )
# Line 57  C                    :: isc etc... sourc Line 58  C                    :: isc etc... sourc
58        INTEGER itc, jtc        INTEGER itc, jtc
59        INTEGER isc, jsc        INTEGER isc, jsc
60        INTEGER isl, jsl        INTEGER isl, jsl
 c     INTEGER ktc, ksc, ksl  
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        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  #ifdef ALLOW_USE_MPI  #ifdef ALLOW_USE_MPI
# Line 104  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 = exch2_oi(nN,thisTile)  
       oj = exch2_oj(nN,thisTile)  
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 = exch2_oi(nN,thisTile)+1  
        itlreduce=1  
       ENDIF  
       IF ( pj(1) .EQ. -1 ) THEN  
        oj = exch2_oj(nN,thisTile)+1  
        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= ',
# Line 127  C     if pj(1) is 1 then +i in source al Line 113  C     if pj(1) is 1 then +i in source al
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)
# Line 190  C         Ran off end of buffer. This sh Line 174  C         Ran off end of buffer. This sh
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)
# Line 205  C         tiles exclusive domain bounds Line 189  C         tiles exclusive domain bounds
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)
# Line 238  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 = exch2_oi(nN,thisTile)  
       oj = exch2_oj(nN,thisTile)  
 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 = exch2_oi(nN,thisTile)+1  
       ENDIF  
       IF ( pj(2) .EQ. -1 ) THEN  
        jtlreduce=1  
        oj = exch2_oj(nN,thisTile)+1  
       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= ',
# Line 261  C     if pj(2) is 1 then +j in source al Line 231  C     if pj(2) is 1 then +j in source al
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)
# Line 325  C         Ran off end of buffer. This sh Line 293  C         Ran off end of buffer. This sh
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)
# Line 340  C         tiles exclusive domain bounds Line 308  C         tiles exclusive domain bounds
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)
# Line 382  C      Setup MPI stuff here Line 350  C      Setup MPI stuff here
350         sProc = exch2_tProc(thisTile)-1         sProc = exch2_tProc(thisTile)-1
351         theType = MPI_REAL8         theType = MPI_REAL8
352  #ifdef W2_E2_DEBUG_ON  #ifdef W2_E2_DEBUG_ON
353         WRITE(messageBuffer,'(A,I4,A,I4,A)') ' SEND FROM TILE=', thisTile,         WRITE(messageBuffer,'(A,I4,A,I4,A)') ' SEND FROM TILE=',thisTile,
354       &                                   ' (proc = ',sProc,')'       &                                   ' (proc = ',sProc,')'
355         CALL PRINT_MESSAGE(messageBuffer,         CALL PRINT_MESSAGE(messageBuffer,
356       I      standardMessageUnit,SQUEEZE_RIGHT,       I      standardMessageUnit,SQUEEZE_RIGHT,
Legend:
Removed from v.1.6  
changed lines
  Added in v.1.7
  ViewVC Help
Powered by ViewVC 1.1.22