File indexing completed on 2024-08-29 05:10:34 UTC
view on githubraw file Latest commit 5237154b on 2024-08-28 14:56:27 UTC
5237154b93 Jean*0001 #include "CPP_EEOPTIONS.h"
0002
0003
0004
0005
0006
0007
0008
0009
0010
0011
0012
0013
0014
0015
0016
0017
0018 SUBROUTINE GLB_SUM_VEC(
0019 I nVec, tiledVec,
0020 O sumVec,
0021 I myThid )
0022
0023
0024
0025
0026
0027
0028
0029
0030
0031
0032
0033 IMPLICIT NONE
0034
0035
0036 #include "SIZE.h"
0037 #include "EEPARAMS.h"
0038 #include "EESUPPORT.h"
0039
0040
0041
0042
0043
0044
0045 INTEGER nVec
0046 Real*8 tiledVec(nSx,nSy,nVec)
0047 Real*8 sumVec(nVec)
0048 INTEGER myThid
0049
0050
0051
0052
0053
0054
0055
0056 INTEGER n, bi, bj
0057 #ifdef ALLOW_USE_MPI
0058 INTEGER mpiRC
0059 # ifdef GLOBAL_SUM_ORDER_TILES
0060 INTEGER biG, bjG, fullLength
0061 Real*8 localSum (nSx*nPx,nSy*nPy,GSVec_size)
0062 Real*8 globalSum(nSx*nPx,nSy*nPy,GSVec_size)
0063 # endif /* GLOBAL_SUM_ORDER_TILES */
0064 #endif /* ALLOW_USE_MPI */
0065 Real*8 sumMyPr(GSVec_size)
0066 CHARACTER*(MAX_LEN_MBUF) msgBuf
0067
0068
0069 IF ( nVec.GT.GSVec_size ) THEN
0070 WRITE(msgBuf,'(A,2(A,I7))') 'GLB_SUM_VEC: ',
0071 & 'nVec=', nVec, ' > GSVec_size=', GSVec_size
0072 CALL PRINT_ERROR( msgBuf, myThid )
0073 WRITE(msgBuf,'(2A)') 'GLB_SUM_VEC: ',
0074 & 'increase "GSVec_size" in EEPARAMS.h and recompile'
0075 CALL PRINT_ERROR( msgBuf, myThid )
0076 STOP 'ABNORMAL END: S/R GLB_SUM_VEC'
0077 ENDIF
0078
0079 _BEGIN_MASTER( myThid )
0080
0081 #if ( defined GLOBAL_SUM_ORDER_TILES && defined ALLOW_USE_MPI )
0082 IF ( usingMPI ) THEN
0083
0084
0085 DO n = 1,nVec
0086 DO bjG=1,nSy*nPy
0087 DO biG=1,nSx*nPx
0088 localSum(biG,bjG,n) = 0.
0089 ENDDO
0090 ENDDO
0091 ENDDO
0092
0093
0094 DO bj=1,nSy
0095 bjG = (myYGlobalLo-1)/sNy+bj
0096 DO bi=1,nSx
0097 biG = (myXGlobalLo-1)/sNx+bi
0098 DO n = 1,nVec
0099 localSum(biG,bjG,n) = tiledVec(bi,bj,n)
0100 ENDDO
0101 ENDDO
0102 ENDDO
0103
0104
0105 fullLength = nSx*nPx*nSy*nPy*nVec
0106 CALL MPI_Allreduce( localSum, globalSum, fullLength,
0107 & MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_MODEL, mpiRC )
0108
0109
0110 DO n = 1,nVec
0111 sumVec(n) = 0.
0112 ENDDO
0113 DO bjG = 1,nSy*nPy
0114 DO biG = 1,nSx*nPx
0115 DO n = 1,nVec
0116 sumVec(n) = sumVec(n) + globalSum(biG,bjG,n)
0117 ENDDO
0118 ENDDO
0119 ENDDO
0120
0121 ELSE
0122 #else /* not (GLOBAL_SUM_ORDER_TILES & ALLOW_USE_MPI) */
0123 IF ( .TRUE. ) THEN
0124 #endif /* not (GLOBAL_SUM_ORDER_TILES & ALLOW_USE_MPI) */
0125
0126
0127 DO n = 1,nVec
0128 sumMyPr(n) = 0.
0129 ENDDO
0130 DO bj = 1,nSy
0131 DO bi = 1,nSx
0132 DO n = 1,nVec
0133 sumMyPr(n) = sumMyPr(n) + tiledVec(bi,bj,n)
0134 ENDDO
0135 ENDDO
0136 ENDDO
0137
0138 #ifdef ALLOW_USE_MPI
0139 IF ( usingMPI ) THEN
0140
0141 CALL MPI_Allreduce( sumMyPr, sumVec, nVec,
0142 & MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_MODEL, mpiRC )
0143 ELSE
0144 #else /* ALLOW_USE_MPI */
0145 IF ( .TRUE. ) THEN
0146 #endif /* ALLOW_USE_MPI */
0147
0148 DO n = 1,nVec
0149 sumVec(n) = sumMyPr(n)
0150 ENDDO
0151 ENDIF
0152
0153 ENDIF
0154
0155 _END_MASTER( myThid )
0156
0157 RETURN
0158 END
0159
0160
0161
0162
0163
0164
0165 SUBROUTINE GLOBAL_SUM_VECTOR_RL(
0166 I nVec, tiledVec,
0167 O sumVec,
0168 I myThid )
0169
0170
0171
0172
0173
0174
0175
0176
0177
0178
0179
0180
0181
0182 IMPLICIT NONE
0183
0184
0185 #include "SIZE.h"
0186 #include "EEPARAMS.h"
0187 #include "GLOBAL_SUM.h"
0188
0189
0190
0191
0192
0193
0194 INTEGER nVec
0195 _RL tiledVec(nSx,nSy,nVec)
0196 _RL sumVec(nVec)
0197 INTEGER myThid
0198
0199
0200
0201
0202
0203
0204 INTEGER bi, bj
0205 INTEGER n, nCuts
0206 INTEGER j, j0, nLoc
0207
0208
0209
0210 nCuts = 1 + INT( (nVec-1)/GSVec_size )
0211 DO n = 1,nCuts
0212 j0 = (n-1)*GSVec_size
0213 nLoc = MIN( n*GSVec_size, nVec ) - j0
0214
0215
0216 DO j = 1,nLoc
0217 DO bj = myByLo(myThid), myByHi(myThid)
0218 DO bi = myBxLo(myThid), myBxHi(myThid)
0219 shareBufGSVec(bi,bj,j) = tiledVec(bi,bj,j+j0)
0220 ENDDO
0221 ENDDO
0222 ENDDO
0223
0224
0225 CALL BAR2( myThid )
0226 _BEGIN_MASTER( myThid )
0227
0228
0229 CALL GLB_SUM_VEC(
0230 I nLoc, shareBufGSVec,
0231 O shareGSVector,
0232 I myThid )
0233
0234 _END_MASTER( myThid )
0235
0236 CALL BAR2( myThid )
0237
0238
0239 DO j=1,nLoc
0240 sumVec(j+j0) = shareGSVector(j)
0241 ENDDO
0242
0243
0244 ENDDO
0245
0246 RETURN
0247 END
0248
0249
0250
0251
0252
0253
0254 SUBROUTINE GLOBAL_SUM_VECTOR_RS(
0255 I nVec, tiledVec,
0256 O sumVec,
0257 I myThid )
0258
0259
0260
0261
0262
0263
0264
0265
0266
0267
0268
0269
0270
0271 IMPLICIT NONE
0272
0273
0274 #include "SIZE.h"
0275 #include "EEPARAMS.h"
0276 #include "GLOBAL_SUM.h"
0277
0278
0279
0280
0281
0282
0283 INTEGER nVec
0284 _RS tiledVec(nSx,nSy,nVec)
0285 _RS sumVec(nVec)
0286 INTEGER myThid
0287
0288
0289
0290
0291
0292
0293 INTEGER bi, bj
0294 INTEGER n, nCuts
0295 INTEGER j, j0, nLoc
0296
0297
0298
0299 nCuts = 1 + INT( (nVec-1)/GSVec_size )
0300 DO n = 1,nCuts
0301 j0 = (n-1)*GSVec_size
0302 nLoc = MIN( n*GSVec_size, nVec ) - j0
0303
0304
0305 DO j = 1,nLoc
0306 DO bj = myByLo(myThid), myByHi(myThid)
0307 DO bi = myBxLo(myThid), myBxHi(myThid)
0308 shareBufGSVec(bi,bj,j) = tiledVec(bi,bj,j+j0)
0309 ENDDO
0310 ENDDO
0311 ENDDO
0312
0313
0314 CALL BAR2( myThid )
0315 _BEGIN_MASTER( myThid )
0316
0317
0318 CALL GLB_SUM_VEC(
0319 I nLoc, shareBufGSVec,
0320 O shareGSVector,
0321 I myThid )
0322
0323 _END_MASTER( myThid )
0324
0325 CALL BAR2( myThid )
0326
0327
0328 DO j=1,nLoc
0329 sumVec(j+j0) = shareGSVector(j)
0330 ENDDO
0331
0332
0333 ENDDO
0334
0335 RETURN
0336 END
0337
0338
0339
0340
0341
0342
0343 SUBROUTINE GLOBAL_SUM_VEC_ALT_RL(
0344 I nDim, nVec, vecTile,
0345 O vecSum,
0346 I myThid )
0347
0348
0349
0350
0351
0352
0353
0354
0355
0356
0357
0358
0359
0360 IMPLICIT NONE
0361
0362
0363 #include "SIZE.h"
0364 #include "EEPARAMS.h"
0365 #include "GLOBAL_SUM.h"
0366
0367
0368
0369
0370
0371
0372
0373 INTEGER nDim, nVec
0374 _RL vecTile(nDim,nSx,nSy)
0375 _RL vecSum(nVec)
0376 INTEGER myThid
0377
0378
0379
0380
0381
0382
0383
0384 INTEGER bi, bj
0385 INTEGER n, nCuts
0386 INTEGER j, j0, nLoc
0387 CHARACTER*(MAX_LEN_MBUF) msgBuf
0388
0389
0390 IF ( nVec.GT.nDim ) THEN
0391 WRITE(msgBuf,'(A,2(A,I7))') 'GLOBAL_SUM_VEC_ALT_RL: ',
0392 & 'nVec=', nVec, ' > nDim =', nDim
0393 CALL PRINT_ERROR( msgBuf, myThid )
0394 STOP 'ABNORMAL END: S/R GLOBAL_SUM_VEC_ALT_RL'
0395 ENDIF
0396
0397
0398 nCuts = 1 + INT( (nVec-1)/GSVec_size )
0399 DO n = 1,nCuts
0400 j0 = (n-1)*GSVec_size
0401 nLoc = MIN( n*GSVec_size, nVec ) - j0
0402
0403
0404 DO j = 1,nLoc
0405 DO bj = myByLo(myThid), myByHi(myThid)
0406 DO bi = myBxLo(myThid), myBxHi(myThid)
0407 shareBufGSVec(bi,bj,j) = vecTile(j+j0,bi,bj)
0408 ENDDO
0409 ENDDO
0410 ENDDO
0411
0412
0413 CALL BAR2( myThid )
0414 _BEGIN_MASTER( myThid )
0415
0416
0417 CALL GLB_SUM_VEC(
0418 I nLoc, shareBufGSVec,
0419 O shareGSVector,
0420 I myThid )
0421
0422 _END_MASTER( myThid )
0423
0424 CALL BAR2( myThid )
0425
0426
0427 DO j=1,nLoc
0428 vecSum(j+j0) = shareGSVector(j)
0429 ENDDO
0430
0431
0432 ENDDO
0433
0434 RETURN
0435 END
0436
0437
0438
0439
0440
0441
0442 SUBROUTINE GLOBAL_SUM_VEC_ALT_RS(
0443 I nDim, nVec, vecTile,
0444 O vecSum,
0445 I myThid )
0446
0447
0448
0449
0450
0451
0452
0453
0454
0455
0456
0457
0458
0459 IMPLICIT NONE
0460
0461
0462 #include "SIZE.h"
0463 #include "EEPARAMS.h"
0464 #include "GLOBAL_SUM.h"
0465
0466
0467
0468
0469
0470
0471
0472 INTEGER nDim, nVec
0473 _RS vecTile(nDim,nSx,nSy)
0474 _RS vecSum(nVec)
0475 INTEGER myThid
0476
0477
0478
0479
0480
0481
0482
0483 INTEGER bi, bj
0484 INTEGER n, nCuts
0485 INTEGER j, j0, nLoc
0486 CHARACTER*(MAX_LEN_MBUF) msgBuf
0487
0488
0489 IF ( nVec.GT.nDim ) THEN
0490 WRITE(msgBuf,'(A,2(A,I7))') 'GLOBAL_SUM_VEC_ALT_RS: ',
0491 & 'nVec=', nVec, ' > nDim =', nDim
0492 CALL PRINT_ERROR( msgBuf, myThid )
0493 STOP 'ABNORMAL END: S/R GLOBAL_SUM_VEC_ALT_RS'
0494 ENDIF
0495
0496
0497 nCuts = 1 + INT( (nVec-1)/GSVec_size )
0498 DO n = 1,nCuts
0499 j0 = (n-1)*GSVec_size
0500 nLoc = MIN( n*GSVec_size, nVec ) - j0
0501
0502
0503 DO j = 1,nLoc
0504 DO bj = myByLo(myThid), myByHi(myThid)
0505 DO bi = myBxLo(myThid), myBxHi(myThid)
0506 shareBufGSVec(bi,bj,j) = vecTile(j+j0,bi,bj)
0507 ENDDO
0508 ENDDO
0509 ENDDO
0510
0511
0512 CALL BAR2( myThid )
0513 _BEGIN_MASTER( myThid )
0514
0515
0516 CALL GLB_SUM_VEC(
0517 I nLoc, shareBufGSVec,
0518 O shareGSVector,
0519 I myThid )
0520
0521 _END_MASTER( myThid )
0522
0523 CALL BAR2( myThid )
0524
0525
0526 DO j=1,nLoc
0527 vecSum(j+j0) = shareGSVector(j)
0528 ENDDO
0529
0530
0531 ENDDO
0532
0533 RETURN
0534 END
0535
0536
0537
0538
0539
0540
0541 SUBROUTINE GLOBAL_SUM_VECTOR_INT(
0542 I nVec, tiledVec,
0543 O sumVec,
0544 I myThid )
0545
0546
0547
0548
0549
0550
0551
0552
0553
0554
0555
0556
0557
0558 IMPLICIT NONE
0559
0560
0561 #include "SIZE.h"
0562 #include "EEPARAMS.h"
0563 #include "EESUPPORT.h"
0564 #include "GLOBAL_SUM.h"
0565
0566
0567
0568
0569
0570
0571 INTEGER nVec
0572 INTEGER tiledVec(nSx,nSy,nVec)
0573 INTEGER sumVec(nVec)
0574 INTEGER myThid
0575
0576
0577
0578
0579
0580
0581
0582 INTEGER bi, bj
0583 INTEGER n, nCuts
0584 INTEGER j, j0, nLoc
0585 INTEGER sumMyPr(GSVec_size)
0586
0587
0588 #ifdef ALLOW_USE_MPI
0589 INTEGER mpiRC
0590 #endif /* ALLOW_USE_MPI */
0591
0592
0593
0594 nCuts = 1 + INT( (nVec-1)/GSVec_size )
0595 DO n = 1,nCuts
0596 j0 = (n-1)*GSVec_size
0597 nLoc = MIN( n*GSVec_size, nVec ) - j0
0598
0599
0600 DO j = 1,nLoc
0601 DO bj = myByLo(myThid), myByHi(myThid)
0602 DO bi = myBxLo(myThid), myBxHi(myThid)
0603 shareBufGSVecI(bi,bj,j) = tiledVec(bi,bj,j+j0)
0604 ENDDO
0605 ENDDO
0606 ENDDO
0607
0608
0609 CALL BAR2( myThid )
0610 _BEGIN_MASTER( myThid )
0611
0612
0613 DO j = 1,nLoc
0614 sumMyPr(n) = 0
0615 ENDDO
0616 DO bj = 1,nSy
0617 DO bi = 1,nSx
0618 DO j = 1,nLoc
0619 sumMyPr(j) = sumMyPr(j) + shareBufGSVecI(bi,bj,j)
0620 ENDDO
0621 ENDDO
0622 ENDDO
0623
0624 #ifdef ALLOW_USE_MPI
0625 IF ( usingMPI ) THEN
0626
0627 CALL MPI_Allreduce( sumMyPr, shareGSVectInt, nLoc,
0628 & MPI_INTEGER, MPI_SUM, MPI_COMM_MODEL, mpiRC )
0629 ELSE
0630 #else /* ALLOW_USE_MPI */
0631 IF ( .TRUE. ) THEN
0632 #endif /* ALLOW_USE_MPI */
0633
0634 DO j = 1,nLoc
0635 shareGSVectInt(j) = sumMyPr(j)
0636 ENDDO
0637 ENDIF
0638
0639 _END_MASTER( myThid )
0640
0641
0642 CALL BAR2( myThid )
0643
0644
0645 DO j = 1,nLoc
0646 sumVec(j+j0) = shareGSVectInt(j)
0647 ENDDO
0648
0649
0650 ENDDO
0651
0652 RETURN
0653 END