Warning, /pkg/exch2/exch2_ad_get_rx1.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_RX1
0006
0007 C !INTERFACE:
0008 SUBROUTINE EXCH2_AD_GET_RX1(
0009 I tIlo, tIhi, tiStride,
0010 I tJlo, tJhi, tjStride,
0011 I tKlo, tKhi, tkStride,
0012 I thisTile, nN, bi, bj,
0013 I e2BufrRecSize, sizeNb, sizeBi, sizeBj,
0014 O iBufr,
0015 O e2Bufr1_RX,
0016 U array,
0017 I i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi,
0018 U e2_msgHandles,
0019 I commSetting, myThid )
0020
0021 C !DESCRIPTION:
0022 C---------------
d6ea3164dc Jean*0023 C AD: IMPORTANT: All comments (except AD:) are taken from the Forward S/R
ed81d0a43c Jean*0024 C AD: and need to be interpreted in the reverse sense: put <-> get,
0025 C AD: send <-> recv, source <-> target ...
0026 C---------------
0027 C Scalar field (1 component) Exchange:
0028 C Get from buffer exchanged data to fill in this tile-egde overlap region.
0029
0030 C !USES:
0031 IMPLICIT NONE
0032
0033 #include "SIZE.h"
0034 #include "EEPARAMS.h"
0035 #include "W2_EXCH2_SIZE.h"
0036 #include "W2_EXCH2_TOPOLOGY.h"
0037
0038 C !INPUT/OUTPUT PARAMETERS:
0039 C === Routine arguments ===
0040 C tIlo,tIhi :: index range in I that will be filled in target "array"
0041 C tIstride :: index step in I that will be filled in target "array"
0042 C tJlo,tJhi :: index range in J that will be filled in target "array"
0043 C tJstride :: index step in J that will be filled in target "array"
0044 C tKlo,tKhi :: index range in K that will be filled in target "array"
0045 C tKstride :: index step in K that will be filled in target "array"
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 e2Bufr1_RX
0051 C sizeNb :: Second dimension of e2Bufr1_RX
0052 C sizeBi :: Third dimension of e2Bufr1_RX
0053 C sizeBj :: Fourth dimension of e2Bufr1_RX
d6ea3164dc Jean*0054 C iBufr :: number of buffer elements to transfer
ed81d0a43c Jean*0055 C e2Bufr1_RX :: Data transport buffer array. This array is used in one of
0056 C :: two ways. For PUT communication the entry in the buffer
0057 C :: associated with the source for this receive (determined
0058 C :: from the opposing_send index) is read.
0059 C :: For MSG communication the entry in the buffer associated
0060 C :: with this neighbor of this tile is used as a receive
0061 C :: location for loading a linear stream of bytes.
0062 C array :: Target array that this receive writes to.
0063 C i1Lo, i1Hi :: I coordinate bounds of target array
0064 C j1Lo, j1Hi :: J coordinate bounds of target array
0065 C k1Lo, k1Hi :: K coordinate bounds of target array
0066 C e2_msgHandles :: Synchronization and coordination data structure used to
0067 C :: coordinate access to e2Bufr1_RX or to regulate message
0068 C :: buffering. In PUT communication sender will increment
0069 C :: handle entry once data is ready in buffer. Receiver will
0070 C :: decrement handle once data is consumed from buffer.
d6ea3164dc Jean*0071 C :: For MPI MSG communication MPI_Wait uses handle to check
ed81d0a43c Jean*0072 C :: Isend has cleared. This is done in routine after receives.
0073 C commSetting :: Mode of communication used to exchange with this neighbor
0074 C myThid :: my Thread Id. number
0075
0076 INTEGER tILo, tIHi, tiStride
0077 INTEGER tJLo, tJHi, tjStride
0078 INTEGER tKLo, tKHi, tkStride
0079 INTEGER i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi
0080 INTEGER thisTile, nN, bi, bj
0081 INTEGER e2BufrRecSize, sizeNb, sizeBi, sizeBj
0082 INTEGER iBufr
0083 _RX e2Bufr1_RX( e2BufrRecSize, sizeNb, sizeBi, sizeBj, 2 )
0084 _RX array(i1Lo:i1Hi,j1Lo:j1Hi,k1Lo:k1Hi)
0085 INTEGER e2_msgHandles( 2, sizeNb, sizeBi, sizeBj )
0086 CHARACTER commSetting
0087 INTEGER myThid
0088 CEOP
0089
0090 C !LOCAL VARIABLES:
0091 C == Local variables ==
0092 C itl,jtl,ktl :: Loop counters (this tile)
0093 C soT :: Source tile Id number
0094 C oNb :: Opposing send record number
d6ea3164dc Jean*0095 C sNb :: buffer (source) Neighbour index to get data from
ed81d0a43c Jean*0096 C sBi :: buffer (source) Tile index (for this Proc) to get data from
0097 C sBj :: buffer (source) Tile index (for this Proc) to get data from
0098 C sLv :: buffer (source) level index to get data from
0099 C i,j :: Loop counters
0100 INTEGER itl, jtl, ktl
0101 INTEGER soT
0102 INTEGER oNb
0103 INTEGER sNb, sBi, sBj, sLv
7c69cee546 Jean*0104 INTEGER iLoc
0105 CHARACTER*(MAX_LEN_MBUF) msgBuf
ed81d0a43c Jean*0106
0107 soT = exch2_neighbourId( nN, thisTile )
0108 oNb = exch2_opposingSend(nN, thisTile )
0109
0110 C Handle receive end data transport according to communication mechanism
0111 C between source and target tile
0112 IF ( commSetting .EQ. 'P' ) THEN
0113 C AD: Need to check that buffer synchronisation token is decremented
0114 C AD: before filling buffer.
0115
0116 C find the tile indices (local to this Proc) corresponding to
170d15a4c7 Jean*0117 C this source tile Id "soT" (note: this is saved in W2_tileIndex array)
ed81d0a43c Jean*0118 sLv = 1
0119 sNb = oNb
170d15a4c7 Jean*0120 sBi = W2_tileIndex(soT)
0121 sBj = 1 + (sBi-1)/sizeBi
0122 sBi = 1 + MOD(sBi-1,sizeBi)
ed81d0a43c Jean*0123 #ifdef ALLOW_USE_MPI
0124 ELSEIF ( commSetting .EQ. 'M' ) THEN
0125 sLv = 2
0126 sBi = bi
0127 sBj = bj
0128 sNb = nN
0129 #endif /* ALLOW_USE_MPI */
0130 ELSE
0131 STOP 'EXCH2_AD_GET_RX1:: commSetting VALUE IS INVALID'
0132 ENDIF
0133
0134 iBufr = 0
0135 DO ktl=tKlo,tKhi,tKStride
0136 DO jtl=tJLo, tJHi, tjStride
0137 DO itl=tILo, tIHi, tiStride
0138 C Read from e2Bufr1_RX(iBufr,sNb,sBi,sBj,sLv)
0139 iBufr = iBufr+1
7c69cee546 Jean*0140 #ifdef W2_USE_E2_SAFEMODE
0141 iLoc = MIN( iBufr, e2BufrRecSize )
0142 #else
0143 iLoc = iBufr
0144 #endif
0145 e2Bufr1_RX(iLoc,sNb,sBi,sBj,sLv) = array(itl,jtl,ktl)
ed81d0a43c Jean*0146 array(itl,jtl,ktl) = 0.
0147 ENDDO
0148 ENDDO
0149 ENDDO
7c69cee546 Jean*0150 IF ( iBufr .GT. e2BufrRecSize ) THEN
0151 WRITE(msgBuf,'(2A,I9,A,I9)') 'EXCH2_AD_GET_RX1:',
0152 & ' iBufr =', iBufr, ' exceeds E2BUFR size=', e2BufrRecSize
0153 CALL PRINT_ERROR ( msgBuf, myThid )
0154 STOP 'ABNORMAL END: S/R EXCH2_AD_GET_RX1 (iBufr over limit)'
0155 ENDIF
ed81d0a43c Jean*0156
0157 RETURN
0158 END
0159
0160 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
0161
0162 CEH3 ;;; Local Variables: ***
0163 CEH3 ;;; mode:fortran ***
0164 CEH3 ;;; End: ***
