New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
linquad.h90 in trunk/NEMOGCM/NEMO/OPA_SRC/OBS – NEMO

source: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/linquad.h90 @ 7881

Last change on this file since 7881 was 2287, checked in by smasson, 13 years ago

update licence of all NEMO files...

  • Property svn:keywords set to Id
File size: 2.4 KB
Line 
1   !!----------------------------------------------------------------------
2   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
3   !! $Id$
4   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
5   !!----------------------------------------------------------------------
6
7   LOGICAL FUNCTION linquad( px, py, pxv, pyv )
8      !!----------------------------------------------------------------------
9      !!                    ***  FUNCTION linquad ***
10      !!
11      !! ** Purpose : Determine whether a point P(x,y) lies within or on the
12      !!              boundary of a quadrangle (ABCD) of any shape on a plane.
13      !!
14      !! ** Method  : Check if the vectorial products PA x PC, PB x PA,
15      !!              PC x PD, and PD x PB are all negative.
16      !!
17      !! ** Action  :
18      !!
19      !! History :
20      !!        !  2001-11  (N. Daget, A. Weaver)
21      !!        !  2006-08  (A. Weaver) NEMOVAR migration
22      !!        !  2006-10  (A. Weaver) Cleanup
23      !!----------------------------------------------------------------------
24
25      !! * Arguments
26      REAL(KIND=wp), INTENT(IN) :: px        ! (lon) of the point P(x,y)
27      REAL(KIND=wp), INTENT(IN) :: py        ! (lat) of the point P(x,y)               
28      REAL(KIND=wp), DIMENSION(4), INTENT(IN) :: &
29         & pxv,  &                  ! (lon, lat) of the surrounding cell
30         & pyv                     
31 
32      !! * Local declarations
33      REAL(KIND=wp) :: zst1
34      REAL(KIND=wp) :: zst2
35      REAL(KIND=wp) :: zst3
36      REAL(KIND=wp) :: zst4
37
38      !-----------------------------------------------------------------------
39      ! Test to see if the point is within the cell
40      !-----------------------------------------------------------------------
41      linquad = .FALSE.
42      zst1 =   ( px - pxv(1) ) * ( py - pyv(4) ) &
43         &   - ( py - pyv(1) ) * ( px - pxv(4) )
44      IF ( zst1 <= 0.0 ) THEN
45         zst2 =   ( px - pxv(4) ) * ( py - pyv(3) ) &
46         &   - ( py - pyv(4) ) * ( px - pxv(3) )
47         IF ( zst2 <= 0.0 ) THEN
48            zst3 =   ( px - pxv(3) ) * ( py - pyv(2) ) &
49               &   - ( py - pyv(3) ) * ( px - pxv(2) )
50            IF ( zst3 <= 0.0) THEN
51               zst4 =   ( px - pxv(2) ) * ( py - pyv(1) ) &
52                  &   - ( py - pyv(2) ) * ( px - pxv(1) )
53               IF ( zst4 <= 0.0 ) linquad = .TRUE.
54            ENDIF
55         ENDIF
56      ENDIF
57
58   END FUNCTION linquad
59
Note: See TracBrowser for help on using the repository browser.