status.f

Go to the documentation of this file.

      SUBROUTINE status(X,I1,I2,I3,I4)
*
*
*       Current configuration.
*       ----------------------
*
      IMPLICIT REAL*8  (a-h,o-z)
      REAL*8  x(12),rr(6)
      INTEGER  ii(4,4),in(6),jn(6),ij(6)
      LOGICAL  switch
      common/ind6/  ind(6)
      common/config/  r2(4,4),j1,j2,j3,j4
      DATA  ii/0,3,2,2,4,0,1,1,4,4,0,1,3,3,2,0/
*
*
*       Form mutual square distances and determine closest pair indices.
      r2min = 1.0d+10
      l = 0
      DO 10 i = 1,3
          DO 5 j = i+1,4
              il = 3*(i - 1)
              jl = 3*(j - 1)
              r2(i,j) = (x(il+1) - x(jl+1))**2 + (x(il+2) - x(jl+2))**2
     &                                         + (x(il+3) - x(jl+3))**2
              r2(j,i) = r2(i,j)
              l = l + 1
              rr(l) = r2(i,j)
              in(l) = i
              jn(l) = j
              IF (r2(i,j).LT.r2min) THEN
                  r2min = r2(i,j)
*       Set closest pair indices in J1 & J2.
                  j1 = i
                  j2 = j
              END IF
    5     CONTINUE
   10 CONTINUE
*
*       Set indices of the two distant particles.
      j3 = ii(j1,j2)
      j4 = ii(j2,j1)
*       Ensure that body #J3 is closest to #J1 & J2.  
      IF (r2(j1,j3) + r2(j2,j3).GT.r2(j1,j4) + r2(j2,j4)) THEN
          jdum = j3
          j3 = j4
          j4 = jdum
      END IF
*
*       Sort square distances.
      CALL rsort(rr,switch,ind)
      DO 20 k = 3,5
          ij(1) = in(ind(1))
          ij(2) = jn(ind(1))
          ij(3) = in(ind(2))
          ij(4) = jn(ind(2))
          ij(5) = in(ind(k))
          ij(6) = jn(ind(k))
*       Form particle chain for regularization.
          CALL ichain(ij,ko,i1,i2,i3,i4)
          IF (ko.EQ.1) go to 30
   20 CONTINUE
*
   30 RETURN
*
      END