Fortran不定大小的数组被subroutine调用是否可以？
写一段代码，从实验数据文件中，选取elab在limit1和limit2之间的实验数据存到type为struct_expt_data的数组中，然后再找出不同的elab值，存到elist数组中。
实验数据格式如下，其中第二列为elab：
DSG 2.72 130.000 0.19556E+03 0.72360E+01 HR(69)
DSG 2.72 150.000 0.17777E+03 0.23620E+02 HR(69)
DSG 3.01 130.000 0.18405E+03 0.68100E+01 HR(69)
DSG 3.01 150.000 0.15368E+03 0.18037E+02 HR(69)
DSG 3.33 130.000 0.17292E+03 0.63980E+01 HR(69)
DSG 3.33 110.000 0.17430E+03 0.11635E+02 HR(69)
DSG 3.33 150.000 0.15494E+03 0.14815E+02 HR(69)
DSG 3.69 130.000 0.16202E+03 0.59950E+01 HR(69)
P 21.10 100.000 0.38000E-01 0.80000E-02 MO(74)
P 21.10 120.000 0.19000E-01 0.11000E-01 MO(74)
P 21.10 140.000 0.60000E-02 0.30000E-02 MO(74)
SGT 29.25 0.000 0.31580E+03 0.26000E+01 BR(70)
SGT 29.60 0.000 0.30910E+03 0.95000E+01 BO(61)
SGT 29.76 0.000 0.31730E+03 0.26140E+01 LI(80)
NSKN 460.00 88.000 0.79000E-01 0.10800E+00 AR(00)
NSKN 460.00 96.000 0.27000E+00 0.10700E+00 AR(00)
NSKN 460.00 104.000 0.29500E+00 0.10000E+00 AR(00)
由于事先不知道处于limit1和limit2之间的实验数据个数，所以先声明不定大小的数组，然后用subroutine找出数组元素个数，然后allocate数组，然后再call一次subroutine写入元素，这样上面的每个步骤需要call两次，allocate一次，代码如下：
module aa
integer,parameter :: NER = kind(0.0d0)
type :: struct_Expt_Data
character(len=6) :: Ref
character(len=4) :: obsName
real(NER) :: acm, elab, val, error
integer :: ii ! ii is the the sequence number of elab list.
end type struct_Expt_Data
type :: data_chain
character(len=6) :: Ref
character(len=4) :: obsName
real(NER) :: acm, elab, val, error
type(data_chain),pointer :: next
end type data_chain
end module aa
module getdata
use aa
implicit none
contains
subroutine get_numdata(numdata,limit1,limit2)
character(len=4) :: obsname
real(NER) :: elab,acm,val,error
character(len=6) :: ref
integer :: numdata
real(NER) :: limit1,limit2
integer :: ii
integer :: istat
numdata=0
open(unit=330,file="all_data.dat",iostat=istat)
do
read(330,*,iostat=istat) obsname,elab
write(*,*) obsname , elab
if (istat /= 0) exit
if (elab >= limit1 .and. elab <= limit2) numdata = numdata + 1
end do
close(330)
end subroutine get_numdata
subroutine get_data(expt_data,numdata,limit1,limit2)
character(len=4) :: obsname
real(NER) :: elab,acm,val,error
character(len=6) :: ref
type(struct_Expt_Data) :: expt_data(:)
integer :: numdata
real(NER) :: limit1,limit2
integer :: ii
integer :: istat
open(unit=330,file="all_data.dat")
ii=0
do
read(330,*,iostat=istat) obsname,elab,acm,val,error,ref
if (istat /= 0 ) exit
if(elab >= limit1 .and. elab <= limit2) then
ii = ii + 1
expt_data(ii)%obsname = obsname
expt_data(ii)%elab = elab
expt_data(ii)%acm = acm
expt_data(ii)%val = val
expt_data(ii)%error = error
expt_data(ii)%ref = ref
end if
end do
close(330)
if (ii==numdata) write(*,*) "right numdata"
end subroutine get_data
subroutine get_numk(numk,expt_data,numdata)
type(data_chain),pointer :: head,tail,ptr,ptr1,ptr2
real(NER) :: elab
character(len=4) :: obsname
integer :: numk
type(struct_Expt_Data) :: expt_data(:)
integer :: numdata
integer :: ii,istat
nullify(head,tail,ptr,ptr1,ptr2)
numk = 0
do ii=1,numdata
elab = expt_data(ii)%elab
if (.not. associated(head)) then
allocate(ptr,stat=istat)
numk=numk+1
ptr%elab = elab
head => ptr
tail => head
nullify(ptr%next)
else if (elab < head%elab-0.0001) then
allocate(ptr,stat=istat)
numk=numk+1
ptr%elab = elab
ptr%next => head
head => ptr
else if (elab > tail%elab+0.0001) then
allocate(ptr,stat=istat)
numk=numk+1
ptr%elab = elab
tail%next => ptr
tail => ptr
nullify(ptr%next)
else
ptr1 => head
if ( .not. (elab-ptr1%elab)<=0.0001) then
ptr2 => ptr1%next
do
if (abs(elab-ptr2%elab)<=0.0001) exit
if ( (elab > ptr1%elab +0.0001) .and. (elab < ptr2%elab - 0.0001)) then
allocate(ptr,stat=istat)
numk=numk+1
ptr%elab = elab
ptr%next => ptr2
ptr1%next => ptr
exit
end if
ptr1 => ptr2
ptr2 => ptr1%next
end do
end if
end if
end do
end subroutine get_numk
subroutine get_elist(elist,numk,expt_data,numdata)
integer :: numk
real(NER) :: elist(:)
real(NER) :: elab
type(data_chain),pointer :: head,tail,ptr,ptr1,ptr2
integer :: ii , istat
type(struct_Expt_Data) :: expt_data(:)
integer :: numdata
nullify(head,tail,ptr,ptr1,ptr2)
do ii=1,numdata
elab = expt_data(ii)%elab
if (.not. associated(head)) then
allocate(ptr,stat=istat)
ptr%elab = elab
head => ptr
tail => head
nullify(ptr%next)
else if (elab < head%elab-0.0001) then
allocate(ptr,stat=istat)
ptr%elab = elab
ptr%next => head
head => ptr
else if (elab > tail%elab+0.0001) then
allocate(ptr,stat=istat)
ptr%elab = elab
tail%next => ptr
tail => ptr
nullify(ptr%next)
else
ptr1 => head
if ( .not. (elab-ptr1%elab)<=0.0001) then
ptr2 => ptr1%next
do
if (abs(elab-ptr2%elab)<=0.0001) exit
if ( (elab > ptr1%elab +0.0001) .and. (elab < ptr2%elab - 0.0001)) then
allocate(ptr,stat=istat)
ptr%elab = elab
ptr%next => ptr2
ptr1%next => ptr
exit
end if
ptr1 => ptr2
ptr2 => ptr1%next
end do
end if
end if
end do
ptr => head
do ii=1,numk
elist(ii) = head%elab
head => head%next
end do
end subroutine get_elist
end module
program main
use getdata
implicit none
type(struct_Expt_Data),allocatable :: expt_data(:)
real(NER),allocatable :: elist(:)
integer :: numdata , numk
real(NER) :: limit1,limit2
integer :: ii
limit1=3.
limit2=5.
call get_numdata(numdata,limit1,limit2)
write(*,*) "numdata= ",numdata
allocate(expt_data(numdata))
call get_data(expt_data,numdata,limit1,limit2)
call get_numk(numk,expt_data,numdata)
allocate(elist(numk))
call get_elist(elist,numk,expt_data,numdata)
write(*,*) elist
end
是否有简单的方法一步做到？