[mpich-discuss] Strange invalid pointer error
Thomas Ruedas
ruedas at dtm.ciw.edu
Tue Oct 27 18:20:00 CDT 2009
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_COMM_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/
More information about the mpich-discuss
mailing list