關於矩陣在副程序宣告問題

max533 · 发表于 2015-8-19 19:02:12

本帖最后由 max533 于 2015-8-19 19:06 编辑

我在windows7-64bit作業系統
使用FTN95編譯軟體
在編譯程序的過程中出現

line 133 - error 941 - array2 is adummy argument and so cannot be allocatable
line 132 - error 941 - array_sort is a dummy argument and so cannot be allocatable
line 163 - error 1173 - only character variable can be assigned to character variables, found integer (kind=3)
line 166 - error 1173 - only character variable can be assigned to character variables, found integer (kind=3)

這四個bug我一直找不出問題的癥結點，想說上來請各位高手幫忙解決這難題。
先在這邊感謝各位高手幫忙。

[Fortran] 纯文本查看 复制代码

001!input gps_all_info.txt dbar_pick_info.txt
002!output result.out result_new.out
003program site_distance
004implicit none
005 
006integer :: number1,number2,k,stat,error,error2,error3,stat2,i
007character(len=6),allocatable :: gps_array(:),cwb_array(:)
008character :: site1*4,site2*6,cwb*6,gps*4
009real*8 :: lat1,lon1,lat2,lon2,distance,height1,height2
010real*8,allocatable :: distance_array(:)
011 
012!--------------------------------------------------  calculate distance of two station
013open(11,file='gps_all_info.txt')
014open(12,file='dbar_pick_info.txt')
015open(13,file='result.out')
016 
017number1=0
018do while(number1==0)
019        read(11,*,iostat=number1) lon1,lat1,site1,height1
020                  if(number1/=0)exit
021   
022        number2=0
023           do while(number2==0)
024                  read(12,*,iostat=number2) lon2,lat2,site2,height2
025                  if(number2/=0) exit
026                          
027                if(site1/=site2)then
028                call dis(lat1,lon1,lat2,lon2,distance)
029        write(13,'(a4,2x,a6,2x,f13.7)')site1,site2,distance
030                end if
031 
032        end do
033    rewind(12)
034end do
035 
036close (11)
037close (12)
038close (13)
039!--------------------------------------------------  calculate distance of two station
040 
041!--------------------------------------------------  give sequence of distance
042open(13,file='result.out')
043open(14,file='result_new.out')
044 
045stat=0
046k=0
047do while (stat==0) 
048  read (13,*,iostat=stat) gps,cwb,distance
049  if (stat/=0) exit
050  k=k+1
051end do
052 
053error=0
054allocate( distance_array(k), stat=error )
055if (error == 0) then
056  write(*,*)'The distance array allocated successfully.'
057else if (error /= 0) then
058  write(*,*)'The distance array failed to allocated.'
059end if
060 
061error2=0
062allocate(gps_array(k),stat=error2)
063if (error2 == 0) then
064  write(*,*)'The site_gps array allocated successfully.'
065else if (error2 /= 0) then
066  write(*,*)'The site_gps array failed to allocated.'
067end if
068 
069error3=0
070allocate(cwb_array(k),stat=error3)
071if (error3 == 0) then
072  write(*,*)'The site_cwb array allocated successfully.'
073else if (error3 /= 0) then
074  write(*,*)'The site_cwb array failed to allocated.'
075end if
076 
077k=0
078stat2=0
079do while (stat2==0)
080  k=k+1
081  read (13,*,iostat=stat2) gps_array(k),cwb_array(k),distance_array(k)
082  if (stat2/=0) exit
083end do
084k=k-1
085call bubble_sort(distance_array,gps_array,cwb_array,k)
086 
087do i=1,k
088  write (14,20) gps_array(i),cwb_array(i),distance_array(i)
089  20 format (a4,1x,a6,1x,f13.7)
090end do
091   
092deallocate (distance_array)
093deallocate (gps_array)
094deallocate (cwb_array)
095 
096close (13)
097close (14)
098!--------------------------------------------------  give sequence of diatance
099end program
100 
101!-----------------------------------------  subroutine : calculate distance of two station
102 
103subroutine dis(rlat1,rlon1,rlat2,rlon2,distance)
104implicit none
105   
106  real*8 :: rlat1,rlon1,rlat2,rlon2,distance
107  real*8 :: clat1,clat2,slat1,slat2,cdlon,crd
108  real*8,parameter :: rerth=6.3712e6
109  real*8,parameter :: pi=3.14159265358979, dpr=180.0/pi
110   
111   
112  if ((abs(rlat1-rlat2).lt.0.0001) .and. (abs(rlon1-rlon2).lt.0.0001)) then
113    distance=0.
114  else
115    clat1=cos(real(rlat1)/dpr)
116    slat1=sin(real(rlat1)/dpr)
117    clat2=cos(real(rlat2)/dpr)
118    slat2=sin(real(rlat2)/dpr)
119    cdlon=cos(real((rlon1-rlon2))/dpr)
120    crd=slat1*slat2+clat1*clat2*cdlon
121    distance=real(rerth*acos(crd)/1000.0)
122  endif
123 
124 end subroutine
125 
126!------------------------------------------subroutine : give sequence of distance 
127subroutine bubble_sort(array_sort,array1,array2,array_dimension)
128implicit none
129 
130integer :: array_dimension,scan_number,scan_order,temp_sort,temp1,temp2
131!character(len=6) :: array1(array_dimension),array2(array_dimension)
132real*8,allocatable :: array_sort(:)
133character(len=*),allocatable :: array1(:),array2(:)
134 
135 
136allocate( array_sort(array_dimension) )
137 
138if (.not. allocated(array_sort))  then
139  write(*,*)'In the subroutine buule_sort,The array_sort failed to allocate.'
140end if
141 
142allocate( array1(array_dimension) )
143 
144if (.not. allocated(array1))  then
145  write(*,*)'In the subroutine buule_sort,The array1 failed to allocate.'
146end if
147 
148allocate( array2(array_dimension) )
149 
150if (.not. allocated(array_sort))  then
151  write(*,*)'In the subroutine buule_sort,The array2 failed to allocate.'
152end if
153 
154do scan_number=array_dimension-1,1,-1
155  do scan_order=1,scan_number,1
156 
157    if  (array_sort(scan_order) > array_sort(scan_order+1)) then
158        temp_sort=array_sort(scan_order)
159        array_sort(scan_order)=array_sort(scan_order+1)
160        array_sort(scan_order+1)=temp_sort
161        temp1=array1(scan_order)
162        array1(scan_order)=array1(scan_order+1)
163        array1(scan_order+1)=temp1
164        temp2=array2(scan_order)
165        array2(scan_order)=array2(scan_order+1)
166        array2(scan_order+1)=temp2
167    end if
168     
169  end do
170end do
171return
172end subroutine
173    

