Warning, /pkg/exch2/exch2_ad_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_AD_GET_RX2
0006
0007 C !INTERFACE:
0008 SUBROUTINE EXCH2_AD_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 O iBufr1, iBufr2,
0015 O e2Bufr1_RX, e2Bufr2_RX,
0016 U array1,
0017 U array2,
0018 I i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi,
0019 I i2Lo, i2Hi, j2Lo, j2Hi, k2Lo, k2Hi,
0020 U e2_msgHandles,
0021 I commSetting, myThid )
0022
0023 C !DESCRIPTION:
0024 C---------------
d6ea3164dc Jean*0025 C AD: IMPORTANT: All comments (except AD:) are taken from the Forward S/R
ed81d0a43c Jean*0026 C AD: and need to be interpreted in the reverse sense: put <-> get,
0027 C AD: send <-> recv, source <-> target ...
0028 C---------------
0029 C Two components vector field Exchange:
0030 C Get from buffer exchanged data to fill in this tile-egde overlap region.
0031
0032 C !USES:
0033 IMPLICIT NONE
0034
0035 #include "SIZE.h"
0036 #include "EEPARAMS.h"
0037 #include "W2_EXCH2_SIZE.h"
0038 #include "W2_EXCH2_TOPOLOGY.h"
0039
0040 C !INPUT/OUTPUT PARAMETERS:
0041 C === Routine arguments ===
0042 C tIlo1, tIhi1 :: index range in I that will be filled in target "array1"
0043 C tIlo2, tIhi2 :: index range in I that will be filled in target "array2"
0044 C tIstride :: index step in I that will be filled in target arrays
0045 C tJlo1, tJhi1 :: index range in J that will be filled in target "array1"
0046 C tJlo2, tJhi2 :: index range in J that will be filled in target "array2"
0047 C tJstride :: index step in J that will be filled in target arrays
0048 C tKlo, tKhi :: index range in K that will be filled in target arrays
0049 C tKstride :: index step in K that will be filled in target arrays
0050 C oIs1, oJs1 :: I,J index offset in target "array1" to source connection
0051 C oIs2, oJs2 :: I,J index offset in target "array2" to source connection
d6ea3164dc Jean*0052 C thisTile :: receiving tile Id. number
ed81d0a43c Jean*0053 C nN :: Neighbour entry that we are processing
0054 C bi,bj :: Indices of the receiving tile within this process
0055 C :: (used to select buffer slots that are allowed).
0056 C e2BufrRecSize :: Number of elements in each entry of e2Bufr[1,2]_RX
0057 C sizeNb :: Second dimension of e2Bufr1_RX & e2Bufr2_RX
0058 C sizeBi :: Third dimension of e2Bufr1_RX & e2Bufr2_RX
0059 C sizeBj :: Fourth dimension of e2Bufr1_RX & e2Bufr2_RX
d6ea3164dc Jean*0060 C iBufr1 :: number of buffer-1 elements to transfer
0061 C iBufr2 :: number of buffer-2 elements to transfer
ed81d0a43c Jean*0062 C e2Bufr1_RX :: Data transport buffer array. This array is used in one of
0063 C e2Bufr2_RX :: two ways. For PUT communication the entry in the buffer
0064 C :: associated with the source for this receive (determined
0065 C :: from the opposing_send index) is read.
0066 C :: For MSG communication the entry in the buffer associated
0067 C :: with this neighbor of this tile is used as a receive
0068 C :: location for loading a linear stream of bytes.
0069 C array1 :: 1rst Component target array that this receive writes to.
0070 C array2 :: 2nd Component target array that this receive writes to.
0071 C i1Lo, i1Hi :: I coordinate bounds of target array1
0072 C j1Lo, j1Hi :: J coordinate bounds of target array1
0073 C k1Lo, k1Hi :: K coordinate bounds of target array1
0074 C i2Lo, i2Hi :: I coordinate bounds of target array2
0075 C j2Lo, j2Hi :: J coordinate bounds of target array2
0076 C k2Lo, k2Hi :: K coordinate bounds of target array2
0077 C e2_msgHandles :: Synchronization and coordination data structure used to
0078 C :: coordinate access to e2Bufr1_RX or to regulate message
0079 C :: buffering. In PUT communication sender will increment
0080 C :: handle entry once data is ready in buffer. Receiver will
0081 C :: decrement handle once data is consumed from buffer.
d6ea3164dc Jean*0082 C :: For MPI MSG communication MPI_Wait uses handle to check
ed81d0a43c Jean*0083 C :: Isend has cleared. This is done in routine after receives.
0084 C commSetting :: Mode of communication used to exchange with this neighbor
0085 C withSigns :: Flag controlling whether vector field is signed.
0086 C myThid :: my Thread Id. number
0087
0088 INTEGER tIlo1, tIhi1, tIlo2, tIhi2, tiStride
0089 INTEGER tJlo1, tJhi1, tJlo2, tJhi2, tjStride
0090 INTEGER tKlo, tKhi, tkStride
0091 INTEGER i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi
0092 INTEGER i2Lo, i2Hi, j2Lo, j2Hi, k2Lo, k2Hi
0093 INTEGER thisTile, nN, bi, bj
0094 INTEGER e2BufrRecSize, sizeNb, sizeBi, sizeBj
0095 INTEGER iBufr1, iBufr2
0096 _RX e2Bufr1_RX( e2BufrRecSize, sizeNb, sizeBi, sizeBj, 2 )
0097 _RX e2Bufr2_RX( e2BufrRecSize, sizeNb, sizeBi, sizeBj, 2 )
0098 _RX array1(i1Lo:i1Hi,j1Lo:j1Hi,k1Lo:k1Hi)
0099 _RX array2(i2Lo:i2Hi,j2Lo:j2Hi,k2Lo:k2Hi)
0100 INTEGER e2_msgHandles( 2, sizeNb, sizeBi, sizeBj )
0101 CHARACTER commSetting
0102 INTEGER myThid
0103 CEOP
0104
0105 C !LOCAL VARIABLES:
0106 C == Local variables ==
0107 C itl,jtl,ktl :: Loop counters (this tile)
0108 C soT :: Source tile Id number
0109 C oNb :: Opposing send record number
d6ea3164dc Jean*0110 C sNb :: buffer(source) Neighbour index to get data from
ed81d0a43c Jean*0111 C sBi :: buffer(source) local(to this Proc) Tile index to get data from
0112 C sBj :: buffer(source) local(to this Proc) Tile index to get data from
0113 C sLv :: buffer(source) level index to get data from
0114 C i,j :: Loop counters
0115
0116 INTEGER itl, jtl, ktl
0117 INTEGER soT
0118 INTEGER oNb
0119 INTEGER sNb, sBi, sBj, sLv
7c69cee546 Jean*0120 INTEGER iLoc
0121 CHARACTER*(MAX_LEN_MBUF) msgBuf
ed81d0a43c Jean*0122
0123 soT = exch2_neighbourId( nN, thisTile )
0124 oNb = exch2_opposingSend(nN, thisTile )
0125
0126 C Handle receive end data transport according to communication mechanism between
0127 C source and target tile
0128 IF ( commSetting .EQ. 'P' ) THEN
0129 C AD: Need to check that buffer synchronisation token is decremented
0130 C AD: before filling buffer.
0131
0132 C find the tile indices (local to this Proc) corresponding to
170d15a4c7 Jean*0133 C this source tile Id "soT" (note: this is saved in W2_tileIndex array)
ed81d0a43c Jean*0134 sLv = 1
0135 sNb = oNb
170d15a4c7 Jean*0136 sBi = W2_tileIndex(soT)
0137 sBj = 1 + (sBi-1)/sizeBi
0138 sBi = 1 + MOD(sBi-1,sizeBi)
ed81d0a43c Jean*0139 #ifdef ALLOW_USE_MPI
0140 ELSEIF ( commSetting .EQ. 'M' ) THEN
0141 sLv = 2
0142 sBi = bi
0143 sBj = bj
0144 sNb = nN
0145 #endif /* ALLOW_USE_MPI */
0146 ELSE
0147 STOP 'EXCH2_AD_GET_RX2:: commSetting VALUE IS INVALID'
0148 ENDIF
0149
0150 iBufr1=0
0151 DO ktl=tKlo,tKhi,tkStride
0152 DO jtl=tJLo1, tJHi1, tjStride
0153 DO itl=tILo1, tIHi1, tiStride
0154 C Read from e2Bufr1_RX(iBufr,sNb,sBi,sBj,sLv)
0155 iBufr1 = iBufr1+1
7c69cee546 Jean*0156 #ifdef W2_USE_E2_SAFEMODE
0157 iLoc = MIN( iBufr1, e2BufrRecSize )
0158 #else
0159 iLoc = iBufr1
0160 #endif
0161 e2Bufr1_RX(iLoc,sNb,sBi,sBj,sLv) = array1(itl,jtl,ktl)
ed81d0a43c Jean*0162 array1(itl,jtl,ktl) = 0.
0163 ENDDO
0164 ENDDO
0165 ENDDO
7c69cee546 Jean*0166 IF ( iBufr1 .GT. e2BufrRecSize ) THEN
0167 WRITE(msgBuf,'(2A,I9,A,I9)') 'EXCH2_AD_GET_RX2:',
0168 & ' iBufr1=', iBufr1, ' exceeds E2BUFR size=', e2BufrRecSize
0169 CALL PRINT_ERROR ( msgBuf, myThid )
0170 STOP 'ABNORMAL END: S/R EXCH2_AD_GET_RX2 (iBufr1 over limit)'
0171 ENDIF
ed81d0a43c Jean*0172
0173 iBufr2=0
0174 DO ktl=tKlo,tKhi,tkStride
0175 DO jtl=tJLo2, tJHi2, tjStride
0176 DO itl=tILo2, tIHi2, tiStride
0177 C Read from e2Bufr2_RX(iBufr,sNb,sBi,sBj,sLv)
0178 iBufr2 = iBufr2+1
7c69cee546 Jean*0179 #ifdef W2_USE_E2_SAFEMODE
0180 iLoc = MIN( iBufr2, e2BufrRecSize )
0181 #else
0182 iLoc = iBufr2
0183 #endif
0184 e2Bufr2_RX(iLoc,sNb,sBi,sBj,sLv) = array2(itl,jtl,ktl)
ed81d0a43c Jean*0185 array2(itl,jtl,ktl) = 0.
0186 ENDDO
0187 ENDDO
0188 ENDDO
7c69cee546 Jean*0189 IF ( iBufr2 .GT. e2BufrRecSize ) THEN
0190 WRITE(msgBuf,'(2A,I9,A,I9)') 'EXCH2_AD_GET_RX2:',
0191 & ' iBufr2=', iBufr2, ' exceeds E2BUFR size=', e2BufrRecSize
0192 CALL PRINT_ERROR ( msgBuf, myThid )
0193 STOP 'ABNORMAL END: S/R EXCH2_AD_GET_RX2 (iBufr2 over limit)'
0194 ENDIF
ed81d0a43c Jean*0195
0196 RETURN
0197 END
0198
0199 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
0200
0201 CEH3 ;;; Local Variables: ***
0202 CEH3 ;;; mode:fortran ***
0203 CEH3 ;;; End: ***
