Dear All I have this code as given below. I compile using 'Debug, Win32 mode in FTN95 V8.10 in VS2015 IDE. I am unable to build and it shows the error as cited in topic. The error happens at line 42 in subroutine extend_header().
Primarily, I want to assign values to a Header array type (info, comment), every time with new values and by incrementing the array size into +1 for every call. I have given the comments in the lines 42-45. I tried in Checkmate and Debug mode, but no use. But the value of isize in Main program is correctly showing, but not in subroutine imax, where it is failing. Can anyone help in knowing what is the error.
module mhead
type header
character(len=32) :: info !format a80 col 2 to 81
character(len=32) :: comment !format a80 col 2 to 81
end type header
type (header), dimension(:), allocatable,save :: hdr
end module mhead
program main
use mhead
implicit none
integer :: hdrpar=1, allocstat, i, isize=1
if (.not. allocated (hdr)) allocate (hdr(1:hdrpar), stat=allocstat)
if(allocstat>0) stop 'header parameters array dynamic allocation failed..'
!array initialise
do i = 1, size(hdr)
hdr(i)%info='' !format a80 col 2 to 81
hdr(i)%comment='' !format a80 col 2 to 81
enddo
hdr(1)%info='firstiteminfo'
hdr(1)%comment = 'firstitemcomment'
isize=ubound(hdr,1) !This shows the ubound as 1 correctly here.
! hdr array size = 1
call extend_header(hdr) !call subroutine to extend hdr array to +1 and return the array
!call extend_header(iaddr,isize)
print*, ubound(hdr,1) ! now ubound(hdr,1) = 2
hdr(ubound(hdr,1))%info='Seconditeminfo'
hdr(ubound(hdr,1))%comment = 'Seconditemcomment'
end program main
subroutine extend_header(s)
use mhead
implicit none
type (hdr), pointer :: s(:), tmp(:)
integer*8 :: imax, istat=0
if (allocated(s)) then
imax = ubound(s,1) !This shows wrong value and stops as 'access violation'
!this should be 1 for the 1st call from main program.
! But this shows 8digit number which is wrong.
! I know, it is nothing but Pointer address from 1 to last of the array hdr.
if (.not. allocated(tmp)) allocate(tmp(1:imax),stat=istat)
if (istat /= 0) stop 'extend_header():some problem in header tmp array allocation'
tmp(1:imax) = s(1:imax) ! this is also throws error as 'access violation'
deallocate(s)
istat=0
allocate(s(1:imax+1),stat=istat)
if (istat /= 0) stop 'extend_header():some problem in extending header array allocation'
s(1:imax) = tmp(1:imax)
deallocate (tmp)
else
print*, 'extend_header(): header array ',s,' is not allocated.'
end if
end subroutine extend_header
But this code was running perfectly in earlier versions 7.10 and 7.20. But why it is failing here. The Pointer is used in subroutine for dynamically increase the array size on the orginal hdr arrays. But it is failing there in subroutine as unable to pickup ubound(s,1) ..
Is there any other betterway of doing this? Pls. suggest.
Thanks in advance,