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 : nrank, npio, ncomm, nproc, ndim_full_init
!
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(NDIM_FULL_INIT) :: 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
  kout = sum(iin)
ENDIF
!
IF (nproc>1) THEN
#ifdef SFX_MPI
  CALL mpi_bcast(kout,kind(kout)/4,mpi_integer,npio,ncomm,infompi)
#endif
ENDIF
!
IF (lhook) CALL dr_hook('SUM_ON_ALL_PROCS_OL',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE sum_on_all_procs_ol