source: NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/LBC/mpp_allreduce_generic.h90

Last change on this file was 10402, checked in by smasson, 2 years ago

dev_r10164_HPC09_ESIWACE_PREP_MERGE: no more need of lk_mpp for mpp_sum/max/min, see #2133

File size: 2.8 KB
Line 
1!                          !==  IN: ptab is an array  ==!
2#   if defined REAL_TYPE
3#      define ARRAY_TYPE(i)    REAL(wp)         , INTENT(inout) ::   ARRAY_IN(i)
4#      define TMP_TYPE(i)      REAL(wp)         , ALLOCATABLE   ::   work(i)
5#      define MPI_TYPE mpi_double_precision
6#   endif
7#   if defined INTEGER_TYPE
8#      define ARRAY_TYPE(i)    INTEGER          , INTENT(inout) ::   ARRAY_IN(i)
9#      define TMP_TYPE(i)      INTEGER          , ALLOCATABLE   ::   work(i)
10#      define MPI_TYPE mpi_integer
11#   endif
12#   if defined COMPLEX_TYPE
13#      define ARRAY_TYPE(i)    COMPLEX          , INTENT(inout) ::   ARRAY_IN(i)
14#      define TMP_TYPE(i)      COMPLEX          , ALLOCATABLE   ::   work(i)
15#      define MPI_TYPE mpi_double_complex
16#   endif
17#   if defined DIM_0d
18#      define ARRAY_IN(i)   ptab
19#      define I_SIZE(ptab)          1
20#   endif
21#   if defined DIM_1d
22#      define ARRAY_IN(i)   ptab(i)
23#      define I_SIZE(ptab)          SIZE(ptab,1)
24#   endif
25#   if defined OPERATION_MAX
26#      define MPI_OPERATION mpi_max
27#   endif
28#   if defined OPERATION_MIN
29#      define MPI_OPERATION mpi_min
30#   endif
31#   if defined OPERATION_SUM
32#      define MPI_OPERATION mpi_sum
33#   endif
34#   if defined OPERATION_SUM_DD
35#      define MPI_OPERATION mpi_sumdd
36#   endif
37
38   SUBROUTINE ROUTINE_ALLREDUCE( cdname, ptab, kdim, kcom )
39      !!----------------------------------------------------------------------
40      CHARACTER(len=*),                   INTENT(in   ) ::   cdname  ! name of the calling subroutine
41      ARRAY_TYPE(:)   ! array or pointer of arrays on which the boundary condition is applied
42      INTEGER, OPTIONAL, INTENT(in   ) ::   kdim        ! optional pointer dimension
43      INTEGER, OPTIONAL, INTENT(in   ) ::   kcom        ! optional communicator
44#if defined key_mpp_mpi
45      !
46      INTEGER :: ipi, ii, ierr
47      INTEGER :: ierror, ilocalcomm
48      TMP_TYPE(:)
49      !!-----------------------------------------------------------------------
50      !
51      IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ld_glb = .TRUE. )
52      !
53      ilocalcomm = mpi_comm_oce
54      IF( PRESENT(kcom) )   ilocalcomm = kcom
55      !
56      IF( PRESENT(kdim) ) then
57         ipi = kdim
58      ELSE
59         ipi = I_SIZE(ptab)   ! 1st dimension
60      ENDIF
61      !
62      ALLOCATE(work(ipi))
63      IF( ln_timing ) CALL tic_tac(.TRUE., ld_global = .TRUE.)
64      CALL mpi_allreduce( ARRAY_IN(:), work, ipi, MPI_TYPE, MPI_OPERATION, ilocalcomm, ierror )
65      IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.)
66      DO ii = 1, ipi
67         ARRAY_IN(ii) = work(ii)
68      ENDDO
69      DEALLOCATE(work)
70#else
71      ! nothing to do if non-mpp case
72      RETURN
73#endif
74
75   END SUBROUTINE ROUTINE_ALLREDUCE
76
77#undef ARRAY_TYPE
78#undef ARRAY_IN
79#undef I_SIZE
80#undef MPI_OPERATION
81#undef TMP_TYPE
82#undef MPI_TYPE
Note: See TracBrowser for help on using the repository browser.