1
- ! haversine_distmat.f90
1
+ module haversine
2
2
!
3
3
! ===========================================================================
4
4
! This file is part of py-eddy-tracker.
22
22
! ===========================================================================
23
23
!
24
24
! 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
27
27
!
28
- ! If you have ifort on your system, change 'gfortran' to 'intelem'
28
+ ! If you have ifort on your system, change 'gfortran' to 'intelem'!
29
29
!
30
30
! Version 1.4.2
31
31
!
32
32
! ===========================================================================
33
+ implicit none
34
+ real (kind= 8 ), parameter :: erad = 6371315.0
35
+ real (kind= 8 ), parameter :: d2r = 0.017453292519943295 ! == pi / 180.
33
36
37
+ contains
34
38
35
39
!- -----------------------------------------------------------------------------
36
40
37
- subroutine haversine_distmat (xa , xb , dist )
41
+ subroutine distance_matrix (xa , xb , dist )
38
42
!- -----------------------------------------------------------------------------
39
- implicit none
43
+
40
44
real (kind= 8 ), dimension (:,:), intent (in ) :: xa, xb
41
- real (kind= 8 ), allocatable , dimension (:) :: xa1, xa2, xb1, xb2
42
45
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
45
47
real (kind= 8 ), dimension (:,:), intent (inout ) :: dist
46
- external :: haversine
47
- ! write (*,*) 'aaa'
48
- d2r = atan2 (0 .,- 1 .)/ 180 . ! atan2(0.,-1.) == pi
48
+
49
49
m = size (xa, 1 )
50
50
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
60
52
61
53
! Loop over empty dist matrix and fill
62
54
do j = 1 , m
63
55
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)
65
57
dist(j,i) = thedist
58
+ ! write (*,*) 'dist(j,i)', dist(j,i)
66
59
enddo
67
60
enddo
68
- deallocate (xa1)
69
- deallocate (xa2)
70
- deallocate (xb1)
71
- deallocate (xb2)
72
61
dist = dist * erad
73
- end subroutine haversine_distmat
62
+ ! write (*,*) 'dist', dist
63
+ end subroutine distance_matrix
74
64
75
65
76
66
!- -----------------------------------------------------------------------------
77
- subroutine haversine_distvec (lon1 , lat1 , lon2 , lat2 , dist )
67
+ subroutine distance_vector (lon1 , lat1 , lon2 , lat2 , dist )
78
68
!- -----------------------------------------------------------------------------
79
69
80
- implicit none
81
70
real (kind= 8 ), dimension (:), intent (in ) :: lon1, lat1, lon2, lat2
82
71
integer (kind= 8 ) :: i, m
83
- real (kind= 8 ) :: thedist, d2r
84
- real (kind= 8 ), parameter :: erad = 6371315.0
72
+ real (kind= 8 ) :: thedist
85
73
real (kind= 8 ), dimension (:), intent (inout ) :: dist
86
- external :: haversine
87
-
88
- d2r = atan2 (0 .,- 1 .) / 180 . ! atan2(0.,-1.) == pi
74
+
89
75
m = size (lon1)
90
76
91
77
! Loop over empty dist matrix and fill
92
78
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)
94
80
dist(i) = thedist
95
81
enddo
96
82
dist = dist * erad
97
83
98
- end subroutine haversine_distvec
99
-
84
+ end subroutine distance_vector
100
85
86
+
101
87
!- -----------------------------------------------------------------------------
102
- subroutine haversine_dist (lon1 , lat1 , lon2 , lat2 , thedist )
88
+ subroutine distance (lon1 , lat1 , lon2 , lat2 , thedist )
103
89
!- -----------------------------------------------------------------------------
104
90
105
- implicit none
106
91
real (kind= 8 ), intent (in ) :: lon1, lat1, lon2, lat2
107
- real (kind= 8 ) :: d2r
108
- real (kind= 8 ), parameter :: erad = 6371315.0
109
92
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)
114
95
thedist = thedist * erad
115
96
116
- end subroutine haversine_dist
117
-
97
+ end subroutine distance
118
98
99
+
119
100
!- -----------------------------------------------------------------------------
120
- subroutine haversine (lon1 , lat1 , lon2 , lat2 , d2r , thedist )
101
+ subroutine get_haversine (lon1 , lat1 , lon2 , lat2 , thedist )
121
102
!- -----------------------------------------------------------------------------
122
103
!
123
- implicit none
124
- real (kind= 8 ), intent (in ) :: lon1, lat1, lon2, lat2, d2r
104
+ real (kind= 8 ), intent (in ) :: lon1, lat1, lon2, lat2
125
105
real (kind= 8 ) :: lt1, lt2, dlat, dlon
126
106
real (kind= 8 ) :: a
127
107
real (kind= 8 ), intent (out ) :: thedist
@@ -136,76 +116,57 @@ subroutine haversine(lon1, lat1, lon2, lat2, d2r, thedist)
136
116
a = a + (sin (0.5 * dlat) * sin (0.5 * dlat))
137
117
thedist = 2 * atan2 (sqrt (a), sqrt (1 - a))
138
118
!
139
- end subroutine haversine
119
+ end subroutine get_haversine
140
120
141
121
142
122
!- -----------------------------------------------------------------------------
143
- subroutine waypoint_vec (lonin , latin , anglein , distin , lon , lat )
123
+ subroutine waypoint_vector (lonin , latin , anglein , distin , lon , lat )
144
124
!- -----------------------------------------------------------------------------
145
125
146
- implicit none
147
126
real (kind= 8 ), dimension (:), intent (in ) :: lonin, latin, anglein, distin
148
127
integer (kind= 8 ) :: i, m
149
- real (kind= 8 ) :: thelon, thelat, d2r
128
+ real (kind= 8 ) :: thelon, thelat
150
129
real (kind= 8 ), dimension (:), intent (inout ) :: lon, lat
151
- external :: waypoint
130
+ ! external :: waypoint
152
131
153
- d2r = atan2 (0 .,- 1 .)/ 180 . ! atan2(0.,-1.) == pi
154
132
m = size (lonin)
155
133
156
134
! 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
162
140
163
- end subroutine waypoint_vec
141
+ end subroutine waypoint_vector
164
142
165
143
166
144
!- -----------------------------------------------------------------------------
167
- subroutine waypoint (lonin , latin , anglein , distin , d2r , thelon , thelat )
145
+ subroutine get_waypoint (lonin , latin , anglein , distin , thelon , thelat )
168
146
!- -----------------------------------------------------------------------------
169
147
!
170
148
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
174
151
real (kind= 8 ), intent (out ) :: thelon, thelat
175
152
!
176
- d_r = distin / erad ! angular distance
153
+ dr = distin / erad ! angular distance
177
154
thelon = d2r * lonin
178
155
thelat = d2r * latin
179
156
angle = d2r * anglein
180
157
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))
183
161
ln1 = ln1 + thelon
184
162
thelat = lt1 / d2r
185
163
thelon = ln1 / d2r
186
164
!
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
210
166
167
+
211
168
169
+
170
+ !- -----------------------------------------------------------------------------
171
+ end module haversine
172
+ !- -----------------------------------------------------------------------------
0 commit comments