You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
42 lines
814 B
Fortran
42 lines
814 B
Fortran
5 years ago
|
SUBROUTINE DROPPTS(NVERT,NINTV,SPAC)
|
||
|
|
|
||
|
|
USE BLKMAP
|
||
|
|
USE BLK1MOD
|
||
|
|
USE BLK2MOD
|
||
|
|
! INCLUDE 'BLK1.COM'
|
||
|
|
! INCLUDE 'BLK2.COM'
|
||
|
|
|
||
|
|
NN=0
|
||
|
|
DO NM=1,NVERT
|
||
|
|
N=NKEY(NM)
|
||
|
|
IF(LIST(N) .EQ. 1) THEN
|
||
|
|
NN=NN+1
|
||
|
|
IF(MOD(NN-1,NINTV) .EQ. 0) THEN
|
||
|
|
LIST(N)=1
|
||
|
|
ELSE
|
||
|
|
LIST(N)=0
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
ENDDO
|
||
|
|
|
||
|
|
IF(SPAC .GT. 0.) THEN
|
||
|
|
DO NM=1,NVERT
|
||
|
|
N=NKEY(NM)
|
||
|
|
IF(LIST(N) .EQ. 1) THEN
|
||
|
|
IF(N .LT. NVERT) THEN
|
||
|
|
DO M=N+1,NVERT
|
||
|
|
IF(LIST(M) .EQ. 1) THEN
|
||
|
|
DISQ=(XUSR(M)-XUSR(N))**2+(XUSR(M)-XUSR(N))**2
|
||
|
|
IF(DISQ .LT. SPAC**2) THEN
|
||
|
|
LIST(M)=0
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
ENDDO
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
ENDDO
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
RETURN
|
||
|
|
END
|