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

Last change on this file since 10300 was 10300, checked in by smasson, 23 months ago

dev_r10164_HPC09_ESIWACE_PREP_MERGE: action 2b: add waiting time for mpp_min/max/sum, see #2133

File size: 3.1 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      !
45      INTEGER :: ipi, ii, ierr
46      INTEGER :: ierror, ilocalcomm
47      TMP_TYPE(:)
48      !
49      ilocalcomm = mpi_comm_oce
50      IF( PRESENT(kcom) )   ilocalcomm = kcom
51      !
52      IF( PRESENT(kdim) ) then
53         ipi = kdim
54      ELSE
55         ipi = I_SIZE(ptab)   ! 1st dimension
56      ENDIF
57
58      IF( ln_timing ) CALL tic_tac(.TRUE., ld_global = .TRUE.)
59      ALLOCATE(work(ipi))
60      CALL mpi_allreduce( ARRAY_IN(:), work, ipi, MPI_TYPE, MPI_OPERATION, ilocalcomm, ierror )
61      DO ii = 1, ipi
62         ARRAY_IN(ii) = work(ii)
63      ENDDO
64      DEALLOCATE(work)
65      IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.)
66      !
67      IF( narea == 1 .AND. ncom_stp == nit000+5 ) THEN
68            IF( .NOT. ALLOCATED( crname_glb) ) THEN
69               ALLOCATE( crname_glb(2000), STAT=ierr )
70               IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'allreduce_generic, cannot allocate crname' )
71            ENDIF
72            n_sequence_glb = n_sequence_glb + 1
73            IF( n_sequence_glb > 2000 ) CALL ctl_stop( 'STOP', 'allreduce_generic, increase crname_glb first dimension' )
74            crname_glb(n_sequence_glb)   = cdname    ! keep the name of the calling routine
75      ENDIF
76
77   END SUBROUTINE ROUTINE_ALLREDUCE
78
79#undef ARRAY_TYPE
80#undef ARRAY_IN
81#undef I_SIZE
82#undef MPI_OPERATION
83#undef TMP_TYPE
84#undef MPI_TYPE
Note: See TracBrowser for help on using the repository browser.