楚香饭 · 发表于 2015-8-19 20:12:11

如果实参是可分配数组，那么建议分配以后再传入子程序进行计算。
此时，虚参定义为普通数组（不建议定义为可分配数组）

另外。bubble_sort 里面 temp1, temp2 应该为 character 类型变量。

[Fortran] 纯文本查看 复制代码

001Module bubble_mod
002Contains
003  ! ------------------------------------------subroutine : give sequence of distance
004  Subroutine bubble_sort(array_sort, array1, array2)
005    Implicit None
006    Integer :: array_dimension, scan_number, scan_order, temp_sort
007    Character (Len=6) :: temp1, temp2
008    Real *8 :: array_sort(:)
009    Character (Len=*) :: array1(:), array2(:)
010    array_dimension = size(array1)
011    Do scan_number = array_dimension - 1, 1, -1
012      Do scan_order = 1, scan_number, 1
013        If (array_sort(scan_order)>array_sort(scan_order+1)) Then
014          temp_sort = array_sort(scan_order)
015          array_sort(scan_order) = array_sort(scan_order+1)
016          array_sort(scan_order+1) = temp_sort
017          temp1 = array1(scan_order)
018          array1(scan_order) = array1(scan_order+1)
019          array1(scan_order+1) = temp1
020          temp2 = array2(scan_order)
021          array2(scan_order) = array2(scan_order+1)
022          array2(scan_order+1) = temp2
023        End If
024      End Do
025    End Do
026    Return
027  End Subroutine bubble_sort
028End Module bubble_mod
029Program site_distance
030  Use bubble_mod
031  Implicit None
032  Integer :: number1, number2, k, stat, error, error2, error3, stat2, i
033  Character (Len=6), Allocatable :: gps_array(:), cwb_array(:)
034  Character :: site1*4, site2*6, cwb*6, gps*4
035  Real *8 :: lat1, lon1, lat2, lon2, distance, height1, height2
036  Real *8, Allocatable :: distance_array(:)
037  ! --------------------------------------------------  calculate distance of two station
038  Open (11, File='gps_all_info.txt')
039  Open (12, File='dbar_pick_info.txt')
040  Open (13, File='result.out')
041  number1 = 0
042  Do While (number1==0)
043    Read (11, *, Iostat=number1) lon1, lat1, site1, height1
044    If (number1/=0) Exit
045    number2 = 0
046    Do While (number2==0)
047      Read (12, *, Iostat=number2) lon2, lat2, site2, height2
048      If (number2/=0) Exit
049      If (site1/=site2) Then
050        Call dis(lat1, lon1, lat2, lon2, distance)
051        Write (13, '(a4,2x,a6,2x,f13.7)') site1, site2, distance
052      End If
053    End Do
054    Rewind (12)
055  End Do
056  Close (11)
057  Close (12)
058  Close (13)
059  ! --------------------------------------------------  calculate distance of two station
060  ! --------------------------------------------------  give sequence of distance
061  Open (13, File='result.out')
062  Open (14, File='result_new.out')
063  stat = 0
064  k = 0
065  Do While (stat==0)
066    Read (13, *, Iostat=stat) gps, cwb, distance
067    If (stat/=0) Exit
068    k = k + 1
069  End Do
070  error = 0
071  Allocate (distance_array(k), Stat=error)
072  If (error==0) Then
073    Write (*, *) 'The distance array allocated successfully.'
074  Else
075    Write (*, *) 'The distance array failed to allocated.'
076  End If
077  error2 = 0
078  Allocate (gps_array(k), Stat=error2)
079  If (error2==0) Then
080    Write (*, *) 'The site_gps array allocated successfully.'
081  Else
082    Write (*, *) 'The site_gps array failed to allocated.'
083  End If
084  error3 = 0
085  Allocate (cwb_array(k), Stat=error3)
086  If (error3==0) Then
087    Write (*, *) 'The site_cwb array allocated successfully.'
088  Else
089    Write (*, *) 'The site_cwb array failed to allocated.'
090  End If
091  k = 0
092  stat2 = 0
093  Do While (stat2==0)
094    k = k + 1
095    Read (13, *, Iostat=stat2) gps_array(k), cwb_array(k), distance_array(k)
096    If (stat2/=0) Exit
097  End Do
098  k = k - 1
099  Call bubble_sort(distance_array, gps_array(1:k), cwb_array(1:k))
100  Do i = 1, k
101    Write (14, 20) gps_array(i), cwb_array(i), distance_array(i)
102  End Do
103  Deallocate (distance_array)
104  Deallocate (gps_array)
105  Deallocate (cwb_array)
106  Close (13)
107  Close (14)
108  20 Format (A4, 1X, A6, 1X, F13.7)
109  ! --------------------------------------------------  give sequence of diatance
110End Program site_distance
111! -----------------------------------------  subroutine : calculate distance of two station
112Subroutine dis(rlat1, rlon1, rlat2, rlon2, distance)
113  Implicit None
114  Real *8 :: rlat1, rlon1, rlat2, rlon2, distance
115  Real *8 :: clat1, clat2, slat1, slat2, cdlon, crd
116  Real *8, Parameter :: rerth = 6.3712E6
117  Real *8, Parameter :: pi = 3.14159265358979, dpr = 180.0/pi
118  If ((abs(rlat1-rlat2)<0.0001) .And. (abs(rlon1-rlon2)<0.0001)) Then
119    distance = 0.
120  Else
121    clat1 = cos(real(rlat1)/dpr)
122    slat1 = sin(real(rlat1)/dpr)
123    clat2 = cos(real(rlat2)/dpr)
124    slat2 = sin(real(rlat2)/dpr)
125    cdlon = cos(real((rlon1-rlon2))/dpr)
126    crd = slat1*slat2 + clat1*clat2*cdlon
127    distance = real(rerth*acos(crd)/1000.0)
128  End If
129End Subroutine dis

