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