------- 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