max533 · 发表于 2015-8-20 17:01:30

本帖最后由 max533 于 2015-8-20 17:12 编辑

楚香饭发表于 2015-8-19 20:12
如果实参是可分配数组，那么建议分配以后再传入子程序进行计算。
此时，虚参定义为普通数组（不建议定义为 ...

感謝楚大的的熱心答覆，但我有部分我不是很確定，想跟您討教一下。
第一個問題
LINE 099
Call bubble_sort(distance_array, gps_array(1:k), cwb_array(1:k))
此行是不是應該要改寫成
Call bubble_sort(distance_array(1:k), gps_array(1:k), cwb_array(1:k))

第二個問題
LINE 008
Real *8 :: array_sort(:)
LINE 009
Character (Len=*) :: array1(:), array2(:)

此兩行中
array_sort和array1, array2 在副程序裡面是可變數組
那為什麼您可以直接宣告成普通數組的樣子。
不是應該要宣告成
LINE 008
Real *8,allocatable :: array_sort(:)
LINE 009
Character (Len=*),allocatable :: array1(:), array2(:)

是因為傳進來的數組大小已經確定，所以不用去擔心數組是否可變的問題嗎?!

第三個問題
我是不是也能改寫成下面這樣呢?!
編譯的過程是沒有問題。但不知道會不會有什麼其他問題產生呢?!

