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

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] 纯文本查看 复制代码

!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:11

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

另外。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: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] 纯文本查看 复制代码

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

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

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

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

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

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

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

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

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

新人勋章

爱心勋章

水王勋章

元老勋章

热心勋章