159599516SKenneth E. Jansenc 259599516SKenneth E. Jansenc-------------- 359599516SKenneth E. Jansenc drvAllreduce 459599516SKenneth E. Jansenc-------------- 559599516SKenneth E. Jansenc 659599516SKenneth E. Jansen subroutine drvAllreduce ( eachproc, result, m ) 759599516SKenneth E. Jansenc 859599516SKenneth E. Jansen include "common.h" 959599516SKenneth E. Jansen include "mpif.h" 1059599516SKenneth E. Jansenc 1159599516SKenneth E. Jansen dimension eachproc(m), result(m) 1259599516SKenneth E. Jansenc 1359599516SKenneth E. Jansen if (numpe > 1) then 1459599516SKenneth E. Jansen if(impistat.eq.1) then 1559599516SKenneth E. Jansen iAllR = iAllR+1 1659599516SKenneth E. Jansen elseif(impistat.eq.2) then 1759599516SKenneth E. Jansen iAllRScal = iAllRScal+1 1859599516SKenneth E. Jansen endif 1959599516SKenneth E. Jansen if(impistat2.eq.1) call MPI_BARRIER (MPI_COMM_WORLD, ierr) 2059599516SKenneth E. Jansen if(impistat.gt.0) rmpitmr = TMRC() 2159599516SKenneth E. Jansen call MPI_ALLREDUCE ( eachproc, result, m, 2259599516SKenneth E. Jansen & MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr ) 2359599516SKenneth E. Jansen if(impistat.eq.1) then 2459599516SKenneth E. Jansen rAllR = rAllR+TMRC()-rmpitmr 2559599516SKenneth E. Jansen elseif(impistat.eq.2) then 2659599516SKenneth E. Jansen rAllRScal = rAllRScal+TMRC()-rmpitmr 2759599516SKenneth E. Jansen endif 2859599516SKenneth E. Jansen else 2959599516SKenneth E. Jansen result = eachproc 3059599516SKenneth E. Jansen endif 3159599516SKenneth E. Jansenc 3259599516SKenneth E. Jansen return 3359599516SKenneth E. Jansen end 3459599516SKenneth E. Jansenc 3559599516SKenneth E. Jansenc------------------ 3659599516SKenneth E. Jansenc drvAllreducesclr 3759599516SKenneth E. Jansenc------------------ 3859599516SKenneth E. Jansenc 3959599516SKenneth E. Jansen subroutine drvAllreducesclr ( eachproc, result ) 4059599516SKenneth E. Jansenc 4159599516SKenneth E. Jansen include "common.h" 4259599516SKenneth E. Jansen include "mpif.h" 4359599516SKenneth E. Jansenc 4459599516SKenneth E. Jansen if (numpe > 1) then 4559599516SKenneth E. Jansen if(impistat.eq.1) then 4659599516SKenneth E. Jansen iAllR = iAllR+1 4759599516SKenneth E. Jansen elseif(impistat.eq.2) then 4859599516SKenneth E. Jansen iAllRScal = iAllRScal+1 4959599516SKenneth E. Jansen endif 5059599516SKenneth E. Jansen if(impistat2.eq.1) call MPI_BARRIER (MPI_COMM_WORLD, ierr) 5159599516SKenneth E. Jansen if(impistat.gt.0) rmpitmr = TMRC() 5259599516SKenneth E. Jansen call MPI_ALLREDUCE ( eachproc, result, 1, 5359599516SKenneth E. Jansen & MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr ) 5459599516SKenneth E. Jansen if(impistat.eq.1) then 5559599516SKenneth E. Jansen rAllR = rAllR+TMRC()-rmpitmr 5659599516SKenneth E. Jansen elseif(impistat.eq.2) then 5759599516SKenneth E. Jansen rAllRScal = rAllRScal+TMRC()-rmpitmr 5859599516SKenneth E. Jansen endif 5959599516SKenneth E. Jansen else 6059599516SKenneth E. Jansen result = eachproc 6159599516SKenneth E. Jansen endif 6259599516SKenneth E. Jansenc 6359599516SKenneth E. Jansen return 6459599516SKenneth E. Jansen end 65*df382577SCameron Smithc 66*df382577SCameron Smithc------------------ 67*df382577SCameron Smithc drvAllreduceMaxInt 68*df382577SCameron Smithc------------------ 69*df382577SCameron Smithc 70*df382577SCameron Smith subroutine drvAllreduceMaxInt ( eachproc, result ) 71*df382577SCameron Smithc 72*df382577SCameron Smith include "common.h" 73*df382577SCameron Smith include "mpif.h" 74*df382577SCameron Smithc 75*df382577SCameron Smith integer :: eachproc, result 76*df382577SCameron Smith 77*df382577SCameron Smith if (numpe > 1) then 78*df382577SCameron Smith if(impistat.eq.1) then 79*df382577SCameron Smith iAllR = iAllR+1 80*df382577SCameron Smith elseif(impistat.eq.2) then 81*df382577SCameron Smith iAllRScal = iAllRScal+1 82*df382577SCameron Smith endif 83*df382577SCameron Smith if(impistat2.eq.1) call MPI_BARRIER (MPI_COMM_WORLD, ierr) 84*df382577SCameron Smith if(impistat.gt.0) rmpitmr = TMRC() 85*df382577SCameron Smith call MPI_ALLREDUCE ( eachproc, result, 1, 86*df382577SCameron Smith & MPI_INTEGER, MPI_MAX, MPI_COMM_WORLD, ierr ) 87*df382577SCameron Smith if(impistat.eq.1) then 88*df382577SCameron Smith rAllR = rAllR+TMRC()-rmpitmr 89*df382577SCameron Smith elseif(impistat.eq.2) then 90*df382577SCameron Smith rAllRScal = rAllRScal+TMRC()-rmpitmr 91*df382577SCameron Smith endif 92*df382577SCameron Smith else 93*df382577SCameron Smith result = eachproc 94*df382577SCameron Smith endif 95*df382577SCameron Smithc 96*df382577SCameron Smith return 97*df382577SCameron Smith end 9859599516SKenneth E. Jansen 9959599516SKenneth E. Jansenc------------------------------------------------------------------------ 10059599516SKenneth E. Jansenc 10159599516SKenneth E. Jansenc sum real*8 array over all processors 10259599516SKenneth E. Jansenc 10359599516SKenneth E. Jansenc------------------------------------------------------------------------ 10459599516SKenneth E. Jansen subroutine sumgat (u, n, summed) 10559599516SKenneth E. Jansen 10659599516SKenneth E. Jansen include "common.h" 10759599516SKenneth E. Jansen include "mpif.h" 10859599516SKenneth E. Jansen include "auxmpi.h" 10959599516SKenneth E. Jansen 11059599516SKenneth E. Jansen dimension u(nshg,n), ilwork(nlwork) 11159599516SKenneth E. Jansen!SCATTER dimension sumvec(numpe), irecvcount(numpe) 11259599516SKenneth E. Jansen 11359599516SKenneth E. Jansen summed = sum(u) 11459599516SKenneth E. Jansen 11559599516SKenneth E. Jansen if (numpe > 1) then 11659599516SKenneth E. Jansen irecvcount = 1 11759599516SKenneth E. Jansen sumvec = summed 11859599516SKenneth E. Jansen if(impistat.eq.1) then 11959599516SKenneth E. Jansen iAllR = iAllR+1 12059599516SKenneth E. Jansen elseif(impistat.eq.2) then 12159599516SKenneth E. Jansen iAllRScal = iAllRScal+1 12259599516SKenneth E. Jansen endif 12359599516SKenneth E. Jansen if(impistat2.eq.1) call MPI_BARRIER (MPI_COMM_WORLD, ierr) 12459599516SKenneth E. Jansen if(impistat.gt.0) rmpitmr = TMRC() 12559599516SKenneth E. Jansen call MPI_ALLREDUCE (sumvec, summed, irecvcount, 12659599516SKenneth E. Jansen & MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr) 12759599516SKenneth E. Jansen if(impistat.eq.1) then 12859599516SKenneth E. Jansen rAllR = rAllR+TMRC()-rmpitmr 12959599516SKenneth E. Jansen elseif(impistat.eq.2) then 13059599516SKenneth E. Jansen rAllRScal = rAllRScal+TMRC()-rmpitmr 13159599516SKenneth E. Jansen endif 13259599516SKenneth E. Jansenc call MPI_REDUCE_SCATTER (sumvec, summed, irecvcount, 13359599516SKenneth E. Jansenc & MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr) 13459599516SKenneth E. Jansen 13559599516SKenneth E. Jansen endif 13659599516SKenneth E. Jansen 13759599516SKenneth E. Jansen return 13859599516SKenneth E. Jansen end 13959599516SKenneth E. Jansen 14059599516SKenneth E. Jansenc------------------------------------------------------------------------ 14159599516SKenneth E. Jansenc 14259599516SKenneth E. Jansenc sum real*8 array of length nnp over all processors 14359599516SKenneth E. Jansenc 14459599516SKenneth E. Jansenc------------------------------------------------------------------------ 14559599516SKenneth E. Jansen subroutine sumgatN (u, n, summed, nnp) 14659599516SKenneth E. Jansen 14759599516SKenneth E. Jansen include "common.h" 14859599516SKenneth E. Jansen include "mpif.h" 14959599516SKenneth E. Jansen include "auxmpi.h" 15059599516SKenneth E. Jansen 15159599516SKenneth E. Jansen dimension u(nnp,n), ilwork(nlwork) 15259599516SKenneth E. Jansen! dimension sumvec(numpe), irecvcount(numpe) 15359599516SKenneth E. Jansen 15459599516SKenneth E. Jansenc protect against underflow 15559599516SKenneth E. Jansenc summed = sum(u) 15659599516SKenneth E. Jansen summed = sum(u) + 1.e-20 15759599516SKenneth E. Jansen 15859599516SKenneth E. Jansen if (numpe > 1) then 15959599516SKenneth E. Jansen irecvcount = 1 16059599516SKenneth E. Jansen sumvec = summed 16159599516SKenneth E. Jansen 16259599516SKenneth E. Jansen if(impistat.eq.1) then 16359599516SKenneth E. Jansen iAllR = iAllR+1 16459599516SKenneth E. Jansen elseif(impistat.eq.2) then 16559599516SKenneth E. Jansen iAllRScal = iAllRScal+1 16659599516SKenneth E. Jansen endif 16759599516SKenneth E. Jansen if(impistat2.eq.1) call MPI_BARRIER (MPI_COMM_WORLD, ierr) 16859599516SKenneth E. Jansen if(impistat.gt.0) rmpitmr = TMRC() 16959599516SKenneth E. Jansen call MPI_ALLREDUCE (sumvec, summed, irecvcount, 17059599516SKenneth E. Jansen & MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr) 17159599516SKenneth E. Jansen if(impistat.eq.1) then 17259599516SKenneth E. Jansen rAllR = rAllR+TMRC()-rmpitmr 17359599516SKenneth E. Jansen elseif(impistat.eq.2) then 17459599516SKenneth E. Jansen rAllRScal = rAllRScal+TMRC()-rmpitmr 17559599516SKenneth E. Jansen endif 17659599516SKenneth E. Jansenc call MPI_REDUCE_SCATTER (sumvec, summed, irecvcount, 17759599516SKenneth E. Jansenc & MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr) 17859599516SKenneth E. Jansen 17959599516SKenneth E. Jansen endif 18059599516SKenneth E. Jansen 18159599516SKenneth E. Jansen return 18259599516SKenneth E. Jansen end 18359599516SKenneth E. Jansen 18459599516SKenneth E. Jansenc------------------------------------------------------------------------ 18559599516SKenneth E. Jansenc 18659599516SKenneth E. Jansenc sum integer array over all processors 18759599516SKenneth E. Jansenc 18859599516SKenneth E. Jansenc------------------------------------------------------------------------ 18959599516SKenneth E. Jansen subroutine sumgatInt (u, n, summed ) 19059599516SKenneth E. Jansen 19159599516SKenneth E. Jansen include "common.h" 19259599516SKenneth E. Jansen include "mpif.h" 19359599516SKenneth E. Jansen include "auxmpi.h" 19459599516SKenneth E. Jansen 19559599516SKenneth E. Jansen integer u(n), summed, sumvec 19659599516SKenneth E. Jansen!SCATTER integer sumvec(numpe), irecvcount(numpe) 19759599516SKenneth E. Jansen 19859599516SKenneth E. Jansenc$$$ ttim(62) = ttim(62) - tmr() 19959599516SKenneth E. Jansen 20059599516SKenneth E. Jansen summed = sum(u) 20159599516SKenneth E. Jansen 20259599516SKenneth E. Jansen if (numpe > 1) then 20359599516SKenneth E. Jansen irecvcount = 1 20459599516SKenneth E. Jansen sumvec = summed 20559599516SKenneth E. Jansen if(impistat.eq.1) then 20659599516SKenneth E. Jansen iAllR = iAllR+1 20759599516SKenneth E. Jansen elseif(impistat.eq.2) then 20859599516SKenneth E. Jansen iAllRScal = iAllRScal+1 20959599516SKenneth E. Jansen endif 21059599516SKenneth E. Jansen if(impistat2.eq.1) call MPI_BARRIER (MPI_COMM_WORLD, ierr) 21159599516SKenneth E. Jansen if(impistat.gt.0) rmpitmr = TMRC() 21259599516SKenneth E. Jansen call MPI_ALLREDUCE (sumvec, summed, irecvcount, 21359599516SKenneth E. Jansen & MPI_INTEGER, MPI_SUM, MPI_COMM_WORLD, ierr) 21459599516SKenneth E. Jansen if(impistat.eq.1) then 21559599516SKenneth E. Jansen rAllR = rAllR+TMRC()-rmpitmr 21659599516SKenneth E. Jansen elseif(impistat.eq.2) then 21759599516SKenneth E. Jansen rAllRScal = rAllRScal+TMRC()-rmpitmr 21859599516SKenneth E. Jansen endif 21959599516SKenneth E. Jansenc call MPI_REDUCE_SCATTER (sumvec, summed, irecvcount, 22059599516SKenneth E. Jansenc & MPI_INTEGER, MPI_SUM, MPI_COMM_WORLD, ierr) 22159599516SKenneth E. Jansen 22259599516SKenneth E. Jansen endif 22359599516SKenneth E. Jansenc$$$ ttim(62) = ttim(62) + tmr() 22459599516SKenneth E. Jansen 22559599516SKenneth E. Jansen return 22659599516SKenneth E. Jansen end 22759599516SKenneth E. Jansen 228