Warning, /pkg/exch2/exch2_get_rx2.template is written in an unsupported language. File is not indexed.
view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
ed81d0a43c Jean*0001 #include "CPP_EEOPTIONS.h"
0002 #include "W2_OPTIONS.h"
0003
0004 CBOP 0
0005 C !ROUTINE: EXCH2_GET_RX2
0006
0007 C !INTERFACE:
0008 SUBROUTINE EXCH2_GET_RX2 (
0009 I tIlo1, tIhi1, tIlo2, tIhi2, tiStride,
0010 I tJlo1, tJhi1, tJlo2, tJhi2, tjStride,
0011 I tKlo, tKhi, tkStride,
0012 I thisTile, nN, bi, bj,
0013 I e2BufrRecSize, sizeNb, sizeBi, sizeBj,
0014 I e2Bufr1_RX, e2Bufr2_RX,
0015 U array1,
0016 U array2,
0017 I i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi,
0018 I i2Lo, i2Hi, j2Lo, j2Hi, k2Lo, k2Hi,
0019 U e2_msgHandles,
0020 I commSetting, myThid )
0021
0022 C !DESCRIPTION:
0023 C Two components vector field Exchange:
0024 C Get from buffer exchanged data to fill in this tile-egde overlap region.
0025
0026 C !USES:
0027 IMPLICIT NONE
0028
0029 #include "SIZE.h"
0030 #include "EEPARAMS.h"
0031 #include "W2_EXCH2_SIZE.h"
0032 #include "W2_EXCH2_TOPOLOGY.h"
0033
0034 C !INPUT/OUTPUT PARAMETERS:
0035 C === Routine arguments ===
0036 C tIlo1, tIhi1 :: index range in I that will be filled in target "array1"
0037 C tIlo2, tIhi2 :: index range in I that will be filled in target "array2"
0038 C tIstride :: index step in I that will be filled in target arrays
0039 C tJlo1, tJhi1 :: index range in J that will be filled in target "array1"
0040 C tJlo2, tJhi2 :: index range in J that will be filled in target "array2"
0041 C tJstride :: index step in J that will be filled in target arrays
0042 C tKlo, tKhi :: index range in K that will be filled in target arrays
0043 C tKstride :: index step in K that will be filled in target arrays
0044 C oIs1, oJs1 :: I,J index offset in target "array1" to source connection
0045 C oIs2, oJs2 :: I,J index offset in target "array2" to source connection
d6ea3164dc Jean*0046 C thisTile :: receiving tile Id. number
ed81d0a43c Jean*0047 C nN :: Neighbour entry that we are processing
0048 C bi,bj :: Indices of the receiving tile within this process
0049 C :: (used to select buffer slots that are allowed).
0050 C e2BufrRecSize :: Number of elements in each entry of e2Bufr[1,2]_RX
0051 C sizeNb :: Second dimension of e2Bufr1_RX & e2Bufr2_RX
0052 C sizeBi :: Third dimension of e2Bufr1_RX & e2Bufr2_RX
0053 C sizeBj :: Fourth dimension of e2Bufr1_RX & e2Bufr2_RX
0054 C e2Bufr1_RX :: Data transport buffer array. This array is used in one of
0055 C e2Bufr2_RX :: two ways. For PUT communication the entry in the buffer
0056 C :: associated with the source for this receive (determined
0057 C :: from the opposing_send index) is read.
0058 C :: For MSG communication the entry in the buffer associated
0059 C :: with this neighbor of this tile is used as a receive
0060 C :: location for loading a linear stream of bytes.
0061 C array1 :: 1rst Component target array that this receive writes to.
0062 C array2 :: 2nd Component target array that this receive writes to.
0063 C i1Lo, i1Hi :: I coordinate bounds of target array1
0064 C j1Lo, j1Hi :: J coordinate bounds of target array1
0065 C k1Lo, k1Hi :: K coordinate bounds of target array1
0066 C i2Lo, i2Hi :: I coordinate bounds of target array2
0067 C j2Lo, j2Hi :: J coordinate bounds of target array2
0068 C k2Lo, k2Hi :: K coordinate bounds of target array2
0069 C e2_msgHandles :: Synchronization and coordination data structure used to
0070 C :: coordinate access to e2Bufr1_RX or to regulate message
0071 C :: buffering. In PUT communication sender will increment
0072 C :: handle entry once data is ready in buffer. Receiver will
0073 C :: decrement handle once data is consumed from buffer.
d6ea3164dc Jean*0074 C :: For MPI MSG communication MPI_Wait uses handle to check
ed81d0a43c Jean*0075 C :: Isend has cleared. This is done in routine after receives.
0076 C commSetting :: Mode of communication used to exchange with this neighbor
0077 C withSigns :: Flag controlling whether vector field is signed.
0078 C myThid :: my Thread Id. number
0079
0080 INTEGER tIlo1, tIhi1, tIlo2, tIhi2, tiStride
0081 INTEGER tJlo1, tJhi1, tJlo2, tJhi2, tjStride
0082 INTEGER tKlo, tKhi, tkStride
0083 INTEGER i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi
0084 INTEGER i2Lo, i2Hi, j2Lo, j2Hi, k2Lo, k2Hi
0085 INTEGER thisTile, nN, bi, bj
0086 INTEGER e2BufrRecSize, sizeNb, sizeBi, sizeBj
0087 _RX e2Bufr1_RX( e2BufrRecSize, sizeNb, sizeBi, sizeBj, 2 )
0088 _RX e2Bufr2_RX( e2BufrRecSize, sizeNb, sizeBi, sizeBj, 2 )
0089 _RX array1(i1Lo:i1Hi,j1Lo:j1Hi,k1Lo:k1Hi)
0090 _RX array2(i2Lo:i2Hi,j2Lo:j2Hi,k2Lo:k2Hi)
0091 INTEGER e2_msgHandles( 2, sizeNb, sizeBi, sizeBj )
0092 CHARACTER commSetting
0093 INTEGER myThid
0094 CEOP
0095
0096 C !LOCAL VARIABLES:
0097 C == Local variables ==
0098 C itl,jtl,ktl :: Loop counters (this tile)
0099 C soT :: Source tile Id number
0100 C oNb :: Opposing send record number
d6ea3164dc Jean*0101 C iBufr1 :: number of buffer-1 elements to transfer
0102 C iBufr2 :: number of buffer-2 elements to transfer
0103 C sNb :: buffer(source) Neighbour index to get data from
ed81d0a43c Jean*0104 C sBi :: buffer(source) local(to this Proc) Tile index to get data from
0105 C sBj :: buffer(source) local(to this Proc) Tile index to get data from
0106 C sLv :: buffer(source) level index to get data from
0107 C i,j :: Loop counters
0108
0109 INTEGER itl, jtl, ktl
0110 INTEGER soT
0111 INTEGER oNb
0112 INTEGER iBufr1, iBufr2
0113 INTEGER sNb, sBi, sBj, sLv
0114 c CHARACTER*(MAX_LEN_MBUF) msgBuf
0115
0116 soT = exch2_neighbourId( nN, thisTile )
0117 oNb = exch2_opposingSend(nN, thisTile )
0118
0119 C Handle receive end data transport according to communication mechanism between
0120 C source and target tile
0121 IF ( commSetting .EQ. 'P' ) THEN
0122
0123 C 1 Need to check and spin on data ready assertion for multithreaded mode,
0124 C for now, ensure global sync using barrier.
0125 C 2 get directly data from 1rst level buffer (sLv=1);
0126
0127 C find the tile indices (local to this Proc) corresponding to
170d15a4c7 Jean*0128 C this source tile Id "soT" (note: this is saved in W2_tileIndex array)
ed81d0a43c Jean*0129 sLv = 1
0130 sNb = oNb
170d15a4c7 Jean*0131 sBi = W2_tileIndex(soT)
0132 sBj = 1 + (sBi-1)/sizeBi
0133 sBi = 1 + MOD(sBi-1,sizeBi)
ed81d0a43c Jean*0134 #ifdef ALLOW_USE_MPI
0135 ELSEIF ( commSetting .EQ. 'M' ) THEN
0136 sLv = 2
0137 sBi = bi
0138 sBj = bj
0139 sNb = nN
0140 #endif /* ALLOW_USE_MPI */
0141 ELSE
0142 STOP 'EXCH2_GET_RX2:: commSetting VALUE IS INVALID'
0143 ENDIF
0144
0145 iBufr1=0
0146 DO ktl=tKlo,tKhi,tkStride
0147 DO jtl=tJLo1, tJHi1, tjStride
0148 DO itl=tILo1, tIHi1, tiStride
0149 C Read from e2Bufr1_RX(iBufr,sNb,sBi,sBj,sLv)
0150 iBufr1 = iBufr1+1
0151 array1(itl,jtl,ktl) = e2Bufr1_RX(iBufr1,sNb,sBi,sBj,sLv)
0152 ENDDO
0153 ENDDO
0154 ENDDO
0155
0156 iBufr2=0
0157 DO ktl=tKlo,tKhi,tkStride
0158 DO jtl=tJLo2, tJHi2, tjStride
0159 DO itl=tILo2, tIHi2, tiStride
0160 C Read from e2Bufr2_RX(iBufr,sNb,sBi,sBj,sLv)
0161 iBufr2 = iBufr2+1
0162 array2(itl,jtl,ktl) = e2Bufr2_RX(iBufr2,sNb,sBi,sBj,sLv)
0163 ENDDO
0164 ENDDO
0165 ENDDO
0166
0167 RETURN
0168 END
0169
0170 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
0171
0172 CEH3 ;;; Local Variables: ***
0173 CEH3 ;;; mode:fortran ***
0174 CEH3 ;;; End: ***
