File indexing completed on 2020-01-15 06:10:56 UTC
view on githubraw file Latest commit 15f808dc on 2019-09-13 16:02:45 UTC
ad773b031f Oliv*0001 #include "PACKAGES_CONFIG.h"
0002 #include "CPP_EEOPTIONS.h"
0003 #undef DBUG_EXCH_VEC
0004
0005
bd11294ab6 Jean*0006
ad773b031f Oliv*0007
0008
0009
bd11294ab6 Jean*0010
ad773b031f Oliv*0011
0012
bd11294ab6 Jean*0013 SUBROUTINE EXCH2_RECV_GET_VEC_RL(
ad773b031f Oliv*0014 U array,
bd11294ab6 Jean*0015 I theHandle,
ad773b031f Oliv*0016 I myd1, myThid )
0017
0018
bd11294ab6 Jean*0019
0020
ad773b031f Oliv*0021
0022
0023
0024
0025
0026
0027 IMPLICIT NONE
0028
0029
0030 #include "SIZE.h"
0031 #include "EEPARAMS.h"
0032 #include "EESUPPORT.h"
0033 #ifdef ALLOW_EXCH2
0034 #include "W2_EXCH2_SIZE.h"
0035 #include "W2_EXCH2_TOPOLOGY.h"
0036 #endif
15f808dcb0 gael*0037 #include "FLT_SIZE.h"
ad773b031f Oliv*0038
0039
0040
0041
0042
0043
0044 INTEGER myd1
0045 _RL array(myd1, nSx, nSy, 4)
bd11294ab6 Jean*0046 #ifdef ALLOW_EXCH2
0047 INTEGER theHandle(2,W2_maxNeighbours,nSx,nSy)
0048 #else
0049 INTEGER theHandle
0050 #endif
ad773b031f Oliv*0051 INTEGER myThid
0052
0053
0054 #ifdef ALLOW_EXCH2
bd11294ab6 Jean*0055 #ifdef ALLOW_USE_MPI
ad773b031f Oliv*0056
0057
0058
0059
0060
0061
0062 INTEGER bi, bj
0063 INTEGER ioUnit
0064 INTEGER thisTile, nN, tgT, oNb, dir
0065 INTEGER theProc, theTag, theType, theSize
bd11294ab6 Jean*0066 INTEGER wHandle
ad773b031f Oliv*0067 INTEGER mpiStatus(MPI_STATUS_SIZE,4), mpiRc
f5995a4aae Gael*0068 INTEGER imax, imax2
0069 PARAMETER(imax=9)
0070 PARAMETER(imax2=imax*max_npart_exch)
0071 INTEGER pi(2), pj(2), oi, oj, ip, itb, jtb, isb, jsb
0072 _RL itc,jtc, itmp, jtmp
ad773b031f Oliv*0073
0074
0075
0076
0077
0078
0079
0080
0081
0082
0083
0084 ioUnit = errorMessageUnit
0085
bd11294ab6 Jean*0086 _BEGIN_MASTER(myThid)
ad773b031f Oliv*0087
bd11294ab6 Jean*0088 DO bj=1,nSy
0089 DO bi=1,nSx
0090 thisTile = W2_myTileList(bi,bj)
ad773b031f Oliv*0091
0092
bd11294ab6 Jean*0093 DO nN=1,exch2_nNeighbours(thisTile)
ad773b031f Oliv*0094
bd11294ab6 Jean*0095 tgT = exch2_neighbourId(nN, thisTile )
0096 oNb = exch2_opposingSend(nN, thisTile )
0097 dir = exch2_neighbourDir(nN,thisTile)
ad773b031f Oliv*0098
0099 #ifdef DBUG_EXCH_VEC
bd11294ab6 Jean*0100 write(ioUnit,'(A,5I6)') 'RECV,0 :',myProcId,bi,bj
ad773b031f Oliv*0101 #endif
bd11294ab6 Jean*0102 IF ( W2_myCommFlag(nN,bi,bj) .EQ. 'M' ) THEN
0103 theProc = W2_tileProc(tgT) - 1
0104 theTag = (tgT-1)*W2_maxNeighbours + oNb
0105 theSize = myd1
0106 theType = _MPI_TYPE_RL
ad773b031f Oliv*0107 #ifdef DBUG_EXCH_VEC
bd11294ab6 Jean*0108 write(ioUnit,'(A,5I5,I8)') 'qq2xW: ',myProcId,bi,bj,
0109 & theProc,theTag,theSize
ad773b031f Oliv*0110 #endif
bd11294ab6 Jean*0111 CALL MPI_Recv( array(1,bi,bj,dir), theSize, theType,
0112 & theProc, theTag, MPI_COMM_MODEL,
0113 & mpiStatus, mpiRc )
f5995a4aae Gael*0114
0115
0116 itb = exch2_tBasex(tgT)
0117 jtb = exch2_tBasey(tgT)
0118 isb = exch2_tBasex(thisTile)
0119 jsb = exch2_tBasey(thisTile)
0120 pi(1)=exch2_pij(1,nN,thisTile)
0121 pi(2)=exch2_pij(2,nN,thisTile)
0122 pj(1)=exch2_pij(3,nN,thisTile)
0123 pj(2)=exch2_pij(4,nN,thisTile)
0124 oi = exch2_oi(nN,thisTile)
0125 oj = exch2_oj(nN,thisTile)
0126
0127 #ifdef DBUG_EXCH_VEC
0128 DO ip=1,max_npart_exch
0129 IF (array(imax*(ip-1)+1,bi,bj,dir).NE.0.) THEN
0130 itc=array(imax*(ip-1)+3,bi,bj,dir)+itb
0131 jtc=array(imax*(ip-1)+4,bi,bj,dir)+jtb
0132 itmp = pi(1)*itc+pi(2)*jtc+oi-isb
0133 jtmp = pj(1)*itc+pj(2)*jtc+oj-jsb
0134 write(ioUnit,'(A,3I6)') 'LOC,1 :',thisTile,tgT,dir
0135 write(ioUnit,'(A,8F10.3)') 'LOC,2 :',
0136 & array(imax*(ip-1)+1,bi,bj,dir),
0137 & array(imax*(ip-1)+2,bi,bj,dir),
0138 & array(imax*(ip-1)+3,bi,bj,dir),
0139 & array(imax*(ip-1)+4,bi,bj,dir),
0140 & itc,jtc,itmp,jtmp
0141 ENDIF
0142 ENDDO
0143 #endif
0144
0145 DO ip=1,max_npart_exch
0146 IF (array(imax*(ip-1)+1,bi,bj,dir).NE.0.) THEN
0147 itc=array(imax*(ip-1)+3,bi,bj,dir)+itb
0148 jtc=array(imax*(ip-1)+4,bi,bj,dir)+jtb
0149 array(imax*(ip-1)+3,bi,bj,dir) = pi(1)*itc+pi(2)*jtc+oi-isb
0150 array(imax*(ip-1)+4,bi,bj,dir) = pj(1)*itc+pj(2)*jtc+oj-jsb
0151 ENDIF
0152 ENDDO
0153
bd11294ab6 Jean*0154 ENDIF
ad773b031f Oliv*0155 #ifdef DBUG_EXCH_VEC
bd11294ab6 Jean*0156 write(ioUnit,'(A,5I6)') 'RECV,1 :',myProcId,bi,bj
ad773b031f Oliv*0157 #endif
bd11294ab6 Jean*0158
0159 ENDDO
0160
ad773b031f Oliv*0161 ENDDO
0162 ENDDO
0163 #ifdef DBUG_EXCH_VEC
bd11294ab6 Jean*0164 write(ioUnit,'(A,5I6,I12)') 'RECV:',myProcId
ad773b031f Oliv*0165 #endif
0166
bd11294ab6 Jean*0167
0168 DO bj=1,nSy
0169 DO bi=1,nSx
0170 thisTile = W2_myTileList(bi,bj)
0171 DO nN=1,exch2_nNeighbours(thisTile)
0172
0173
0174
0175
0176
0177
0178
0179
0180 IF ( W2_myCommFlag(nN,bi,bj) .EQ. 'M' ) THEN
0181 wHandle = theHandle(1,nN,bi,bj)
0182 CALL MPI_Wait( wHandle, mpiStatus, mpiRc )
0183 ENDIF
0184
0185 ENDDO
0186 ENDDO
0187 ENDDO
0188
0189 _END_MASTER(myThid)
0190
0191
0192 _BARRIER
0193
0194 #endif /* ALLOW_USE_MPI */
ad773b031f Oliv*0195 #endif /* ALLOW_EXCH2 */
0196
0197 RETURN
0198 END