The TELEMAC-MASCARET system  trunk
p_dmin_array.F
Go to the documentation of this file.
1 ! ***********************
2  SUBROUTINE p_dmin_array
3 ! ***********************
4 !
5  &(mypart, n, values)
6 !
7 !***********************************************************************
8 ! PARALLEL V6P1 21/08/2010
9 !***********************************************************************
10 !
11 !brief MINIMUM 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 # ifdef COMPAD
42  values=0.d0
43  CALL ampi_allreduce(mypart,values,n,ampi_type,ampi_op_min,
44  & comm,ier)
45 # else
46  CALL mpi_allreduce(mypart,values,n,mpi_double_precision,mpi_min,
47  & comm,ier)
48 # endif
49 !
50  IF(ier.NE.0) THEN
51  WRITE(lu,*) 'P_DMIN: ERROR IN MPI_ALLREDUCE'
52  WRITE(lu,*) 'MPI ERROR ',ier
53  CALL plante(1)
54  stop
55  ENDIF
56  RETURN
57 #else
58 !
59  values=mypart
60 !
61 #endif
62 !
63 !-----------------------------------------------------------------------
64 !
65  END
integer, parameter mpi_double_precision
subroutine p_dmin_array(MYPART, N, VALUES)
Definition: p_dmin_array.F:7
integer, parameter ampi_type