[mpich-discuss] Strange invalid pointer error
Rajeev Thakur
thakur at mcs.anl.gov
Tue Oct 27 20:10:06 CDT 2009
The buftot that is passed to MPI_Gather on the root (rank 0) needs to be
allocated of size RLEN*n*nprocs where nprocs is the size of COMM_WORLD.
Is it that size?
Rajeev
> -----Original Message-----
> From: mpich-discuss-bounces at mcs.anl.gov
> [mailto:mpich-discuss-bounces at mcs.anl.gov] On Behalf Of Thomas Ruedas
> Sent: Tuesday, October 27, 2009 6:20 PM
> To: MPICH Discussion List
> Subject: [mpich-discuss] Strange invalid pointer error
>
> Hi,
> sorry if this is a bit off-topic on this group, but the MPI,
> Fortran, or
> parallel computing groups on Google seem to be dead and
> drowned in spam,
> so this my best guess.
>
> I use MPICH and the Intel Fortran compiler v.9.1.045. The
> routines that
> cause trouble are posted in full below. As far as I can tell, the
> problems are caused by the allocatable array C_x, because the program
> passes through the routine if I comment out the IF blocks where
> f_bindump is called with it or with the tmp array that holds
> a part of
> it; that part in the code is enclosed between the lines with
> !#####. The
> error I get is:
> *** glibc detected *** free(): invalid pointer: 0xafc75008 ***
> forrtl: error (76): IOT trap signal
> If I compile and run the same program as a single-processor
> job, there
> is no problem at all with this routine, which lets me assume that the
> arrays are passed correctly. In parallel mode, all other
> arrays except
> for C_x seem to be passed between the nodes correctly, too. The
> dimensions of C_x should be ok, too, as nrq and nvol are known to all
> nodes with the correct values.
> Does anybody see an obvious or not so obvious mistake in my
> coding that
> I overlook or have any other suggestion? The Intel compiler
> should have
> produced a core dump file according to the description of this error
> code, but it didn't.
>
> I'd also appreciate if you can point me to a more appropriate
> forum than
> this.
> Thanks,
> Thomas
>
> subroutine
> dump_frame(temp,u,eta,comp,fmelt,vmelt,rho,damage,age,nmelt,&
> stress,edot,W,ut,up,inum,istep,ttime,nx,ny,nz,nb)
> use io
> use control
> use grid
> use stencildef
> use refstat
> use viscostuff, only: const_eta
> use comppars, only: nrq,radnames
> use externalfns,only: mynode
> implicit none
> integer,intent(in):: inum,nx,ny,nz,nb,istep
> integer :: i,nvol,ierr
> real,intent(in),dimension(-1:nx,-1:ny,-1:nz,nb)::
> temp,comp,fmelt,vmelt,rho,&
> damage,age,nmelt,stress,edot,W
> real,intent(in),dimension(4,-1:nx+1,-1:ny+1,-1:nz,nb):: u,ut,up
> real,intent(in),dimension(9,-1:nx,-1:ny,-1:nz,nb):: eta
> real,intent(in):: ttime
> real, allocatable :: tmp(:,:,:,:),tmp2(:,:,:,:),A(:),geoid(:,:,:,:),&
> cs(:,:,:,:),C_x(:,:,:,:,:),vptmp(:,:,:,:,:)
> complex, allocatable :: geoid_lm(:,:,:),cs_lm(:,:,:)
> character :: name*100,rdwrt*8
> name=output_file_stem
> if (t_write) call f_bindump(name,'_t
> ',inum,deltaT_dimensional,temp,ttime,1)
> if (vp_write) then
> allocate(vptmp(4,-1:nx,-1:ny,-1:nz,nb))
> vptmp=u(:4,-1:nx,-1:ny,-1:nz,:nb)
> call f_bindump(name,'_v ',inum,1.,vptmp,ttime,4)
> deallocate(vptmp)
> end if
> if (eta_write.and..not.const_eta) &
> call f_bindump(name,'_eta ',inum,eta0,eta(1,:,:,:,:),ttime,1)
> if ((composition.or.tracers).and.c_write) &
> call f_bindump(name,'_c ',inum,1.,comp,ttime,1)
> if (H2O_write) then
> nvol=1
> else
> nvol=0
> end if
> !########################
> if (rdnuc_write .or. H2O_write) then
>
> allocate(C_x(-1:nx,-1:ny,-1:nz,nb,nrq+nvol),tmp(-1:nx,-1:ny,-1
> :nz,nb),stat=ierr)
> if (ierr /= 0) stop 'ERROR: Data array allocation for
> tracers_to_C_x
> failed.'
> if (tracers) &
> call
> tracers_to_C_x(temp,fmelt,comp,rho,C_x,nx,ny,nz,nb,nrq+nvol,nrq)
> end if
> if (rdnuc_write) then
> do i=1,nrq
> rdwrt='_'//trim(radnames(i))//' '
> tmp=C_x(:,:,:,:,i)
> call f_bindump(name,rdwrt,inum,1.,tmp,ttime,1)
> end do
> end if
> if (H2O_write) then
> tmp=C_x(:,:,:,:,nrq+nvol)
> call f_bindump(name,'_H2O ',inum,1.,tmp,ttime,1)
> end if
> if (allocated(C_x)) then
> deallocate(C_x,tmp,stat=ierr)
> if (ierr /= 0) &
> stop 'ERROR: Data array deallocation in
> tracers_to_C_x failed.'
> end if
> !########################
> if (damage_evolution .and. d_write .and. me0) &
> write(*,*) 'WARNING: dump not implemented for damage'
> if (melting) then
> if (f_write) &
> call f_bindump(name,'_f ',inum,1.,fmelt,ttime,1)
> if (vm_write .and. me0) write(*,*) 'WARNING: dump not implemented
> for vm'
> end if
> if (g_write) topo_write=.true.
> if (topo_write) then
> allocate(tmp2(2,-1:nx,-1:ny,nb))
> call topography(u,eta,rho,gl,nx,ny,nz,nb,tmp2)
> call write_2D_fields (name,'_cs ',inum,tmp2, &
> nx,ny,nb,istep,ttime,2)
> if (topo_write_ascii) call write_ascii_2Dfields (name,'_sc
> ',inum,tmp2,2, &
> nx,ny,nb,gl%dx,gl%dy)
> if (g_write) then
> allocate(geoid_lm(2,0:lmax,0:lmax),cs_lm(2,0:lmax,0:lmax), &
> geoid(2,-1:nx,-1:ny,nb),cs(2,-1:nx,-1:ny,nb))
> call calc_geoid
> (rho,tmp2,nx,ny,nz,nb,lmax,geoid_lm,geoid,cs_lm,cs)
> call write_2D_fields (name,'_g
> ',inum,geoid,nx,ny,nb,istep,ttime,2)
> call write_2D_fields (name,'_csg ',inum,cs,
> nx,ny,nb,istep,ttime,2)
> if (g_write_ascii) then
> call write_ascii_2Dfields(name,'_g
> ',inum,geoid,2,nx,ny,nb,gl%dx,gl%dy)
> call write_ascii_2Dfields(name,'_scg
> ',inum,cs,2,nx,ny,nb,gl%dx,gl%dy)
> end if
> call write_sphharm_ascii( cs_lm,2,lmax,name,'_cslm ',inum)
> call write_sphharm_ascii(geoid_lm,2,lmax,name,'_glm ',inum)
> deallocate(geoid_lm,cs_lm,geoid,cs)
> end if
> deallocate(tmp2)
> end if
> if (stress_write .or. vd_write .or. edot_write) then
> if (me0) write(*,*) 'WARNING: dump not implemented for
> stress/edot/vd'
> end if
> if (tra_write.and.tracers .and. me0) &
> write(*,*) 'WARNING: dump not implemented for tracers'
> return
> end subroutine dump_frame
>
> !-------------------------------------------------------------
> -----------------
>
> subroutine f_bindump(name_stem,cen,inum,scf,a,total_timedMy,ndim)
> use control
> use grid
> use meltstuff
> use pgz
> use externalfns, only: ncharl,cnum,mynode
> use refstat
> implicit none
> integer, intent(in) :: inum,ndim
> integer :: ntot
> real, intent(in) ::
> a(ndim,-1:nxtot,-1:nytot,-1:nztot,nbtot),scf,total_timedMy
> real, allocatable :: atot(:,:,:,:,:)
> character, intent(in) :: name_stem*100,cen*12
> character :: name*100,c0*1
> if (me0) allocate(atot(:ndim,-1:nxtot,-1:nytot,-1:nztot,:nbtot))
> ntot=ndim*(nxpn+2)*(nypn+2)*(nzpn+2)*nbpn
> call ggather(a,atot,ntot)
> if (me0) then
> call char0(c0)
>
> name=name_stem(1:ncharl(name_stem))//cen(1:ncharl(cen))//cnum(
> inum)//c0
> open(10,file=name,form='unformatted',action='write')
> write(10) ndim
> write(10) nxtot,nytot,nztot,nbtot
> write(10) axisymmetric,cylindrical,spherical
> write(10) scf,total_timedMy,D_dimensional,aspect_ratio
> write(10) zl(1,0:nztot-1)
> write(10) phyd(0:nztot-1)
> write(10) atot(:ndim,0:nxtot-1,0:nytot-1,0:nztot-1,:nbtot)
> close(10)
> deallocate(atot)
> end if
> call gsync()
> return
> end subroutine f_bindump
>
> subroutine ggather(buf,buftot,n)
> use mpi
> use precision,only: RLEN
> implicit none
> integer, intent(in) :: n
> integer :: ierr
> real, intent(in) :: buf(n)
> real, intent(out) :: buftot(*)
> call
> MPI_GATHER(buf,RLEN*n,MPI_BYTE,buftot,RLEN*n,MPI_BYTE,0,MPI_CO
> MM_WORLD,ierr)
> end subroutine ggather
>
> subroutine gsync ()
> use mpi
> call mpi_barrier (MPI_comm_world,ierr)
> end subroutine gsync
> --
> -----------------------------------
> Thomas Ruedas
> Department of Terrestrial Magnetism
> Carnegie Institution of Washington
> http://www.dtm.ciw.edu/users/ruedas/
> _______________________________________________
> mpich-discuss mailing list
> mpich-discuss at mcs.anl.gov
> https://lists.mcs.anl.gov/mailman/listinfo/mpich-discuss
>
More information about the mpich-discuss
mailing list