PYTHIA/jetset/luupda.F

   1
   2 C*********************************************************************
   3
   4       SUBROUTINE LUUPDA(MUPDA,LFN)
   5
   6 C...Purpose: to facilitate the updating of particle and decay data.
   7       COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
   8       COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
   9       COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5)
  10       COMMON/LUDAT4/CHAF(500)
  11       CHARACTER CHAF*8
  12       SAVE /LUDAT1/,/LUDAT2/,/LUDAT3/,/LUDAT4/
  13       CHARACTER CHINL*80,CHKC*4,CHVAR(19)*9,CHLIN*72,
  14      &CHBLK(20)*72,CHOLD*12,CHTMP*12,CHNEW*12,CHCOM*12
  15       DATA CHVAR/ 'KCHG(I,1)','KCHG(I,2)','KCHG(I,3)','PMAS(I,1)',
  16      &'PMAS(I,2)','PMAS(I,3)','PMAS(I,4)','MDCY(I,1)','MDCY(I,2)',
  17      &'MDCY(I,3)','MDME(I,1)','MDME(I,2)','BRAT(I)  ','KFDP(I,1)',
  18      &'KFDP(I,2)','KFDP(I,3)','KFDP(I,4)','KFDP(I,5)','CHAF(I)  '/
  19
  20 C...Write information on file for editing.
  21       IF(MSTU(12).GE.1) CALL LULIST(0)
  22       IF(MUPDA.EQ.1) THEN
  23         DO 110 KC=1,MSTU(6)
  24         WRITE(LFN,5000) KC,CHAF(KC),(KCHG(KC,J1),J1=1,3),
  25      &  (PMAS(KC,J2),J2=1,4),MDCY(KC,1)
  26         DO 100 IDC=MDCY(KC,2),MDCY(KC,2)+MDCY(KC,3)-1
  27         WRITE(LFN,5100) MDME(IDC,1),MDME(IDC,2),BRAT(IDC),
  28      &  (KFDP(IDC,J),J=1,5)
  29   100   CONTINUE
  30   110   CONTINUE
  31
  32 C...Reset variables and read information from edited file.
  33       ELSEIF(MUPDA.EQ.2) THEN
  34         DO 130 I=1,MSTU(7)
  35         MDME(I,1)=1
  36         MDME(I,2)=0
  37         BRAT(I)=0.
  38         DO 120 J=1,5
  39         KFDP(I,J)=0
  40   120   CONTINUE
  41   130   CONTINUE
  42         KC=0
  43         IDC=0
  44         NDC=0
  45   140   READ(LFN,5200,END=150) CHINL
  46         IF(CHINL(2:5).NE.'    ') THEN
  47           CHKC=CHINL(2:5)
  48           IF(KC.NE.0) THEN
  49             MDCY(KC,2)=0
  50             IF(NDC.NE.0) MDCY(KC,2)=IDC+1-NDC
  51             MDCY(KC,3)=NDC
  52           ENDIF
  53           READ(CHKC,5300) KC
  54           IF(KC.LE.0.OR.KC.GT.MSTU(6)) CALL LUERRM(27,
  55      &    '(LUUPDA:) Read KC code illegal, KC ='//CHKC)
  56           READ(CHINL,5000) KCR,CHAF(KC),(KCHG(KC,J1),J1=1,3),
  57      &    (PMAS(KC,J2),J2=1,4),MDCY(KC,1)
  58           NDC=0
  59         ELSE
  60           IDC=IDC+1
  61           NDC=NDC+1
  62           IF(IDC.GE.MSTU(7)) CALL LUERRM(27,
  63      &    '(LUUPDA:) Decay data arrays full by KC ='//CHKC)
  64           READ(CHINL,5100) MDME(IDC,1),MDME(IDC,2),BRAT(IDC),
  65      &    (KFDP(IDC,J),J=1,5)
  66         ENDIF
  67         GOTO 140
  68   150   MDCY(KC,2)=0
  69         IF(NDC.NE.0) MDCY(KC,2)=IDC+1-NDC
  70         MDCY(KC,3)=NDC
  71
  72 C...Perform possible tests that new information is consistent.
  73         MSTJ24=MSTJ(24)
  74         MSTJ(24)=0
  75         DO 180 KC=1,MSTU(6)
  76         WRITE(CHKC,5300) KC
  77         IF(MIN(PMAS(KC,1),PMAS(KC,2),PMAS(KC,3),PMAS(KC,1)-PMAS(KC,3),
  78      &  PMAS(KC,4)).LT.0..OR.MDCY(KC,3).LT.0) CALL LUERRM(17,
  79      &  '(LUUPDA:) Mass/width/life/(# channels) wrong for KC ='//CHKC)
  80         BRSUM=0.
  81         DO 170 IDC=MDCY(KC,2),MDCY(KC,2)+MDCY(KC,3)-1
  82         IF(MDME(IDC,2).GT.80) GOTO 170
  83         KQ=KCHG(KC,1)
  84         PMS=PMAS(KC,1)-PMAS(KC,3)-PARJ(64)
  85         MERR=0
  86         DO 160 J=1,5
  87         KP=KFDP(IDC,J)
  88         IF(KP.EQ.0.OR.KP.EQ.81.OR.IABS(KP).EQ.82) THEN
  89         ELSEIF(LUCOMP(KP).EQ.0) THEN
  90           MERR=3
  91         ELSE
  92           KQ=KQ-LUCHGE(KP)
  93           PMS=PMS-ULMASS(KP)
  94         ENDIF
  95   160   CONTINUE
  96         IF(KQ.NE.0) MERR=MAX(2,MERR)
  97         IF(KFDP(IDC,2).NE.0.AND.(KC.LE.20.OR.KC.GT.40).AND.
  98      &  (KC.LE.80.OR.KC.GT.100).AND.MDME(IDC,2).NE.34.AND.
  99      &  MDME(IDC,2).NE.61.AND.PMS.LT.0.) MERR=MAX(1,MERR)
 100         IF(MERR.EQ.3) CALL LUERRM(17,
 101      &  '(LUUPDA:) Unknown particle code in decay of KC ='//CHKC)
 102         IF(MERR.EQ.2) CALL LUERRM(17,
 103      &  '(LUUPDA:) Charge not conserved in decay of KC ='//CHKC)
 104         IF(MERR.EQ.1) CALL LUERRM(7,
 105      &  '(LUUPDA:) Kinematically unallowed decay of KC ='//CHKC)
 106         BRSUM=BRSUM+BRAT(IDC)
 107   170   CONTINUE
 108         WRITE(CHTMP,5500) BRSUM
 109         IF(ABS(BRSUM).GT.0.0005.AND.ABS(BRSUM-1.).GT.0.0005) CALL
 110      &  LUERRM(7,'(LUUPDA:) Sum of branching ratios is '//CHTMP(5:12)//
 111      &  ' for KC ='//CHKC)
 112   180   CONTINUE
 113         MSTJ(24)=MSTJ24
 114
 115 C...Initialize writing of DATA statements for inclusion in program.
 116       ELSEIF(MUPDA.EQ.3) THEN
 117         DO 250 IVAR=1,19
 118         NDIM=MSTU(6)
 119         IF(IVAR.GE.11.AND.IVAR.LE.18) NDIM=MSTU(7)
 120         NLIN=1
 121         CHLIN=' '
 122         CHLIN(7:35)='DATA ('//CHVAR(IVAR)//',I=   1,    )/'
 123         LLIN=35
 124         CHOLD='START'
 125
 126 C...Loop through variables for conversion to characters.
 127         DO 230 IDIM=1,NDIM
 128         IF(IVAR.EQ.1) WRITE(CHTMP,5400) KCHG(IDIM,1)
 129         IF(IVAR.EQ.2) WRITE(CHTMP,5400) KCHG(IDIM,2)
 130         IF(IVAR.EQ.3) WRITE(CHTMP,5400) KCHG(IDIM,3)
 131         IF(IVAR.EQ.4) WRITE(CHTMP,5500) PMAS(IDIM,1)
 132         IF(IVAR.EQ.5) WRITE(CHTMP,5500) PMAS(IDIM,2)
 133         IF(IVAR.EQ.6) WRITE(CHTMP,5500) PMAS(IDIM,3)
 134         IF(IVAR.EQ.7) WRITE(CHTMP,5500) PMAS(IDIM,4)
 135         IF(IVAR.EQ.8) WRITE(CHTMP,5400) MDCY(IDIM,1)
 136         IF(IVAR.EQ.9) WRITE(CHTMP,5400) MDCY(IDIM,2)
 137         IF(IVAR.EQ.10) WRITE(CHTMP,5400) MDCY(IDIM,3)
 138         IF(IVAR.EQ.11) WRITE(CHTMP,5400) MDME(IDIM,1)
 139         IF(IVAR.EQ.12) WRITE(CHTMP,5400) MDME(IDIM,2)
 140         IF(IVAR.EQ.13) WRITE(CHTMP,5500) BRAT(IDIM)
 141         IF(IVAR.EQ.14) WRITE(CHTMP,5400) KFDP(IDIM,1)
 142         IF(IVAR.EQ.15) WRITE(CHTMP,5400) KFDP(IDIM,2)
 143         IF(IVAR.EQ.16) WRITE(CHTMP,5400) KFDP(IDIM,3)
 144         IF(IVAR.EQ.17) WRITE(CHTMP,5400) KFDP(IDIM,4)
 145         IF(IVAR.EQ.18) WRITE(CHTMP,5400) KFDP(IDIM,5)
 146         IF(IVAR.EQ.19) CHTMP=CHAF(IDIM)
 147
 148 C...Length of variable, trailing decimal zeros, quotation marks.
 149         LLOW=1
 150         LHIG=1
 151         DO 190 LL=1,12
 152         IF(CHTMP(13-LL:13-LL).NE.' ') LLOW=13-LL
 153         IF(CHTMP(LL:LL).NE.' ') LHIG=LL
 154   190   CONTINUE
 155         CHNEW=CHTMP(LLOW:LHIG)//' '
 156         LNEW=1+LHIG-LLOW
 157         IF((IVAR.GE.4.AND.IVAR.LE.7).OR.IVAR.EQ.13) THEN
 158           LNEW=LNEW+1
 159   200     LNEW=LNEW-1
 160           IF(CHNEW(LNEW:LNEW).EQ.'0') GOTO 200
 161           IF(LNEW.EQ.1) CHNEW(1:2)='0.'
 162           IF(LNEW.EQ.1) LNEW=2
 163         ELSEIF(IVAR.EQ.19) THEN
 164           DO 210 LL=LNEW,1,-1
 165           IF(CHNEW(LL:LL).EQ.'''') THEN
 166             CHTMP=CHNEW
 167             CHNEW=CHTMP(1:LL)//''''//CHTMP(LL+1:11)
 168             LNEW=LNEW+1
 169           ENDIF
 170   210     CONTINUE
 171           CHTMP=CHNEW
 172           CHNEW(1:LNEW+2)=''''//CHTMP(1:LNEW)//''''
 173           LNEW=LNEW+2
 174         ENDIF
 175
 176 C...Form composite character string, often including repetition counter.
 177         IF(CHNEW.NE.CHOLD) THEN
 178           NRPT=1
 179           CHOLD=CHNEW
 180           CHCOM=CHNEW
 181           LCOM=LNEW
 182         ELSE
 183           LRPT=LNEW+1
 184           IF(NRPT.GE.2) LRPT=LNEW+3
 185           IF(NRPT.GE.10) LRPT=LNEW+4
 186           IF(NRPT.GE.100) LRPT=LNEW+5
 187           IF(NRPT.GE.1000) LRPT=LNEW+6
 188           LLIN=LLIN-LRPT
 189           NRPT=NRPT+1
 190           WRITE(CHTMP,5400) NRPT
 191           LRPT=1
 192           IF(NRPT.GE.10) LRPT=2
 193           IF(NRPT.GE.100) LRPT=3
 194           IF(NRPT.GE.1000) LRPT=4
 195           CHCOM(1:LRPT+1+LNEW)=CHTMP(13-LRPT:12)//'*'//CHNEW(1:LNEW)
 196           LCOM=LRPT+1+LNEW
 197         ENDIF
 198
 199 C...Add characters to end of line, to new line (after storing old line),
 200 C...or to new block of lines (after writing old block).
 201         IF(LLIN+LCOM.LE.70) THEN
 202           CHLIN(LLIN+1:LLIN+LCOM+1)=CHCOM(1:LCOM)//','
 203           LLIN=LLIN+LCOM+1
 204         ELSEIF(NLIN.LE.19) THEN
 205           CHLIN(LLIN+1:72)=' '
 206           CHBLK(NLIN)=CHLIN
 207           NLIN=NLIN+1
 208           CHLIN(6:6+LCOM+1)='&'//CHCOM(1:LCOM)//','
 209           LLIN=6+LCOM+1
 210         ELSE
 211           CHLIN(LLIN:72)='/'//' '
 212           CHBLK(NLIN)=CHLIN
 213           WRITE(CHTMP,5400) IDIM-NRPT
 214           CHBLK(1)(30:33)=CHTMP(9:12)
 215           DO 220 ILIN=1,NLIN
 216           WRITE(LFN,5600) CHBLK(ILIN)
 217   220     CONTINUE
 218           NLIN=1
 219           CHLIN=' '
 220           CHLIN(7:35+LCOM+1)='DATA ('//CHVAR(IVAR)//',I=    ,    )/'//
 221      &    CHCOM(1:LCOM)//','
 222           WRITE(CHTMP,5400) IDIM-NRPT+1
 223           CHLIN(25:28)=CHTMP(9:12)
 224           LLIN=35+LCOM+1
 225         ENDIF
 226   230   CONTINUE
 227
 228 C...Write final block of lines.
 229         CHLIN(LLIN:72)='/'//' '
 230         CHBLK(NLIN)=CHLIN
 231         WRITE(CHTMP,5400) NDIM
 232         CHBLK(1)(30:33)=CHTMP(9:12)
 233         DO 240 ILIN=1,NLIN
 234         WRITE(LFN,5600) CHBLK(ILIN)
 235   240   CONTINUE
 236   250   CONTINUE
 237       ENDIF
 238
 239 C...Formats for reading and writing particle data.
 240  5000 FORMAT(1X,I4,2X,A8,3I3,3F12.5,2X,F12.5,I3)
 241  5100 FORMAT(5X,2I5,F12.5,5I8)
 242  5200 FORMAT(A80)
 243  5300 FORMAT(I4)
 244  5400 FORMAT(I12)
 245  5500 FORMAT(F12.5)
 246  5600 FORMAT(A72)
 247
 248       RETURN
 249       END