|
older-version
|
|
a.tgz,
f.00,
f.1,
f.10,
f.11,
f.12,
f.13,
f.14,
f.15,
f.16,
f.17,
f.18,
f.19,
f.2,
f.20,
f.21,
f.22,
f.23,
f.24,
f.25,
f.26,
f.27,
f.28,
f.29,
f.3,
f.30,
f.31,
f.32,
f.33,
f.34,
f.35,
f.36,
f.37,
f.4,
f.5,
f.6,
f.7,
f.8,
f.9
|
|
|
C *******************************************************************
C ** THIS FORTRAN CODE IS INTENDED TO ILLUSTRATE POINTS MADE IN **
C ** THE TEXT. TO OUR KNOWLEDGE IT WORKS CORRECTLY. HOWEVER IT IS **
C ** THE RESPONSIBILITY OF THE USER TO TEST IT, IF IT IS USED IN A **
C ** RESEARCH APPLICATION. **
C *******************************************************************
C *******************************************************************
C ** FICHE F.34. AN EFFICIENT CLUSTERING ROUTINE **
C *******************************************************************
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
|
