[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