Back to home page

sPhenix code displayed by LXR

 
 

    


File indexing completed on 2025-08-05 08:21:11

0001  
0002 C*********************************************************************
0003  
0004 C...PYINBM
0005 C...Identifies the two incoming particles and the choice of frame.
0006  
0007        SUBROUTINE PYINBM(CHFRAM,CHBEAM,CHTARG,WIN)
0008  
0009 C...Double precision and integer declarations.
0010       IMPLICIT DOUBLE PRECISION(A-H, O-Z)
0011       IMPLICIT INTEGER(I-N)
0012       INTEGER PYK,PYCHGE,PYCOMP
0013  
0014 C...User process initialization commonblock.
0015       INTEGER MAXPUP
0016       PARAMETER (MAXPUP=100)
0017       INTEGER IDBMUP,PDFGUP,PDFSUP,IDWTUP,NPRUP,LPRUP
0018       DOUBLE PRECISION EBMUP,XSECUP,XERRUP,XMAXUP
0019       COMMON/HEPRUP/IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2),
0020      &IDWTUP,NPRUP,XSECUP(MAXPUP),XERRUP(MAXPUP),XMAXUP(MAXPUP),
0021      &LPRUP(MAXPUP)
0022       SAVE /HEPRUP/
0023  
0024 C...Commonblocks.
0025       COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5)
0026       COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0027       COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
0028       COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200)
0029       COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
0030       COMMON/PYINT1/MINT(400),VINT(400)
0031       SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYSUBS/,/PYPARS/,/PYINT1/
0032  
0033 C...Local arrays, character variables and data.
0034       CHARACTER CHFRAM*12,CHBEAM*12,CHTARG*12,CHCOM(3)*12,CHALP(2)*26,
0035      &CHIDNT(3)*12,CHTEMP*12,CHCDE(39)*12,CHINIT*76,CHNAME*16
0036       DIMENSION LEN(3),KCDE(39),PM(2)
0037       DATA CHALP/'abcdefghijklmnopqrstuvwxyz',
0038      &'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
0039       DATA CHCDE/    'e-          ','e+          ','nu_e        ',
0040      &'nu_ebar     ','mu-         ','mu+         ','nu_mu       ',
0041      &'nu_mubar    ','tau-        ','tau+        ','nu_tau      ',
0042      &'nu_taubar   ','pi+         ','pi-         ','n0          ',
0043      &'nbar0       ','p+          ','pbar-       ','gamma       ',
0044      &'lambda0     ','sigma-      ','sigma0      ','sigma+      ',
0045      &'xi-         ','xi0         ','omega-      ','pi0         ',
0046      &'reggeon     ','pomeron     ','gamma/e-    ','gamma/e+    ',
0047      &'gamma/mu-   ','gamma/mu+   ','gamma/tau-  ','gamma/tau+  ',
0048      &'k+          ','k-          ','ks0         ','kl0         '/
0049       DATA KCDE/11,-11,12,-12,13,-13,14,-14,15,-15,16,-16,
0050      &211,-211,2112,-2112,2212,-2212,22,3122,3112,3212,3222,
0051      &3312,3322,3334,111,110,990,6*22,321,-321,310,130/
0052  
0053 C...Store initial energy. Default frame.
0054       VINT(290)=WIN
0055       MINT(111)=0
0056  
0057 C...Special user process initialization; convert to normal input.
0058       IF(CHFRAM(1:1).EQ.'u'.OR.CHFRAM(1:1).EQ.'U') THEN
0059         MINT(111)=11
0060         IF(PDFGUP(1).EQ.-9.OR.PDFGUP(2).EQ.-9) MINT(111)=12
0061         CALL PYNAME(IDBMUP(1),CHNAME)
0062         CHBEAM=CHNAME(1:12)
0063         CALL PYNAME(IDBMUP(2),CHNAME)
0064         CHTARG=CHNAME(1:12)
0065       ENDIF
0066  
0067 C...Convert character variables to lowercase and find their length.
0068       CHCOM(1)=CHFRAM
0069       CHCOM(2)=CHBEAM
0070       CHCOM(3)=CHTARG
0071       DO 130 I=1,3
0072         LEN(I)=12
0073         DO 110 LL=12,1,-1
0074           IF(LEN(I).EQ.LL.AND.CHCOM(I)(LL:LL).EQ.' ') LEN(I)=LL-1
0075           DO 100 LA=1,26
0076             IF(CHCOM(I)(LL:LL).EQ.CHALP(2)(LA:LA)) CHCOM(I)(LL:LL)=
0077      &      CHALP(1)(LA:LA)
0078   100     CONTINUE
0079   110   CONTINUE
0080         CHIDNT(I)=CHCOM(I)
0081  
0082 C...Fix up bar, underscore and charge in particle name (if needed).
0083         DO 120 LL=1,10
0084           IF(CHIDNT(I)(LL:LL).EQ.'~') THEN
0085             CHTEMP=CHIDNT(I)
0086             CHIDNT(I)=CHTEMP(1:LL-1)//'bar'//CHTEMP(LL+1:10)//'  '
0087           ENDIF
0088   120   CONTINUE
0089         IF(CHIDNT(I)(1:2).EQ.'nu'.AND.CHIDNT(I)(3:3).NE.'_') THEN
0090           CHTEMP=CHIDNT(I)
0091           CHIDNT(I)='nu_'//CHTEMP(3:7)
0092         ELSEIF(CHIDNT(I)(1:2).EQ.'n ') THEN
0093           CHIDNT(I)(1:3)='n0 '
0094         ELSEIF(CHIDNT(I)(1:4).EQ.'nbar') THEN
0095           CHIDNT(I)(1:5)='nbar0'
0096         ELSEIF(CHIDNT(I)(1:2).EQ.'p ') THEN
0097           CHIDNT(I)(1:3)='p+ '
0098         ELSEIF(CHIDNT(I)(1:4).EQ.'pbar'.OR.
0099      &    CHIDNT(I)(1:2).EQ.'p-') THEN
0100           CHIDNT(I)(1:5)='pbar-'
0101         ELSEIF(CHIDNT(I)(1:6).EQ.'lambda') THEN
0102           CHIDNT(I)(7:7)='0'
0103         ELSEIF(CHIDNT(I)(1:3).EQ.'reg') THEN
0104           CHIDNT(I)(1:7)='reggeon'
0105         ELSEIF(CHIDNT(I)(1:3).EQ.'pom') THEN
0106           CHIDNT(I)(1:7)='pomeron'
0107         ENDIF
0108   130 CONTINUE
0109  
0110 C...Identify free initialization.
0111       IF(CHCOM(1)(1:2).EQ.'no') THEN
0112         MINT(65)=1
0113         RETURN
0114       ENDIF
0115  
0116 C...Identify incoming beam and target particles.
0117       DO 160 I=1,2
0118         DO 140 J=1,39
0119           IF(CHIDNT(I+1).EQ.CHCDE(J)) MINT(10+I)=KCDE(J)
0120   140   CONTINUE
0121         PM(I)=PYMASS(MINT(10+I))
0122         VINT(2+I)=PM(I)
0123         MINT(140+I)=0
0124         IF(MINT(10+I).EQ.22.AND.CHIDNT(I+1)(6:6).EQ.'/') THEN
0125           CHTEMP=CHIDNT(I+1)(7:12)//' '
0126           DO 150 J=1,12
0127             IF(CHTEMP.EQ.CHCDE(J)) MINT(140+I)=KCDE(J)
0128   150     CONTINUE
0129           PM(I)=PYMASS(MINT(140+I))
0130           VINT(302+I)=PM(I)
0131         ENDIF
0132   160 CONTINUE
0133       IF(MINT(11).EQ.0) WRITE(MSTU(11),5000) CHBEAM(1:LEN(2))
0134       IF(MINT(12).EQ.0) WRITE(MSTU(11),5100) CHTARG(1:LEN(3))
0135       IF(MINT(11).EQ.0.OR.MINT(12).EQ.0) CALL PYSTOP(7)
0136  
0137 C...Identify choice of frame and input energies.
0138       CHINIT=' '
0139  
0140 C...Events defined in the CM frame.
0141       IF(CHCOM(1)(1:2).EQ.'cm') THEN
0142         MINT(111)=1
0143         S=WIN**2
0144         IF(MSTP(122).GE.1) THEN
0145           IF(CHCOM(2)(1:1).NE.'e') THEN
0146             LOFFS=(31-(LEN(2)+LEN(3)))/2
0147             CHINIT(LOFFS+1:76)='PYTHIA will be initialized for a '//
0148      &      CHCOM(2)(1:LEN(2))//' on '//CHCOM(3)(1:LEN(3))//
0149      &      ' collider'//' '
0150           ELSE
0151             LOFFS=(30-(LEN(2)+LEN(3)))/2
0152             CHINIT(LOFFS+1:76)='PYTHIA will be initialized for an '//
0153      &      CHCOM(2)(1:LEN(2))//' on '//CHCOM(3)(1:LEN(3))//
0154      &      ' collider'//' '
0155           ENDIF
0156           WRITE(MSTU(11),5200) CHINIT
0157           WRITE(MSTU(11),5300) WIN
0158         ENDIF
0159  
0160 C...Events defined in fixed target frame.
0161       ELSEIF(CHCOM(1)(1:3).EQ.'fix') THEN
0162         MINT(111)=2
0163         S=PM(1)**2+PM(2)**2+2D0*PM(2)*SQRT(PM(1)**2+WIN**2)
0164         IF(MSTP(122).GE.1) THEN
0165           LOFFS=(29-(LEN(2)+LEN(3)))/2
0166           CHINIT(LOFFS+1:76)='PYTHIA will be initialized for '//
0167      &    CHCOM(2)(1:LEN(2))//' on '//CHCOM(3)(1:LEN(3))//
0168      &    ' fixed target'//' '
0169           WRITE(MSTU(11),5200) CHINIT
0170           WRITE(MSTU(11),5400) WIN
0171           WRITE(MSTU(11),5500) SQRT(S)
0172         ENDIF
0173  
0174 C...Frame defined by user three-vectors.
0175       ELSEIF(CHCOM(1)(1:1).EQ.'3') THEN
0176         MINT(111)=3
0177         P(1,5)=PM(1)
0178         P(2,5)=PM(2)
0179         P(1,4)=SQRT(P(1,1)**2+P(1,2)**2+P(1,3)**2+P(1,5)**2)
0180         P(2,4)=SQRT(P(2,1)**2+P(2,2)**2+P(2,3)**2+P(2,5)**2)
0181 C        S=4.*P(1,4)*P(2,4)
0182         S=(P(1,4)+P(2,4))**2-(P(1,1)+P(2,1))**2-(P(1,2)+P(2,2))**2-
0183      &  (P(1,3)+P(2,3))**2
0184         IF(MSTP(122).GE.1) THEN
0185           LOFFS=(22-(LEN(2)+LEN(3)))/2
0186           CHINIT(LOFFS+1:76)='PYTHIA will be initialized for '//
0187      &    CHCOM(2)(1:LEN(2))//' on '//CHCOM(3)(1:LEN(3))//
0188      &    ' user configuration'//' '
0189           WRITE(MSTU(11),5200) CHINIT
0190           WRITE(MSTU(11),5600)
0191           WRITE(MSTU(11),5700) CHCOM(2),P(1,1),P(1,2),P(1,3),P(1,4)
0192           WRITE(MSTU(11),5700) CHCOM(3),P(2,1),P(2,2),P(2,3),P(2,4)
0193           WRITE(MSTU(11),5500) SQRT(MAX(0D0,S))
0194         ENDIF
0195  
0196 C...Frame defined by user four-vectors.
0197       ELSEIF(CHCOM(1)(1:1).EQ.'4') THEN
0198         MINT(111)=4
0199         PMS1=P(1,4)**2-P(1,1)**2-P(1,2)**2-P(1,3)**2
0200         P(1,5)=SIGN(SQRT(ABS(PMS1)),PMS1)
0201         PMS2=P(2,4)**2-P(2,1)**2-P(2,2)**2-P(2,3)**2
0202         P(2,5)=SIGN(SQRT(ABS(PMS2)),PMS2)
0203         S=(P(1,4)+P(2,4))**2-(P(1,1)+P(2,1))**2-(P(1,2)+P(2,2))**2-
0204      &  (P(1,3)+P(2,3))**2
0205         IF(MSTP(122).GE.1) THEN
0206           LOFFS=(22-(LEN(2)+LEN(3)))/2
0207           CHINIT(LOFFS+1:76)='PYTHIA will be initialized for '//
0208      &    CHCOM(2)(1:LEN(2))//' on '//CHCOM(3)(1:LEN(3))//
0209      &    ' user configuration'//' '
0210           WRITE(MSTU(11),5200) CHINIT
0211           WRITE(MSTU(11),5600)
0212           WRITE(MSTU(11),5700) CHCOM(2),P(1,1),P(1,2),P(1,3),P(1,4)
0213           WRITE(MSTU(11),5700) CHCOM(3),P(2,1),P(2,2),P(2,3),P(2,4)
0214           WRITE(MSTU(11),5500) SQRT(MAX(0D0,S))
0215         ENDIF
0216  
0217 C...Frame defined by user five-vectors.
0218       ELSEIF(CHCOM(1)(1:1).EQ.'5') THEN
0219         MINT(111)=5
0220         S=(P(1,4)+P(2,4))**2-(P(1,1)+P(2,1))**2-(P(1,2)+P(2,2))**2-
0221      &  (P(1,3)+P(2,3))**2
0222         IF(MSTP(122).GE.1) THEN
0223           LOFFS=(22-(LEN(2)+LEN(3)))/2
0224           CHINIT(LOFFS+1:76)='PYTHIA will be initialized for '//
0225      &    CHCOM(2)(1:LEN(2))//' on '//CHCOM(3)(1:LEN(3))//
0226      &    ' user configuration'//' '
0227           WRITE(MSTU(11),5200) CHINIT
0228           WRITE(MSTU(11),5600)
0229           WRITE(MSTU(11),5700) CHCOM(2),P(1,1),P(1,2),P(1,3),P(1,4)
0230           WRITE(MSTU(11),5700) CHCOM(3),P(2,1),P(2,2),P(2,3),P(2,4)
0231           WRITE(MSTU(11),5500) SQRT(MAX(0D0,S))
0232         ENDIF
0233  
0234 C...Frame defined by HEPRUP common block.
0235       ELSEIF(MINT(111).GE.11) THEN
0236         S=(EBMUP(1)+EBMUP(2))**2-(SQRT(MAX(0D0,EBMUP(1)**2-PM(1)**2))-
0237      &  SQRT(MAX(0D0,EBMUP(2)**2-PM(2)**2)))**2
0238         IF(MSTP(122).GE.1) THEN
0239           LOFFS=(22-(LEN(2)+LEN(3)))/2
0240           CHINIT(LOFFS+1:76)='PYTHIA will be initialized for '//
0241      &    CHCOM(2)(1:LEN(2))//' on '//CHCOM(3)(1:LEN(3))//
0242      &    ' user configuration'//' '
0243           WRITE(MSTU(11),5200) CHINIT
0244           WRITE(MSTU(11),6000) EBMUP(1),EBMUP(2)
0245           WRITE(MSTU(11),5500) SQRT(MAX(0D0,S))
0246         ENDIF
0247  
0248 C...Unknown frame. Error for too low CM energy.
0249       ELSE
0250         WRITE(MSTU(11),5800) CHFRAM(1:LEN(1))
0251         CALL PYSTOP(7)
0252       ENDIF
0253       IF(S.LT.PARP(2)**2) THEN
0254         WRITE(MSTU(11),5900) SQRT(S)
0255         CALL PYSTOP(7)
0256       ENDIF
0257  
0258 C...Formats for initialization and error information.
0259  5000 FORMAT(1X,'Error: unrecognized beam particle ''',A,'''D0'/
0260      &1X,'Execution stopped!')
0261  5100 FORMAT(1X,'Error: unrecognized target particle ''',A,'''D0'/
0262      &1X,'Execution stopped!')
0263  5200 FORMAT(/1X,78('=')/1X,'I',76X,'I'/1X,'I',A76,'I')
0264  5300 FORMAT(1X,'I',18X,'at',1X,F10.3,1X,'GeV center-of-mass energy',
0265      &19X,'I'/1X,'I',76X,'I'/1X,78('='))
0266  5400 FORMAT(1X,'I',22X,'at',1X,F10.3,1X,'GeV/c lab-momentum',22X,'I')
0267  5500 FORMAT(1X,'I',76X,'I'/1X,'I',11X,'corresponding to',1X,F10.3,1X,
0268      &'GeV center-of-mass energy',12X,'I'/1X,'I',76X,'I'/1X,78('='))
0269  5600 FORMAT(1X,'I',76X,'I'/1X,'I',18X,'px (GeV/c)',3X,'py (GeV/c)',3X,
0270      &'pz (GeV/c)',6X,'E (GeV)',9X,'I')
0271  5700 FORMAT(1X,'I',8X,A8,4(2X,F10.3,1X),8X,'I')
0272  5800 FORMAT(1X,'Error: unrecognized coordinate frame ''',A,'''D0'/
0273      &1X,'Execution stopped!')
0274  5900 FORMAT(1X,'Error: too low CM energy,',F8.3,' GeV for event ',
0275      &'generation.'/1X,'Execution stopped!')
0276  6000 FORMAT(1X,'I',12X,'with',1X,F10.3,1X,'GeV on',1X,F10.3,1X,
0277      &'GeV beam energies',13X,'I')
0278  
0279       RETURN
0280       END