orog_mask_tools 1.14.0
Loading...
Searching...
No Matches
enclosure_cnvx.F90
Go to the documentation of this file.
1
4#ifdef INCLUDE_TEST_DRIVER
5 PROGRAM testenc
6 IMPLICIT NONE
7 real*8 :: v(2,4)
8 real*8 :: p(2)
9
10 real*8 :: d2r
11 LOGICAL:: enclosure_cnvx, inside
12 INTEGER :: co_gc
13
14 d2r = acos(-1.0)/180.0d0
15
16 v(1,1) = 10.0d0*d2r; v(2,1) = 20.0d0*d2r
17 v(1,2) = 15.0d0*d2r; v(2,2) = 30.0d0*d2r
18 v(1,3) = 17.7d0*d2r; v(2,3) = 25.0d0*d2r
19 v(1,4) = 20.0d0*d2r; v(2,4) = 20.0d0*d2r
20
21! p(1) = 15.0D0*d2r; p(2) = 30.00000001D0*d2r
22! p(1) = 20.00000000D0*d2r; p(2) = 20.0D0*d2r
23! p(1) = 9.999999999D0*d2r; p(2) = 20.0D0*d2r
24! p(1) = 10.00000000*d2r; p(2) = 20.000000001D0*d2r
25 p(1) = 17.7d0*d2r; p(2) = 25.000000001d0*d2r
26
27 inside = enclosure_cnvx(v,4,p,co_gc)
28 IF (inside) THEN
29 print*, 'inside ', co_gc
30 ELSE
31 print*, 'outside ', co_gc
32 ENDIF
33
34 END PROGRAM
35#endif
36
49LOGICAL FUNCTION enclosure_cnvx(v, n, p, co_gc)
50 IMPLICIT NONE
51 real*8, INTENT(IN) :: v(2,n), p(2)
52 INTEGER, INTENT(IN) :: n
53 INTEGER, INTENT(OUT) :: co_gc
54
55 real*8 v_xy(2, n)
56 real*8 cp_z(n), cos_d2c, eps
57
58 INTEGER :: i, ip1
59
60
61 eps = 0.000000000000001d0
62 co_gc = 0
63 DO i = 1, n
64 cos_d2c = sin(p(1))*sin(v(1,i)) + cos(p(1))*cos(v(1,i))*cos(v(2,i)-p(2))
65 v_xy(1,i) = (cos(v(1,i))*sin(v(2,i)-p(2)))/cos_d2c
66 v_xy(2,i) = (cos(p(1))*sin(v(1,i))-sin(p(1))*cos(v(1,i))*cos(v(2,i)-p(2)))/cos_d2c
67
68 ENDDO
69
70 DO i = 1, n
71 ip1 = mod(i,n)+1
72 cp_z(i) = v_xy(1,i)*v_xy(2,ip1)-v_xy(2,i)*v_xy(1,ip1)
73 IF (abs(cp_z(i)) < eps) co_gc = i
74 ENDDO
75
76 DO i = 1, n-1
77 ip1 = mod(i,n)+1
78 IF (cp_z(i)*cp_z(ip1) .LT. -eps) THEN
79 enclosure_cnvx = .false.
80 RETURN
81 ENDIF
82 ENDDO
83
84 enclosure_cnvx = .true.
85 RETURN
86
87END FUNCTION enclosure_cnvx
logical function enclosure_cnvx(v, n, p, co_gc)
Test whether a given point 'p' is inside a convex spherical polygon defined with a series of 'n' vert...