The TELEMAC-MASCARET system  trunk
p_mpi_type_create_struct.F
Go to the documentation of this file.
1 ! ***********************************
2  SUBROUTINE p_mpi_type_create_struct
3 ! ***********************************
4 !
5  &(nblock,nelem,displ,elem_type,new_datatype,ierr)
6 !
7 !***********************************************************************
8 ! PARALLEL V6P2 21/08/2010
9 !***********************************************************************
10 !
11 !brief CALLS FUNCTION MPI_TYPE_STRUCT.
12 !
13 !history C. DENIS (SINETICS)
14 !+ 27/10/2009
15 !+ V6P0
16 !+
17 !
18 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
19 !+ 13/07/2010
20 !+ V6P0
21 !+ Translation of French comments within the FORTRAN sources into
22 !+ English comments
23 !
24 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
25 !+ 21/08/2010
26 !+ V6P0
27 !+ Creation of DOXYGEN tags for automated documentation and
28 !+ cross-referencing of the FORTRAN sources
29 !
30 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
31 !| NBLOCK |-->| NUMBER OF BLOCKS
32 !| NELEM |-->| NUMBER OF ELEMENTS IN EACH BLOCK
33 !| DISPL |-->| BYTE DISLACEMENT IN EACH BLOCK
34 !| ELEM_TYPE |-->| TYPE OF ELEMENTS IN EACH BLOCK
35 !| NEW_DATATYPE |<--| NEW DATATYPE
36 !| IERR |<--| ERROR VALUE
37 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
38 !
41  IMPLICIT NONE
42 !
43 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
44 !
45  INTEGER, INTENT(IN) :: NBLOCK
46  INTEGER, INTENT(OUT) :: IERR
47  INTEGER, INTENT(OUT) :: NEW_DATATYPE
48  INTEGER, INTENT(IN) :: NELEM(nblock)
49  INTEGER, INTENT(IN) :: ELEM_TYPE(nblock)
50  INTEGER(KIND=MY_ADDRESS_KIND), INTENT(INOUT) :: DISPL(nblock)
51 !
52 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
53 !
54  INTEGER I
55 
56  ierr = 0
57  new_datatype = 0
58 #if defined HAVE_MPI
59  CALL mpi_type_create_struct(nblock,nelem,displ,elem_type,
60  & new_datatype,ierr)
61 !
62  IF(ierr.NE.0) THEN
63  CALL mpi_error_string(ierr, mpi_error_msg, mpi_error_len, i)
64  WRITE(lu,*) 'P_MPI_TYPE_STRUCT:'
65  WRITE(lu,*) 'MPI_MSG: ', trim(mpi_error_msg)
66  WRITE(lu,*) 'MPI ERROR ',ierr
67  CALL plante(1)
68  stop
69  ENDIF
70  RETURN
71 #else
72  WRITE(lu,*) 'CALL OF P_MPI_TYPE_CREATE_STRUCT IN '//
73  & 'ITS VOID VERSION'
74 #endif
75 !
76 !-----------------------------------------------------------------------
77 !
78  END
character(len=mpi_max_error_string) mpi_error_msg
subroutine p_mpi_type_create_struct(NBLOCK, NELEM, DISPL, ELEM_TYPE, NEW_DATATYPE, IERR)