sum_on_all_procs_ol.F90

Go to the documentation of this file.

!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
!SFX_LIC for details. version 1.
!     #########
      SUBROUTINE sum_on_all_procs_ol(HGRID,KSIZE,KIN,KOUT,HNAME)
!     #######################################################
!
!
!!****  *SUM_ON_ALL_PROCS_OL* - sums the values of the integers provided on each processor
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      V. Masson    *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    07/2011 
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE modd_surfex_mpi, ONLY : nindex, nrank, npio, ncomm, nproc
!
USE modd_surfex_omp, ONLY : nwork0
!
USE modi_gather_and_write_mpi
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
#ifdef SFX_MPI
include "mpif.h"
#endif
!
!*       0.1   Declarations of arguments
!              -------------------------
!
 CHARACTER(LEN=10),         INTENT(IN)    :: hgrid ! grid type
INTEGER,                   INTENT(IN)    :: ksize ! size of integer array
INTEGER, DIMENSION(KSIZE), INTENT(IN)    :: kin   ! integer array to sum
INTEGER,                   INTENT(INOUT) :: kout  ! sum of all integers
 CHARACTER(LEN=3),          INTENT(IN)    :: hname ! name of type of field
!
!*       0.2   Declarations of local variables
!              -------------------------------
!
INTEGER, DIMENSION(SIZE(NINDEX)) :: iin
INTEGER :: infompi
REAL(KIND=JPRB)           :: zhook_handle
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('SUM_ON_ALL_PROCS_OL',0,zhook_handle)
!
!* sum of field
!
 CALL gather_and_write_mpi(kin,iin)
IF (nrank==npio) THEN
!$OMP SINGLE
  nwork0 = sum(iin)
!$OMP END SINGLE
ENDIF
!
IF (nproc>1) THEN
!$OMP SINGLE
#ifdef SFX_MPI
  CALL mpi_bcast(nwork0,kind(nwork0)/4,mpi_integer,npio,ncomm,infompi)
#endif
!$OMP END SINGLE
ENDIF
!
kout = nwork0
!
IF (lhook) CALL dr_hook('SUM_ON_ALL_PROCS_OL',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE sum_on_all_procs_ol