C $Header: /u/gcmpack/MITgcm/eesupp/src/global_sum.F,v 1.16 2012/09/06 15:25:01 jmc Exp $
C $Name: $
#include "CPP_EEOPTIONS.h"
C-- File global_sum.F: Routines that perform global sum on an array
C of thread values.
C Contents
C o GLOBAL_SUM_R4
C o GLOBAL_SUM_R8
C o GLOBAL_SUM_INT
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP
C !ROUTINE: GLOBAL_SUM_R4
C !INTERFACE:
SUBROUTINE GLOBAL_SUM_R4(
U sumPhi,
I myThid )
C !DESCRIPTION:
C *==========================================================*
C | SUBROUTINE GLOBAL\_SUM\_R4
C | o Handle sum for real*4 data.
C *==========================================================*
C | Perform sum an array of one value per thread and then
C | sum result of all the processes.
C | Notes:
C | Within a process only one thread does the sum.
C | The same thread also does the inter-process sum for
C | example with MPI and then writes the result into a shared
C | location. All threads wait until the sum is avaiailable.
C *==========================================================*
C !USES:
IMPLICIT NONE
C == Global data ==
#include "SIZE.h"
#include "EEPARAMS.h"
#include "EESUPPORT.h"
#include "GLOBAL_SUM.h"
C !INPUT/OUTPUT PARAMETERS:
C == Routine arguments ==
C sumPhi :: Result of sum.
C myThid :: My thread id.
Real*4 sumPhi
INTEGER myThid
C !LOCAL VARIABLES:
C == Local variables ==
C I :: Loop counters
C mpiRC :: MPI return code
INTEGER I
Real*4 tmp
#ifdef ALLOW_USE_MPI
INTEGER mpiRC
#endif /* ALLOW_USE_MPI */
CEOP
C-- write local sum into array
phiGSR4(1,myThid) = sumPhi
C-- Can not start until everyone is ready
CALL BAR2( myThid )
C-- Sum within the process first
_BEGIN_MASTER( myThid )
tmp = 0.
DO I=1,nThreads
tmp = tmp + phiGSR4(1,I)
ENDDO
sumPhi = tmp
#ifdef ALLOW_USE_MPI
IF ( usingMPI ) THEN
CALL MPI_ALLREDUCE(tmp,sumPhi,1,MPI_REAL,MPI_SUM,
& MPI_COMM_MODEL,mpiRC)
ENDIF
#endif /* ALLOW_USE_MPI */
C-- Write solution to place where all threads can see it
phiGSR4(1,0) = sumPhi
_END_MASTER( myThid )
C--
CALL BAR2( myThid )
C-- set result for every process
sumPhi = phiGSR4(1,0)
RETURN
END
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP
C !ROUTINE: GLOBAL_SUM_R8
C !INTERFACE:
SUBROUTINE GLOBAL_SUM_R8(
U sumPhi,
I myThid )
C !DESCRIPTION:
C *==========================================================*
C | SUBROUTINE GLOBAL\_SUM\_R8
C | o Handle sum for real*8 data.
C *==========================================================*
C | Perform sum an array of one value per thread and then
C | sum result of all the processes.
C | Notes:
C | Within a process only one thread does the sum.
C | The same thread also does the inter-process sum for
C | example with MPI and then writes the result into a shared
C | location. All threads wait until the sum is avaiailable.
C *==========================================================*
C !USES:
IMPLICIT NONE
C === Global data ===
#include "SIZE.h"
#include "EEPARAMS.h"
#include "EESUPPORT.h"
#include "GLOBAL_SUM.h"
C !INPUT/OUTPUT PARAMETERS:
C === Routine arguments ===
C sumPhi :: Result of sum.
C myThid :: My thread id.
Real*8 sumPhi
INTEGER myThid
C !LOCAL VARIABLES:
C === Local variables ===
C I :: Loop counters
C mpiRC :: MPI return code
INTEGER I
Real*8 tmp
#ifdef ALLOW_USE_MPI
INTEGER mpiRC
#endif /* ALLOW_USE_MPI */
CEOP
C-- write local sum into array
phiGSR8(1,myThid) = sumPhi
C-- Can not start until everyone is ready
C CALL FOOL_THE_COMPILER( phiGSR8 )
C CALL MS
CALL BAR2( myThid )
C _BARRIER
C _BARRIER
C CALL FOOL_THE_COMPILER( phiGSR8 )
C-- Sum within the process first
_BEGIN_MASTER( myThid )
tmp = 0. _d 0
DO I=1,nThreads
tmp = tmp + phiGSR8(1,I)
ENDDO
sumPhi = tmp
#ifdef ALLOW_USE_MPI
IF ( usingMPI ) THEN
CALL MPI_ALLREDUCE(tmp,sumPhi,1,MPI_DOUBLE_PRECISION,MPI_SUM,
& MPI_COMM_MODEL,mpiRC)
ENDIF
#endif /* ALLOW_USE_MPI */
C-- Write solution to place where all threads can see it
phiGSR8(1,0) = sumPhi
_END_MASTER( myThid )
C-- Do not leave until we are sure that the sum is done
C CALL FOOL_THE_COMPILER( phiGSR8 )
C CALL MS
C _BARRIER
C _BARRIER
CALL BAR2( myThid )
C CALL FOOL_THE_COMPILER( phiGSR8 )
C-- set result for every process
sumPhi = phiGSR8(1,0)
RETURN
END
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP
C !ROUTINE: GLOBAL_SUM_INT
C !INTERFACE:
SUBROUTINE GLOBAL_SUM_INT(
U sumPhi,
I myThid )
C !DESCRIPTION:
C *==========================================================*
C | SUBROUTINE GLOBAL\_SUM\_INT
C | o Handle sum for integer data.
C *==========================================================*
C | Perform sum an array of one value per thread and then
C | sum result of all the processes.
C | Notes:
C | Within a process only one thread does the sum.
C | The same thread also does the inter-process sum for
C | example with MPI and then writes the result into a shared
C | location. All threads wait until the sum is avaiailable.
C *==========================================================*
C !USES:
IMPLICIT NONE
C === Global data ===
#include "SIZE.h"
#include "EEPARAMS.h"
#include "EESUPPORT.h"
#include "GLOBAL_SUM.h"
C !INPUT/OUTPUT PARAMETERS:
C === Routine arguments ===
C sumPhi :: Result of sum.
C myThid :: My thread id.
INTEGER sumPhi
INTEGER myThid
C !LOCAL VARIABLES:
C === Local variables ===
C I :: Loop counters
C mpiRC :: MPI return code
INTEGER I
INTEGER tmp
#ifdef ALLOW_USE_MPI
INTEGER mpiRC
#endif /* ALLOW_USE_MPI */
CEOP
C-- write local sum into array
phiGSI(1,myThid) = sumPhi
C-- Can not start until everyone is ready
_BARRIER
C-- Sum within the process first
_BEGIN_MASTER( myThid )
tmp = 0
DO I=1,nThreads
tmp = tmp + phiGSI(1,I)
ENDDO
sumPhi = tmp
#ifdef ALLOW_USE_MPI
IF ( usingMPI ) THEN
CALL MPI_ALLREDUCE(tmp,sumPhi,1,MPI_INTEGER,MPI_SUM,
& MPI_COMM_MODEL,mpiRC)
ENDIF
#endif /* ALLOW_USE_MPI */
C-- Write solution to place where all threads can see it
phiGSI(1,0) = sumPhi
_END_MASTER( myThid )
C-- Do not leave until we are sure that the sum is done
_BARRIER
C-- set result for every process
sumPhi = phiGSI(1,0)
RETURN
END