source: trunk/fsource/polymask.for @ 100

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

add histogram2d.for
fix polymask.for

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) Y
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
20      INTEGER*4    I,K
21      REAL*4       P1X,P1Y,P2X,P2Y,XINTERS
22     
23      DO K=0,N
24        MASK(K) = .FALSE.
25        DO I=0,M-1
26          P2X = POLY(I,0)
27          P2Y = POLY(I,1)
28          IF (Y(K) .GT. MIN(P1Y,P2Y)) THEN
29            IF (Y(K) .LE. MAX(P1Y,P2Y)) THEN
30              IF (X(K) .LE. MAX(P1X,P2X)) THEN
31                IF (P1Y .NE.P2Y) THEN
32                  XINTERS = (Y(K)-P1Y)*(P2X-P1X)/(P2Y-P1Y)+P1X
33                END IF
34                IF ( (P1X .EQ. P2X) .OR. (X(K) .LE. XINTERS) ) THEN
35                  MASK(K) = .NOT.MASK(K)
36                END IF
37              END IF
38            END IF
39          END IF
40          P1X = P2X
41          P1Y = P2Y
42        END DO
43      END DO
44
45      RETURN
46      END
47
Note: See TracBrowser for help on using the repository browser.