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

!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
    

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

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