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

楚香饭

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

另外。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

楚香饭

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

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

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