1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
|
SUBROUTINE CONDET (NDP,XD,YD,NCP,IPC)
C
C +-----------------------------------------------------------------+
C | |
C | Copyright (C) 1986 by UCAR |
C | University Corporation for Atmospheric Research |
C | All Rights Reserved |
C | |
C | NCARGRAPHICS Version 1.00 |
C | |
C +-----------------------------------------------------------------+
C
C
C
C******************************************************************
C* *
C* THIS FILE IS A PACKAGE OF SUPPORT ROUTINES FOR THE ULIB *
C* FILES CONRAN , CONRAQ AND CONRAS. SEE THOSE FILES FOR AN *
C* EXPLAINATION OF THE ENTRY POINTS. *
C* *
C******************************************************************
C
C THIS SUBROUTINE SELECTS SEVERAL DATA POINTS THAT ARE CLOSEST
C TO EACH OF THE DATA POINT.
C THE INPUT PARAMETERS ARE
C NDP = NUMBER OF DATA POINTS,
C XD,YD = ARRAYS CONTAINING THE X AND Y COORDINATES
C OF DATA POINTS,
C NCP = NUMBER OF DATA POINTS CLOSEST TO EACH DATA
C POINTS.
C THE OUTPUT PARAMETER IS
C IPC = INTEGER ARRAY OF DIMENSION NCP*NDP, WHERE THE
C POINT NUMBERS OF NCP DATA POINTS CLOSEST TO
C EACH OF THE NDP DATA POINTS ARE TO BE STORED.
C THIS SUBROUTINE ARBITRARILY SETS A RESTRICTION THAT NCP MUST
C NOT EXCEED 25 WITHOUT MODIFICATION TO THE ARRAYS DSQ0 AND IPC0.
C DECLARATION STATEMENTS
C
COMMON /CONRA3/ IREC
DIMENSION XD(NDP) ,YD(NDP) ,IPC(1)
DIMENSION DSQ0(25) ,IPC0(25)
C
SAVE
C
C STATEMENT FUNCTION
C
DSQF(U1,V1,U2,V2) = (U2-U1)**2+(V2-V1)**2
C
C CALCULATION
C
DO 220 IP1=1,NDP
C
C - SELECTS NCP POINTS.
C
X1 = XD(IP1)
Y1 = YD(IP1)
J1 = 0
DSQMX = 0.0
DO 110 IP2=1,NDP
IF (IP2 .EQ. IP1) GO TO 110
DSQI = DSQF(X1,Y1,XD(IP2),YD(IP2))
J1 = J1+1
DSQ0(J1) = DSQI
IPC0(J1) = IP2
IF (DSQI .LE. DSQMX) GO TO 100
DSQMX = DSQI
JMX = J1
100 IF (J1 .GE. NCP) GO TO 120
110 CONTINUE
120 IP2MN = IP2+1
IF (IP2MN .GT. NDP) GO TO 150
DO 140 IP2=IP2MN,NDP
IF (IP2 .EQ. IP1) GO TO 140
DSQI = DSQF(X1,Y1,XD(IP2),YD(IP2))
IF (DSQI .GE. DSQMX) GO TO 140
DSQ0(JMX) = DSQI
IPC0(JMX) = IP2
DSQMX = 0.0
DO 130 J1=1,NCP
IF (DSQ0(J1) .LE. DSQMX) GO TO 130
DSQMX = DSQ0(J1)
JMX = J1
130 CONTINUE
140 CONTINUE
C
C - CHECKS IF ALL THE NCP+1 POINTS ARE COLLINEAR.
C
150 IP2 = IPC0(1)
DX12 = XD(IP2)-X1
DY12 = YD(IP2)-Y1
DO 160 J3=2,NCP
IP3 = IPC0(J3)
DX13 = XD(IP3)-X1
DY13 = YD(IP3)-Y1
IF ((DY13*DX12-DX13*DY12) .NE. 0.0) GO TO 200
160 CONTINUE
C
C - SEARCHES FOR THE CLOSEST NONCOLLINEAR POINT.
C
NCLPT = 0
DO 190 IP3=1,NDP
IF (IP3 .EQ. IP1) GO TO 190
DO 170 J4=1,NCP
IF (IP3 .EQ. IPC0(J4)) GO TO 190
170 CONTINUE
DX13 = XD(IP3)-X1
DY13 = YD(IP3)-Y1
IF ((DY13*DX12-DX13*DY12) .EQ. 0.0) GO TO 190
DSQI = DSQF(X1,Y1,XD(IP3),YD(IP3))
IF (NCLPT .EQ. 0) GO TO 180
IF (DSQI .GE. DSQMN) GO TO 190
180 NCLPT = 1
DSQMN = DSQI
IP3MN = IP3
190 CONTINUE
DSQMX = DSQMN
IPC0(JMX) = IP3MN
C
C - REPLACES THE LOCAL ARRAY FOR THE OUTPUT ARRAY.
C
200 J1 = (IP1-1)*NCP
DO 210 J2=1,NCP
J1 = J1+1
IPC(J1) = IPC0(J2)
210 CONTINUE
220 CONTINUE
RETURN
END
|
