[Bug fortran/31560] Array size declaration depended on order of declaration of variable containing size

["David dot Duffy at qimr dot edu dot au" <gcc-bugzilla at gcc dot gnu dot org>]

------- Comment #5 from David dot Duffy at qimr dot edu dot au  2007-04-14 01:09 -------
Subject: Re:  Array size declaration depended on order of
 declaration of variable containing size 

You wrote:

> as parameter is not allowed in a type specification and using a simple
>   type ped_data
>     integer :: maxsiz = 5
>   end type ped_data
> does also not work:
>   integer, dimension(dataset%maxsiz) :: nobs
>                     1
> Error: Variable 'dataset' cannot appear in the expression at (1)
> or in words of NAG f95:
>   DATASET is not permitted in a specification expression


and tobi at gcc dot gnu dot org wrote:

> 
> 
> ------- Comment #2 from tobi at gcc dot gnu dot org  2007-04-13 15:22 -------
> (In reply to comment #0)
>> GNU Fortran (GCC) 4.3.0 20070412 (experimental)
>> Linux 2.4.20-20030701 #2 SMP
>>
>>   use ped_class
>>   type (ped_data) :: dataset
>>   integer, dimension(dataset%maxsiz) :: nobs
>> 
>> works but
>>
>>   use ped_class
>>   integer, dimension(dataset%maxsiz) :: nobs
>>   type (ped_data) :: dataset
>> 
>> doesn't.
> 
> If I understand you correctly, what you're trying to do is invalid.  You may
> only reference previously declared objects in data object declarations.  In
> your second example dataset is referenced before it is declared.
> 
> Please provide a complete testcase, and if the problem is indeed the order of
> declarations please tell us where you think I'm wrong.
>

Hi.

Please find a cutdown example attached.  In this form, it compiles successfully
with gfortran, ifort and g95.  If line 251 is commented out and line 256
uncommented, only g95 compiles it successfully.

Since dataset, nobs and relid are all subroutine arguments, it seems
plausible to me that the order of declaration should be irrelevant, even
though it require more work by the compiler.  I haven't looked at the Fortran
Standard (and probably couldn't work out what it was saying anyway ;)) to see
if there is a defined behaviour.

Cheers,

David Duffy.
!
! Output stream
!
module outstream
  integer :: outstr
end module outstream
!
! One big pedigree data structure
! Updating size requires copying entire structure
! (hopefully maintaining contiguous storage)
!
module idstring_widths
  integer, parameter :: ped_width = 20
  integer, parameter :: id_width = 12
end module idstring_widths
module ped_class
  use idstring_widths
  type ped_data
    integer :: nped   ! number of pedigrees
    integer :: nact   ! number of active pedigrees
    integer :: maxsiz ! size of largest pedigree
    integer :: nobs   ! number of records
    integer :: numloc ! number of columns of locus data
! pedigree level data
    character (len=ped_width), dimension(:), allocatable :: pedigree
    integer, dimension(:), allocatable :: num
    integer, dimension(:), allocatable :: nfound
    integer, dimension(:), allocatable :: actset
! individual level data
    integer, dimension(:), allocatable :: iped
    character (len=id_width), dimension(:), allocatable :: id
    integer, dimension(:), allocatable :: fa
    integer, dimension(:), allocatable :: mo
    integer, dimension(:), allocatable :: sex
    double precision, dimension(:,:), allocatable :: locus
! useful work arrays -- usually referring to locus being currently analysed
    logical, dimension(:), allocatable :: untyped
  end type ped_data

contains
!
! allocate pedigree data
!
  subroutine setup_peds(nped, nobs, numloc, dataset)
    integer :: nobs, nped, numloc
    type (ped_data) :: dataset
    dataset%nped = nped
    dataset%nact = nped
    dataset%maxsiz = 0
    dataset%nobs = nobs
    dataset%numloc = numloc
    allocate(dataset%pedigree(nped))
    allocate(dataset%num(0:nped))
    allocate(dataset%nfound(nped))
    allocate(dataset%actset(nped))
    dataset%num(0)=0

    allocate(dataset%iped(nobs))
    allocate(dataset%id(nobs))
    allocate(dataset%fa(nobs))
    allocate(dataset%mo(nobs))
    allocate(dataset%sex(nobs))
    allocate(dataset%locus(nobs, numloc))
    allocate(dataset%untyped(nobs))
  end subroutine setup_peds
!
! copy pedigree data
!
  subroutine copy_peds(set1, set2)
    type (ped_data) :: set1, set2
    integer :: i
    set2%nped = set1%nped
    set2%nact = set1%nact
    set2%maxsiz = set1%maxsiz
    set2%nobs = set1%nobs
    set2%numloc = set1%numloc
    do i=0, set1%nped
      set2%num(i)      = set1%num(i)     
    end do
    do i=1, set1%nped
      set2%pedigree(i) = set1%pedigree(i)
      set2%nfound(i)   = set1%nfound(i)  
      set2%actset(i)   = set1%actset(i)  
    end do
    do i=1, set1%nobs
      set2%iped(i) = set1%iped(i) 
      set2%id(i) = set1%id(i) 
      set2%fa(i) = set1%fa(i) 
      set2%mo(i) = set1%mo(i)
      set2%sex(i) = set1%sex(i)
      set2%locus(i, 1:set1%numloc) =  set1%locus(i, 1:set1%numloc)
    end do
  end subroutine copy_peds
!
! deallocate pedigree structure arrays
!
  subroutine cleanup_peds(dataset)
    type (ped_data) :: dataset
    if (allocated(dataset%locus)) then
      deallocate(dataset%pedigree)
      deallocate(dataset%num)
      deallocate(dataset%nfound)
      deallocate(dataset%actset)

      deallocate(dataset%iped)
      deallocate(dataset%id)
      deallocate(dataset%fa)
      deallocate(dataset%mo)
      deallocate(dataset%sex)
      deallocate(dataset%locus)
      deallocate(dataset%untyped)
    end if
    dataset%nped=0
    dataset%nact=0
    dataset%maxsiz=0
    dataset%nobs=0
    dataset%numloc=0
  end subroutine cleanup_peds
end module ped_class
program tester
  use outstream
  use ped_class
  type (ped_data) :: work   
  integer :: MISS=-9999
  outstr=6
  call setup_peds(1, 4, 1, work)
  work%maxsiz=4
  work%pedigree(1)='Test'
  work%num(1)=4
  work%nfound(1)=2
  work%actset(1)=2
  work%iped=1
  work%id(1)='1'
  work%id(2)='2'
  work%id(3)='3'
  work%id(4)='4'
  work%fa=MISS
  work%mo=MISS
  work%fa(3)=1
  work%mo(3)=2
  work%fa(4)=1
  work%mo(4)=2
  work%sex=1
  work%locus=1.0d0
  call getrelval('sib', 'mea', 'test', 4, 1, MISS, work, 0)
  call cleanup_peds(work)
end program tester
!
! Get values for trait in relatives
!
subroutine getrelval(relate, summary, locnam, loctyp, trait,  &
                     sumval, dataset, plevel)
  use outstream
  use ped_class  
  implicit none
  character (len=3), intent(in) :: relate, summary
  character (len=10), intent(in) :: locnam
  integer, intent(in) :: loctyp
  integer, intent(in) :: trait, sumval
  type (ped_data) :: dataset
  integer, intent(in) :: plevel
!
  integer, parameter :: MISS=-9999, MAXREC=20
! trait values in relatives
  integer, dimension(dataset%maxsiz) :: nobs
  integer, dimension(dataset%maxsiz, MAXREC) :: relid
  integer :: currf, currm, i, idx, j, k, nsibs, num, pedoffset, ped, pos,  &
             reltyp, totobs
  character (len=1) :: ch
  character (len=6), dimension(13) :: relnam = (/  'All      ',  &
    'Offspring', 'Son      ', 'Daughter ',  &
    'Parent   ', 'Father   ', 'Mother   ',  &
    'Sibling  ', 'Brother  ', 'Sister   ',  &
    'Spouse   ', 'Husband  ', 'Wife     ' /)

  reltyp=1
  if (relate=='sib') then
    reltyp=8
  end if
  if (plevel >= 0) then
    write(outstr, '(/3a/a)') 'Pedigree       ID         Rel   Summary (',
summary, ')',  &
                            '------------ ------------ ---
--------------------'
  end if
  totobs=0
! Siblings
  if (reltyp==8 .or. reltyp==9 .or. reltyp==10) then
    do ped=1, dataset%nped
    if (dataset%actset(ped) > 0) then
      pedoffset=dataset%num(ped-1)+dataset%nfound(ped)
      num=dataset%num(ped)-dataset%num(ped-1)
      do k=1, num
        nobs(k)=-1
      end do
      nobs((dataset%nfound(ped)+1):num)=0
      currf=MISS
      currm=MISS
      idx=num
      i=dataset%num(ped)
      do while (i > pedoffset)
        currf=dataset%fa(i)
        currm=dataset%mo(i)
        nsibs=0
        pos=i-1
        do while (dataset%fa(pos)==currf .and. dataset%mo(pos)==currm)
          nsibs=nsibs+1
          pos=pos-1
        end do
        do j=pos+1, i
          if (reltyp==8 .or. (reltyp==9 .and. dataset%sex(j)==1) .or.  &
                             (reltyp==10 .and. dataset%sex(j)==2)) then
            if (dataset%locus(j,trait) /= MISS .and. nobs(idx) < MAXREC) then
              nobs(idx)=nobs(idx)+1
              relid(idx, nobs(idx))=j
            end if
          end if
        end do
        do j=idx-nsibs, idx-1
          nobs(j)=nobs(idx)
          do k=1, nobs(idx)
            relid(j,k)=relid(idx,k)
          end do
        end do
        i=pos
        idx=idx-nsibs-1
      end do
      call prirelval(relnam(reltyp), summary, trait, loctyp, ped, nobs, relid, 
&
                     sumval, totobs, dataset, plevel)
    end if
    end do
  end if
  if (plevel <= 0 .and. totobs>=30) then
    write(outstr, '(a)') '...'
  end if
  write(outstr, '(/a,i6,a)')  &
    'Processed', totobs, ' trait values from relatives.'
end subroutine getrelval
!
! Output values for each eligible persion
! 
subroutine prirelval(relate, summary, trait, loctyp, ped,  &
                     nobs, relid, sumval, totobs, dataset, plevel)
  use outstream
  use ped_class  
  implicit none
  integer, parameter :: MAXREC=20
  character (len=3), intent(in) :: relate
  character (len=3), intent(in) :: summary
  integer, intent(in) :: trait, loctyp
  integer, intent(in) :: ped
! FROM HERE
  type (ped_data) :: dataset 
! trait values in relatives
  integer, dimension(dataset%maxsiz) :: nobs
  integer, dimension(dataset%maxsiz, MAXREC) :: relid
! TO HERE
! type (ped_data) :: dataset
  integer, intent(in) :: sumval
  integer, intent(inout) :: totobs
  integer, intent(in) :: plevel
!
  integer, parameter :: MISS=-9999
  integer :: i, idx, j, n, pedoffset
  double precision :: res
  character (len=1) :: ch
! functions
!
! Detailed output
!
  pedoffset=dataset%num(ped-1)
  if (summary=='sum' .or. summary=='mea') then
    idx=0
    do i=pedoffset+1, dataset%num(ped)
      idx=idx+1
      res=MISS
      if (nobs(idx) > 0) then
        totobs=totobs+1
        res=0.0d0
        do j=1, nobs(idx)
          res=res+dataset%locus(relid(idx,j),trait)
        end do
        if (loctyp==4) res=res-dfloat(nobs(idx))
        if (summary=='mea') res=res/dfloat(nobs(idx))
        if (plevel>0 .or. (plevel==0 .and. totobs<30)) then
          write(outstr, '(a12,1x,a12,1x,a3,1x,f16.4)')  &
             dataset%pedigree(ped), dataset%id(i), relate, res
        end if
      else if (nobs(idx) == 0 .and.  &
               (plevel>0 .or. (plevel==0 .and. totobs<30))) then
        write(outstr, '(a12,1x,a12,1x,a3,12x,a)')  &
          dataset%pedigree(ped), dataset%id(i), relate, 'x'
      end if
      if (sumval /= MISS) dataset%locus(i, sumval)=res
    end do
  end if
end subroutine prirelval
!  
! binary trait as character
!  
subroutine wraff(value, ch, typ)
  double precision, intent(in) :: value
  character (len=1), intent(out) :: ch
  integer, intent(in) :: typ
  character (len=1), dimension(6), parameter :: let=(/'x','n','y','?','U','A'/)
  ch=let(1+3*(typ-1))
  if (value == 1.0d0) then
    ch=let(2+3*(typ-1))
  else if (value == 2.0d0) then
    ch=let(3+3*(typ-1))
  end if
end subroutine wraff


-- 


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=31560