]>
Commit | Line | Data |
---|---|---|
0795afa3 | 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 |