Hi,
I have a problem with a derived type that gives me an error when I change one of the arrays in the derived type to allocatable:
Assertion failed in file src/mpid/common/datatype/dataloop/segment.c at line 816: 0
internal ABORT - process 3
I can’t see why there should be a problem in the code:
program struct
USE MPI
IMPLICIT NONE
INTEGER,PARAMETER :: IB = 4,RP=KIND(0.0)
INTEGER,PARAMETER :: NFIELD = 30
INTEGER,PARAMETER :: NPVPERT = 5,NSTN = 30,NARFP = 1,NPV = 5, NVMX = 20
INTEGER,PARAMETER :: NDEP = 25, NRAN = 60, NDAT = 6592, src = 0
INTEGER(KIND=IB) :: ifield,rank,ierr,numtasks,isource1,isource2,tag1
INTEGER(KIND=IB) :: oldtypes(NFIELD), blockcounts(NFIELD)
INTEGER(KIND=MPI_ADDRESS_KIND) :: offsets(NFIELD)
INTEGER(KIND=IB) :: iextent,rextent,dextent
integer :: n, status(mpi_status_size)
INTEGER :: objtype !! Name of objtype for MPI sending
TYPE :: objstruc
REAL(KIND=RP),DIMENSION(NVMX,NPV) :: voro
REAL(KIND=RP),DIMENSION(NDEP,NRAN) :: ffsl1
REAL(KIND=RP),DIMENSION(NDEP,NRAN) :: ffsl2
REAL(KIND=RP),DIMENSION(NDEP,NRAN) :: ffsr
REAL(KIND=RP),DIMENSION(NDEP,NRAN) :: ffdelay
REAL(KIND=RP),DIMENSION(NSTN) :: sdpar
REAL(KIND=RP),DIMENSION(NARFP*NSTN) :: arpar
INTEGER(KIND=IB),DIMENSION(NARFP*NSTN) :: idxar
REAL(KIND=RP),DIMENSION(NPVPERT-2) :: g
REAL(KIND=RP),DIMENSION(NPVPERT-2) :: gp
REAL(KIND=RP),DIMENSION(NPVPERT-2,NPVPERT-2) :: Chat
REAL(KIND=RP),DIMENSION(NPVPERT-2,NPVPERT-2) :: Chati
REAL(KIND=RP) :: detChat
REAL(KIND=RP) :: beta
INTEGER(KIND=IB) :: k
REAL(KIND=RP) :: sd
REAL(KIND=RP) :: logL
REAL(KIND=RP) :: logPr
REAL(KIND=RP) :: lognorm
INTEGER(KIND=IB) :: ipropose_bd = 0
INTEGER(KIND=IB) :: iaccept_bd = 0
INTEGER(KIND=IB),DIMENSION(NPV) :: iproposevoro = 0
INTEGER(KIND=IB),DIMENSION(NPV) :: iacceptvoro = 0
REAL(KIND=RP), DIMENSION(NPV) :: pertsd = 0._RP
REAL(KIND=RP) :: tcmp
REAL(KIND=RP),DIMENSION(NDAT) :: dobs
REAL(KIND=RP),DIMENSION(NDAT) :: drep
REAL(KIND=RP),DIMENSION(NDAT) :: dres
!REAL(KIND=RP),DIMENSION(NDAT) :: dar
REAL(KIND=RP),DIMENSION(:),ALLOCATABLE :: dar
INTEGER(KIND=IB),DIMENSION(:),ALLOCATABLE :: NTSMP
END TYPE objstruc
TYPE (objstruc),DIMENSION(2) :: obj
ALLOCATE( obj(1)%dar(NDAT) )
ALLOCATE( obj(2)%dar(NDAT) )
call mpi_init(ierr)
call mpi_comm_rank(mpi_comm_world, rank, ierr)
call mpi_comm_size(mpi_comm_world, numtasks, ierr)
! Need to first figure offset by getting size of MPI_REAL etc
call MPI_TYPE_EXTENT(MPI_INTEGER, iextent, ierr)
call MPI_TYPE_EXTENT(MPI_REAL, rextent, ierr)
call MPI_TYPE_EXTENT(MPI_DOUBLE_PRECISION, dextent, ierr)
blockcounts = (/ NVMX*NPV , NDEP*NRAN, NDEP*NRAN, NDEP*NRAN, NDEP*NRAN, NSTN, NARFP*NSTN, NARFP*NSTN, &
NPVPERT-2, NPVPERT-2, (NPVPERT-2)**2, (NPVPERT-2)**2, 1, &
1, 1, 1, 1, 1, 1, &
1, 1, NPV, NPV, NPV, 1, &
NDAT, NDAT, NDAT, NDAT, NSTN /)
oldtypes(1:7) = MPI_REAL
oldtypes(8) = MPI_INTEGER
oldtypes(9:14) = MPI_REAL
oldtypes(15) = MPI_INTEGER
oldtypes(16:19) = MPI_REAL
oldtypes(20:23) = MPI_INTEGER
oldtypes(24:25) = MPI_REAL
oldtypes(26:29) = MPI_REAL
oldtypes(30) = MPI_INTEGER
offsets(1) = 0
IF(oldtypes(1) == MPI_REAL)THEN
offsets(2) = rextent * blockcounts(1)
ELSEIF(oldtypes(1) == MPI_INTEGER)THEN
offsets(2) = iextent * blockcounts(1)
ENDIF
DO ifield = 3,NFIELD
IF(oldtypes(ifield-1) == MPI_REAL)THEN
offsets(ifield) = offsets(ifield-1) + rextent*blockcounts(ifield-1)
ELSEIF(oldtypes(ifield-1) == MPI_INTEGER)THEN
offsets(ifield) = offsets(ifield-1) + iextent*blockcounts(ifield-1)
ENDIF
ENDDO
call MPI_TYPE_CREATE_STRUCT( NFIELD, blockcounts, offsets, oldtypes, objtype, ierr)
call MPI_TYPE_COMMIT(objtype, ierr)
IF(rank==src)THEN
PRINT*,rank,'receiving'
CALL MPI_RECV(obj(1), 1, objtype, MPI_ANY_SOURCE,MPI_ANY_TAG, MPI_COMM_WORLD, status, ierr )
isource1 = status(MPI_SOURCE) !! This saves the slave id for the following communication
PRINT*,rank,'received from',isource1
CALL MPI_RECV(obj(2), 1, objtype, MPI_ANY_SOURCE,MPI_ANY_TAG, MPI_COMM_WORLD, status, ierr )
isource2 = status(MPI_SOURCE) !! This saves the slave id for the following communication
PRINT*,rank,'receiving from',isource2
CALL MPI_SEND(obj(1), 1,objtype, isource1, rank, MPI_COMM_WORLD, ierr)
PRINT*, 'SENDING'
CALL MPI_SEND(obj(2), 1,objtype, isource2, rank, MPI_COMM_WORLD, ierr)
PRINT*, 'DONE SENDING'
ELSE
PRINT*,rank,'sending'
tag1 = 1
CALL MPI_SEND(obj, 1,objtype, src, tag1, MPI_COMM_WORLD, ierr)
PRINT*,rank,'receiving'
CALL MPI_RECV(obj, 1,objtype, src, MPI_ANY_TAG, MPI_COMM_WORLD, status, ierr )
ENDIF
call mpi_finalize(ierr)
end
Any help would be greatly appreciated.
Jan