orog_mask_tools  1.13.0
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 
49 LOGICAL 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 
87 END FUNCTION enclosure_cnvx
logical function enclosure_cnvx(v, n, p, co_gc)
Test whether a given point &#39;p&#39; is inside a convex spherical polygon defined with a series of &#39;n&#39; vert...