寫一段代碼，從實驗數據文件中，選取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_Datacharacter(len=6) :: Refcharacter(len=4) :: obsNamereal(NER) :: acm, elab, val, errorinteger :: ii ! ii is the the sequence number of elab list.end type struct_Expt_Data type :: data_chaincharacter(len=6) :: Refcharacter(len=4) :: obsNamereal(NER) :: acm, elab, val, errortype(data_chain),pointer :: nextend type data_chain end module aa module getdata use aa implicit none contains subroutine get_numdata(numdata,limit1,limit2)character(len=4) :: obsnamereal(NER) :: elab,acm,val,errorcharacter(len=6) :: ref integer :: numdata real(NER) :: limit1,limit2integer :: ii integer :: istatnumdata=0open(unit=330,file="all_data.dat",iostat=istat)do read(330,*,iostat=istat) obsname,elab write(*,*) obsname , elabif (istat /= 0) exitif (elab >= limit1 .and. elab <= limit2) numdata = numdata + 1end do close(330) end subroutine get_numdatasubroutine get_data(expt_data,numdata,limit1,limit2)character(len=4) :: obsnamereal(NER) :: elab,acm,val,errorcharacter(len=6) :: ref type(struct_Expt_Data) :: expt_data(:)integer :: numdata real(NER) :: limit1,limit2integer :: ii integer :: istatopen(unit=330,file="all_data.dat")ii=0do read(330,*,iostat=istat) obsname,elab,acm,val,error,ref if (istat /= 0 ) exit if(elab >= limit1 .and. elab <= limit2) thenii = ii + 1expt_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,ptr2real(NER) :: elab character(len=4) :: obsnameinteger :: numk type(struct_Expt_Data) :: expt_data(:)integer :: numdatainteger :: ii,istatnullify(head,tail,ptr,ptr1,ptr2)numk = 0do ii=1,numdataelab = expt_data(ii)%elab if (.not. associated(head)) thenallocate(ptr,stat=istat)numk=numk+1ptr%elab = elab head => ptr tail => headnullify(ptr%next)else if (elab < head%elab-0.0001) thenallocate(ptr,stat=istat)numk=numk+1ptr%elab = elab ptr%next => head head => ptr else if (elab > tail%elab+0.0001) then allocate(ptr,stat=istat)numk=numk+1ptr%elab = elab tail%next => ptrtail => ptr nullify(ptr%next)else ptr1 => head if ( .not. (elab-ptr1%elab)<=0.0001) then ptr2 => ptr1%nextdo if (abs(elab-ptr2%elab)<=0.0001) exit if ( (elab > ptr1%elab +0.0001) .and. (elab < ptr2%elab - 0.0001)) thenallocate(ptr,stat=istat)numk=numk+1ptr%elab = elab ptr%next => ptr2 ptr1%next => ptr exitend if ptr1 => ptr2ptr2 => ptr1%nextend do end if end if end do end subroutine get_numksubroutine get_elist(elist,numk,expt_data,numdata)integer :: numkreal(NER) :: elist(:)real(NER) :: elab type(data_chain),pointer :: head,tail,ptr,ptr1,ptr2integer :: ii , istattype(struct_Expt_Data) :: expt_data(:)integer :: numdatanullify(head,tail,ptr,ptr1,ptr2)do ii=1,numdataelab = expt_data(ii)%elab if (.not. associated(head)) thenallocate(ptr,stat=istat)ptr%elab = elab head => ptr tail => headnullify(ptr%next)else if (elab < head%elab-0.0001) thenallocate(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 => ptrtail => ptr nullify(ptr%next)else ptr1 => head if ( .not. (elab-ptr1%elab)<=0.0001) then ptr2 => ptr1%nextdo if (abs(elab-ptr2%elab)<=0.0001) exit if ( (elab > ptr1%elab +0.0001) .and. (elab < ptr2%elab - 0.0001)) thenallocate(ptr,stat=istat)ptr%elab = elab ptr%next => ptr2 ptr1%next => ptr exitend if ptr1 => ptr2ptr2 => ptr1%nextend do end if end ifend do ptr => headdo ii=1,numk elist(ii) = head%elab head => head%next end do end subroutine get_elist end module program main use getdataimplicit none type(struct_Expt_Data),allocatable :: expt_data(:)real(NER),allocatable :: elist(:)integer :: numdata , numk real(NER) :: limit1,limit2integer :: ii limit1=3.limit2=5.call get_numdata(numdata,limit1,limit2)write(*,*) "numdata= ",numdataallocate(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(*,*) elistend

是否有簡單的方法一步做到？

總結

以上是生活随笔為你收集整理的Fortran不定大小的数组被subroutine调用是否可以？的全部內容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網站內容還不錯，歡迎將生活随笔推薦給好友。