CCL Home Page
Up Directory CCL f.34
********************************************************************************
** 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



Modified: Sat Jul 22 04:41:17 2000 GMT
Page accessed 11852 times since Sat Apr 17 21:34:15 1999 GMT