Print

Print
hello unto the list,
 
 I am having problems with the deallocate and allocate aspects of part of my  FORTRAN code.  in particular, i think that the issue has to do with memory allocation. After completing iteration # 2 of my f loop (see below), the program crashes or rather most of the time it crashes and sometimes it just freezes up. I am confident that this is the point where the bug is. as the program runs up to this point.
 
I have subroutines not shown but since they work for other simulation combinations, I am reasonably confident that they are not the problem. I am using deallocate and allocate in other plces within the program (successfully) so I am surprised that it is not working here.
 
here are a couple of the error messages i received
 

jgold@clinic:~/smwcv/error_infect/test/surfaces/multistage/adaptonly$ ./adatptmultistage1.out                                                                *** glibc detected *** ./adatptmultistage1.out: munmap_chunk(): invalid pointer: 0x0000000001742ca0 ***

======= Backtrace: =========

/lib/libc.so.6(+0x77806)[0x7f0a06ec7806]

./adatptmultistage1.out[0x427dac]

./adatptmultistage1.out[0x403e28]

./adatptmultistage1.out[0x40310c]

/lib/libc.so.6(__libc_start_main+0xfd)[0x7f0a06e6ec4d]

./adatptmultistage1.out[0x403009]

 

 

and

*** glibc detected *** ./adatptmultistage1.out: double free or corruption (out): 0x0000000001b34dd0 ***

======= Backtrace: =========

/lib/libc.so.6(+0x77806)[0x7f2ffdfe8806]

/lib/libc.so.6(cfree+0x73)[0x7f2ffdfef0d3]

./adatptmultistage1.out[0x427fcc]

./adatptmultistage1.out[0x403f44]

./adatptmultistage1.out[0x40310c]

/lib/libc.so.6(__libc_start_main+0xfd)[0x7f2ffdf8fc4d]

./adatptmultistage1.out[0x403009]

 

 

if this is not the right forum to ask this question can you suggest a better one. thank you in advance for your help.

 

below is the program.

 

program main

implicit none  
character(LEN =5) :: ch_index, ch_indexwin  
character (len = 5) :: filenumchar, filenumcharimp  
character (len = 1) :: nad  
integer :: indexbtw, indexwin, nobs, e, f, i, stagecount, j, one, m, n,g,
h, filenum, dumzero, nperiodphi1, nperiodphi2, l, hmax  

integer , dimension(:), allocatable :: randvect 
character (LEN = 50) :: phi1name, phi2name, freqname  
 integer, dimension(:) , allocatable  :: phi1vect, phi2vect, phi1out,
phi2out, phi1outind, phi2outind, phi1outs1, phi2outs1, phi1outinds1, phi2outinds1 
real, dimension(:), allocatable :: freq, weight50ks2hyb, weightpercum,
weight50k, weight50ks2ind, freqtrue, weight50ks3hyb, weight50ks3ind, poffvect
real, dimension (: , :), allocatable  ::  freqtestindep, freqtesthyb
real :: moddat, rand1, efphi1, efphi2, efvaraprox1, efvaraprox2  
real, dimension(1:6)  :: adremvect, exprate 
integer, dimension(1:6)  :: stagemaxa, iterat 
integer, dimension (1:7) :: iteratst1 
integer, dimension (1:4) ::  stagemaxnona, sizevectn 

nperiodphi1 = 35 
nperiodphi2 = 30 

nobs = nperiodphi1*(nperiodphi2 - 10) 

!stagemax = 40 


call random_seed 

   allocate(phi1vect(1:nobs))  
    allocate(phi2vect(1:nobs)) 
     allocate(weight50k(1:nobs)) 
     allocate(weight50ks3hyb(1:nobs)) 
    allocate(weight50ks3ind(1:nobs)) 
     allocate(freqtrue(1:nobs)) 
   allocate(poffvect(1:6)) 
   allocate(phi1out(1:1)) 
   allocate(phi2out(1:1)) 
allocate(phi1outs1(1:1)) 
   allocate(phi2outs1(1:1)) 

! temp allocation
 allocate(phi1outind(1:1)) 
   allocate(phi2outind(1:1)) 
allocate(phi1outinds1(1:1)) 
   allocate(phi2outinds1(1:1)) 
! temp allocation
 
  ! adjust phi1 & phi2out vector
hmax = 20 
!hmax = 2 
poffvect = (/0.01, 0.025, 0.05, 0.1, 0.25, 0.5  /) 
allocate(randvect(1:hmax)) 

randvect = 0 
!print *, "test" 
do h = 1, hmax 

! for 20 randomly selected files 
do
 dumzero = 0 

 call random_number(rand1) 
 filenum = int(rand1*200)+1 
 if (h .gt. 1) then 
