Dear Gilles, Dear all,
I'm sorry to bother you again, but I have some problem with send and
receive the struct_data.
I tried to send a MPI_Type_Create_Struct but I get a segmentation fault
occurred and I do not know why. The program is very simple, it is the old
one with the isend and irecv subroutines
(you can find it in the attachment)
Thanks again
Diego
On 5 January 2015 at 15:54, Diego Avesani <[email protected]> wrote:
> Dear Gilles,
>
> Thanks, Thanks a lot.
> Now is more clear.
>
> Again, thanks a lot
>
> Diego
>
>
MODULE MOD_PRECISION
integer, parameter :: dp = selected_real_kind(p=16)
ENDMODULE
PROGRAM PROVA_STRUCT
USE MOD_PRECISION
IMPLICIT NONE
INCLUDE 'mpif.h'
!
TYPE tMPI
INTEGER :: myrank, nCPU, iErr, status
END TYPE tMPI
!
type particle
sequence
integer :: ip
real(dp) :: rp(2)
real(dp) :: QQ(4)
end type particle
!
TYPE(tMPI) :: MPI
INTEGER :: COMM_CART
INTEGER :: MPI_PARTICLE_TYPE_OLD
INTEGER :: MPI_PARTICLE_TYPE
INTEGER :: nstruct
INTEGER,ALLOCATABLE :: TYPES(:)
INTEGER,ALLOCATABLE :: LENGTHS(:)
INTEGER(MPI_ADDRESS_KIND),ALLOCATABLE,DIMENSION(:) ::DISPLACEMENTS
type(particle) :: dummy(2) ! Used for calculation of displacement
CALL MPI_INIT(MPI%iErr)
CALL MPI_COMM_RANK(MPI_COMM_WORLD, MPI%myrank, MPI%iErr)
CALL MPI_COMM_SIZE(MPI_COMM_WORLD, MPI%nCPU, MPI%iErr)
!
!
nstruct=3
ALLOCATE(TYPES(nstruct))
ALLOCATE(LENGTHS(nstruct))
ALLOCATE(DISPLACEMENTS(0:nstruct+1))
!
TYPES(1)=MPI_INTEGER
TYPES(2)=MPI_DOUBLE_PRECISION
TYPES(3)=MPI_DOUBLE_PRECISION
!
LENGTHS(1)=1
LENGTHS(2)=2
LENGTHS(3)=4
!
!
CALL MPI_GET_ADDRESS(dummy(1),DISPLACEMENTS(0),MPI%iErr)
CALL MPI_GET_ADDRESS(dummy(1)%ip,DISPLACEMENTS(1),MPI%iErr)
CALL MPI_GET_ADDRESS(dummy(1)%RP(1),DISPLACEMENTS(2),MPI%iErr)
CALL MPI_GET_ADDRESS(dummy(1)%QQ(1),DISPLACEMENTS(3),MPI%iErr)
CALL MPI_GET_ADDRESS(dummy(2),DISPLACEMENTS(4),MPI%iErr)
!
DISPLACEMENTS(1:nstruct+1)= DISPLACEMENTS(1:nstruct+1)-DISPLACEMENTS(0)
!
CALL MPI_TYPE_CREATE_STRUCT(nstruct,lengths,displacements,types,MPI_PARTICLE_TYPE_OLD,MPI%iErr)
CALL MPI_TYPE_COMMIT(MPI_PARTICLE_TYPE_OLD,MPI%iErr)
!
!
CALL MPI_TYPE_CREATE_RESIZED(MPI_PARTICLE_TYPE_OLD, DISPLACEMENTS(1), DISPLACEMENTS(4), MPI_PARTICLE_TYPE, MPI%iErr)
CALL MPI_TYPE_COMMIT(MPI_PARTICLE_TYPE,MPI%iErr)
!
IF(MPI%myrank==0)THEN
WRITE(*,*) DISPLACEMENTS
ENDIF
!
IF(MPI%myrank==0)THEN
CALL MPI_ISEND(DUMMY(1),1,MPI_PARTICLE_TYPE,1,0,MPI_COMM_WORLD,1,MPI%iErr)
ENDIF
!
IF(MPI%myrank==1)THEN
CALL MPI_IRECV(DUMMY(1),1,MPI_PARTICLE_TYPE,0,0,MPI_COMM_WORLD,1,MPI%iErr)
ENDIF
!
CALL MPI_Finalize(MPI%iErr)
!
ENDPROGRAM
