Fortran Coder
标题: 關於矩陣在副程序宣告問題 [打印本页]
作者: max533 时间: 2015-8-19 19:02
标题: 關於矩陣在副程序宣告問題
本帖最后由 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] 纯文本查看 复制代码
!input gps_all_info.txt dbar_pick_info.txt
!output result.out result_new.out
program site_distance
implicit none
integer :: number1,number2,k,stat,error,error2,error3,stat2,i
character(len=6),allocatable :: gps_array(:),cwb_array(:)
character :: site1*4,site2*6,cwb*6,gps*4
real*8 :: lat1,lon1,lat2,lon2,distance,height1,height2
real*8,allocatable :: distance_array(:)
!-------------------------------------------------- calculate distance of two station
open(11,file='gps_all_info.txt')
open(12,file='dbar_pick_info.txt')
open(13,file='result.out')
number1=0
do while(number1==0)
read(11,*,iostat=number1) lon1,lat1,site1,height1
if(number1/=0)exit
number2=0
do while(number2==0)
read(12,*,iostat=number2) lon2,lat2,site2,height2
if(number2/=0) exit
if(site1/=site2)then
call dis(lat1,lon1,lat2,lon2,distance)
write(13,'(a4,2x,a6,2x,f13.7)')site1,site2,distance
end if
end do
rewind(12)
end do
close (11)
close (12)
close (13)
!-------------------------------------------------- calculate distance of two station
!-------------------------------------------------- give sequence of distance
open(13,file='result.out')
open(14,file='result_new.out')
stat=0
k=0
do while (stat==0)
read (13,*,iostat=stat) gps,cwb,distance
if (stat/=0) exit
k=k+1
end do
error=0
allocate( distance_array(k), stat=error )
if (error == 0) then
write(*,*)'The distance array allocated successfully.'
else if (error /= 0) then
write(*,*)'The distance array failed to allocated.'
end if
error2=0
allocate(gps_array(k),stat=error2)
if (error2 == 0) then
write(*,*)'The site_gps array allocated successfully.'
else if (error2 /= 0) then
write(*,*)'The site_gps array failed to allocated.'
end if
error3=0
allocate(cwb_array(k),stat=error3)
if (error3 == 0) then
write(*,*)'The site_cwb array allocated successfully.'
else if (error3 /= 0) then
write(*,*)'The site_cwb array failed to allocated.'
end if
k=0
stat2=0
do while (stat2==0)
k=k+1
read (13,*,iostat=stat2) gps_array(k),cwb_array(k),distance_array(k)
if (stat2/=0) exit
end do
k=k-1
call bubble_sort(distance_array,gps_array,cwb_array,k)
do i=1,k
write (14,20) gps_array(i),cwb_array(i),distance_array(i)
20 format (a4,1x,a6,1x,f13.7)
end do
deallocate (distance_array)
deallocate (gps_array)
deallocate (cwb_array)
close (13)
close (14)
!-------------------------------------------------- give sequence of diatance
end program
!----------------------------------------- subroutine : calculate distance of two station
subroutine dis(rlat1,rlon1,rlat2,rlon2,distance)
implicit none
real*8 :: rlat1,rlon1,rlat2,rlon2,distance
real*8 :: clat1,clat2,slat1,slat2,cdlon,crd
real*8,parameter :: rerth=6.3712e6
real*8,parameter :: pi=3.14159265358979, dpr=180.0/pi
if ((abs(rlat1-rlat2).lt.0.0001) .and. (abs(rlon1-rlon2).lt.0.0001)) then
distance=0.
else
clat1=cos(real(rlat1)/dpr)
slat1=sin(real(rlat1)/dpr)
clat2=cos(real(rlat2)/dpr)
slat2=sin(real(rlat2)/dpr)
cdlon=cos(real((rlon1-rlon2))/dpr)
crd=slat1*slat2+clat1*clat2*cdlon
distance=real(rerth*acos(crd)/1000.0)
endif
end subroutine
!------------------------------------------subroutine : give sequence of distance
subroutine bubble_sort(array_sort,array1,array2,array_dimension)
implicit none
integer :: array_dimension,scan_number,scan_order,temp_sort,temp1,temp2
!character(len=6) :: array1(array_dimension),array2(array_dimension)
real*8,allocatable :: array_sort(:)
character(len=*),allocatable :: array1(:),array2(:)
allocate( array_sort(array_dimension) )
if (.not. allocated(array_sort)) then
write(*,*)'In the subroutine buule_sort,The array_sort failed to allocate.'
end if
allocate( array1(array_dimension) )
if (.not. allocated(array1)) then
write(*,*)'In the subroutine buule_sort,The array1 failed to allocate.'
end if
allocate( array2(array_dimension) )
if (.not. allocated(array_sort)) then
write(*,*)'In the subroutine buule_sort,The array2 failed to allocate.'
end if
do scan_number=array_dimension-1,1,-1
do scan_order=1,scan_number,1
if (array_sort(scan_order) > array_sort(scan_order+1)) then
temp_sort=array_sort(scan_order)
array_sort(scan_order)=array_sort(scan_order+1)
array_sort(scan_order+1)=temp_sort
temp1=array1(scan_order)
array1(scan_order)=array1(scan_order+1)
array1(scan_order+1)=temp1
temp2=array2(scan_order)
array2(scan_order)=array2(scan_order+1)
array2(scan_order+1)=temp2
end if
end do
end do
return
end subroutine
作者: 楚香饭 时间: 2015-8-19 20:12
如果实参是可分配数组，那么建议分配以后再传入子程序进行计算。
此时，虚参定义为普通数组（不建议定义为可分配数组）
另外。bubble_sort 里面 temp1, temp2 应该为 character 类型变量。
[Fortran] 纯文本查看 复制代码
Module bubble_mod
Contains
! ------------------------------------------subroutine : give sequence of distance
Subroutine bubble_sort(array_sort, array1, array2)
Implicit None
Integer :: array_dimension, scan_number, scan_order, temp_sort
Character (Len=6) :: temp1, temp2
Real *8 :: array_sort(:)
Character (Len=*) :: array1(:), array2(:)
array_dimension = size(array1)
Do scan_number = array_dimension - 1, 1, -1
Do scan_order = 1, scan_number, 1
If (array_sort(scan_order)>array_sort(scan_order+1)) Then
temp_sort = array_sort(scan_order)
array_sort(scan_order) = array_sort(scan_order+1)
array_sort(scan_order+1) = temp_sort
temp1 = array1(scan_order)
array1(scan_order) = array1(scan_order+1)
array1(scan_order+1) = temp1
temp2 = array2(scan_order)
array2(scan_order) = array2(scan_order+1)
array2(scan_order+1) = temp2
End If
End Do
End Do
Return
End Subroutine bubble_sort
End Module bubble_mod
Program site_distance
Use bubble_mod
Implicit None
Integer :: number1, number2, k, stat, error, error2, error3, stat2, i
Character (Len=6), Allocatable :: gps_array(:), cwb_array(:)
Character :: site1*4, site2*6, cwb*6, gps*4
Real *8 :: lat1, lon1, lat2, lon2, distance, height1, height2
Real *8, Allocatable :: distance_array(:)
! -------------------------------------------------- calculate distance of two station
Open (11, File='gps_all_info.txt')
Open (12, File='dbar_pick_info.txt')
Open (13, File='result.out')
number1 = 0
Do While (number1==0)
Read (11, *, Iostat=number1) lon1, lat1, site1, height1
If (number1/=0) Exit
number2 = 0
Do While (number2==0)
Read (12, *, Iostat=number2) lon2, lat2, site2, height2
If (number2/=0) Exit
If (site1/=site2) Then
Call dis(lat1, lon1, lat2, lon2, distance)
Write (13, '(a4,2x,a6,2x,f13.7)') site1, site2, distance
End If
End Do
Rewind (12)
End Do
Close (11)
Close (12)
Close (13)
! -------------------------------------------------- calculate distance of two station
! -------------------------------------------------- give sequence of distance
Open (13, File='result.out')
Open (14, File='result_new.out')
stat = 0
k = 0
Do While (stat==0)
Read (13, *, Iostat=stat) gps, cwb, distance
If (stat/=0) Exit
k = k + 1
End Do
error = 0
Allocate (distance_array(k), Stat=error)
If (error==0) Then
Write (*, *) 'The distance array allocated successfully.'
Else
Write (*, *) 'The distance array failed to allocated.'
End If
error2 = 0
Allocate (gps_array(k), Stat=error2)
If (error2==0) Then
Write (*, *) 'The site_gps array allocated successfully.'
Else
Write (*, *) 'The site_gps array failed to allocated.'
End If
error3 = 0
Allocate (cwb_array(k), Stat=error3)
If (error3==0) Then
Write (*, *) 'The site_cwb array allocated successfully.'
Else
Write (*, *) 'The site_cwb array failed to allocated.'
End If
k = 0
stat2 = 0
Do While (stat2==0)
k = k + 1
Read (13, *, Iostat=stat2) gps_array(k), cwb_array(k), distance_array(k)
If (stat2/=0) Exit
End Do
k = k - 1
Call bubble_sort(distance_array, gps_array(1:k), cwb_array(1:k))
Do i = 1, k
Write (14, 20) gps_array(i), cwb_array(i), distance_array(i)
End Do
Deallocate (distance_array)
Deallocate (gps_array)
Deallocate (cwb_array)
Close (13)
Close (14)
20 Format (A4, 1X, A6, 1X, F13.7)
! -------------------------------------------------- give sequence of diatance
End Program site_distance
! ----------------------------------------- subroutine : calculate distance of two station
Subroutine dis(rlat1, rlon1, rlat2, rlon2, distance)
Implicit None
Real *8 :: rlat1, rlon1, rlat2, rlon2, distance
Real *8 :: clat1, clat2, slat1, slat2, cdlon, crd
Real *8, Parameter :: rerth = 6.3712E6
Real *8, Parameter :: pi = 3.14159265358979, dpr = 180.0/pi
If ((abs(rlat1-rlat2)<0.0001) .And. (abs(rlon1-rlon2)<0.0001)) Then
distance = 0.
Else
clat1 = cos(real(rlat1)/dpr)
slat1 = sin(real(rlat1)/dpr)
clat2 = cos(real(rlat2)/dpr)
slat2 = sin(real(rlat2)/dpr)
cdlon = cos(real((rlon1-rlon2))/dpr)
crd = slat1*slat2 + clat1*clat2*cdlon
distance = real(rerth*acos(crd)/1000.0)
End If
End Subroutine dis
作者: max533 时间: 2015-8-20 17:01
本帖最后由 max533 于 2015-8-20 17: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] 纯文本查看 复制代码
Module bubble_mod
Contains
! ------------------------------------------subroutine : give sequence of distance
Subroutine bubble_sort(array_sort, array1, array2,array_dimension)
Implicit None
Integer :: array_dimension, scan_number, scan_order, temp_sort
Character (Len=6) :: temp1, temp2
Real *8 :: array_sort(array_dimension)
Character (Len=6) :: array1(array_dimension), array2(array_dimension)
array_dimension = size(array1)
Do scan_number = array_dimension - 1, 1, -1
Do scan_order = 1, scan_number, 1
If (array_sort(scan_order)>array_sort(scan_order+1)) Then
temp_sort = array_sort(scan_order)
array_sort(scan_order) = array_sort(scan_order+1)
array_sort(scan_order+1) = temp_sort
temp1 = array1(scan_order)
array1(scan_order) = array1(scan_order+1)
array1(scan_order+1) = temp1
temp2 = array2(scan_order)
array2(scan_order) = array2(scan_order+1)
array2(scan_order+1) = temp2
End If
End Do
End Do
Return
End Subroutine bubble_sort
End Module bubble_mod
Program site_distance
Use bubble_mod
Implicit None
Integer :: number1, number2, k, stat, error, error2, error3, stat2, i
Character (Len=6), Allocatable :: gps_array(:), cwb_array(:)
Character :: site1*4, site2*6, cwb*6, gps*4
Real *8 :: lat1, lon1, lat2, lon2, distance, height1, height2
Real *8, Allocatable :: distance_array(:)
! -------------------------------------------------- calculate distance of two station
Open (11, File='gps_all_info.txt')
Open (12, File='dbar_pick_info.txt')
Open (13, File='result.out')
number1 = 0
Do While (number1==0)
Read (11, *, Iostat=number1) lon1, lat1, site1, height1
If (number1/=0) Exit
number2 = 0
Do While (number2==0)
Read (12, *, Iostat=number2) lon2, lat2, site2, height2
If (number2/=0) Exit
If (site1/=site2) Then
Call dis(lat1, lon1, lat2, lon2, distance)
Write (13, '(a4,2x,a6,2x,f13.7)') site1, site2, distance
End If
End Do
Rewind (12)
End Do
Close (11)
Close (12)
Close (13)
! -------------------------------------------------- calculate distance of two station
! -------------------------------------------------- give sequence of distance
Open (13, File='result.out')
Open (14, File='result_new.out')
stat = 0
k = 0
Do While (stat==0)
Read (13, *, Iostat=stat) gps, cwb, distance
If (stat/=0) Exit
k = k + 1
End Do
error = 0
Allocate (distance_array(k), Stat=error)
If (error==0) Then
Write (*, *) 'The distance array allocated successfully.'
Else
Write (*, *) 'The distance array failed to allocated.'
End If
error2 = 0
Allocate (gps_array(k), Stat=error2)
If (error2==0) Then
Write (*, *) 'The site_gps array allocated successfully.'
Else
Write (*, *) 'The site_gps array failed to allocated.'
End If
error3 = 0
Allocate (cwb_array(k), Stat=error3)
If (error3==0) Then
Write (*, *) 'The site_cwb array allocated successfully.'
Else
Write (*, *) 'The site_cwb array failed to allocated.'
End If
k = 0
stat2 = 0
Do While (stat2==0)
k = k + 1
Read (13, *, Iostat=stat2) gps_array(k), cwb_array(k), distance_array(k)
If (stat2/=0) Exit
End Do
k = k - 1
Call bubble_sort(distance_array(1:k), gps_array(1:k), cwb_array(1:k),k)
Do i = 1, k
Write (14, 20) gps_array(i), cwb_array(i), distance_array(i)
End Do
Deallocate (distance_array)
Deallocate (gps_array)
Deallocate (cwb_array)
Close (13)
Close (14)
20 Format (A4, 1X, A6, 1X, F13.7)
! -------------------------------------------------- give sequence of diatance
End Program site_distance
! ----------------------------------------- subroutine : calculate distance of two station
Subroutine dis(rlat1, rlon1, rlat2, rlon2, distance)
Implicit None
Real *8 :: rlat1, rlon1, rlat2, rlon2, distance
Real *8 :: clat1, clat2, slat1, slat2, cdlon, crd
Real *8, Parameter :: rerth = 6.3712E6
Real *8, Parameter :: pi = 3.14159265358979, dpr = 180.0/pi
If ((abs(rlat1-rlat2)<0.0001) .And. (abs(rlon1-rlon2)<0.0001)) Then
distance = 0.
Else
clat1 = cos(real(rlat1)/dpr)
slat1 = sin(real(rlat1)/dpr)
clat2 = cos(real(rlat2)/dpr)
slat2 = sin(real(rlat2)/dpr)
cdlon = cos(real((rlon1-rlon2))/dpr)
crd = slat1*slat2 + clat1*clat2*cdlon
distance = real(rerth*acos(crd)/1000.0)
End If
End Subroutine dis
作者: 楚香饭 时间: 2015-8-20 19:21
问题1，是的。也需要修改，我没注意到。
问题2，见我之前的回答。
问题3，可以。你这样叫自动数组，我那样叫假定形状。
推荐用假定形状，这样少传递一个参数，简洁
作者: max533 时间: 2015-8-20 20:28
感謝楚大，小弟受益良多。
| 欢迎光临 Fortran Coder (http://bbs.fcode.cn/) |
Powered by Discuz! X3.2 |