| |
| |
| subroutine copypriv(ithRun, srFlag, nescgp, enesc, wcut, |
| & wmin, wmax, wlost, wesc, wrr, wabs, wcen, epgain, etot, |
| & npart, nphtot, nploss, nlost, nesc, nrr, nabs, ncen, |
| & nscat, nsplt, ntrac, |
| & g_etot, g_epgain, g_wlost, g_wesc, g_wrr, g_wabs, |
| & g_wcen, g_enesc, ng_npart, ng_nphtot, ng_nploss, |
| & ng_nlost, ng_nesc, ng_nrr, ng_nabs, ng_ncen, ng_nscat, |
| & ng_nsplt, ng_ntrac, ng_nescgp, ibuf, jbuf, rbuf, sbuf, |
| & lescbuf, nescbuf, lenbuf, enbuf ) |
| |
| |
| include 'params.inc' |
| include 'globals.inc' |
| c include 'shared.inc' |
| include 'geomz.inc' |
| include 'times.inc' |
| include 'mpif.h' |
| |
| INTEGER ithRun |
| LOGICAL srFlag |
| INTEGER*4 nescgp(negrps) |
| real*8 enesc(negrps) |
| real*8 wcut, wmin, wmax |
| real*8 wlost, wesc, wrr |
| real*8 wabs, wcen, epgain, etot |
| integer*4 npart, nphtot, nploss |
| integer*4 nlost, nesc, nrr, nabs, ncen |
| integer*4 nscat, nsplt, ntrac |
| |
| real*8 g_etot(maxruns) |
| real*8 g_epgain(maxruns) |
| real*8 g_wlost(maxruns) |
| real*8 g_wesc(maxruns) |
| real*8 g_wrr(maxruns) |
| real*8 g_wabs(maxruns) |
| real*8 g_wcen(maxruns) |
| real*8 g_enesc (maxruns,negrps) |
| |
| integer*4 ng_npart(maxruns) |
| integer*4 ng_nphtot(maxruns) |
| integer*4 ng_nploss(maxruns) |
| integer*4 ng_nlost(maxruns) |
| integer*4 ng_nesc(maxruns) |
| integer*4 ng_nrr(maxruns) |
| integer*4 ng_nabs(maxruns) |
| integer*4 ng_ncen(maxruns) |
| integer*4 ng_nscat(maxruns) |
| integer*4 ng_nsplt(maxruns) |
| integer*4 ng_ntrac(maxruns) |
| integer*4 ng_nescgp(maxruns,negrps) |
| |
| INTEGER OMP_GET_THREAD_NUM, OMP_GET_NUM_THREADS |
| EXTERNAL OMP_GET_NUM_THREADS, OMP_GET_THREAD_NUM |
| |
| INTEGER numThreads, ierr, MPIid, thrID, |
| & stat(MPI_STATUS_SIZE), |
| & req(maxMPItasks), |
| & statArray(MPI_STATUS_SIZE, maxMPItasks), |
| & ibuf(maxThreadsPerMPItask*11), |
| & jbuf(maxThreadsPerMPItask*11, maxMPItasks), |
| & lescbuf(maxThreadsPerMPItask*negrps), |
| & nescbuf(maxThreadsPerMPItask*negrps, maxMPItasks) |
| |
| REAL*8 rbuf(maxThreadsPerMPItask*7), |
| & sbuf(maxThreadsPerMPItask*7, maxMPItasks), |
| & lenbuf(maxThreadsPerMPItask*negrps), |
| & enbuf(maxThreadsPerMPItask*negrps, maxMPItasks) |
| |
| |
| c... Take all contributions to these global values and sum them onto the |
| c... MPI task 0 |
| |
| CALL MPI_COMM_RANK( MPI_COMM_WORLD, MPIid, ierr ) |
| CALL MPI_COMM_SIZE( MPI_COMM_WORLD, numMPItasks, ierr ) |
| |
| numThreads = OMP_GET_NUM_THREADS() |
| thrID = OMP_GET_THREAD_NUM() |
| |
| c... Just set the global arrays if I'm the master node |
| |
| if( MPIid .eq. 0 )then |
| |
| k = ithRun |
| |
| ng_npart(k) = npart |
| ng_nphtot(k) = nphtot |
| ng_nploss(k) = nploss |
| ng_nlost(k) = nlost |
| ng_nesc(k) = nesc |
| ng_nrr(k) = nrr |
| ng_ncen(k) = ncen |
| ng_nabs(k) = nabs |
| ng_nscat(k) = nscat |
| ng_nsplt(k) = nsplt |
| ng_ntrac(k) = ntrac |
| |
| g_etot(k) = etot |
| g_epgain(k) = epgain |
| g_wlost(k) = wlost |
| g_wesc(k) = wesc |
| g_wrr(k) = wrr |
| g_wcen(k) = wcen |
| g_wabs(k) = wabs |
| |
| |
| do 10 j = 1,negrps |
| |
| ng_nescgp(k,j) = nescgp(j) |
| g_enesc(k,j) = enesc(j) |
| |
| 10 continue |
| |
| |
| end if |
| |
| if( numMPItasks .eq. 1 ) return |
| |
| c.... If I'm MPI task=0 and I know that I have no sends/receives to |
| c.... perform with other MPI tasks, then just return |
| |
| if( (MPIid .eq. 0) .AND. (srFlag .EQV. .FALSE.) )return |
| |
| |
| c.... Set up some buffers |
| |
| k = 11*OMP_GET_THREAD_NUM() |
| |
| ibuf(k+1) = npart |
| ibuf(k+2) = nphtot |
| ibuf(k+3) = nploss |
| ibuf(k+4) = nlost |
| ibuf(k+5) = nesc |
| ibuf(k+6) = nrr |
| ibuf(k+7) = ncen |
| ibuf(k+8) = nabs |
| ibuf(k+9) = nscat |
| ibuf(k+10)= nsplt |
| ibuf(k+11)= ntrac |
| |
| k = 7*OMP_GET_THREAD_NUM() |
| |
| rbuf(k+1) = etot |
| rbuf(k+2) = epgain |
| rbuf(k+3) = wlost |
| rbuf(k+4) = wesc |
| rbuf(k+5) = wrr |
| rbuf(k+6) = wcen |
| rbuf(k+7) = wabs |
| c.....Make sure all threads have written their part before proceeding |
| !$OMP BARRIER |
| |
| c.....Send/recv ibuf..... |
| |
| c.....Only one thread per MPI task performs communications |
| !$OMP MASTER |
| if( MPIid .eq. 0 )then |
| do 20 i = 1, numMPItasks-1 |
| CALL MPI_IRECV( jbuf(1,i), (numThreads*11), |
| & MPI_INTEGER, MPI_ANY_SOURCE, |
| & MPI_ANY_TAG, MPI_COMM_WORLD, req(i), ierr ) |
| 20 continue |
| |
| CALL MPI_WAITALL( numMPItasks-1, req, statArray, ierr ) |
| |
| do 30 i = 1, numMPItasks-1 |
| k = statArray(MPI_TAG,i) - 1 |
| DO 35 j = 1, numThreads |
| kk = 11*(j-1) |
| ng_npart(k+j) = jbuf(kk+1,i) |
| ng_nphtot(k+j) = jbuf(kk+2,i) |
| ng_nploss(k+j) = jbuf(kk+3,i) |
| ng_nlost(k+j) = jbuf(kk+4,i) |
| ng_nesc(k+j) = jbuf(kk+5,i) |
| ng_nrr(k+j) = jbuf(kk+6,i) |
| ng_ncen(k+j) = jbuf(kk+7,i) |
| ng_nabs(k+j) = jbuf(kk+8,i) |
| ng_nscat(k+j) = jbuf(kk+9,i) |
| ng_nsplt(k+j) = jbuf(kk+10,i) |
| ng_ntrac(k+j) = jbuf(kk+11,i) |
| 35 continue |
| 30 continue |
| end if |
| |
| |
| if( MPIid .gt. 0 )then |
| CALL MPI_SEND( ibuf, (numThreads*11), MPI_INTEGER, 0, |
| & ithRun, MPI_COMM_WORLD, ierr ) |
| end if |
| |
| CALL MPI_BARRIER( MPI_COMM_WORLD, ierr ) |
| !$OMP END MASTER |
| |
| |
| c.....Send/recv sbuf..... |
| |
| c.....Only one thread per MPI task performs communications |
| !$OMP MASTER |
| if( MPIid .eq. 0 )then |
| do 40 i = 1, numMPItasks-1 |
| CALL MPI_IRECV( sbuf(1,i), 7*numThreads, |
| & MPI_DOUBLE_PRECISION, |
| & MPI_ANY_SOURCE, MPI_ANY_TAG, MPI_COMM_WORLD, req(i), |
| & ierr ) |
| 40 continue |
| |
| CALL MPI_WAITALL( numMPItasks-1, req, statArray, ierr ) |
| |
| do 50 i = 1, numMPItasks-1 |
| |
| k = statArray(MPI_TAG,i)-1 |
| |
| do 55 j = 1, numThreads |
| kk = (j-1)*7 |
| g_etot(k+j) = sbuf(kk+1,i) |
| g_epgain(k+j) = sbuf(kk+2,i) |
| g_wlost(k+j) = sbuf(kk+3,i) |
| g_wesc(k+j) = sbuf(kk+4,i) |
| g_wrr(k+j) = sbuf(kk+5,i) |
| g_wcen(k+j) = sbuf(kk+6,i) |
| g_wabs(k+j) = sbuf(kk+7,i) |
| |
| 55 continue |
| 50 continue |
| end if |
| |
| if( MPIid .gt. 0 )then |
| CALL MPI_SEND( rbuf, 7*numThreads, MPI_DOUBLE_PRECISION, 0, |
| & ithRun, MPI_COMM_WORLD, ierr ) |
| end if |
| |
| CALL MPI_BARRIER(MPI_COMM_WORLD,ierr) |
| !$OMP END MASTER |
| |
| |
| c.....Send/recv nescgp..... |
| |
| k = negrps*OMP_GET_THREAD_NUM() |
| DO i = 1, negrps |
| lescbuf(k+i) = nescgp(i) |
| END DO |
| c.....Make sure all threads have written their part before proceeding |
| !$OMP BARRIER |
| |
| c.....Only one thread per MPI task performs communications |
| !$OMP MASTER |
| if( MPIid .eq. 0 )then |
| do 60 i = 1, numMPItasks-1 |
| CALL MPI_IRECV( nescbuf(1,i), numThreads*negrps, |
| & MPI_INTEGER, MPI_ANY_SOURCE, MPI_ANY_TAG, |
| & MPI_COMM_WORLD, req(i), ierr ) |
| 60 continue |
| |
| CALL MPI_WAITALL( numMPItasks-1, req, |
| & statArray, ierr ) |
| |
| do 70 i = 1, numMPItasks-1 |
| k = statArray(MPI_TAG,i) -1 |
| do 75 jj = 1, numThreads |
| kk = (jj-1)*negrps |
| do 80 j = 1,negrps |
| ng_nescgp(k+jj,j) = nescbuf(kk+j,i) |
| 80 continue |
| 75 continue |
| 70 continue |
| end if |
| |
| if( MPIid .gt. 0 )then |
| CALL MPI_SEND( lescbuf, numThreads*negrps, MPI_INTEGER, 0, |
| & ithRun, MPI_COMM_WORLD, ierr ) |
| end if |
| |
| CALL MPI_BARRIER(MPI_COMM_WORLD,ierr) |
| !$OMP END MASTER |
| |
| |
| c.....Send/recv enesc.... |
| |
| |
| k = negrps*OMP_GET_THREAD_NUM() |
| DO i = 1, negrps |
| lenbuf(k+i) = enesc(i) |
| END DO |
| c.....Make sure all threads have written their part before proceeding |
| !$OMP BARRIER |
| |
| c.....Only one thread per MPI task performs communications |
| !$OMP MASTER |
| if( MPIid .eq. 0 )then |
| do 90 i = 1, numMPItasks-1 |
| CALL MPI_IRECV( enbuf(1,i), numThreads*negrps, |
| & MPI_DOUBLE_PRECISION, |
| & MPI_ANY_SOURCE, MPI_ANY_TAG, MPI_COMM_WORLD, req(i), |
| & ierr ) |
| 90 continue |
| |
| CALL MPI_WAITALL( numMPItasks-1, req, |
| & statArray, ierr ) |
| |
| do 100 i = 1, numMPItasks-1 |
| k = statArray(MPI_TAG,i)-1 |
| do 105 jj = 1, numThreads |
| kk = (jj-1)*negrps |
| do 110 j = 1,negrps |
| g_enesc(k+jj,j) = enbuf(kk+j,i) |
| 110 continue |
| 105 continue |
| 100 continue |
| end if |
| |
| |
| if( MPIid .gt. 0 )then |
| CALL MPI_SEND( lenbuf, numThreads*negrps, MPI_DOUBLE_PRECISION, |
| & 0, ithRun, MPI_COMM_WORLD, ierr ) |
| end if |
| |
| CALL MPI_BARRIER(MPI_COMM_WORLD,ierr) |
| !$OMP END MASTER |
| |
| |
| return |
| end |
