https://github.com/florentrenaud/nbody6tt
Raw File
Tip revision: 8a4716382ead3ece116c48a4ae5c65f8c9534437 authored by Florent on 29 January 2015, 12:19:28 UTC
Nbody6 - 29 January 2015 (added GPU2/Build/.gitkeep)
Tip revision: 8a47163
delay.f
      SUBROUTINE DELAY(KCH,KS)
*
*
*       Delay of multiple regularization.
*       ---------------------------------
*
      INCLUDE 'common6.h'
      COMMON/SAVEIT/  IPH0,KS0,KCH0,KS20,JC0,JCL0
*
*
*       Check for saving KS pointers from IMPACT or termination at TBLOCK.
      IF (KS.GE.0) THEN
          IPH0 = IPHASE
          KS0 = KSPAIR
          KCH0 = KCH
          KS20 = KS
          JC0 = JCOMP
          JCL0 = JCLOSE
      ELSE
*       Copy relevant indices for delayed KS termination.
          IPHASE = IPH0
          KSPAIR = KS0
          KCHAIN = KCH0
          KS2 = KS20
          JCOMP = JC0
          JCLOSE = JCL0
*      Preserve contents of KSAVE during chain regularization.
          IF (NCH.EQ.0) THEN
              KSAVE(1) = 0
              KSAVE(2) = 0
          END IF
          KSKIP = 0
*
*      Exit in case of new merger or merger termination.
          IF (IPHASE.EQ.6.OR.IPHASE.EQ.7) THEN
              GO TO 10
          END IF
*
*       Include the case of two interacting KS pairs (inert KS excluded).
          IF (JCOMP.GT.N) THEN
              IF (KCHAIN.GT.0.AND.KSTAR(N+KSPAIR).NE.0) THEN
                  KSAVE(1) = KSTAR(N+KSPAIR)
                  KSAVE(2) = NAME(2*KSPAIR-1) + NAME(2*KSPAIR)
                  KSKIP = 1
              END IF
*       Terminate smallest pair first and copy second pair index.
              CALL KSTERM
              KSPAIR = KS2
*       Specify JCOMP < 0 to prevent spurious prediction second KSTERM call.
              JCOMP = -1
*       Set JCLOSE = 0 to prevent KSTERM in SETSYS for #26 < 2. (bug 23/4/14)
              IF (KZ(26).LT.2) JCLOSE = 0  ! IF statement added 14/6/14
          END IF
*
*       Save KSTAR (> 0) and sum of component names (for chain termination).
      IF (KCHAIN.GT.0.AND.KSTAR(N+KSPAIR).NE.0.AND.KSKIP.EQ.0) THEN
          KSAVE(1) = KSTAR(N+KSPAIR)
          KSAVE(2) = NAME(2*KSPAIR-1) + NAME(2*KSPAIR)
      END IF
*
*       Terminate binary in triple or widest binary-binary collision pair.
          CALL KSTERM
*
*       See whether chain regularization indicator should be switched on.
          IF (KCHAIN.GT.0) THEN
              IPHASE = 8
          END IF
      END IF
*
   10 RETURN
*
      END
back to top