|
Last change
on this file since 2058 was
2058,
checked in by vondreele, 6 years ago
|
|
fix do loop error in polymask.f; recompile bin-32 & bin-64 for Windows.
|
|
File size:
1.1 KB
|
| Line | |
|---|
| 1 | SUBROUTINE POLYMASK(N,X,Y,M,POLY,MASK) |
|---|
| 2 | |
|---|
| 3 | Cf2py intent(in) N |
|---|
| 4 | Cf2py intent(in) X |
|---|
| 5 | Cf2py depend(N) X |
|---|
| 6 | Cf2py intent(in) Y |
|---|
| 7 | Cf2py depend(N) Y |
|---|
| 8 | Cf2py intent(in) M |
|---|
| 9 | Cf2py intent(in) POLY |
|---|
| 10 | Cf2py depend(M) POLY |
|---|
| 11 | Cf2py intent(in,out) MASK |
|---|
| 12 | |
|---|
| 13 | IMPLICIT NONE |
|---|
| 14 | INTEGER*4 N,M |
|---|
| 15 | REAL*4 X(0:N-1),Y(0:N-1) |
|---|
| 16 | REAL*8 POLY(0:M-1,0:1) |
|---|
| 17 | LOGICAL*1 MASK(0:1024*1024-1) |
|---|
| 18 | |
|---|
| 19 | INTEGER*4 I,K |
|---|
| 20 | REAL*4 P1X,P1Y,P2X,P2Y,XINTERS |
|---|
| 21 | |
|---|
| 22 | DO K=0,N-1 |
|---|
| 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.
