swcond.f

Go to the documentation of this file.

      SUBROUTINE swcond(CHECK)
*
*
*       Check switching conditions.
*       ---------------------------
*
      include 'commonc.h'
      common/swcall/ ncall
      LOGICAL check
      SAVE nsw
      DATA nsw/20000/
*
*
      check=.false.
      ncall=ncall+1
*       Impose switch after every NSW steps.
      IF(ncall.GE.nsw)THEN
      ncall=0
      check=.true.
      RETURN
      END IF
*
*       Inspect the chain structure (NOTE: Inverse values 1/r are used).
      adisti=0.5*(n-1)/rsum
      lri=n-1
      DO i=1,n-2
      DO j=i+2,n
      lri=lri+1
*
*       Do not inspect if 1/r is small.
      IF(rinv(lri).GT.adisti)THEN
      IF(j-i.GT.2)THEN
*        Check for a dangerous long loop.
*     RINVMX=MAX(RINV(I-1),RINV(I),RINV(J-1),RINV(J))
      IF(i.GT.1)THEN
      rinvmx=max(rinv(i-1),rinv(i))
      ELSE
      rinvmx=rinv(1)
      END IF
      rinvmx=max(rinvmx,rinv(j-1))
      IF(j.LT.n)rinvmx=max(rinvmx,rinv(j))
      IF(rinv(lri).GT.0.5*rinvmx)THEN
      check=.true.
      ncall=0
      RETURN
      END IF
      ELSE
*        See whether this is a triangle with smallest size not regularized.
      IF(rinv(lri).GT.max(rinv(i),rinv(i+1)))THEN
      check=.true.
      ncall=0
      RETURN
      END IF
*
      END IF
      END IF
      END DO
      END DO
*
      RETURN
      END