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

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

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

revision 1.5 by jmc, Tue Jul 29 20:25:23 2008 UTC revision 1.6 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_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,
# Line 27  C $Name$ Line 27  C $Name$
27  #include "W2_EXCH2_TOPOLOGY.h"  #include "W2_EXCH2_TOPOLOGY.h"
28    
29  C     === Routine arguments ===  C     === Routine arguments ===
30  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"
31  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"
32  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"
33    C     tJlo2,tJhi2,tJstride :: index range in J that will be filled in target "array2"
34    C     tKlo, tKhi, tKstride :: index range in K that will be filled in target arrays
35  C     thisTile             :: Rank of the receiveing tile  C     thisTile             :: Rank of the receiveing tile
36  C     thisI                :: Index of the receiving tile within this process (used  C     thisI                :: Index of the receiving tile within this process (used
37  C                          :: to select buffer slots that are allowed).  C                          :: to select buffer slots that are allowed).
# Line 56  C                          :: MPI MSG co Line 58  C                          :: MPI MSG co
58  C                          :: This is done in routine after receives.  C                          :: This is done in routine after receives.
59  C     myTiles              :: List of nt tiles that this process owns.  C     myTiles              :: List of nt tiles that this process owns.
60  C     commSetting          :: Mode of communication used to exchnage with this neighbor  C     commSetting          :: Mode of communication used to exchnage with this neighbor
61  C     myThid               :: Thread number of this instance of EXCH2_RECV_RX1  C     myThid               :: Thread number of this instance of EXCH2_RECV_RX2
62  C  
63        INTEGER tILo, tIHi, tiStride        INTEGER tIlo1, tIhi1, tIlo2, tIhi2, tiStride
64        INTEGER tJLo, tJHi, tjStride        INTEGER tJlo1, tJhi1, tJlo2, tJhi2, tjStride
65        INTEGER tKLo, tKHi, tkStride        INTEGER tKlo, tKhi, tkStride
66        INTEGER i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi        INTEGER i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi
67        INTEGER i2Lo, i2Hi, j2Lo, j2Hi, k2Lo, k2Hi        INTEGER i2Lo, i2Hi, j2Lo, j2Hi, k2Lo, k2Hi
68        INTEGER thisTile, nN, thisI        INTEGER thisTile, nN, thisI
# Line 78  C Line 80  C
80  C     == Local variables ==  C     == Local variables ==
81  C     itl, jtl, ktl  :: Loop counters  C     itl, jtl, ktl  :: Loop counters
82  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  
83        INTEGER itl, jtl, ktl        INTEGER itl, jtl, ktl
 c     INTEGER itc, jtc, ktc  
 c     INTEGER isc, jsc, ksc  
 c     INTEGER isl, jsl, ksl  
84  C     tt         :: Target tile  C     tt         :: Target tile
85  C     iBufr1     :: Buffer counter  C     iBufr1     :: Buffer counter
86  C     iBufr2     ::  C     iBufr2     ::
# Line 97  C     oN     :: Opposing send record num Line 93  C     oN     :: Opposing send record num
93        INTEGER oN        INTEGER oN
94  C     Loop counters  C     Loop counters
95        INTEGER I        INTEGER I
       INTEGER itl1reduce, jtl1reduce  
       INTEGER itl2reduce, jtl2reduce  
96    
97  C     MPI setup  C     MPI setup
98  #ifdef ALLOW_USE_MPI  #ifdef ALLOW_USE_MPI
99        INTEGER    nri1, nrj1, nrk1        INTEGER nri1, nrj1, nrk1
100        INTEGER    nri2, nrj2, nrk2        INTEGER nri2, nrj2, nrk2
101        INTEGER theTag1, theTag2, theType        INTEGER theTag1, theTag2, theType
 c     INTEGER theSize1, theSize2  
