/[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.7 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_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_TOPOLOGY.h"  #include "W2_EXCH2_TOPOLOGY.h"
28    
 #include "EEPARAMS.h"  
       CHARACTER*(MAX_LEN_MBUF) messageBuffer  
 C  
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 54  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
69        INTEGER e2BufrRecSize        INTEGER e2BufrRecSize
70        INTEGER mnb, nt        INTEGER mnb, nt
71        _RX     e2Bufr1_RX( e2BufrRecSize, mnb, nt, 2 )        _RX     e2Bufr1_RX( e2BufrRecSize, mnb, nt, 2 )
72        _RX     e2Bufr2_RX( e2BufrRecSize, mnb, nt, 2 )        _RX     e2Bufr2_RX( e2BufrRecSize, mnb, nt, 2 )
# Line 76  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
       INTEGER itc, jtc, ktc  
       INTEGER isc, jsc, ksc  
       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 91  C     iBufr2     :: Line 89  C     iBufr2     ::
89  C     mb, nb :: Selects e2Bufr, msgHandle record to use  C     mb, nb :: Selects e2Bufr, msgHandle record to use
90  C     ir     ::  C     ir     ::
91        INTEGER mb, nb, ir        INTEGER mb, nb, ir
92  C     oN     :: Opposing send record number  C     oN     :: Opposing send record number
93        INTEGER oN        INTEGER oN
94  C     Loop counters  C     Loop counters
95        INTEGER I, nri1, nrj1, nrk1        INTEGER I
       INTEGER    nri2, nrj2, nrk2  
       INTEGER itl1reduce, jtl1reduce  
       INTEGER itl2reduce, jtl2reduce  
96    
97  C     MPI setup  C     MPI setup
 #include "SIZE.h"  
 #include "EESUPPORT.h"  
       INTEGER theTag1, theSize1, theType  
       INTEGER theTag2, theSize2  
       INTEGER sProc, tProc  
98  #ifdef ALLOW_USE_MPI  #ifdef ALLOW_USE_MPI
99          INTEGER nri1, nrj1, nrk1
100          INTEGER nri2, nrj2, nrk2
101          INTEGER theTag1, theTag2, theType
102          INTEGER sProc, tProc
103        INTEGER mpiStatus(MPI_STATUS_SIZE), mpiRc        INTEGER mpiStatus(MPI_STATUS_SIZE), mpiRc
104    #ifdef W2_E2_DEBUG_ON
105          CHARACTER*(MAX_LEN_MBUF) messageBuffer
106    #endif
107  #endif  #endif
108    
109        tt=exch2_neighbourId(nN, thisTile )        tt=exch2_neighbourId(nN, thisTile )
110        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  
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
114        IF     ( commSetting .EQ. 'P' ) THEN        IF     ( commSetting .EQ. 'P' ) THEN
115  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.
116  C        assume only one thread per process.  C        assume only one thread per process.
117    
118  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.
119         oN = exch2_opposingSend_record(nN, thisTile )         oN = exch2_opposingSend(nN, thisTile )
120         mb = oN         mb = oN
121         ir = 1         ir = 1
122         DO I=1,nt         DO I=1,nt
# Line 143  C      Setup MPI stuff here Line 132  C      Setup MPI stuff here
132         mb = nN         mb = nN
133         ir = 2         ir = 2
134         theTag1 =  (tt-1)*MAX_NEIGHBOURS*2 + oN-1         theTag1 =  (tt-1)*MAX_NEIGHBOURS*2 + oN-1
      &         + 10000*(  
      &            (thisTile-1)*MAX_NEIGHBOURS*2 + oN-1  
      &           )  
135         theTag2 =  (tt-1)*MAX_NEIGHBOURS*2 + MAX_NEIGHBOURS + oN-1         theTag2 =  (tt-1)*MAX_NEIGHBOURS*2 + MAX_NEIGHBOURS + oN-1
      &         + 10000*(  
      &            (thisTile-1)*MAX_NEIGHBOURS*2 + MAX_NEIGHBOURS + oN-1  
      &           )  
136         tProc = exch2_tProc(thisTile)-1         tProc = exch2_tProc(thisTile)-1
137         sProc = exch2_tProc(tt)-1         sProc = exch2_tProc(tt)-1
138         theType = MPI_REAL8         theType = MPI_REAL8
139         nri1 = (tIhi-tIlo+1-itl1reduce)/tiStride         nri1 = (tIhi1-tIlo1+1)/tiStride
140         nrj1 = (tJhi-tJlo+1-jtl1reduce)/tjStride         nrj1 = (tJhi1-tJlo1+1)/tjStride
141         nrk1 = (tKhi-tKlo+1)/tkStride         nrk1 = (tKhi-tKlo+1)/tkStride
142         iBufr1 = nri1*nrj1*nrk1         iBufr1 = nri1*nrj1*nrk1
143         nri2 = (tIhi-tIlo+1-itl2reduce)/tiStride         nri2 = (tIhi2-tIlo2+1)/tiStride
144         nrj2 = (tJhi-tJlo+1-jtl2reduce)/tjStride         nrj2 = (tJhi2-tJlo2+1)/tjStride
145         nrk2 = (tKhi-tKlo+1)/tkStride         nrk2 = (tKhi-tKlo+1)/tkStride
146         iBufr2 = nri2*nrj2*nrk2         iBufr2 = nri2*nrj2*nrk2
147         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 154  C      Setup MPI stuff here
154         CALL PRINT_MESSAGE(messageBuffer,         CALL PRINT_MESSAGE(messageBuffer,
155       I      standardMessageUnit,SQUEEZE_RIGHT,       I      standardMessageUnit,SQUEEZE_RIGHT,
156       I      myThid)       I      myThid)
157         WRITE(messageBuffer,'(A,I4,A,I4,A)') '      INTO TILE=', thisTile,         WRITE(messageBuffer,'(A,I4,A,I4,A)') '      INTO TILE=',thisTile,
158       &                                   ' (proc = ',tProc,')'       &                                   ' (proc = ',tProc,')'
159         CALL PRINT_MESSAGE(messageBuffer,         CALL PRINT_MESSAGE(messageBuffer,
160       I      standardMessageUnit,SQUEEZE_RIGHT,       I      standardMessageUnit,SQUEEZE_RIGHT,
# Line 202  C      Set nt to this tiles rank Line 185  C      Set nt to this tiles rank
185        ENDIF        ENDIF
186    
187        iBufr1=0        iBufr1=0
188        DO ktl=tKlo,tKhi,tKStride        DO ktl=tKlo,tKhi,tkStride
189         DO jtl=tJLo+jtl1reduce, tJHi, tjStride         DO jtl=tJLo1, tJHi1, tjStride
190          DO itl=tILo+itl1reduce, tIHi, tiStride          DO itl=tILo1, tIHi1, tiStride
191  C        Read from e2Bufr1_RX(iBufr,mb,nb)  C        Read from e2Bufr1_RX(iBufr,mb,nb)
192           iBufr1=iBufr1+1           iBufr1=iBufr1+1
193           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 196  C        Read from e2Bufr1_RX(iBufr,mb,n
196        ENDDO        ENDDO
197    
198        iBufr2=0        iBufr2=0
199        DO ktl=tKlo,tKhi,tKStride        DO ktl=tKlo,tKhi,tkStride
200         DO jtl=tJLo+jtl2reduce, tJHi, tjStride         DO jtl=tJLo2, tJHi2, tjStride
201          DO itl=tILo+itl2reduce, tIHi, tiStride          DO itl=tILo2, tIHi2, tiStride
202  C        Read from e2Bufr1_RX(iBufr,mb,nb)  C        Read from e2Bufr1_RX(iBufr,mb,nb)
203           iBufr2=iBufr2+1           iBufr2=iBufr2+1
204           array2(itl,jtl,ktl)=e2Bufr2_RX(iBufr2,mb,nb,ir)           array2(itl,jtl,ktl)=e2Bufr2_RX(iBufr2,mb,nb,ir)
205          ENDDO          ENDDO
206         ENDDO         ENDDO
207        ENDDO        ENDDO
208    
209        RETURN        RETURN
210        END        END
211    
212    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
213    
214    CEH3 ;;; Local Variables: ***
215    CEH3 ;;; mode:fortran ***
216    CEH3 ;;; End: ***
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.7
  ViewVC Help
Powered by ViewVC 1.1.22