      SUBROUTINE assign(site,np,L)
*     占有された格子点にクラスター番号を割り付ける
      IMPLICIT NONE
      INTEGER down, left, ncluster, x, y, site(0:64,0:64), np(0:1000), 
     +        L, proper, Itmp1_
      DO Itmp1_ = 0, 1000
         np(Itmp1_) = 0
      END DO
      ncluster = 0                          ! クラスター番号
      DO y = 1, L
         DO x = 1, L
            IF(site(x,y) .LT. 0) THEN
               down = y - 1                 ! 正方格子
               left = x - 1
               IF(site(x,down) + site(left,y) .EQ. 0) THEN
                  ncluster = ncluster + 1   ! 新しいクラスター
                  site(x,y) = ncluster
                  np(ncluster) = ncluster   ! 本来のラベル
               ELSE
                  CALL neighbor(site,np,x,y)
               END IF
            END IF
         END DO
      END DO
*     クラスターの配列に本来のラベルを割り付ける
      DO y = 1, L
         DO x = 1, L
            site(x,y) = proper(np,site(x,y))
         END DO
      END DO
      END
C
      SUBROUTINE neighbor(site,np,x,y)
      IMPLICIT NONE
      INTEGER down, left, site(0:64,0:64), np(0:1000), x, y
      down = y - 1
      left = x - 1
      IF(site(x,down)*site(left,y) .GT. 0) THEN
*        両隣接格子点とも占有されている
         CALL label_min(site,np,x,y,left,down)
      ELSE IF(site(x,down) .GT. 0) THEN
         site(x,y) = site(x,down)
      ELSE
         site(x,y) = site(left,y)
      END IF
      END
C
      SUBROUTINE label_min(site,np,x,y,left,down)
*     両隣接格子点が占有されているので，小さい方のクラスター番号を求める
      IMPLICIT NONE
      INTEGER cl_down, cl_left, nmin, nmax, site(0:64,0:64), 
     +        np(0:1000), x, y, left, down, proper
      IF(site(left,y) .EQ. site(x,down)) THEN
*        両隣接格子点とも同じクラスター番号を持つ
         site(x,y) = site(left,y)
      ELSE
*        小さい方のクラスター番号を求める
         cl_left = proper(np,site(left,y))
         cl_down = proper(np,site(x,down))
         nmax = max(cl_left,cl_down)
         nmin = min(cl_left,cl_down)
         site(x,y) = nmin
         IF(nmin .NE. nmax) THEN
            np(nmax) = nmin                 ! 不適当なラベルでは nmax = nmin とする
         END IF
      END IF
      END
