Merging the VirtualMC branch to the main development branch (HEAD)

[u/mrichter/AliRoot.git] / ISAJET / code / rescal.F

#include "isajet/pilot.h"
      SUBROUTINE RESCAL(N1,N2,PSUM,IFAIL)
C          RESCALE MOMENTA OF PARTICLES N1...N2 TO GIVE TOTAL
C          FOUR-MOMENTUM PSUM.
C          RETURN IFAIL=0 IF OK, IFAIL=1 IF NO GOOD.
#include "isajet/itapes.inc"
#include "isajet/partcl.inc"
      DIMENSION PSUM(5),PADD(5),BETA(3)
      DATA ERRLIM/.0001/
C          ORIGIONAL MOMENTUM IS PADD.
      IFAIL=1
      IF(N1.GE.N2) RETURN
      DO 100 K=1,5
100   PADD(K)=0.
      DO 110 IP=N1,N2
      DO 110 K=1,5
      PADD(K)=PADD(K)+PPTCL(K,IP)
110   CONTINUE
      IF(PADD(5).GE.PSUM(5)) RETURN
      PADD(5)=PADD(4)**2-PADD(1)**2-PADD(2)**2-PADD(3)**2
      IF(PADD(5).LE.0) RETURN
      PADD(5)=SQRT(PADD(5))
      DO 120 K=1,3
120   BETA(K)=-PADD(K)/PADD(5)
      GAMMA=PADD(4)/PADD(5)
C          BOOST PARTICLES TO REST.
200   CONTINUE
      DO 210 IP=N1,N2
      BP=0.
      DO 220 K=1,3
220   BP=BP+PPTCL(K,IP)*BETA(K)
      DO 230 K=1,3
230   PPTCL(K,IP)=PPTCL(K,IP)+BETA(K)*PPTCL(4,IP)
     $+BETA(K)*BP/(GAMMA+1.)
      PPTCL(4,IP)=GAMMA*PPTCL(4,IP)+BP
210   CONTINUE
      IF(IFAIL.EQ.0) RETURN
C          RESCALE MOMENTA IN REST FRAME.
      SCAL=1.
      DO 301 IPASS=1,200
      SUM=0.
      DO 310 IP=N1,N2
      DO 320 K=1,3
320   PPTCL(K,IP)=SCAL*PPTCL(K,IP)
      PPTCL(4,IP)=SQRT(PPTCL(1,IP)**2+PPTCL(2,IP)**2+PPTCL(3,IP)**2
     $+PPTCL(5,IP)**2)
      SUM=SUM+PPTCL(4,IP)
310   CONTINUE
      SCAL=PSUM(5)/SUM
301   IF(ABS(SCAL-1.).LE.ERRLIM) GO TO 300
300   CONTINUE
C          BOOST BACK WITH PSUM.
      BMAG=0.
      DO 400 K=1,3
      BETA(K)=PSUM(K)/PSUM(5)
      BMAG=BMAG+ABS(BETA(K))
400   CONTINUE
      GAMMA=PSUM(4)/PSUM(5)
      IFAIL=0
      IF(BMAG.EQ.0.) RETURN
      GO TO 200
      END