-
Notifications
You must be signed in to change notification settings - Fork 14
/
Copy pathclustering.f
158 lines (105 loc) · 4.57 KB
/
clustering.f
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
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
********************************************************************************
** FICHE F.34. AN EFFICIENT CLUSTERING ROUTINE **
** This FORTRAN code is intended to illustrate points made in the text. **
** To our knowledge it works correctly. However it is the responsibility of **
** the user to test it, if it is to be used in a research application. **
********************************************************************************
SUBROUTINE MYGANG ( RCL, IT, NIT )
COMMON / BLOCK1 / RX, RY, RZ
C *******************************************************************
C ** ROUTINE TO IDENTIFY ATOM CLUSTERS IN A CONFIGURATION. **
C ** **
C ** THIS ROUTINE SORTS N ATOMS INTO CLUSTERS DEFINED BY A **
C ** CRITICAL CLUSTER RADIUS, AND COUNTS THE NUMBER OF ATOMS IN **
C ** THE CLUSTER CONTAINING THE ATOM 'IT'. THE ATOMS ARE IN A **
C ** BOX OF UNIT LENGTH CENTRED AT THE ORIGIN **
C ** **
C ** REFERENCE: **
C ** **
C ** STODDARD J COMP PHYS, 27, 291, 1977. **
C ** **
C ** PRINCIPAL VARIABLES: **
C ** **
C ** INTEGER N NUMBER OF ATOMS **
C ** INTEGER IT AN ATOM IN A PARTICULAR CLUSTER **
C ** INTEGER L(N) A LINKED-LIST **
C ** INTEGER NIT NUMBER OF ATOMS IN THAT CLUSTER **
C ** REAL RX(N),RY(N),RZ(N) POSITIONS **
C ** REAL RCL CRITICAL CLUSTER DISTANCE **
C *******************************************************************
INTEGER N
PARAMETER ( N = 108 )
REAL RX(N), RY(N), RZ(N)
REAL RCL
INTEGER IT, NIT
REAL RCLSQ, RXJK, RYJK, RZJK
REAL RJKSQ, RXJ, RYJ, RZJ
INTEGER I, J, K, LK, LIT, L(N)
C ****************************************************************
RCLSQ = RCL * RCL
C ** SET UP THE SORTING ARRAY **
DO 10 I = 1, N
L(I) = I
10 CONTINUE
C ** SORT THE CLUSTERS **
DO 50 I = 1, N - 1
IF ( I .EQ. L(I) ) THEN
J = I
RXJ = RX(J)
RYJ = RY(J)
RZJ = RZ(J)
DO 20 K = I + 1, N
LK = L(K)
IF ( LK .EQ. K ) THEN
RXJK = RXJ - RX(K)
RYJK = RYJ - RY(K)
RZJK = RZJ - RZ(K)
RXJK = RXJK - ANINT ( RXJK )
RYJK = RYJK - ANINT ( RYJK )
RZJK = RZJK - ANINT ( RZJK )
RJKSQ = RXJK * RXJK + RYJK * RYJK + RZJK * RZJK
IF ( RJKSQ .LE. RCLSQ ) THEN
L(K) = L(J)
L(J) = LK
ENDIF
ENDIF
20 CONTINUE
J = L(J)
RXJ = RX(J)
RYJ = RY(J)
RZJ = RZ(J)
30 IF ( J .NE. I ) THEN
DO 40 K = I + 1, N
LK = L(K)
IF ( LK .EQ. K ) THEN
RXJK = RXJ - RX(K)
RYJK = RYJ - RY(K)
RZJK = RZJ - RZ(K)
RXJK = RXJK - ANINT ( RXJK )
RYJK = RYJK - ANINT ( RYJK )
RZJK = RZJK - ANINT ( RZJK )
RJKSQ = RXJK * RXJK + RYJK * RYJK + RZJK * RZJK
IF ( RJKSQ .LE. RCLSQ ) THEN
L(K) = L(J)
L(J) = LK
ENDIF
ENDIF
40 CONTINUE
J = L(J)
RXJ = RX(J)
RYJ = RY(J)
RZJ = RZ(J)
GO TO 30
ENDIF
ENDIF
50 CONTINUE
C ** COUNT THE NUMBER IN A CLUSTER CONTAINING ATOM IT **
NIT = 1
LIT = L(IT)
60 IF ( LIT .NE. IT ) THEN
NIT = NIT + 1
LIT = L(LIT)
GO TO 60
ENDIF
RETURN
END