source: branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/mpp_tam.F90 @ 1885

#if defined key_mpp_mpi
#if defined key_sp
#define mpivar mpi_real
#else
#define mpivar mpi_double_precision
#endif
#endif
MODULE mpp_tam
   !!======================================================================
   !!                       ***  MODULE mpp_tam  ***
   !! NEMOTAM: Various MPP support routines
   !!======================================================================

   !!----------------------------------------------------------------------
   !! mpp_sum_reals       : Sum an array of reals from all processors
   !! mpp_global_or,      : Do an op operation
   !! mpp_global_max_real : Som
   !!----------------------------------------------------------------------
   !! * Modules used   
   USE par_kind, ONLY : &   ! Precision variables
      & wp
   USE par_oce, ONLY : &    ! Ocean parameters
      & jpnij
   USE dom_oce, ONLY : &    ! Ocean space and time domain variables
      & nproc, &
      & jpiglo, &
      & jpjglo, &
      & jpi, &
      & jpj, &
      & nldi, &
      & nldj, &
      & nlei, &
      & nlej, &
      & mig, &
      & mjg
#if defined key_mpp_mpi
   USE lib_mpp, ONLY : &    ! MPP library
      & mpi_comm_opa
#endif
   
   IMPLICIT NONE

   !! * Routine accessibility
   PRIVATE

   PUBLIC &
      & mpp_sum_reals,      &
      & mpp_global_or,      &
      & mpp_global_max_real

CONTAINS

   SUBROUTINE mpp_sum_reals( pvalin, pvalout, kn )
      !!----------------------------------------------------------------------
      !!               ***  ROUTINE mpp_sum_integers ***
      !!          
      !! ** Purpose : Sum all elements of a real array
      !!
      !! ** Method  : MPI all reduce.
      !!
      !! ** Action  : This does only work for MPI. 
      !!              It does not work for SHMEM.
      !!
      !! References : http://www.mpi-forum.org
      !!
      !! History :
      !!        !  07-07  (K. Mogensen)  Original code
      !!----------------------------------------------------------------------

      !! * Arguments
      INTEGER :: &
         & kn 
      REAL(wp), DIMENSION(kn), INTENT(IN) :: &
         & pvalin
      REAL(wp), DIMENSION(kn), INTENT(OUT) :: &
         & pvalout

#if defined key_mpp_mpi
      !! * Local declarations
      INTEGER :: &
         & ierr
#     include <mpif.h>

      !-----------------------------------------------------------------------
      ! Call the MPI library to find the sum across processors
      !-----------------------------------------------------------------------
      CALL mpi_allreduce( pvalin, pvalout, kn, mpivar, mpi_sum, &
         &                mpi_comm_opa, ierr )
#elif defined key_mpp_shmem
#error "Only MPI support for MPP in NEMOVAR"
#else

      !-----------------------------------------------------------------------
      ! For no-MPP just return input values
      !-----------------------------------------------------------------------
      pvalout(:) = pvalin(:)
#endif
   END SUBROUTINE mpp_sum_reals

   SUBROUTINE mpp_global_or( ldval )
      !!----------------------------------------------------------------------
      !!               ***  ROUTINE mpp_global_or ***
      !!          
      !! ** Purpose : Apply the "or" operation for all elements in
      !!              a global (jpiglo,jpjglo) array across processors
      !!
      !! ** Method  : MPI allreduce
      !!
      !! ** Action  : This does only work for MPI. 
      !!              It does not work for SHMEM.
      !!
      !! References : http://www.mpi-forum.org
      !!
      !! History :
      !!        !  08-01  (K. Mogensen)  Original code
      !!----------------------------------------------------------------------

      !! * Arguments
      LOGICAL, DIMENSION(jpiglo,jpjglo), INTENT(INOUT) :: &
         & ldval
      !! * Local declarations
      INTEGER :: &
         & ierr
#if defined key_mpp_mpi
#include <mpif.h>
      LOGICAL, DIMENSION(:,:), ALLOCATABLE :: &
         & llcp

      ! Copy data for input to MPI

      ALLOCATE( &
         & llcp(jpiglo,jpjglo) &
         & )
      llcp(:,:) = ldval(:,:)

      ! Call the MPI library to find the coast lines globally

      CALL mpi_allreduce( llcp, ldval, jpiglo*jpjglo, mpi_logical, &
         &                mpi_lor, mpi_comm_opa, ierr )

      DEALLOCATE( &
         & llcp &
         & )

#elif defined key_mpp_shmem
#error "Only MPI support for MPP in NEMOVAR"
#endif
      
   END SUBROUTINE mpp_global_or

   SUBROUTINE mpp_global_max_real( zin, zout )
      !!----------------------------------------------------------------------
      !!               ***  ROUTINE mpp_global_or ***
      !!          
      !! ** Purpose : Copy a local zin array to a global array and
      !!              apply the "max" operation for all elements in
      !!              a global (jpiglo,jpjglo) array across processors
      !!
      !! ** Method  : MPI allreduce
      !!
      !! ** Action  : This does only work for MPI. 
      !!              It does not work for SHMEM.
      !!
      !! References : http://www.mpi-forum.org
      !!
      !! History :
      !!        !  08-01  (K. Mogensen)  Original code
      !!----------------------------------------------------------------------

      !! * Arguments
      REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: &
         & zin
      REAL(wp), DIMENSION(jpiglo,jpjglo), INTENT(OUT) :: &
         & zout
      !! * Local declarations
      INTEGER :: &
         & ierr
#if defined key_mpp_mpi
#include <mpif.h>
      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: &
         & zcp
      INTEGER :: &
         & ji, &
         & jj
      
      ! Copy data for input to MPI

      ALLOCATE( &
         & zcp(jpiglo,jpjglo) &
         & )
      zcp(:,:) = 0.0
      DO jj = nldj, nlej
         DO ji = nldi, nlei
            zcp(mig(ji),mjg(jj)) = zin(ji,jj)
         ENDDO
      ENDDO

      ! Call the MPI library to find the coast lines globally

      CALL mpi_allreduce( zcp, zout, jpiglo*jpjglo, mpivar, &
         &                mpi_max, mpi_comm_opa, ierr )

      DEALLOCATE( &
         & zcp &
         & )

#elif defined key_mpp_shmem
#error "Only MPI support for MPP in NEMOVAR"
#else
      zout(:,:) = zin(:,:)
#endif
      
   END SUBROUTINE mpp_global_max_real

END MODULE mpp_tam