/[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.1 by afe, Fri Jan 9 20:46:09 2004 UTC revision 1.9 by jmc, Wed May 20 21:01:45 2009 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_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 17  Line 21 
21    
22        IMPLICIT NONE        IMPLICIT NONE
23    
24  C  #include "SIZE.h"
25  #include "W2_OPTIONS.h"  #include "EEPARAMS.h"
26    #include "EESUPPORT.h"
27    #include "W2_EXCH2_SIZE.h"
28  #include "W2_EXCH2_TOPOLOGY.h"  #include "W2_EXCH2_TOPOLOGY.h"
29    
 #include "EEPARAMS.h"  
       CHARACTER*(MAX_LEN_MBUF) messageBuffer  
 C  
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).
# Line 54  C                          :: MPI MSG co Line 59  C                          :: MPI MSG co
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
70        INTEGER e2BufrRecSize        INTEGER e2BufrRecSize
71        INTEGER mnb, nt        INTEGER mnb, nt
72        _RX     e2Bufr1_RX( e2BufrRecSize, mnb, nt, 2 )        _RX     e2Bufr1_RX( e2BufrRecSize, mnb, nt, 2 )
73        _RX     e2Bufr2_RX( e2BufrRecSize, mnb, nt, 2 )        _RX     e2Bufr2_RX( e2BufrRecSize, mnb, nt, 2 )
# Line 76  C Line 81  C
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
       INTEGER itc, jtc, ktc  
       INTEGER isc, jsc, ksc  
       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     ::
# Line 91  C     iBufr2     :: Line 90  C     iBufr2     ::
90  C     mb, nb :: Selects e2Bufr, msgHandle record to use  C     mb, nb :: Selects e2Bufr, msgHandle record to use
91  C     ir     ::  C     ir     ::
92        INTEGER mb, nb, ir        INTEGER mb, nb, ir
93  C     oN     :: Opposing send record number  C     oN     :: Opposing send record number
94        INTEGER oN        INTEGER oN
95  C     Loop counters  C     Loop counters
96        INTEGER I, nri1, nrj1, nrk1        INTEGER I
       INTEGER    nri2, nrj2, nrk2  
       INTEGER itl1reduce, jtl1reduce  
       INTEGER itl2reduce, jtl2reduce  
97    
98  C     MPI setup  C     MPI setup
 #include "SIZE.h"  
 #include "EESUPPORT.h"  
       INTEGER theTag1, theSize1, theType  
       INTEGER theTag2, theSize2  
       INTEGER sProc, tProc  
99  #ifdef ALLOW_USE_MPI  #ifdef ALLOW_USE_MPI
100          INTEGER nri1, nrj1, nrk1
101          INTEGER nri2, nrj2, nrk2
102          INTEGER theTag1, theTag2, theType
103          INTEGER sProc, tProc
104        INTEGER mpiStatus(MPI_STATUS_SIZE), mpiRc        INTEGER mpiStatus(MPI_STATUS_SIZE), mpiRc
105    #ifdef W2_E2_DEBUG_ON
106          CHARACTER*(MAX_LEN_MBUF) messageBuffer
107    #endif
108  #endif  #endif
109    
110        tt=exch2_neighbourId(nN, thisTile )        tt=exch2_neighbourId(nN, thisTile )
111        oN=exch2_opposingSend_record(nN, thisTile )        oN=exch2_opposingSend(nN, thisTile )
       itl1reduce=0  
       jtl1reduce=0  
       itl2reduce=0  
       jtl2reduce=0  
       IF ( exch2_pi(1,oN,tt) .EQ. -1 ) itl1reduce=1  
       IF ( exch2_pj(1,oN,tt) .EQ. -1 ) itl1reduce=1  
       IF ( exch2_pi(2,oN,tt) .EQ. -1 ) jtl2reduce=1  
       IF ( exch2_pj(2,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
115        IF     ( commSetting .EQ. 'P' ) THEN        IF     ( commSetting .EQ. 'P' ) THEN
116  C      1 Need to check and spin on data ready assertion for multithreaded mode, for now do nothing i.e.  C      1 Need to check and spin on data ready assertion for multithreaded mode, for now do nothing i.e.
117  C        assume only one thread per process.  C        assume only one thread per process.
118    
119  C      2 Need to set e2Bufr to use put buffer from opposing send.  C      2 Need to set e2Bufr to use put buffer from opposing send.
120         oN = exch2_opposingSend_record(nN, thisTile )         oN = exch2_opposingSend(nN, thisTile )
121         mb = oN         mb = oN
122         ir = 1         ir = 1
123         DO I=1,nt         DO I=1,nt
# Line 142  C      Setup MPI stuff here Line 132  C      Setup MPI stuff here
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,
# Line 171  C      Setup MPI stuff here Line 155  C      Setup MPI stuff here
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,
# Line 202  C      Set nt to this tiles rank Line 186  C      Set nt to this tiles rank
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)
# Line 213  C        Read from e2Bufr1_RX(iBufr,mb,n Line 197  C        Read from e2Bufr1_RX(iBufr,mb,n
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)
206          ENDDO          ENDDO
207         ENDDO         ENDDO
208        ENDDO        ENDDO
209    
210        RETURN        RETURN
211        END        END
212    
213    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
214    
215    CEH3 ;;; Local Variables: ***
216    CEH3 ;;; mode:fortran ***
217    CEH3 ;;; End: ***
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.9
  ViewVC Help
Powered by ViewVC 1.1.22