Distance and Bearing: Difference between revisions
m
→{{header|Fortran}}: added syntax highlighting
m (Improved comments.) |
m (→{{header|Fortran}}: added syntax highlighting) |
||
| (5 intermediate revisions by 2 users not shown) | |||
Line 164:
68.4 272 EGMT United Kingdom Thurrock Airfield
</pre>
=={{header|Fortran}}==
<syntaxhighlight lang="fortran">
program code_translation
use iso_fortran_env , only:real64 , real32
use helpers
implicit none
integer :: i
character(len = 300) :: input_string
character(len = *) , parameter :: filnam = "airports.csv"
character(len = *) , parameter :: delimiter = ","
character(len = 100) :: tokens(20)
integer :: num_tokens
integer :: iostat , counter
type(airport) , allocatable :: airports(:)
type(whereme) :: location
integer :: ii , jj
real(real64) :: dist
location%latitude = (51.514669D0)!Rosetta co-ords
location%longitude = (2.19858D0)
!Nearest to latitude 51.51467,longitude 2.19858 degrees
!
!Open the file for reading
open(unit = 10 , file = 'airports.csv' , status = 'OLD' , &
&action = 'READ' , iostat = iostat , encoding = 'UTF-8')
if( iostat/=0 )stop 'Could not open file'
counter = 0
do
read(10 , '(a)' , end = 100)input_string
counter = counter + 1
end do
100 continue ! Now we know how many elements there are
rewind(unit = 10)
write(*, '(a,1x,i0,1x,a)') 'Scanning',counter,'lines'
allocate(airports(counter))
call system_clock(count = ii)
do i = 1 , counter
read(10 , '(a)' , end = 200)input_string
call tokenizes(input_string , tokens , num_tokens , ',')
read(tokens(1) , *)airports(i)%airportid
airports(i)%name = trim(adjustl(tokens(2)))
airports(i)%city = trim(adjustl(tokens(3)))
airports(i)%country = trim(adjustl(tokens(4)))
airports(i)%iata = trim(adjustl(tokens(5)))
airports(i)%icao = trim(adjustl(tokens(6)))
read(tokens(7) , '(f20.16)')airports(i)%latitude
read(tokens(8) , '(F20.16)')airports(i)%longitude
read(tokens(9) , *)airports(i)%altitude
read(tokens(10) , '(F5.2)' )airports(i)%timezone
airports(i)%dst = trim(adjustl(tokens(11)))
airports(i)%tzolson = trim(adjustl(tokens(12)))
airports(i)%typez = trim(adjustl(tokens(13)))
airports(i)%source = trim(adjustl(tokens(14)))
! Calculate the distance and bearing straight away
airports(i)%distance = haversine(location%latitude , &
& location%longitude , airports(i)%latitude ,&
& airports(i)%longitude)
airports(i)%bearing = bearing(location%latitude , &
& location%longitude , airports(i)%latitude , &
& airports(i)%longitude)
end do
200 continue
call system_clock(count = jj)
write(* , *) 'Read complete, time taken = ' , (jj - ii) , &
& 'milliseconds' // char(10) // char(13)
call sortem(airports) ! Sort the airports out
write(*, '(/,2x,a,t14,a,t75,a,t95,a,t108,a,t117,a)') 'Num' , 'Name' , &
&'Country' , 'ICAO' , 'Dist.' , 'Bearing'
write(*, '(a)') repeat('=' , 130)
do jj = 1 , 20!First 20 only
write(*, '(i5,t8,a,t75,a,t95,a,t105,f8.1,t117,i0)') airports(jj) &
& %airportid , airports(jj)%name , airports(jj)%country , &
& airports(jj)%icao , airports(jj)%distance , &
& nint(airports(jj)%bearing)
end do
stop 'Normal completion' // char(10) // char(13)
end program code_translation
module helpers
use iso_fortran_env , only:real32,real64
implicit none
real(real64) , parameter :: radius_in_km = 6372.8D0
real(real64) , parameter :: kilos_to_nautical = 0.5399568D0
type whereme
real(real64) :: latitude , longitude
end type whereme
type airport
integer :: airportid
character(len = 100) :: name
character(len = 50) :: city , country
character(len = 10) :: iata , icao
real(real64) :: latitude , longitude
integer :: altitude
real(real32) :: timezone
character(len = 10) :: dst
character(len = 100) :: tzolson
character(len = 20) :: typez , source
real(real64) :: distance , bearing
end type airport
contains ! We'll calculate them and store in each airport
!
! The given angles are in radians, and the result is in degrees in the range [0, 360).
function bearing(lat1 , lon1 , lat2 , lon2)
real(real64) , parameter :: toradians = acos( - 1.0D0)/180.0D0
real(real64) :: bearing
real(real64) , intent(in) :: lat1
real(real64) , intent(in) :: lon1
real(real64) , intent(in) :: lat2
real(real64) , intent(in) :: lon2
real(real64) :: dlat
real(real64) :: dlon
real(real64) :: rlat1
real(real64) :: rlat2
real(real64) :: x
real(real64) :: y
!
dlat = (lat2 - lat1)*toradians
dlon = toradians*(lon2 - lon1)
rlat1 = toradians*(lat1)
rlat2 = toradians*(lat2)
!
x = cos(rlat2)*sin(dlon)
y = cos(rlat1)*sin(rlat2) - sin(rlat1)*cos(rlat2)*cos(dlon)
bearing = atan2(x , y)
bearing = to_degrees(bearing)
bearing = mod(bearing + 360.0D0 , 360.0D0)
end function bearing
!
!
function to_radian(degree) result(rad)
real(real64) , parameter :: deg_to_rad = atan(1.0D0)/45.0D0 ! exploit intrinsic atan to generate pi/180 runtime constant
!
real(real64) :: rad
real(real64) , intent(in) :: degree
! degrees to radians
rad = degree*deg_to_rad
end function to_radian
!
function to_degrees(radians) result(deg)
real(real64) , parameter :: radian_to_degree = 180.0D0/acos( - 1.0D0)
!
real(real64) :: deg
real(real64) , intent(in) :: radians
deg = radians*radian_to_degree
end function to_degrees
!
function haversine(deglat1 , deglon1 , deglat2 , deglon2) result(dist)
real(real64) :: dist
real(real64) , intent(in) :: deglat1
real(real64) , intent(in) :: deglon1
real(real64) , intent(in) :: deglat2
real(real64) , intent(in) :: deglon2
real(real64) :: a
real(real64) :: c
real(real64) :: dlat
real(real64) :: dlon
real(real64) :: lat1
real(real64) :: lat2
! great circle distance
dlat = to_radian(deglat2 - deglat1)
dlon = to_radian(deglon2 - deglon1)
lat1 = to_radian(deglat1)
lat2 = to_radian(deglat2)
a = (sin(dlat/2.0D0)**2) + cos(lat1)*cos(lat2) &
& *((sin(dlon/2.0D0))**2)
c = 2.0D0*asin(sqrt(a))
dist = radius_in_km*c*kilos_to_nautical
end function haversine
subroutine sortem(airports)!Bubble sort them, nice and easy
type(airport) , intent(inout) , dimension(:) :: airports
integer :: i
integer :: k
logical :: swapped
type(airport) :: temp
swapped = .true.
k = size(airports%distance)
do while ( swapped )
swapped = .false.
do i = 1 , k - 1
if( airports(i)%distance>airports(i + 1)%distance )then
temp = airports(i)
airports(i) = airports(i + 1)
airports(i + 1) = temp
swapped = .true.
end if
end do
end do
return
end subroutine sortem
!
subroutine tokenizes(input_string , tokens , num_tokens , delimiter)
character(*) , intent(in) :: input_string
character(*) , intent(out) , dimension(:) :: tokens
integer , intent(out) :: num_tokens
character(1) , intent(in) :: delimiter
integer :: end_idx
integer :: i
integer :: start_idx
character(100) :: temp_string
num_tokens = 0
temp_string = trim(input_string)
start_idx = 1
do i = 1 , len_trim(temp_string)
if( (temp_string(i:i)==delimiter) )then
end_idx = i - 1
if( end_idx>=start_idx )then
num_tokens = num_tokens + 1
tokens(num_tokens) = ''
tokens(num_tokens) = temp_string(start_idx:end_idx)
end if
start_idx = i + 1
end if
end do
! Handle the last token
if( start_idx<=len_trim(temp_string) )then
num_tokens = num_tokens + 1
tokens(num_tokens) = temp_string(start_idx:len_trim( &
& temp_string))
end if
end subroutine tokenizes
!
end module helpers
!
</syntaxhighlight>
{{out}}
<small>Scanning 7698 lines
Read complete, time taken = 93 milliseconds
Num Name Country ICAO Dist. Bearing
==================================================================================================================================
306 Koksijde Air Base Belgium EBFN 30.7 146
310 Ostend-Bruges International Airport Belgium EBOS 31.3 127
510 Kent International Airport United Kingdom EGMH 33.6 252
1254 Calais-Dunkerque Airport France LFAC 34.4 196
7810 Westkapelle heliport Belgium EBKW 42.6 105
6886 Lympne Airport United Kingdom EGMK 51.6 240
314 Ursel Air Base Belgium EBUL 52.8 114
508 Southend Airport United Kingdom EGMC 56.2 274
1400 Merville-Calonne Airport France LFQT 56.4 163
308 Wevelgem Airport Belgium EBKT 56.5 137
7836 Midden-Zeeland Airport Netherlands EHMZ 57.3 90
509 Lydd Airport United Kingdom EGMD 58.0 235
558 RAF Wattisham United Kingdom EGUW 59.0 309
8965 Beccles Airport United Kingdom EGSM 59.3 339
10089 Lille/Marcq-en-Baroeul Airport France LFQO 59.7 146
10745 Lashenden (Headcorn) Airfield United Kingdom EGKH 62.2 250
1259 Le Touquet-Côte d'Opale Airport France LFAT 63.7 200
8894 Rochester Airport United Kingdom EGTO 64.2 262
1399 Lille-Lesquin Airport France LFQQ 66.3 149
10747 Thurrock Airfield United Kingdom EGMT 68.4 272</small>
=={{header|J}}==
Line 1,683 ⟶ 1,933:
{{libheader|Wren-fmt}}
However, rather than use Wren-sql, we program it so that it can be run from Wren-CLI. Runtime is about 0.24 seconds.
<syntaxhighlight lang="
import "./dynamic" for Tuple
import "./str" for Str
| |||