! ensuring sample is w/o replacement 
 do i = 1, h 
 
  if (randvect(i) == filenum) then 
   dumzero = 1
   exit 
  end if  
 end do 

  end if 
 if (dumzero == 0) exit 

 end do 


 ! print *, h 
 randvect(h) = filenum 

 write(filenumchar, '(i3.3)') filenum 
write(filenumcharimp, '(i3.0)') filenum  

filenumchar = adjustl(filenumchar) 
 
filenumcharimp = adjustl(filenumcharimp) 

open(unit = 10, file = "surfacerevfreq"//trim(filenumcharimp)//".txt",  status = 'old')
!open(unit = 10, file = "surfacerevfreq11.txt",  status = 'old')

 read (10, *) phi1name, phi2name, freqname 

 do i = 1, nobs 

        read (10, *) phi1vect(i), phi2vect(i), freqtrue(i) 
            ! if (freqtrue(i) .ne. 0) then 
           !print *, freqtrue(i) 
           !end if 
         end do
close(10) 

!print *, "surfacerevfreq"//trim(filenumchar)//".txt" 
indexbtw  = 0 
! Open index file, read its index, update it.
  !do indexbtw = 1, 10 
   do indexbtw = 1, 5 
! for 5 replicates each

! Write the index to character variable ch_index

write(ch_index,'(i5.5)')indexbtw 


! nad = "a"
! adaptive info for max number of iterations, stages, and percent off at each stage

adremvect = (/ 0.9/4, 0.9/10, 0.9/13, 0.9/23, 0.9/28, 0.9/58 /) 
stagemaxa = (/ 6, 12, 15, 25, 30, 60 /) 
iterat =  (/ 50000, 25000, 20000, 15000, 10000, 5000 /)
iteratst1 = (/ 5000, 10000, 15000, 20000, 30000, 40000, 50000 /)
exprate = (/ 0.0, 0.5, 0.25, 0.125, 0.0625, 0.03125 /)

do e = 1, 6 
print *,"e", e
do f = 1, 7

print *,"f", f, iteratst1(f) 
 
deallocate(phi1outinds1) 
deallocate(phi2outinds1) 
print *, "we deallocate f loop ok", iteratst1(f) 

allocate(phi1outinds1(1:iteratst1(f))) 
   allocate(phi2outinds1(1:iteratst1(f))) 
 phi2outinds1 = 0 
 
!print *, "iteratst1(f) ", iteratst1(f) 
do g = 1, 6 
!print *,"g", g 
!print *, iterat(g), iteratst1(f) 
deallocate(phi1outind) 
deallocate(phi2outind) 

   allocate(phi1outind(1:iterat(g))) 
   allocate(phi2outind(1:iterat(g)))  
     

call stage1 ( iteratst1(f), nobs, nperiodphi1, nperiodphi2, ch_index, filenumchar, phi1vect, phi2vect, freqtrue, phi1outind, phi2outind, phi1outinds1, phi2outinds1) 

call weight( iteratst1(f), nobs, nperiodphi1, nperiodphi2, weight50k, "H", phi1outind, phi2outind) 

call indepstage2(2, iterat(g), nobs, nperiodphi1, nperiodphi2, ch_index,
 filenumchar, phi1vect, phi2vect, freqtrue, weight50k, stagemaxa(g), phi1outind, phi2outind, "a", adremvect(g), iteratst1(f), exprate(e)) 

!print *, "this is not the bug" 
call weight( iterat(g), nobs, nperiodphi1, nperiodphi2, weight50ks3ind,phi1outind,  phi2outind) 

do stagecount = 3, stagemaxa(g) -1 

call indepstage2(stagemaxnona(g), iterat(g), nobs, nperiodphi1, nperiodphi2, ch_index,  filenumchar, phi1vect, phi2vect,
  freqtrue, weight50ks3ind, stagemaxa(g), phi1outind, phi2outind, "a", adremvect(g), iteratst1(f), exprate(e))
 
 call weight( iterat(g), nobs, nperiodphi1, nperiodphi2, weight50ks3ind,phi1outind, phi2outind)

end do 

call indepstage2(stagemaxa(g), iterat(g), nobs, nperiodphi1, nperiodphi2, ch_index, filenumchar, phi1vect, phi2vect, freqtrue, weight50ks3ind, stagemaxa(g), phi1outind, phi2outind, "a", adremvect(g), iteratst1(f), exprate(e))

call efsize(phi1outind, iterat(g), efphi1) 
call efsize(phi2outind, iterat(g), efphi2) 

call kldiv(stagemaxa(g), iterat(g), nobs, nperiodphi1, nperiodphi2, 1, 0, filenumchar,
 ch_index, freqtrue,  "I", phi1outind, phi2outind, "a", efphi1, efphi2, phi1outinds1, phi2outinds1, iteratst1(f), exprate(e)) 


do j = 1, 6 
call stage1 ( iteratst1(f), nobs, nperiodphi1, nperiodphi2, ch_index, filenumchar,
phi1vect, phi2vect, freqtrue, phi1outind, phi2outind, phi1outinds1, phi2outinds1)

!print *, "testnn"
call weight( iteratst1(f), nobs, nperiodphi1, nperiodphi2, weight50k, "H", phi1outind, phi2outind) 


call indepstage2nnwght(2, iterat(g), nobs, nperiodphi1, nperiodphi2, poffvect(j), ch_index,
 filenumchar, phi1vect, phi2vect, freqtrue, weight50k, stagemaxa(g), phi1outind, phi2outind, "a", adremvect(g), iteratst1(f), exprate(e)) 

call weight( iterat(g), nobs, nperiodphi1, nperiodphi2, weight50ks3ind,phi1outind, phi2outind) 

!print *, "seg error is after here"

do stagecount = 3, stagemaxa(g) - 1 

call indepstage2nnwght(stagecount, iterat(g), nobs, nperiodphi1, nperiodphi2, poffvect(j), ch_index, filenumchar, phi1vect, phi2vect, freqtrue, weight50ks3ind, stagemaxa(g), phi1outind, phi2outind, "a", adremvect(g), iteratst1(f), exprate(e)) 

call weight( iterat(g), nobs, nperiodphi1, nperiodphi2, weight50ks3ind,phi1outind, phi2outind)

end do


call indepstage2nnwght(stagemaxa(g), iterat(g), nobs, nperiodphi1, nperiodphi2, poffvect(j), ch_index, filenumchar, phi1vect, phi2vect, freqtrue, weight50ks3ind,  stagemaxa(g), phi1outind, phi2outind, "a", adremvect(g), iteratst1(f), exprate(e)) 

call efsize(phi1outind, iterat(g), efphi1) 
call efsize(phi2outind, iterat(g), efphi2) 

call kldiv(stagemaxa(g), iterat(g), nobs, nperiodphi1, nperiodphi2, 4, poffvect(j), filenumchar, ch_index, freqtrue,  "I", phi1outind, phi2outind, "a", efphi1, efphi2, phi1outinds1, phi2outinds1, iteratst1(f), exprate(e)) 

end do 

!8 nn

do j = 1, 6
call stage1 ( iteratst1(f), nobs, nperiodphi1, nperiodphi2, ch_index, filenumchar, phi1vect, phi2vect, freqtrue, phi1outind, phi2outind, phi1outinds1, phi2outinds1)
call weight( iteratst1(f), nobs, nperiodphi1, nperiodphi2, weight50k, "H", phi1outind, phi2outind)

call indepstage28nnwght(2, iterat(g), nobs, nperiodphi1, nperiodphi2, poffvect(j), ch_index, filenumchar, phi1vect, phi2vect, freqtrue, weight50k, stagemaxa(g), phi1outind, phi2outind, "a", adremvect(g), iteratst1(f), exprate(e))

call weight( iterat(g), nobs, nperiodphi1, nperiodphi2, weight50ks3ind,phi1outind, phi2outind) 

do stagecount = 3, stagemaxa(g) - 1 

call indepstage28nnwght(stagecount, iterat(g), nobs, nperiodphi1, nperiodphi2, poffvect(j), ch_index,  filenumchar, phi1vect, phi2vect, freqtrue, weight50ks3ind,  stagemaxa(g), phi1outind, phi2outind, "a",adremvect(g), iteratst1(f), exprate(e))

call weight( iterat(g), nobs, nperiodphi1, nperiodphi2, weight50ks3ind,phi1outind, phi2outind)

end do

call indepstage28nnwght(stagemaxa(g), iterat(g), nobs, nperiodphi1, nperiodphi2, poffvect(j), ch_index, filenumchar, phi1vect, phi2vect, freqtrue, weight50ks3ind, stagemaxa(g), phi1outind, phi2outind, "a", adremvect(g), iteratst1(f), exprate(e)) 

call efsize(phi1outind, iterat(g), efphi1) 
call efsize(phi2outind, iterat(g), efphi2) 

call kldiv(stagemaxa(g), iterat(g), nobs, nperiodphi1, nperiodphi2, 8, poffvect(j), filenumchar, ch_index,  freqtrue, "I", phi1outind, phi2outind, "a", efphi1, efphi2, phi1outinds1, phi2outinds1, iteratst1(f), exprate(e)) 
! end various percentage off

end do 

! end loop of number of iterations under various adaptationsend do
! end number iterations stage onwards
end do 
print *, "f loop done", f 
end do 
 ! end replicates
end do 

! end multiple files
end do 
end do 

end program main



--
Jourdan Gold,
PhD Candidate,
Department of Mathematics and Statistics,
University of Guelph