ISAJET/code/iprtns.F

   1 #include "isajet/pilot.h"
   2       SUBROUTINE IPRTNS(NPRTNS,PRTNS,IDQ)
   3 C----------------------------------------------------------------------
   4 C-
   5 C-   Purpose and Methods :
   6 C-      Fill PINITS common block
   7 C-   Inputs  :
   8 C-     IDQ(2)= id's of partons starting reaction
   9 C-
  10 C-   Created  10-OCT-1991   Serban D. Protopopescu
  11 C-   Renamed from IPINIT to avoid name clash with Cern Library
  12 C-
  13 C----------------------------------------------------------------------
  14 #if defined(CERNLIB_IMPNONE)
  15       IMPLICIT NONE
  16 #endif
  17       INTEGER NPRTNS,IDQ(2)
  18       REAL    PRTNS(4,NPRTNS)
  19 #include "isajet/jetpar.inc"
  20 #include "isajet/pinits.inc"
  21       REAL AMASS, AM1SQ,AM2SQ,ROOT,QPL,QMN,P1PL,P1MN,P2PL,P2MN
  22       INTEGER I
  23 C----------------------------------------------------------------------
  24 C          sum P+ and P-, shat
  25 C          assumes sum of transverse momenta is zero
  26       QPL=0
  27       QMN=0
  28       DO 1 I=1,NPRTNS
  29         QPL=QPL+PRTNS(4,I)+PRTNS(3,I)
  30         QMN=QMN+PRTNS(4,I)-PRTNS(3,I)
  31     1 CONTINUE
  32       SHAT=QPL*QMN
  33 C
  34 C          fill PINITS
  35       DO 2 I=1,2
  36         IDINIT(I)=IDQ(I)
  37         PINITS(5,I)=AMASS(IDQ(I))
  38         PINITS(1,I)=0.
  39         PINITS(2,I)=0.
  40     2 CONTINUE
  41 C          and solve initial kinematics
  42       AM1SQ=PINITS(5,1)**2
  43       AM2SQ=PINITS(5,2)**2
  44       ROOT=SQRT((QPL*QMN-AM1SQ-AM2SQ)**2-4.*AM1SQ*AM2SQ)
  45       P1PL=(QPL*QMN+AM1SQ-AM2SQ+ROOT)/(2.*QMN)
  46       P1MN=AM1SQ/P1PL
  47       P2MN=(QPL*QMN+AM2SQ-AM1SQ+ROOT)/(2.*QPL)
  48       P2PL=AM2SQ/P2MN
  49       PINITS(3,1)=.5*(P1PL-P1MN)
  50       PINITS(4,1)=.5*(P1PL+P1MN)
  51       PINITS(3,2)=.5*(P2PL-P2MN)
  52       PINITS(4,2)=.5*(P2PL+P2MN)
  53   999 RETURN
  54       END