HIJING/hipyset1_35/luupda_hijing.F

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