New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
mpp_allreduce_generic.h90 in NEMO/trunk/src/OCE/LBC – NEMO

source: NEMO/trunk/src/OCE/LBC/mpp_allreduce_generic.h90 @ 13226

Last change on this file since 13226 was 13226, checked in by orioltp, 4 years ago

Merging dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation into the trunk

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