1- !  haversine_distmat.f90 
1+ module  haversine 
22! 
33!  ===========================================================================
44!  This file is part of py-eddy-tracker.
2222!  ===========================================================================
2323! 
2424!     To compile for f2py do following in terminal:
25- !     f2py -m haversine_distmat  -h haversine_distmat .pyf haversine_distmat .f90  --overwrite-signature
26- !     f2py -c --fcompiler=gfortran haversine_distmat .pyf haversine_distmat .f90
25+ !     f2py -m haversine  -h haversine .pyf haversine .f90  --overwrite-signature
26+ !     f2py -c --fcompiler=gfortran haversine .pyf haversine .f90
2727! 
28- !     If you have ifort on your system, change 'gfortran' to 'intelem'
28+ !     If you have ifort on your system, change 'gfortran' to 'intelem'! 
2929! 
3030!    Version 1.4.2
3131! 
3232! ===========================================================================
33+ implicit none 
34+ real (kind= 8 ), parameter  ::  erad =  6371315.0 
35+ real (kind= 8 ), parameter  ::  d2r =  0.017453292519943295  !  == pi / 180.
3336
37+ contains 
3438
3539!- -----------------------------------------------------------------------------
3640
37-     subroutine  haversine_distmat (xa , xb , dist )
41+     subroutine  distance_matrix (xa , xb , dist )
3842!- -----------------------------------------------------------------------------
39-        implicit none 
43+ 
4044      real (kind= 8 ), dimension (:,:), intent (in )    ::  xa, xb
41-       real (kind= 8 ), allocatable , dimension (:)     ::  xa1, xa2, xb1, xb2
4245      integer (kind= 8 )                             ::  i, j, m, n
43-       real (kind= 8 )                                ::  thedist, d2r
44-       real (kind= 8 ), parameter                      ::  erad =  6371315.0 
46+       real (kind= 8 )                                ::  thedist
4547      real (kind= 8 ), dimension (:,:), intent (inout ) ::  dist
46-       external  ::  haversine
47-       ! write (*,*) 'aaa'
48-       d2r =  atan2 (0 .,- 1 .)/  180 . !  atan2(0.,-1.) == pi
48+ 
4949      m =  size (xa, 1 )
5050      n =  size (xb, 1 )
51-       allocate (xa1(m))
52-       allocate (xa2(m))
53-       allocate (xb1(n))
54-       allocate (xb2(n))
55-       xa1 =  xa(:,1 )
56-       xa2 =  xa(:,2 )
57-       xb1 =  xb(:,1 )
58-       xb2 =  xb(:,2 )
59-       ! write (*,*) 'bbb', xa1
51+ !        write (*,*) 'm,n', m, n
6052
6153!      Loop over empty dist matrix and fill
6254      do  j =  1 , m
6355        do  i =  1 , n
64-           call  haversine(xa1(j ), xa2(j ), xb1(i ), xb2(i), d2r , thedist)
56+           call  get_haversine(xa(j, 1 ), xa(j, 2 ), xb(i, 1 ), xb(i, 2 ) , thedist)
6557          dist(j,i) =  thedist
58+ !            write (*,*) 'dist(j,i)', dist(j,i)
6659        enddo 
6760      enddo 
68-       deallocate (xa1)
69-       deallocate (xa2)
70-       deallocate (xb1)
71-       deallocate (xb2)
7261      dist =  dist *  erad
73-     end  subroutine  haversine_distmat 
62+ !        write (*,*) 'dist', dist
63+     end  subroutine  distance_matrix 
7464
7565
7666!- -----------------------------------------------------------------------------
77-     subroutine  haversine_distvec (lon1 , lat1 , lon2 , lat2 , dist )
67+     subroutine  distance_vector (lon1 , lat1 , lon2 , lat2 , dist )
7868!- -----------------------------------------------------------------------------
7969
80-       implicit none 
8170      real (kind= 8 ), dimension (:), intent (in ) ::  lon1, lat1, lon2, lat2
8271      integer (kind= 8 )                        ::  i, m
83-       real (kind= 8 )             ::  thedist, d2r
84-       real (kind= 8 ), parameter   ::  erad =  6371315.0 
72+       real (kind= 8 )             ::  thedist
8573      real (kind= 8 ), dimension (:), intent (inout ) ::  dist
86-       external  ::  haversine
87- 
88-       d2r =  atan2 (0 .,- 1 .) /  180 . !  atan2(0.,-1.) == pi
74+       
8975      m =  size (lon1)
9076
9177!      Loop over empty dist matrix and fill
9278      do  i =  1 , m
93-         call  haversine (lon1(i), lat1(i), lon2(i), lat2(i), d2r , thedist)
79+         call  get_haversine (lon1(i), lat1(i), lon2(i), lat2(i), thedist)
9480        dist(i) =  thedist
9581      enddo 
9682      dist =  dist *  erad
9783
98-     end  subroutine  haversine_distvec 
99- 
84+     end  subroutine  distance_vector 
10085
86+     
10187!- -----------------------------------------------------------------------------
102-     subroutine  haversine_dist (lon1 , lat1 , lon2 , lat2 , thedist )
88+     subroutine  distance (lon1 , lat1 , lon2 , lat2 , thedist )
10389!- -----------------------------------------------------------------------------
10490
105-       implicit none 
10691      real (kind= 8 ), intent (in ) ::  lon1, lat1, lon2, lat2
107-       real (kind= 8 )             ::  d2r
108-       real (kind= 8 ), parameter   ::  erad =  6371315.0 
10992      real (kind= 8 ), intent (out ) ::  thedist
110-       external  ::  haversine
111-       
112-       d2r =  atan2 (0 .,- 1 .) /  180 . !  atan2(0.,-1.) == pi
113-       call  haversine(lon1, lat1, lon2, lat2, d2r, thedist)
93+ ! 
94+       call  get_haversine(lon1, lat1, lon2, lat2, thedist)
11495      thedist =  thedist *  erad
11596
116-     end  subroutine  haversine_dist 
117- 
97+     end  subroutine  distance 
11898
99+     
119100!- -----------------------------------------------------------------------------
120-     subroutine  haversine (lon1 , lat1 , lon2 , lat2 ,  d2r , thedist )
101+     subroutine  get_haversine (lon1 , lat1 , lon2 , lat2 , thedist )
121102!- -----------------------------------------------------------------------------
122103! 
123-       implicit none 
124-       real (kind= 8 ), intent (in )  ::  lon1, lat1, lon2, lat2, d2r
104+       real (kind= 8 ), intent (in )  ::  lon1, lat1, lon2, lat2
125105      real (kind= 8 )              ::  lt1, lt2, dlat, dlon
126106      real (kind= 8 )              ::  a
127107      real (kind= 8 ), intent (out ) ::  thedist
@@ -136,76 +116,57 @@ subroutine haversine(lon1, lat1, lon2, lat2, d2r, thedist)
136116      a =  a +  (sin (0.5  *  dlat) *  sin (0.5  *  dlat))
137117      thedist =  2  *  atan2 (sqrt (a), sqrt (1  -  a))
138118! 
139-     end  subroutine  haversine  
119+     end  subroutine  get_haversine  
140120
141121
142122!- -----------------------------------------------------------------------------
143-     subroutine  waypoint_vec (lonin , latin , anglein , distin , lon , lat )
123+     subroutine  waypoint_vector (lonin , latin , anglein , distin , lon , lat )
144124!- -----------------------------------------------------------------------------
145125
146-       implicit none 
147126      real (kind= 8 ), dimension (:), intent (in ) ::  lonin, latin, anglein, distin
148127      integer (kind= 8 )                        ::  i, m
149-       real (kind= 8 )             ::  thelon, thelat, d2r 
128+       real (kind= 8 )             ::  thelon, thelat
150129      real (kind= 8 ), dimension (:), intent (inout ) ::  lon, lat
151-       external  ::  waypoint
130+ !         external :: waypoint
152131
153-       d2r =  atan2 (0 .,- 1 .)/  180 . !  atan2(0.,-1.) == pi
154132      m =  size (lonin)
155133
156134!      Loop over empty dist matrix and fill
157-          do  i =  1 , m
158-            call  waypoint (lonin(i), latin(i), anglein(i), distin(i), d2r , thelon, thelat)
159-            lon(i) =  thelon
160-            lat(i) =  thelat
161-          enddo 
135+       do  i =  1 , m
136+         call  get_waypoint (lonin(i), latin(i), anglein(i), distin(i), thelon, thelat)
137+         lon(i) =  thelon
138+         lat(i) =  thelat
139+       enddo 
162140
163-     end  subroutine  waypoint_vec  
141+     end  subroutine  waypoint_vector  
164142
165143
166144!- -----------------------------------------------------------------------------
167-     subroutine  waypoint (lonin , latin , anglein , distin ,  d2r , thelon , thelat )
145+     subroutine  get_waypoint (lonin , latin , anglein , distin , thelon , thelat )
168146!- -----------------------------------------------------------------------------
169147! 
170148      implicit none 
171-       real (kind= 8 ), intent (in )  ::  lonin, latin, anglein, distin, d2r
172-       real (kind= 8 )              ::  ln1, lt1, angle, d_r
173-       real (kind= 8 ), parameter    ::  erad =  6371315.0 
149+       real (kind= 8 ), intent (in )  ::  lonin, latin, anglein, distin
150+       real (kind= 8 )              ::  ln1, lt1, angle, dr
174151      real (kind= 8 ), intent (out ) ::  thelon, thelat
175152! 
176-       d_r  =  distin /  erad !  angular distance
153+       dr  =  distin /  erad !  angular distance
177154      thelon =  d2r *  lonin
178155      thelat =  d2r *  latin
179156      angle =  d2r *  anglein
180157
181-       lt1 =  asin (sin (thelat) *  cos (d_r) +  cos (thelat) *  sin (d_r) *  cos (angle))
182-       ln1 =  atan2 (sin (angle) *  sin (d_r) *  cos (thelat), cos (d_r) -  sin (thelat) *  sin (lt1))
158+       lt1 =  asin (sin (thelat) *  cos (dr) +  cos (thelat) *  sin (dr) *  cos (angle))
159+       ln1 =  atan2 (sin (angle) *  sin (dr) *  cos (thelat), cos (dr) &
160+                                       -  sin (thelat) *  sin (lt1))
183161      ln1 =  ln1 +  thelon
184162      thelat =  lt1 /  d2r
185163      thelon =  ln1 /  d2r
186164! 
187-     end  subroutine  waypoint 
188- 
189- 
190- !       
191- !  !------------------------------------------------------------------------------
192- !      subroutine concat_arrays(a, b)
193- !  !------------------------------------------------------------------------------
194- !        implicit none
195- !        real(kind=8), dimension(:) :: a
196- !        real(kind=8), dimension(:) :: b
197- !        real(kind=8), dimension(:), allocatable :: c
198- !  !
199- !        allocate(c(size(a)+size(b)))
200- !        c(1:size(a)) = a
201- !        c(size(a)+1:size(a)+size(b)) = b
202- !   
203- !      end subroutine concat_arrays
204- 
205- 
206- 
207- 
208- 
209- 
165+     end  subroutine  get_waypoint 
210166
167+     
211168
169+     
170+ !- -----------------------------------------------------------------------------
171+ end module  haversine
172+ !- -----------------------------------------------------------------------------
0 commit comments