[Fortran] 纯文本查看 复制代码

001Module bubble_mod
002Contains
003  ! ------------------------------------------subroutine : give sequence of distance
004  Subroutine bubble_sort(array_sort, array1, array2,array_dimension)
005    Implicit None
006    Integer :: array_dimension, scan_number, scan_order, temp_sort
007    Character (Len=6) :: temp1, temp2
008    Real *8 :: array_sort(array_dimension)
009    Character (Len=6) :: array1(array_dimension), array2(array_dimension)
010    array_dimension = size(array1)
011    Do scan_number = array_dimension - 1, 1, -1
012      Do scan_order = 1, scan_number, 1
013        If (array_sort(scan_order)>array_sort(scan_order+1)) Then
014          temp_sort = array_sort(scan_order)
015          array_sort(scan_order) = array_sort(scan_order+1)
016          array_sort(scan_order+1) = temp_sort
017          temp1 = array1(scan_order)
018          array1(scan_order) = array1(scan_order+1)
019          array1(scan_order+1) = temp1
020          temp2 = array2(scan_order)
021          array2(scan_order) = array2(scan_order+1)
022          array2(scan_order+1) = temp2
023        End If
024      End Do
025    End Do
026    Return
027  End Subroutine bubble_sort
028End Module bubble_mod
029Program site_distance
030  Use bubble_mod
031  Implicit None
032  Integer :: number1, number2, k, stat, error, error2, error3, stat2, i
033  Character (Len=6), Allocatable :: gps_array(:), cwb_array(:)
034  Character :: site1*4, site2*6, cwb*6, gps*4
035  Real *8 :: lat1, lon1, lat2, lon2, distance, height1, height2
036  Real *8, Allocatable :: distance_array(:)
037  ! --------------------------------------------------  calculate distance of two station
038  Open (11, File='gps_all_info.txt')
039  Open (12, File='dbar_pick_info.txt')
040  Open (13, File='result.out')
041  number1 = 0
042  Do While (number1==0)
043    Read (11, *, Iostat=number1) lon1, lat1, site1, height1
044    If (number1/=0) Exit
045    number2 = 0
046    Do While (number2==0)
047      Read (12, *, Iostat=number2) lon2, lat2, site2, height2
048      If (number2/=0) Exit
049      If (site1/=site2) Then
050        Call dis(lat1, lon1, lat2, lon2, distance)
051        Write (13, '(a4,2x,a6,2x,f13.7)') site1, site2, distance
052      End If
053    End Do
054    Rewind (12)
055  End Do
056  Close (11)
057  Close (12)
058  Close (13)
059  ! --------------------------------------------------  calculate distance of two station
060  ! --------------------------------------------------  give sequence of distance
061  Open (13, File='result.out')
062  Open (14, File='result_new.out')
063  stat = 0
064  k = 0
065  Do While (stat==0)
066    Read (13, *, Iostat=stat) gps, cwb, distance
067    If (stat/=0) Exit
068    k = k + 1
069  End Do
070  error = 0
071  Allocate (distance_array(k), Stat=error)
072  If (error==0) Then
073    Write (*, *) 'The distance array allocated successfully.'
074  Else
075    Write (*, *) 'The distance array failed to allocated.'
076  End If
077  error2 = 0
078  Allocate (gps_array(k), Stat=error2)
079  If (error2==0) Then
080    Write (*, *) 'The site_gps array allocated successfully.'
081  Else
082    Write (*, *) 'The site_gps array failed to allocated.'
083  End If
084  error3 = 0
085  Allocate (cwb_array(k), Stat=error3)
086  If (error3==0) Then
087    Write (*, *) 'The site_cwb array allocated successfully.'
088  Else
089    Write (*, *) 'The site_cwb array failed to allocated.'
090  End If
091  k = 0
092  stat2 = 0
093  Do While (stat2==0)
094    k = k + 1
095    Read (13, *, Iostat=stat2) gps_array(k), cwb_array(k), distance_array(k)
096    If (stat2/=0) Exit
097  End Do
098  k = k - 1
099  Call bubble_sort(distance_array(1:k), gps_array(1:k), cwb_array(1:k),k)
100  Do i = 1, k
101    Write (14, 20) gps_array(i), cwb_array(i), distance_array(i)
102  End Do
103  Deallocate (distance_array)
104  Deallocate (gps_array)
105  Deallocate (cwb_array)
106  Close (13)
107  Close (14)
108  20 Format (A4, 1X, A6, 1X, F13.7)
109  ! --------------------------------------------------  give sequence of diatance
110End Program site_distance
111! -----------------------------------------  subroutine : calculate distance of two station
112Subroutine dis(rlat1, rlon1, rlat2, rlon2, distance)
113  Implicit None
114  Real *8 :: rlat1, rlon1, rlat2, rlon2, distance
115  Real *8 :: clat1, clat2, slat1, slat2, cdlon, crd
116  Real *8, Parameter :: rerth = 6.3712E6
117  Real *8, Parameter :: pi = 3.14159265358979, dpr = 180.0/pi
118  If ((abs(rlat1-rlat2)<0.0001) .And. (abs(rlon1-rlon2)<0.0001)) Then
119    distance = 0.
120  Else
121    clat1 = cos(real(rlat1)/dpr)
122    slat1 = sin(real(rlat1)/dpr)
123    clat2 = cos(real(rlat2)/dpr)
124    slat2 = sin(real(rlat2)/dpr)
125    cdlon = cos(real((rlon1-rlon2))/dpr)
126    crd = slat1*slat2 + clat1*clat2*cdlon
127    distance = real(rerth*acos(crd)/1000.0)
128  End If
129End Subroutine dis

楚香饭 · 发表于 2015-8-20 19:21:00

问题1，是的。也需要修改，我没注意到。

问题2，见我之前的回答。

问题3，可以。你这样叫自动数组，我那样叫假定形状。
推荐用假定形状，这样少传递一个参数，简洁

max533 · 发表于 2015-8-20 20:28:17

楚香饭发表于 2015-8-20 19:21
问题1，是的。也需要修改，我没注意到。

问题2，见我之前的回答。

感謝楚大，小弟受益良多。

[求助] 關於矩陣在副程序宣告問題

新人勋章

爱心勋章

水王勋章

元老勋章

热心勋章