102        INTEGER sProc, tProc        INTEGER sProc, tProc
103        INTEGER mpiStatus(MPI_STATUS_SIZE), mpiRc        INTEGER mpiStatus(MPI_STATUS_SIZE), mpiRc
104  #ifdef W2_E2_DEBUG_ON  #ifdef W2_E2_DEBUG_ON
# Line 115  c     INTEGER theSize1, theSize2 Line 108  c     INTEGER theSize1, theSize2
108    
109        tt=exch2_neighbourId(nN, thisTile )        tt=exch2_neighbourId(nN, thisTile )
110        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  
111    
112  C     Handle receive end data transport according to communication mechanism between  C     Handle receive end data transport according to communication mechanism between
113  C     source and target tile  C     source and target tile
# Line 157  C      Setup MPI stuff here Line 142  C      Setup MPI stuff here
142         tProc = exch2_tProc(thisTile)-1         tProc = exch2_tProc(thisTile)-1
143         sProc = exch2_tProc(tt)-1         sProc = exch2_tProc(tt)-1
144         theType = MPI_REAL8         theType = MPI_REAL8
145         nri1 = (tIhi-tIlo+1-itl1reduce)/tiStride         nri1 = (tIhi1-tIlo1+1)/tiStride
146         nrj1 = (tJhi-tJlo+1-jtl1reduce)/tjStride         nrj1 = (tJhi1-tJlo1+1)/tjStride
147         nrk1 = (tKhi-tKlo+1)/tkStride         nrk1 = (tKhi-tKlo+1)/tkStride
148         iBufr1 = nri1*nrj1*nrk1         iBufr1 = nri1*nrj1*nrk1
149         nri2 = (tIhi-tIlo+1-itl2reduce)/tiStride         nri2 = (tIhi2-tIlo2+1)/tiStride
150         nrj2 = (tJhi-tJlo+1-jtl2reduce)/tjStride         nrj2 = (tJhi2-tJlo2+1)/tjStride
151         nrk2 = (tKhi-tKlo+1)/tkStride         nrk2 = (tKhi-tKlo+1)/tkStride
152         iBufr2 = nri2*nrj2*nrk2         iBufr2 = nri2*nrj2*nrk2
153         CALL MPI_Recv( e2Bufr1_RX(1,mb,nb,ir), iBufr1, theType, sProc,         CALL MPI_Recv( e2Bufr1_RX(1,mb,nb,ir), iBufr1, theType, sProc,
# Line 175  C      Setup MPI stuff here Line 160  C      Setup MPI stuff here
160         CALL PRINT_MESSAGE(messageBuffer,         CALL PRINT_MESSAGE(messageBuffer,
161       I      standardMessageUnit,SQUEEZE_RIGHT,       I      standardMessageUnit,SQUEEZE_RIGHT,
162       I      myThid)       I      myThid)
163         WRITE(messageBuffer,'(A,I4,A,I4,A)') '      INTO TILE=', thisTile,         WRITE(messageBuffer,'(A,I4,A,I4,A)') '      INTO TILE=',thisTile,
164       &                                   ' (proc = ',tProc,')'       &                                   ' (proc = ',tProc,')'
165         CALL PRINT_MESSAGE(messageBuffer,         CALL PRINT_MESSAGE(messageBuffer,
166       I      standardMessageUnit,SQUEEZE_RIGHT,       I      standardMessageUnit,SQUEEZE_RIGHT,
# Line 206  C      Set nt to this tiles rank Line 191  C      Set nt to this tiles rank
191        ENDIF        ENDIF
192    
193        iBufr1=0        iBufr1=0
194        DO ktl=tKlo,tKhi,tKStride        DO ktl=tKlo,tKhi,tkStride
195         DO jtl=tJLo+jtl1reduce, tJHi, tjStride         DO jtl=tJLo1, tJHi1, tjStride
196          DO itl=tILo+itl1reduce, tIHi, tiStride          DO itl=tILo1, tIHi1, tiStride
197  C        Read from e2Bufr1_RX(iBufr,mb,nb)  C        Read from e2Bufr1_RX(iBufr,mb,nb)
198           iBufr1=iBufr1+1           iBufr1=iBufr1+1
199           array1(itl,jtl,ktl)=e2Bufr1_RX(iBufr1,mb,nb,ir)           array1(itl,jtl,ktl)=e2Bufr1_RX(iBufr1,mb,nb,ir)
# Line 217  C        Read from e2Bufr1_RX(iBufr,mb,n Line 202  C        Read from e2Bufr1_RX(iBufr,mb,n
202        ENDDO        ENDDO
203    
204        iBufr2=0        iBufr2=0
205        DO ktl=tKlo,tKhi,tKStride        DO ktl=tKlo,tKhi,tkStride
206         DO jtl=tJLo+jtl2reduce, tJHi, tjStride         DO jtl=tJLo2, tJHi2, tjStride
207          DO itl=tILo+itl2reduce, tIHi, tiStride          DO itl=tILo2, tIHi2, tiStride
208  C        Read from e2Bufr1_RX(iBufr,mb,nb)  C        Read from e2Bufr1_RX(iBufr,mb,nb)
209           iBufr2=iBufr2+1           iBufr2=iBufr2+1
210           array2(itl,jtl,ktl)=e2Bufr2_RX(iBufr2,mb,nb,ir)           array2(itl,jtl,ktl)=e2Bufr2_RX(iBufr2,mb,nb,ir)
Legend:
Removed from v.1.5  
changed lines
  Added in v.1.6
  ViewVC Help
Powered by ViewVC 1.1.22