The TELEMAC-MASCARET system  trunk
p_mpi_alltoallv_alg.F
Go to the documentation of this file.
1 ! ******************************
2  SUBROUTINE p_mpi_alltoallv_alg
3 ! ******************************
4 !
5  &(send_buffer,nsend,send_displ,send_datyp,recv_buffer,nrecv,
6  & recv_displ,recv_datyp,ierr)
7 !
8 !***********************************************************************
9 ! PARALLEL V6P3 21/08/2010
10 !***********************************************************************
11 !
12 !brief Calls function MPI_ALLTOALLV with type ALG_TYPE.
13 !
14 !history J-M HERVOUET (EDF R&D, LNHE)
15 !+ 23/05/2013
16 !+ V6P3
17 !+ First version, inpired from P_MPI_ALLTOALLV.
18 !
19 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
20 !| SEND_BUFFER |-->| SEND BUFFER
21 !| NSEND |-->| SPECIFIES THE NUMBER OF ELEMENTS TO SEND TO EACH
22 !| | | PROCESSOR
23 !| SEND_DISPL |-->| DISPLACEMENT ARRAY FOR THE SEND BUFFER
24 !| SEND_DATYP |-->| DATA TYPE OF SEND BUFFER ELEMENTS
25 !| RECV_BUFFER |<--| RECEIVE BUFFER
26 !| NRECV |-->| SPECIFIES THE MAXIMUM NUMBER OF ELEMENTS THAT
27 !| | | CAN BE RECEIVED FROM EACH PROCESSOR
28 !| RECV_DISPL |-->| DISPLACEMENT ARRAY FOR THE RECEIVE BUFFER
29 !| RECV_DATYP |-->| DATA TYPE OF RECEIVE BUFFER ELEMENTS
30 !| IERR |-->| ERROR VALUE
31 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
32 !
35  IMPLICIT NONE
36 !
37 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
38 !
39  INTEGER, INTENT(IN) :: NSEND(*),SEND_DISPL(*),SEND_DATYP,NRECV(*)
40  INTEGER, INTENT(IN) :: RECV_DISPL(*),RECV_DATYP
41  INTEGER, INTENT(OUT) :: IERR
42  TYPE(alg_type), INTENT(IN) :: SEND_BUFFER(*)
43 ! NO DEFAULT INITIALISATION FOR USER TYPE COMPONENTS ALLOWED
44  TYPE(alg_type), INTENT(INOUT) :: RECV_BUFFER(*)
45 !
46 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
47 !
48  recv_buffer(1)%MYPID = 0
49  ierr = 0
50 !
51 #if defined HAVE_MPI
52 ! TERMINATE ON MPI PARTS NOT HANDLED BY COMPAD
53 # if defined COMPAD
54  WRITE(lu,*) 'P_MPI_ALLTOALLV_ALG: COMPAD CRITICAL MPI OPERATION'
55  WRITE(lu,*) ' PLEASE CONTACT JR @ ADJOINTWARE'
56  CALL plante(1)
57  stop
58 # endif
59  CALL mpi_alltoallv(send_buffer,nsend,send_displ,send_datyp,
60  & recv_buffer,nrecv,recv_displ,recv_datyp,
61  & comm,ierr)
62 !
63  IF(ierr.NE.0) THEN
64  WRITE(lu,*) 'P_MPI_ALLTOALLV_ALG:'
65  WRITE(lu,*) 'MPI ERROR ',ierr
66  CALL plante(1)
67  stop
68  ENDIF
69  RETURN
70 #else
71  WRITE(lu,*) 'CALL OF P_MPI_ALLTOALLV_ALG IN '//
72  & 'ITS VOID VERSION'
73 #endif
74 !
75 !-----------------------------------------------------------------------
76 !
77  END
subroutine p_mpi_alltoallv_alg(SEND_BUFFER, NSEND, SEND_DISPL, SEND_DATYP, RECV_BUFFER, NRECV, RECV_DISPL, RECV_DATYP, IERR)