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

Annotation of /MITgcm/pkg/exch2/exch2_recv_rx1.template

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


Revision 1.6 - (hide annotations) (download)
Tue Jul 29 20:25:23 2008 UTC (15 years, 9 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint61b
Changes since 1.5: +3 -3 lines
- change index-bounds storage (move from target to local tile,
  more intuitive this way)
- rename/remove some variables

1 jmc 1.6 C $Header: /u/gcmpack/MITgcm/pkg/exch2/exch2_recv_rx1.template,v 1.5 2007/07/27 22:15:23 heimbach Exp $
2 edhill 1.2 C $Name: $
3    
4 jmc 1.4 #include "CPP_EEOPTIONS.h"
5     #include "W2_OPTIONS.h"
6 afe 1.1
7     SUBROUTINE EXCH2_RECV_RX1(
8     I tIlo, tIhi, tiStride,
9     I tJlo, tJhi, tjStride,
10     I tKlo, tKhi, tkStride,
11     I thisTile, thisI, nN,
12     I e2Bufr1_RX, e2BufrRecSize,
13     I mnb, nt,
14     U array,
15     I i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi,
16     U e2_msgHandles, myTiles,
17     I commSetting,
18     I myThid )
19    
20     IMPLICIT NONE
21    
22 jmc 1.4 #include "SIZE.h"
23     #include "EEPARAMS.h"
24     #include "EESUPPORT.h"
25 afe 1.1 #include "W2_EXCH2_TOPOLOGY.h"
26    
27     C === Routine arguments ===
28     C tIlo, tIhi, tIstride :: index range in I that will be filled in target "array"
29     C tJlo, tJhi, tJstride :: index range in J that will be filled in target "array"
30     C tKlo, tKhi, tKstride :: index range in K that will be filled in target "array"
31     C thisTile :: Rank of the receiveing tile
32     C thisI :: Index of the receiving tile within this process (used
33     C :: to select buffer slots that are allowed).
34     C nN :: Neighbour entry that we are processing
35     C e2Bufr1_RX :: Data transport buffer array. This array is used in one of
36     C :: two ways. For PUT communication the entry in the buffer
37     C :: associated with the source for this receive (determined
38     C :: from the opposing_send index) is read. For MSG communication
39     C :: the entry in the buffer associated with this neighbor of this
40     C :: tile is used as a receive location for loading a linear
41     C :: stream of bytes.
42     C e2BufrRecSize :: Number of elements in each entry of e2Bufr1_RX
43     C mnb :: Second dimension of e2Bufr1_RX
44     C nt :: Third dimension of e2Bufr1_RX
45     C array :: Target array that this receive writes to.
46     C i1Lo, i1Hi :: I coordinate bounds of target array
47     C j1Lo, j1Hi :: J coordinate bounds of target array
48     C k1Lo, k1Hi :: K coordinate bounds of target array
49     C e2_msgHandles :: Synchronization and coordination data structure used to coordinate access
50     C :: to e2Bufr1_RX or to regulate message buffering. In PUT communication
51     C :: sender will increment handle entry once data is ready in buffer.
52     C :: Receiver will decrement handle once data is consumed from buffer. For
53     C :: MPI MSG communication MPI_Wait uses hanlde to check Isend has cleared.
54     C :: This is done in routine after receives.
55     C myTiles :: List of nt tiles that this process owns.
56     C commSetting :: Mode of communication used to exchnage with this neighbor
57     C myThid :: Thread number of this instance of EXCH2_RECV_RX1
58     C
59     INTEGER tILo, tIHi, tiStride
60     INTEGER tJLo, tJHi, tjStride
61     INTEGER tKLo, tKHi, tkStride
62     INTEGER i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi
63     INTEGER thisTile, nN, thisI
64     INTEGER e2BufrRecSize
65     INTEGER mnb, nt
66     _RX e2Bufr1_RX( e2BufrRecSize, mnb, nt, 2 )
67     _RX array(i1Lo:i1Hi,j1Lo:j1Hi,k1Lo:k1Hi)
68     INTEGER e2_msgHandles(mnb, nt)
69     INTEGER myThid
70     INTEGER myTiles(nt)
71     CHARACTER commSetting
72    
73     C == Local variables ==
74     C itl, jtl, ktl :: Loop counters
75     C :: itl etc... target local
76     C :: itc etc... target canonical
77     C :: isl etc... source local
78     C :: isc etc... source canonical
79     INTEGER itl, jtl, ktl
80 jmc 1.3 c INTEGER itc, jtc, ktc
81     c INTEGER isc, jsc, ksc
82     c INTEGER isl, jsl, ksl
83 afe 1.1 C tt :: Target tile
84     C iBufr :: Buffer counter
85     INTEGER tt
86     INTEGER iBufr
87     C mb, nb :: Selects e2Bufr, msgHandle record to use
88     C ir ::
89     INTEGER mb, nb, ir
90     C oN :: Opposing send record number
91     INTEGER oN
92     C Loop counters
93 jmc 1.3 c INTEGER I, nri, nrj, nrk
94     INTEGER I
95 afe 1.1
96     C MPI setup
97 jmc 1.3 #ifdef ALLOW_USE_MPI
98     c INTEGER theTag, theSize, theType
99     INTEGER theTag, theType
100 afe 1.1 INTEGER sProc, tProc
101 jmc 1.3 INTEGER nri, nrj, nrk
102 afe 1.1 INTEGER mpiStatus(MPI_STATUS_SIZE), mpiRc
103 jmc 1.3 #ifdef W2_E2_DEBUG_ON
104     CHARACTER*(MAX_LEN_MBUF) messageBuffer
105     #endif
106 afe 1.1 #endif
107    
108     tt=exch2_neighbourId(nN, thisTile )
109 jmc 1.6 oN=exch2_opposingSend(nN, thisTile )
110 afe 1.1
111     C Handle receive end data transport according to communication mechanism between
112     C source and target tile
113     IF ( commSetting .EQ. 'P' ) THEN
114     C 1 Need to check and spin on data ready assertion for multithreaded mode, for now do nothing i.e.
115     C assume only one thread per process.
116    
117     C 2 Need to set e2Bufr to use put buffer from opposing send.
118 jmc 1.6 oN = exch2_opposingSend(nN, thisTile )
119 afe 1.1 mb = oN
120     DO I=1,nt
121     IF ( myTiles(I) .EQ. tt ) THEN
122     nb = I
123     ir = 1
124     ENDIF
125     ENDDO
126     C Get data from e2Bufr(1,mb,nb)
127     ELSEIF ( commSetting .EQ. 'M' ) THEN
128     #ifdef ALLOW_USE_MPI
129     C Setup MPI stuff here
130     nb = thisI
131     mb = nN
132     ir = 2
133     theTag = (tt-1)*MAX_NEIGHBOURS + oN
134     & + 10000*(
135     & (thisTile-1)*MAX_NEIGHBOURS + oN
136     & )
137     tProc = exch2_tProc(thisTile)-1
138     sProc = exch2_tProc(tt)-1
139     theType = MPI_REAL8
140     nri = (tIhi-tIlo+1)/tiStride
141     nrj = (tJhi-tJlo+1)/tjStride
142     nrk = (tKhi-tKlo+1)/tkStride
143     iBufr = nri*nrj*nrk
144     CALL MPI_Recv( e2Bufr1_RX(1,mb,nb,ir), iBufr, theType, sProc,
145     & theTag, MPI_COMM_MODEL, mpiStatus, mpiRc )
146     #ifdef W2_E2_DEBUG_ON
147     WRITE(messageBuffer,'(A,I4,A,I4,A)') ' RECV FROM TILE=', tt,
148     & ' (proc = ',sProc,')'
149     CALL PRINT_MESSAGE(messageBuffer,
150     I standardMessageUnit,SQUEEZE_RIGHT,
151     I myThid)
152 heimbach 1.5 WRITE(messageBuffer,'(A,I4,A,I4,A)') ' INTO TILE=', thisTile,
153 afe 1.1 & ' (proc = ',tProc,')'
154     CALL PRINT_MESSAGE(messageBuffer,
155     I standardMessageUnit,SQUEEZE_RIGHT,
156     I myThid)
157     WRITE(messageBuffer,'(A,I10)') ' TAG=', theTag
158     CALL PRINT_MESSAGE(messageBuffer,
159     I standardMessageUnit,SQUEEZE_RIGHT,
160     I myThid)
161     WRITE(messageBuffer,'(A,I4)') ' NEL=', iBufr
162     CALL PRINT_MESSAGE(messageBuffer,
163     I standardMessageUnit,SQUEEZE_RIGHT,
164     I myThid)
165     #endif /* W2_E2_DEBUG_ON */
166     C Set mb to neighbour entry
167     C Set nt to this tiles rank
168     mb = nN
169     #endif
170     ELSE
171     STOP 'EXCH2_RECV_RX1:: commSetting VALUE IS INVALID'
172     ENDIF
173    
174     iBufr=0
175     DO ktl=tKlo,tKhi,tKStride
176     DO jtl=tJLo, tJHi, tjStride
177     DO itl=tILo, tIHi, tiStride
178     C Read from e2Bufr1_RX(iBufr,mb,nb)
179     iBufr=iBufr+1
180     array(itl,jtl,ktl)=e2Bufr1_RX(iBufr,mb,nb,ir)
181     ENDDO
182     ENDDO
183     ENDDO
184    
185     RETURN
186     END
187 edhill 1.2
188     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
189    
190     CEH3 ;;; Local Variables: ***
191     CEH3 ;;; mode:fortran ***
192     CEH3 ;;; End: ***

  ViewVC Help
Powered by ViewVC 1.1.22