lframe.F

Go to the documentation of this file. Or view the newest version in sPHENIX GitHub for file lframe.F

C **********************************************************************

      SUBROUTINE lframe(IFR,IPH)

      IMPLICIT NONE

C...Make transformation from hadronic CM frame to lab frame.

      INTEGER  nlupdm,nplbuf
      parameter(nlupdm=4000,nplbuf=5)
      common/lujets/n,k(nlupdm,5),p(nlupdm,nplbuf),v(nlupdm,5)
      INTEGER  n,k
      REAL  p,v
      SAVE /lujets/

      common/ludat1/mstu(200),paru(200),mstj(200),parj(200)
      INTEGER  mstu,mstj
      REAL  paru,parj
      SAVE /ludat1/

*
* to avoid variable conflictions, a second keep element is necessary
* with the same common block name (see LPTOU2)
*
      COMMON /leptou/ cut(14),lst(40),parl(30),
     &                x,y,w2,q2,u
      REAL cut,parl,x,y,w2,q2,u
      INTEGER lst
      SAVE /leptou/

      COMMON /linter/ pari(50),ewqc(2,2,8),qc(8),zl(2,4),zq(2,8),pq(17)
      REAL  pari,ewqc,qc,zl,zq,pq
      SAVE /linter/

      COMMON /lintrl/ psave(3,4,5),ksave(4),xmin,xmax,ymin,ymax,
     &q2min,q2max,w2min,w2max,ilep,inu,ig,iz
      REAL psave,xmin,xmax,ymin,ymax,q2min,q2max,w2min,w2max
      INTEGER ksave,ilep,inu,ig,iz
      SAVE /lintrl/

      COMMON /lboost/ dbeta(2,3),stheta(2),sphi(2),pb(5),phir
      DOUBLE PRECISION dbeta
      REAL stheta,sphi,pb,phir
      SAVE /lboost/


      INTEGER ifr,iph,iframe,iphi,i,j
      REAL thebos,phibos,plu

      iframe=ifr
      iphi=iph
      IF(iframe.LT.1.OR.iframe.GT.4.OR.iphi.LT.0.OR.iphi.GT.1) goto 999
      IF(iframe.EQ.1) iphi=0

CGI -- Also boost lines up to N+MSTU(3)
      n=n+1+mstu(3)
      DO 5 j=1,5
    5 p(n,j)=pb(j)
C     Must also set status >0 for LUROBO/LUDBRB
      k(n,1)=21

   10 CONTINUE
      IF(iphi.NE.lst(29)) THEN
         iframe=2
      ELSE
         iframe=ifr
      ENDIF
      IF((iframe.EQ.lst(28)).AND.(iphi.EQ.lst(29))) THEN
        DO 15 j=1,5
   15   pb(j)=p(n,j)
        n=n-1-mstu(3)
        RETURN
      ENDIF

      goto(100,200,300,400), lst(28)
      goto 999

  100 IF(iframe.GE.2) THEN
        CALL ludbrb(0,0,stheta(2),sphi(2),0.d0,0.d0,0.d0)
        CALL ludbrb(0,0,0.,0.,dbeta(2,1),dbeta(2,2),dbeta(2,3))
        lst(28)=2
      ELSE
        goto 999
      ENDIF
      goto 10

  200 IF(iphi.NE.lst(29)) THEN
       CALL ludbrb(0,0,0.,sign(phir,float(iphi-lst(29))),0.d0,0.d0,0.d0)
       lst(29)=iphi
      ENDIF

      IF(iframe.EQ.1) THEN
        CALL ludbrb(0,0,0.,0.,-dbeta(2,1),-dbeta(2,2),-dbeta(2,3))
        CALL ludbrb(0,0,-stheta(2),0.,0.d0,0.d0,0.d0)
        lst(28)=1
      ELSEIF(iframe.GE.3) THEN
        IF(lst(17).EQ.0) THEN
          CALL ludbrb(0,0,0.,0.,0.d0,0.d0,dbeta(1,3))
          IF(psave(3,1,3).LT.0.) THEN
            DO 210 i=1,n
            v(i,3)=-v(i,3)
  210       p(i,3)=-p(i,3)
          ENDIF
        ELSE
          CALL ludbrb(0,0,stheta(1),sphi(1),0.d0,0.d0,0.d0)
          CALL ludbrb(0,0,0.,0.,dbeta(1,1),dbeta(1,2),dbeta(1,3))
        ENDIF
        lst(28)=3
      ENDIF
      goto 10

  300 IF(iframe.LE.2) THEN
        IF(lst(17).EQ.0) THEN
          IF(psave(3,1,3).LT.0.) THEN
            DO 310 i=1,n
            v(i,3)=-v(i,3)
  310       p(i,3)=-p(i,3)
          ENDIF
          CALL ludbrb(0,0,0.,0.,0.d0,0.d0,-dbeta(1,3))
        ELSE
          CALL ludbrb(0,0,0.,0.,-dbeta(1,1),-dbeta(1,2),-dbeta(1,3))
          CALL ludbrb(0,0,0.,-sphi(1),0.d0,0.d0,0.d0)
          CALL ludbrb(0,0,-stheta(1),0.,0.d0,0.d0,0.d0)
        ENDIF
        lst(28)=2
      ELSEIF(iframe.EQ.4) THEN
        thebos=plu(n,13)
        phibos=plu(n,15)
        CALL ludbrb(0,0,0.,-phibos,0.d0,0.d0,0.d0)
        CALL ludbrb(0,0,-thebos,0.,0.d0,0.d0,0.d0)
        lst(28)=4
      ENDIF
      goto 10

  400 IF(iframe.LE.3) THEN
        CALL ludbrb(0,0,thebos,phibos,0.d0,0.d0,0.d0)
        lst(28)=3
      ENDIF
      goto 10

  999 WRITE(6,1000) iframe,iphi,lst(28),lst(29)
 1000 FORMAT(' BAD VARIABLES IN SUBROUTINE LFRAME: IFRAME,IPHI,',      
     &'LST(28),LST(29) =',4i5)
      RETURN
      END