PHOS/shaker/lugive.f

   1 *CMZ :          17/07/98  16.45.04  by  Federico Carminati
   2 *-- Author :
   3 C*********************************************************************
   4
   5       SUBROUTINE LUGIVE(CHIN)
   6
   7 C...Purpose: to set values of commonblock variables (also in PYTHIA!).
   8 *KEEP,LUJETS.
   9       COMMON /LUJETS/ N,K(200000,5),P(200000,5),V(200000,5)
  10       SAVE /LUJETS/
  11 *KEEP,LUDAT1.
  12       COMMON /LUDAT1/ MSTU(200),PARU(200),MSTJ(200),PARJ(200)
  13       SAVE /LUDAT1/
  14 *KEEP,LUDAT2.
  15       COMMON /LUDAT2/ KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
  16       SAVE /LUDAT2/
  17 *KEEP,LUDAT3.
  18       COMMON /LUDAT3/ MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5)
  19       SAVE /LUDAT3/
  20 *KEEP,LUDAT4.
  21       COMMON /LUDAT4/ CHAF(500)
  22       SAVE /LUDAT4/
  23 *KEND.
  24       CHARACTER CHAF*8
  25 *KEEP,LUDATR.
  26       COMMON /LUDATR/ MRLU(6),RRLU(100)
  27       SAVE /LUDATR/
  28 *KEEP,PYSUBS.
  29       COMMON /PYSUBS/ MSEL,MSUB(200),KFIN(2,-40:40),CKIN(200)
  30       SAVE /PYSUBS/
  31 *KEEP,PYPARS.
  32       COMMON /PYPARS/ MSTP(200),PARP(200),MSTI(200),PARI(200)
  33       SAVE /PYPARS/
  34 *KEEP,PYINT1.
  35       COMMON /PYINT1/ MINT(400),VINT(400)
  36       SAVE /PYINT1/
  37 *KEEP,PYINT2.
  38       COMMON /PYINT2/ ISET(200),KFPR(200,2),COEF(200,20),ICOL(40,4,2)
  39       SAVE /PYINT2/
  40 *KEEP,PYINT3.
  41       COMMON /PYINT3/ XSFX(2,-40:40),ISIG(1000,3),SIGH(1000)
  42       SAVE /PYINT3/
  43 *KEEP,PYINT4.
  44       COMMON /PYINT4/ WIDP(21:40,0:40),WIDE(21:40,0:40),WIDS(21:40,3)
  45       SAVE /PYINT4/
  46 *KEEP,PYINT5.
  47       COMMON /PYINT5/ NGEN(0:200,3),XSEC(0:200,3)
  48       SAVE /PYINT5/
  49 *KEEP,PYINT6.
  50       COMMON /PYINT6/ PROC(0:200)
  51       SAVE /PYINT6/
  52 *KEND.
  53       CHARACTER PROC*28
  54       CHARACTER CHIN*(*),CHFIX*104,CHBIT*104,CHOLD*8,CHNEW*8,CHOLD2*28,
  55      &CHNEW2*28,CHNAM*4,CHVAR(42)*4,CHALP(2)*26,CHIND*8,CHINI*10,
  56      &CHINR*16
  57       DIMENSION MSVAR(42,8)
  58
  59 C...For each variable to be translated give: name,
  60 C...integer/real/character, no. of indices, lower&upper index bounds.
  61       DATA CHVAR/'N','K','P','V','MSTU','PARU','MSTJ','PARJ','KCHG',
  62      &'PMAS','PARF','VCKM','MDCY','MDME','BRAT','KFDP','CHAF','MRLU',
  63      &'RRLU','MSEL','MSUB','KFIN','CKIN','MSTP','PARP','MSTI','PARI',
  64      &'MINT','VINT','ISET','KFPR','COEF','ICOL','XSFX','ISIG','SIGH',
  65      &'WIDP','WIDE','WIDS','NGEN','XSEC','PROC'/
  66       DATA ((MSVAR(I,J),J=1,8),I=1,42)/ 1,7*0,  1,2,1,4000,1,5,2*0,
  67      & 2,2,1,4000,1,5,2*0,  2,2,1,4000,1,5,2*0,  1,1,1,200,4*0,
  68      & 2,1,1,200,4*0,  1,1,1,200,4*0,  2,1,1,200,4*0,
  69      & 1,2,1,500,1,3,2*0,  2,2,1,500,1,4,2*0,  2,1,1,2000,4*0,
  70      & 2,2,1,4,1,4,2*0,  1,2,1,500,1,3,2*0,  1,2,1,2000,1,2,2*0,
  71      & 2,1,1,2000,4*0,  1,2,1,2000,1,5,2*0,  3,1,1,500,4*0,
  72      & 1,1,1,6,4*0,  2,1,1,100,4*0,
  73      & 1,7*0,  1,1,1,200,4*0,  1,2,1,2,-40,40,2*0,  2,1,1,200,4*0,
  74      & 1,1,1,200,4*0,  2,1,1,200,4*0,  1,1,1,200,4*0,  2,1,1,200,4*0,
  75      & 1,1,1,400,4*0,  2,1,1,400,4*0,  1,1,1,200,4*0,
  76      & 1,2,1,200,1,2,2*0,  2,2,1,200,1,20,2*0,  1,3,1,40,1,4,1,2,
  77      & 2,2,1,2,-40,40,2*0,  1,2,1,1000,1,3,2*0,  2,1,1,1000,4*0,
  78      & 2,2,21,40,0,40,2*0,  2,2,21,40,0,40,2*0,  2,2,21,40,1,3,2*0,
  79      & 1,2,0,200,1,3,2*0,  2,2,0,200,1,3,2*0,  4,1,0,200,4*0/
  80       DATA CHALP/'abcdefghijklmnopqrstuvwxyz',
  81      &'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
  82
  83 C...Length of character variable. Subdivide it into instructions.
  84       IF(MSTU(12).GE.1) CALL LULIST(0)
  85       CHBIT=CHIN//' '
  86       LBIT=101
  87   100 LBIT=LBIT-1
  88       IF(CHBIT(LBIT:LBIT).EQ.' ') GOTO 100
  89       LTOT=0
  90       DO 110 LCOM=1,LBIT
  91       IF(CHBIT(LCOM:LCOM).EQ.' ') GOTO 110
  92       LTOT=LTOT+1
  93       CHFIX(LTOT:LTOT)=CHBIT(LCOM:LCOM)
  94   110 CONTINUE
  95       LLOW=0
  96   120 LHIG=LLOW+1
  97   130 LHIG=LHIG+1
  98       IF(LHIG.LE.LTOT.AND.CHFIX(LHIG:LHIG).NE.';') GOTO 130
  99       LBIT=LHIG-LLOW-1
 100       CHBIT(1:LBIT)=CHFIX(LLOW+1:LHIG-1)
 101
 102 C...Identify commonblock variable.
 103       LNAM=1
 104   140 LNAM=LNAM+1
 105       IF(CHBIT(LNAM:LNAM).NE.'('.AND.CHBIT(LNAM:LNAM).NE.'='.AND.
 106      &LNAM.LE.4) GOTO 140
 107       CHNAM=CHBIT(1:LNAM-1)//' '
 108       DO 150 LCOM=1,LNAM-1
 109       DO 150 LALP=1,26
 110   150 IF(CHNAM(LCOM:LCOM).EQ.CHALP(1)(LALP:LALP)) CHNAM(LCOM:LCOM)=
 111      &CHALP(2)(LALP:LALP)
 112       IVAR=0
 113       DO 160 IV=1,42
 114   160 IF(CHNAM.EQ.CHVAR(IV)) IVAR=IV
 115       IF(IVAR.EQ.0) THEN
 116         CALL LUERRM(18,'(LUGIVE:) do not recognize variable '//CHNAM)
 117         LLOW=LHIG
 118         IF(LLOW.LT.LTOT) GOTO 120
 119         RETURN
 120       ENDIF
 121
 122 C...Identify any indices.
 123       I1=0
 124       I2=0
 125       I3=0
 126       NINDX=0
 127       IF(CHBIT(LNAM:LNAM).EQ.'(') THEN
 128         LIND=LNAM
 129   170   LIND=LIND+1
 130         IF(CHBIT(LIND:LIND).NE.')'.AND.CHBIT(LIND:LIND).NE.',') GOTO 170
 131         CHIND=' '
 132         IF((CHBIT(LNAM+1:LNAM+1).EQ.'C'.OR.CHBIT(LNAM+1:LNAM+1).EQ.'c').
 133      &  AND.(IVAR.EQ.9.OR.IVAR.EQ.10.OR.IVAR.EQ.13.OR.IVAR.EQ.17)) THEN
 134           CHIND(LNAM-LIND+11:8)=CHBIT(LNAM+2:LIND-1)
 135           READ(CHIND,'(I8)') KF
 136           I1=LUCOMP(KF)
 137         ELSEIF(CHBIT(LNAM+1:LNAM+1).EQ.'C'.OR.CHBIT(LNAM+1:LNAM+1).EQ.
 138      &  'c') THEN
 139           CALL LUERRM(18,'(LUGIVE:) not allowed to use C index for '//
 140      &    CHNAM)
 141           LLOW=LHIG
 142           IF(LLOW.LT.LTOT) GOTO 120
 143           RETURN
 144         ELSE
 145           CHIND(LNAM-LIND+10:8)=CHBIT(LNAM+1:LIND-1)
 146           READ(CHIND,'(I8)') I1
 147         ENDIF
 148         LNAM=LIND
 149         IF(CHBIT(LNAM:LNAM).EQ.')') LNAM=LNAM+1
 150         NINDX=1
 151       ENDIF
 152       IF(CHBIT(LNAM:LNAM).EQ.',') THEN
 153         LIND=LNAM
 154   180   LIND=LIND+1
 155         IF(CHBIT(LIND:LIND).NE.')'.AND.CHBIT(LIND:LIND).NE.',') GOTO 180
 156         CHIND=' '
 157         CHIND(LNAM-LIND+10:8)=CHBIT(LNAM+1:LIND-1)
 158         READ(CHIND,'(I8)') I2
 159         LNAM=LIND
 160         IF(CHBIT(LNAM:LNAM).EQ.')') LNAM=LNAM+1
 161         NINDX=2
 162       ENDIF
 163       IF(CHBIT(LNAM:LNAM).EQ.',') THEN
 164         LIND=LNAM
 165   190   LIND=LIND+1
 166         IF(CHBIT(LIND:LIND).NE.')'.AND.CHBIT(LIND:LIND).NE.',') GOTO 190
 167         CHIND=' '
 168         CHIND(LNAM-LIND+10:8)=CHBIT(LNAM+1:LIND-1)
 169         READ(CHIND,'(I8)') I3
 170         LNAM=LIND+1
 171         NINDX=3
 172       ENDIF
 173
 174 C...Check that indices allowed.
 175       IERR=0
 176       IF(NINDX.NE.MSVAR(IVAR,2)) IERR=1
 177       IF(NINDX.GE.1.AND.(I1.LT.MSVAR(IVAR,3).OR.I1.GT.MSVAR(IVAR,4)))
 178      &IERR=2
 179       IF(NINDX.GE.2.AND.(I2.LT.MSVAR(IVAR,5).OR.I2.GT.MSVAR(IVAR,6)))
 180      &IERR=3
 181       IF(NINDX.EQ.3.AND.(I3.LT.MSVAR(IVAR,7).OR.I3.GT.MSVAR(IVAR,8)))
 182      &IERR=4
 183       IF(CHBIT(LNAM:LNAM).NE.'=') IERR=5
 184       IF(IERR.GE.1) THEN
 185         CALL LUERRM(18,'(LUGIVE:) unallowed indices for '//
 186      &  CHBIT(1:LNAM-1))
 187         LLOW=LHIG
 188         IF(LLOW.LT.LTOT) GOTO 120
 189         RETURN
 190       ENDIF
 191
 192 C...Save old value of variable.
 193       IF(IVAR.EQ.1) THEN
 194         IOLD=N
 195       ELSEIF(IVAR.EQ.2) THEN
 196         IOLD=K(I1,I2)
 197       ELSEIF(IVAR.EQ.3) THEN
 198         ROLD=P(I1,I2)
 199       ELSEIF(IVAR.EQ.4) THEN
 200         ROLD=V(I1,I2)
 201       ELSEIF(IVAR.EQ.5) THEN
 202         IOLD=MSTU(I1)
 203       ELSEIF(IVAR.EQ.6) THEN
 204         ROLD=PARU(I1)
 205       ELSEIF(IVAR.EQ.7) THEN
 206         IOLD=MSTJ(I1)
 207       ELSEIF(IVAR.EQ.8) THEN
 208         ROLD=PARJ(I1)
 209       ELSEIF(IVAR.EQ.9) THEN
 210         IOLD=KCHG(I1,I2)
 211       ELSEIF(IVAR.EQ.10) THEN
 212         ROLD=PMAS(I1,I2)
 213       ELSEIF(IVAR.EQ.11) THEN
 214         ROLD=PARF(I1)
 215       ELSEIF(IVAR.EQ.12) THEN
 216         ROLD=VCKM(I1,I2)
 217       ELSEIF(IVAR.EQ.13) THEN
 218         IOLD=MDCY(I1,I2)
 219       ELSEIF(IVAR.EQ.14) THEN
 220         IOLD=MDME(I1,I2)
 221       ELSEIF(IVAR.EQ.15) THEN
 222         ROLD=BRAT(I1)
 223       ELSEIF(IVAR.EQ.16) THEN
 224         IOLD=KFDP(I1,I2)
 225       ELSEIF(IVAR.EQ.17) THEN
 226         CHOLD=CHAF(I1)
 227       ELSEIF(IVAR.EQ.18) THEN
 228         IOLD=MRLU(I1)
 229       ELSEIF(IVAR.EQ.19) THEN
 230         ROLD=RRLU(I1)
 231       ELSEIF(IVAR.EQ.20) THEN
 232         IOLD=MSEL
 233       ELSEIF(IVAR.EQ.21) THEN
 234         IOLD=MSUB(I1)
 235       ELSEIF(IVAR.EQ.22) THEN
 236         IOLD=KFIN(I1,I2)
 237       ELSEIF(IVAR.EQ.23) THEN
 238         ROLD=CKIN(I1)
 239       ELSEIF(IVAR.EQ.24) THEN
 240         IOLD=MSTP(I1)
 241       ELSEIF(IVAR.EQ.25) THEN
 242         ROLD=PARP(I1)
 243       ELSEIF(IVAR.EQ.26) THEN
 244         IOLD=MSTI(I1)
 245       ELSEIF(IVAR.EQ.27) THEN
 246         ROLD=PARI(I1)
 247       ELSEIF(IVAR.EQ.28) THEN
 248         IOLD=MINT(I1)
 249       ELSEIF(IVAR.EQ.29) THEN
 250         ROLD=VINT(I1)
 251       ELSEIF(IVAR.EQ.30) THEN
 252         IOLD=ISET(I1)
 253       ELSEIF(IVAR.EQ.31) THEN
 254         IOLD=KFPR(I1,I2)
 255       ELSEIF(IVAR.EQ.32) THEN
 256         ROLD=COEF(I1,I2)
 257       ELSEIF(IVAR.EQ.33) THEN
 258         IOLD=ICOL(I1,I2,I3)
 259       ELSEIF(IVAR.EQ.34) THEN
 260         ROLD=XSFX(I1,I2)
 261       ELSEIF(IVAR.EQ.35) THEN
 262         IOLD=ISIG(I1,I2)
 263       ELSEIF(IVAR.EQ.36) THEN
 264         ROLD=SIGH(I1)
 265       ELSEIF(IVAR.EQ.37) THEN
 266         ROLD=WIDP(I1,I2)
 267       ELSEIF(IVAR.EQ.38) THEN
 268         ROLD=WIDE(I1,I2)
 269       ELSEIF(IVAR.EQ.39) THEN
 270         ROLD=WIDS(I1,I2)
 271       ELSEIF(IVAR.EQ.40) THEN
 272         IOLD=NGEN(I1,I2)
 273       ELSEIF(IVAR.EQ.41) THEN
 274         ROLD=XSEC(I1,I2)
 275       ELSEIF(IVAR.EQ.42) THEN
 276         CHOLD2=PROC(I1)
 277       ENDIF
 278
 279 C...Print current value of variable. Loop back.
 280       IF(LNAM.GE.LBIT) THEN
 281         CHBIT(LNAM:14)=' '
 282         CHBIT(15:60)=' has the value                                '
 283         IF(MSVAR(IVAR,1).EQ.1) THEN
 284           WRITE(CHBIT(51:60),'(I10)') IOLD
 285         ELSEIF(MSVAR(IVAR,1).EQ.2) THEN
 286           WRITE(CHBIT(47:60),'(F14.5)') ROLD
 287         ELSEIF(MSVAR(IVAR,1).EQ.3) THEN
 288           CHBIT(53:60)=CHOLD
 289         ELSE
 290           CHBIT(33:60)=CHOLD
 291         ENDIF
 292         IF(MSTU(13).GE.1) WRITE(MSTU(11),1000) CHBIT(1:60)
 293         LLOW=LHIG
 294         IF(LLOW.LT.LTOT) GOTO 120
 295         RETURN
 296       ENDIF
 297
 298 C...Read in new variable value.
 299       IF(MSVAR(IVAR,1).EQ.1) THEN
 300         CHINI=' '
 301         CHINI(LNAM-LBIT+11:10)=CHBIT(LNAM+1:LBIT)
 302         READ(CHINI,'(I10)') INEW
 303       ELSEIF(MSVAR(IVAR,1).EQ.2) THEN
 304         CHINR=' '
 305         CHINR(LNAM-LBIT+17:16)=CHBIT(LNAM+1:LBIT)
 306         READ(CHINR,'(F16.2)') RNEW
 307       ELSEIF(MSVAR(IVAR,1).EQ.3) THEN
 308         CHNEW=CHBIT(LNAM+1:LBIT)//' '
 309       ELSE
 310         CHNEW2=CHBIT(LNAM+1:LBIT)//' '
 311       ENDIF
 312
 313 C...Store new variable value.
 314       IF(IVAR.EQ.1) THEN
 315         N=INEW
 316       ELSEIF(IVAR.EQ.2) THEN
 317         K(I1,I2)=INEW
 318       ELSEIF(IVAR.EQ.3) THEN
 319         P(I1,I2)=RNEW
 320       ELSEIF(IVAR.EQ.4) THEN
 321         V(I1,I2)=RNEW
 322       ELSEIF(IVAR.EQ.5) THEN
 323         MSTU(I1)=INEW
 324       ELSEIF(IVAR.EQ.6) THEN
 325         PARU(I1)=RNEW
 326       ELSEIF(IVAR.EQ.7) THEN
 327         MSTJ(I1)=INEW
 328       ELSEIF(IVAR.EQ.8) THEN
 329         PARJ(I1)=RNEW
 330       ELSEIF(IVAR.EQ.9) THEN
 331         KCHG(I1,I2)=INEW
 332       ELSEIF(IVAR.EQ.10) THEN
 333         PMAS(I1,I2)=RNEW
 334       ELSEIF(IVAR.EQ.11) THEN
 335         PARF(I1)=RNEW
 336       ELSEIF(IVAR.EQ.12) THEN
 337         VCKM(I1,I2)=RNEW
 338       ELSEIF(IVAR.EQ.13) THEN
 339         MDCY(I1,I2)=INEW
 340       ELSEIF(IVAR.EQ.14) THEN
 341         MDME(I1,I2)=INEW
 342       ELSEIF(IVAR.EQ.15) THEN
 343         BRAT(I1)=RNEW
 344       ELSEIF(IVAR.EQ.16) THEN
 345         KFDP(I1,I2)=INEW
 346       ELSEIF(IVAR.EQ.17) THEN
 347         CHAF(I1)=CHNEW
 348       ELSEIF(IVAR.EQ.18) THEN
 349         MRLU(I1)=INEW
 350       ELSEIF(IVAR.EQ.19) THEN
 351         RRLU(I1)=RNEW
 352       ELSEIF(IVAR.EQ.20) THEN
 353         MSEL=INEW
 354       ELSEIF(IVAR.EQ.21) THEN
 355         MSUB(I1)=INEW
 356       ELSEIF(IVAR.EQ.22) THEN
 357         KFIN(I1,I2)=INEW
 358       ELSEIF(IVAR.EQ.23) THEN
 359         CKIN(I1)=RNEW
 360       ELSEIF(IVAR.EQ.24) THEN
 361         MSTP(I1)=INEW
 362       ELSEIF(IVAR.EQ.25) THEN
 363         PARP(I1)=RNEW
 364       ELSEIF(IVAR.EQ.26) THEN
 365         MSTI(I1)=INEW
 366       ELSEIF(IVAR.EQ.27) THEN
 367         PARI(I1)=RNEW
 368       ELSEIF(IVAR.EQ.28) THEN
 369         MINT(I1)=INEW
 370       ELSEIF(IVAR.EQ.29) THEN
 371         VINT(I1)=RNEW
 372       ELSEIF(IVAR.EQ.30) THEN
 373         ISET(I1)=INEW
 374       ELSEIF(IVAR.EQ.31) THEN
 375         KFPR(I1,I2)=INEW
 376       ELSEIF(IVAR.EQ.32) THEN
 377         COEF(I1,I2)=RNEW
 378       ELSEIF(IVAR.EQ.33) THEN
 379         ICOL(I1,I2,I3)=INEW
 380       ELSEIF(IVAR.EQ.34) THEN
 381         XSFX(I1,I2)=RNEW
 382       ELSEIF(IVAR.EQ.35) THEN
 383         ISIG(I1,I2)=INEW
 384       ELSEIF(IVAR.EQ.36) THEN
 385         SIGH(I1)=RNEW
 386       ELSEIF(IVAR.EQ.37) THEN
 387         WIDP(I1,I2)=RNEW
 388       ELSEIF(IVAR.EQ.38) THEN
 389         WIDE(I1,I2)=RNEW
 390       ELSEIF(IVAR.EQ.39) THEN
 391         WIDS(I1,I2)=RNEW
 392       ELSEIF(IVAR.EQ.40) THEN
 393         NGEN(I1,I2)=INEW
 394       ELSEIF(IVAR.EQ.41) THEN
 395         XSEC(I1,I2)=RNEW
 396       ELSEIF(IVAR.EQ.42) THEN
 397         PROC(I1)=CHNEW2
 398       ENDIF
 399
 400 C...Write old and new value. Loop back.
 401       CHBIT(LNAM:14)=' '
 402       CHBIT(15:60)=' changed from                to               '
 403       IF(MSVAR(IVAR,1).EQ.1) THEN
 404         WRITE(CHBIT(33:42),'(I10)') IOLD
 405         WRITE(CHBIT(51:60),'(I10)') INEW
 406         IF(MSTU(13).GE.1) WRITE(MSTU(11),1000) CHBIT(1:60)
 407       ELSEIF(MSVAR(IVAR,1).EQ.2) THEN
 408         WRITE(CHBIT(29:42),'(F14.5)') ROLD
 409         WRITE(CHBIT(47:60),'(F14.5)') RNEW
 410         IF(MSTU(13).GE.1) WRITE(MSTU(11),1000) CHBIT(1:60)
 411       ELSEIF(MSVAR(IVAR,1).EQ.3) THEN
 412         CHBIT(35:42)=CHOLD
 413         CHBIT(53:60)=CHNEW
 414         IF(MSTU(13).GE.1) WRITE(MSTU(11),1000) CHBIT(1:60)
 415       ELSE
 416         CHBIT(15:88)=' changed from '//CHOLD2//' to '//CHNEW2
 417         IF(MSTU(13).GE.1) WRITE(MSTU(11),1100) CHBIT(1:88)
 418       ENDIF
 419       LLOW=LHIG
 420       IF(LLOW.LT.LTOT) GOTO 120
 421
 422 C...Format statement for output on unit MSTU(11) (by default 6).
 423  1000 FORMAT(5X,A60)
 424  1100 FORMAT(5X,A88)
 425
 426       RETURN
 427       END