delay.f

Go to the documentation of this file.

      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.
          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
          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