Changeset 681 for trunk/NEMO/OPA_SRC/lib_mpp.F90

Timestamp:

2007-06-29T18:31:31+02:00 (17 years ago)

Author:

rblod

Message:

nemo_v2_update_019 : SM : add mppmax for integer

File:

• trunk/NEMO/OPA_SRC/lib_mpp.F90 (modified) (7 diffs)

trunk/NEMO/OPA_SRC/lib_mpp.F90

@@ -26 +26 @@
    !!                mppmin_int , mppmin_a_int , mppmin_real, mppmin_a_real
    !!   mpp_max    : generic interface for :
-   !!                mppmax_real, mppmax_a_real
+   !!                mppmax_int , mppmax_a_int , mppmax_real, mppmax_a_real
    !!   mpp_sum    : generic interface for :
    !!                mppsum_int , mppsum_a_int , mppsum_real, mppsum_a_real
@@ -48 +48 @@
    !!----------------------------------------------------------------------
    !!  OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Header$ 
+   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/lib_mpp.F90,v 1.21 2007/06/05 10:28:55 opalod Exp $ 
    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
    !!---------------------------------------------------------------------
@@ -77 +77 @@
    END INTERFACE
    INTERFACE mpp_max
-      MODULE PROCEDURE mppmax_a_real, mppmax_real
+      MODULE PROCEDURE mppmax_a_int, mppmax_int, mppmax_a_real, mppmax_real
    END INTERFACE
    INTERFACE mpp_sum
@@ -270 +270 @@
    !!----------------------------------------------------------------------
    !!  OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Header$ 
+   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/lib_mpp.F90,v 1.21 2007/06/05 10:28:55 opalod Exp $ 
    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
    !!---------------------------------------------------------------------
@@ -3069 +3069 @@
 
 
+   SUBROUTINE mppmax_a_int( ktab, kdim )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppmax_a_int  ***
+      !! 
+      !! ** Purpose :   Find maximum value in an integer layout array
+      !!
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER , INTENT( in  )                  ::   kdim        ! size of array
+      INTEGER , INTENT(inout), DIMENSION(kdim) ::   ktab        ! input array
+  
+#if defined key_mpp_shmem
+      !! * Local declarations    (SHMEM version)
+      INTEGER :: ji
+      INTEGER, SAVE :: ibool=0
+  
+      IF( kdim > jpmppsum ) CALL ctl_stop( 'mppmax_a_int routine : kdim is too big', &
+           &                               'change jpmppsum dimension in mpp.h' )
+  
+      DO ji = 1, kdim
+         niltab_shmem(ji) = ktab(ji)
+      END DO
+      CALL  barrier()
+      IF(ibool == 0 ) THEN 
+         CALL shmem_int8_max_to_all (niltab_shmem,niltab_shmem,kdim,0,0   &
+              ,N$PES,nil1wrk_shmem,nil1sync_shmem )
+      ELSE
+         CALL shmem_int8_max_to_all (niltab_shmem,niltab_shmem,kdim,0,0   &
+              ,N$PES,nil2wrk_shmem,nil2sync_shmem )
+      ENDIF
+      CALL  barrier()
+      ibool=ibool+1
+      ibool=MOD( ibool,2)
+      DO ji = 1, kdim
+         ktab(ji) = niltab_shmem(ji)
+      END DO
+  
+#  elif defined key_mpp_mpi
+  
+      !! * Local variables   (MPI version)
+      INTEGER :: ierror
+      INTEGER, DIMENSION(kdim) ::   iwork
+  
+      CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer,   &
+           &                mpi_max, mpi_comm_opa, ierror )
+  
+      ktab(:) = iwork(:)
+#endif
+
+   END SUBROUTINE mppmax_a_int
+
+
+   SUBROUTINE mppmax_int( ktab )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppmax_int  ***
+      !!
+      !! ** Purpose :
+      !!     Massively parallel processors
+      !!     Find maximum value in an integer layout array
+      !!
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT(inout) ::   ktab      ! ???
+  
+      !! * Local declarations
+
+#if defined key_mpp_shmem
+
+      !! * Local variables   (SHMEM version)
+      INTEGER :: ji
+      INTEGER, SAVE :: ibool=0
+  
+      niltab_shmem(1) = ktab
+      CALL  barrier()
+      IF(ibool == 0 ) THEN 
+         CALL shmem_int8_max_to_all (niltab_shmem,niltab_shmem, 1,0,0   &
+              ,N$PES,nil1wrk_shmem,nil1sync_shmem )
+      ELSE
+         CALL shmem_int8_max_to_all (niltab_shmem,niltab_shmem, 1,0,0   &
+              ,N$PES,nil2wrk_shmem,nil2sync_shmem )
+      ENDIF
+      CALL  barrier()
+      ibool=ibool+1
+      ibool=MOD( ibool,2)
+      ktab = niltab_shmem(1)
+  
+#  elif defined key_mpp_mpi
+
+      !! * Local variables   (MPI version)
+      INTEGER ::  ierror, iwork
+  
+      CALL mpi_allreduce(ktab,iwork, 1,mpi_integer   &
+           &              ,mpi_max,mpi_comm_opa,ierror)
+  
+      ktab = iwork
+#endif
+
+   END SUBROUTINE mppmax_int
+
+
    SUBROUTINE mppmin_a_int( ktab, kdim )
       !!----------------------------------------------------------------------
@@ -5117 +5217 @@
    END INTERFACE
    INTERFACE mpp_max
-      MODULE PROCEDURE mppmax_a_real, mppmax_real
+      MODULE PROCEDURE mppmax_a_int, mppmax_int, mppmax_a_real, mppmax_real
    END INTERFACE
    INTERFACE mpp_min
@@ -5198 +5298 @@
    END SUBROUTINE mppmin_real
 
+   SUBROUTINE mppmax_a_int( karr, kdim )
+      INTEGER, DIMENSION(:) :: karr
+      INTEGER               :: kdim
+      WRITE(*,*) 'mppmax_a_int: You should not have seen this print! error?', kdim, karr(1)
+   END SUBROUTINE mppmax_a_int
+
+   SUBROUTINE mppmax_int( kint )
+      INTEGER               :: kint
+      WRITE(*,*) 'mppmax_int: You should not have seen this print! error?', kint
+   END SUBROUTINE mppmax_int
+
    SUBROUTINE mppmin_a_int( karr, kdim )
       INTEGER, DIMENSION(:) :: karr