The TELEMAC-MASCARET system  trunk
p_dmax_array.F
Go to the documentation of this file.
1 ! ***********************
2  SUBROUTINE p_dmax_array
3 ! ***********************
4 !
5  &(mypart, n, values)
6 !
7 !***********************************************************************
8 ! PARALLEL V6P3 21/08/2010
9 !***********************************************************************
10 !
11 !brief MAXIMUM VALUE FROM ALL THE PROCESSORS.
12 !
13 !history Y AUDOUIN (LNHE)
14 !+ 09/03/2018
15 !+
16 !+
17 !
18 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
19 !| MYPART |-->| SEND BUFFER
20 !| N |-->| SIZE OF BUFFER
21 !| VALUES |-->| RECEIVED BUFFER
22 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
23 !
26  IMPLICIT NONE
27 !
28 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
29 !
30  INTEGER, INTENT(IN) :: N
31  DOUBLE PRECISION, INTENT(IN) :: MYPART(n)
32  DOUBLE PRECISION, INTENT(INOUT) :: VALUES(n)
33 !
34 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
35 !
36 #if defined HAVE_MPI
37  INTEGER IER
38 !
39 !-----------------------------------------------------------------------
40 !
41 
42 # ifdef COMPAD
43  values=0.d0
44  CALL ampi_allreduce(mypart,values,n,ampi_type,ampi_op_max,
45  & comm,ier)
46 # else
47  CALL mpi_allreduce(mypart,values,n,mpi_double_precision,mpi_max,
48  & comm,ier)
49 # endif
50 !
51  IF(ier.NE.0) THEN
52  WRITE(lu,*) 'P_DMAX_ARRAY: ERROR IN MPI_ALLREDUCE'
53  WRITE(lu,*) 'MPI ERROR ',ier
54  CALL plante(1)
55  stop
56  ENDIF
57  RETURN
58 #else
59 !
60  values=mypart
61 !
62 #endif
63 !
64 !-----------------------------------------------------------------------
65 !
66  END
integer, parameter mpi_double_precision
subroutine p_dmax_array(MYPART, N, VALUES)
Definition: p_dmax_array.F:7
integer, parameter ampi_type