source: trunk/fsource/polymask.for @ 97

Last change on this file since 97 was 97, checked in by vondreel, 12 years ago

polymask.for added

File size: 1.1 KB
Line 
1      SUBROUTINE POLYMASK(N,X,Y,M,POLY,MASK)
2
3Cf2py intent(in) N
4Cf2py intent(in) X
5Cf2py depend(N) X
6Cf2py intent(in) X
7Cf2py depend(N) Y
8Cf2py intent(in) M
9Cf2py intent(in) POLY
10Cf2py depend(M) POLY
11Cf2py intent(in,out) MASK
12Cf2py depend(N) MASK
13
14      IMPLICIT NONE
15      INTEGER*4    N,M
16      REAL*4       X(0:N-1),Y(0:N-1)
17      REAL*8       POLY(0:M-1,0:1)
18      LOGICAL*1    MASK(N)
19      INTEGER*4    I,K
20      REAL*4       P1X,P1Y,P2X,P2Y,XINTERS
21     
22      DO K=0,N
23        MASK(K) = .FALSE.
24        DO I=0,M-1
25          P2X = POLY(I,0)
26          P2Y = POLY(I,1)
27          IF (Y(K) .GT. MIN(P1Y,P2Y)) THEN
28            IF (Y(K) .LE. MAX(P1Y,P2Y)) THEN
29              IF (X(K) .LE. MAX(P1X,P2X)) THEN
30                IF (P1Y .NE.P2Y) THEN
31                  XINTERS = (Y(K)-P1Y)*(P2X-P1X)/(P2Y-P1Y)+P1X
32                END IF
33                IF ( (P1X .EQ. P2X) .OR. (X(K) .LE. XINTERS) ) THEN
34                  MASK(K) = .NOT.MASK(K)
35                END IF
36              END IF
37            END IF
38          END IF
39          P1X = P2X
40          P1Y = P2Y
41        END DO
42      END DO
43
44      RETURN
45      END
46
Note: See TracBrowser for help on using the repository browser.