HIJING/hipyset1_35/lugive_hijing.F

   1 * $Id$
   2
   3 C*********************************************************************
   4
   5       SUBROUTINE LUGIVE_HIJING(CHIN)
   6
   7 C...Purpose: to set values of commonblock variables.
   8 #include "lujets_hijing.inc"
   9 #include "ludat1_hijing.inc"
  10 #include "ludat2_hijing.inc"
  11 #include "ludat3_hijing.inc"
  12 #include "ludat4_hijing.inc"
  13       CHARACTER CHIN*(*),CHFIX*104,CHBIT*104,CHOLD*8,CHNEW*8,
  14      &CHNAM*4,CHVAR(17)*4,CHALP(2)*26,CHIND*8,CHINI*10,CHINR*16
  15       DATA CHVAR/'N','K','P','V','MSTU','PARU','MSTJ','PARJ','KCHG',
  16      &'PMAS','PARF','VCKM','MDCY','MDME','BRAT','KFDP','CHAF'/
  17       DATA CHALP/'abcdefghijklmnopqrstuvwxyz',
  18      &'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
  19
  20 C...Length of character variable. Subdivide it into instructions.
  21       IF(MSTU(12).GE.1) CALL LULIST_HIJING(0)
  22       CHBIT=CHIN//' '
  23       LBIT=101
  24   100 LBIT=LBIT-1
  25       IF(CHBIT(LBIT:LBIT).EQ.' ') GOTO 100
  26       LTOT=0
  27       DO 110 LCOM=1,LBIT
  28       IF(CHBIT(LCOM:LCOM).EQ.' ') GOTO 110
  29       LTOT=LTOT+1
  30       CHFIX(LTOT:LTOT)=CHBIT(LCOM:LCOM)
  31   110 CONTINUE
  32       LLOW=0
  33   120 LHIG=LLOW+1
  34   130 LHIG=LHIG+1
  35       IF(LHIG.LE.LTOT.AND.CHFIX(LHIG:LHIG).NE.';') GOTO 130
  36       LBIT=LHIG-LLOW-1
  37       CHBIT(1:LBIT)=CHFIX(LLOW+1:LHIG-1)
  38
  39 C...Identify commonblock variable.
  40       LNAM=1
  41   140 LNAM=LNAM+1
  42       IF(CHBIT(LNAM:LNAM).NE.'('.AND.CHBIT(LNAM:LNAM).NE.'='.AND.
  43      &LNAM.LE.4) GOTO 140
  44       CHNAM=CHBIT(1:LNAM-1)//' '
  45       DO 150 LCOM=1,LNAM-1
  46       DO 150 LALP=1,26
  47   150 IF(CHNAM(LCOM:LCOM).EQ.CHALP(1)(LALP:LALP)) CHNAM(LCOM:LCOM)=
  48      &CHALP(2)(LALP:LALP)
  49       IVAR=0
  50       DO 160 IV=1,17
  51   160 IF(CHNAM.EQ.CHVAR(IV)) IVAR=IV
  52       IF(IVAR.EQ.0) THEN
  53          CALL LUERRM_HIJING(18
  54      $        ,'(LUGIVE_HIJING:) do not recognize variable '//CHNAM)
  55         LLOW=LHIG
  56         IF(LLOW.LT.LTOT) GOTO 120
  57         RETURN
  58       ENDIF
  59
  60 C...Identify any indices.
  61       I=0
  62       J=0
  63       IF(CHBIT(LNAM:LNAM).EQ.'(') THEN
  64         LIND=LNAM
  65   170   LIND=LIND+1
  66         IF(CHBIT(LIND:LIND).NE.')'.AND.CHBIT(LIND:LIND).NE.',') GOTO 170
  67         CHIND=' '
  68         IF((CHBIT(LNAM+1:LNAM+1).EQ.'C'.OR.CHBIT(LNAM+1:LNAM+1).EQ.'c').
  69      &  AND.(IVAR.EQ.9.OR.IVAR.EQ.10.OR.IVAR.EQ.13.OR.IVAR.EQ.17)) THEN
  70           CHIND(LNAM-LIND+11:8)=CHBIT(LNAM+2:LIND-1)
  71           READ(CHIND,'(I8)') I1
  72           I=LUCOMP_HIJING(I1)
  73         ELSE
  74           CHIND(LNAM-LIND+10:8)=CHBIT(LNAM+1:LIND-1)
  75           READ(CHIND,'(I8)') I
  76         ENDIF
  77         LNAM=LIND
  78         IF(CHBIT(LNAM:LNAM).EQ.')') LNAM=LNAM+1
  79       ENDIF
  80       IF(CHBIT(LNAM:LNAM).EQ.',') THEN
  81         LIND=LNAM
  82   180   LIND=LIND+1
  83         IF(CHBIT(LIND:LIND).NE.')'.AND.CHBIT(LIND:LIND).NE.',') GOTO 180
  84         CHIND=' '
  85         CHIND(LNAM-LIND+10:8)=CHBIT(LNAM+1:LIND-1)
  86         READ(CHIND,'(I8)') J
  87         LNAM=LIND+1
  88       ENDIF
  89
  90 C...Check that indices allowed and save old value.
  91       IERR=1
  92       IF(CHBIT(LNAM:LNAM).NE.'=') GOTO 190
  93       IF(IVAR.EQ.1) THEN
  94         IF(I.NE.0.OR.J.NE.0) GOTO 190
  95         IOLD=N
  96       ELSEIF(IVAR.EQ.2) THEN
  97         IF(I.LT.1.OR.I.GT.MSTU(4).OR.J.LT.1.OR.J.GT.5) GOTO 190
  98         IOLD=K(I,J)
  99       ELSEIF(IVAR.EQ.3) THEN
 100         IF(I.LT.1.OR.I.GT.MSTU(4).OR.J.LT.1.OR.J.GT.5) GOTO 190
 101         ROLD=P(I,J)
 102       ELSEIF(IVAR.EQ.4) THEN
 103         IF(I.LT.1.OR.I.GT.MSTU(4).OR.J.LT.1.OR.J.GT.5) GOTO 190
 104         ROLD=V(I,J)
 105       ELSEIF(IVAR.EQ.5) THEN
 106         IF(I.LT.1.OR.I.GT.200.OR.J.NE.0) GOTO 190
 107         IOLD=MSTU(I)
 108       ELSEIF(IVAR.EQ.6) THEN
 109         IF(I.LT.1.OR.I.GT.200.OR.J.NE.0) GOTO 190
 110         ROLD=PARU(I)
 111       ELSEIF(IVAR.EQ.7) THEN
 112         IF(I.LT.1.OR.I.GT.200.OR.J.NE.0) GOTO 190
 113         IOLD=MSTJ(I)
 114       ELSEIF(IVAR.EQ.8) THEN
 115         IF(I.LT.1.OR.I.GT.200.OR.J.NE.0) GOTO 190
 116         ROLD=PARJ(I)
 117       ELSEIF(IVAR.EQ.9) THEN
 118         IF(I.LT.1.OR.I.GT.MSTU(6).OR.J.LT.1.OR.J.GT.3) GOTO 190
 119         IOLD=KCHG(I,J)
 120       ELSEIF(IVAR.EQ.10) THEN
 121         IF(I.LT.1.OR.I.GT.MSTU(6).OR.J.LT.1.OR.J.GT.4) GOTO 190
 122         ROLD=PMAS(I,J)
 123       ELSEIF(IVAR.EQ.11) THEN
 124         IF(I.LT.1.OR.I.GT.2000.OR.J.NE.0) GOTO 190
 125         ROLD=PARF(I)
 126       ELSEIF(IVAR.EQ.12) THEN
 127         IF(I.LT.1.OR.I.GT.4.OR.J.LT.1.OR.J.GT.4) GOTO 190
 128         ROLD=VCKM(I,J)
 129       ELSEIF(IVAR.EQ.13) THEN
 130         IF(I.LT.1.OR.I.GT.MSTU(6).OR.J.LT.1.OR.J.GT.3) GOTO 190
 131         IOLD=MDCY(I,J)
 132       ELSEIF(IVAR.EQ.14) THEN
 133         IF(I.LT.1.OR.I.GT.MSTU(7).OR.J.LT.1.OR.J.GT.2) GOTO 190
 134         IOLD=MDME(I,J)
 135       ELSEIF(IVAR.EQ.15) THEN
 136         IF(I.LT.1.OR.I.GT.MSTU(7).OR.J.NE.0) GOTO 190
 137         ROLD=BRAT(I)
 138       ELSEIF(IVAR.EQ.16) THEN
 139         IF(I.LT.1.OR.I.GT.MSTU(7).OR.J.LT.1.OR.J.GT.5) GOTO 190
 140         IOLD=KFDP(I,J)
 141       ELSEIF(IVAR.EQ.17) THEN
 142         IF(I.LT.1.OR.I.GT.MSTU(6).OR.J.NE.0) GOTO 190
 143         CHOLD=CHAF(I)
 144       ENDIF
 145       IERR=0
 146   190 IF(IERR.EQ.1) THEN
 147          CALL LUERRM_HIJING(18,'(LUGIVE_HIJING:) unallowed indices for '
 148      $        //CHBIT(1:LNAM-1))
 149         LLOW=LHIG
 150         IF(LLOW.LT.LTOT) GOTO 120
 151         RETURN
 152       ENDIF
 153
 154 C...Print current value of variable. Loop back.
 155       IF(LNAM.GE.LBIT) THEN
 156         CHBIT(LNAM:14)=' '
 157         CHBIT(15:60)=' has the value                                '
 158         IF(IVAR.EQ.1.OR.IVAR.EQ.2.OR.IVAR.EQ.5.OR.IVAR.EQ.7.OR.
 159      &  IVAR.EQ.9.OR.IVAR.EQ.13.OR.IVAR.EQ.14.OR.IVAR.EQ.16) THEN
 160           WRITE(CHBIT(51:60),'(I10)') IOLD
 161         ELSEIF(IVAR.NE.17) THEN
 162           WRITE(CHBIT(47:60),'(F14.5)') ROLD
 163         ELSE
 164           CHBIT(53:60)=CHOLD
 165         ENDIF
 166         IF(MSTU(13).GE.1) WRITE(MSTU(11),1000) CHBIT(1:60)
 167         LLOW=LHIG
 168         IF(LLOW.LT.LTOT) GOTO 120
 169         RETURN
 170       ENDIF
 171
 172 C...Read in new variable value.
 173       IF(IVAR.EQ.1.OR.IVAR.EQ.2.OR.IVAR.EQ.5.OR.IVAR.EQ.7.OR.
 174      &IVAR.EQ.9.OR.IVAR.EQ.13.OR.IVAR.EQ.14.OR.IVAR.EQ.16) THEN
 175         CHINI=' '
 176         CHINI(LNAM-LBIT+11:10)=CHBIT(LNAM+1:LBIT)
 177         READ(CHINI,'(I10)') INEW
 178       ELSEIF(IVAR.NE.17) THEN
 179         CHINR=' '
 180         CHINR(LNAM-LBIT+17:16)=CHBIT(LNAM+1:LBIT)
 181         READ(CHINR,'(F16.2)') RNEW
 182       ELSE
 183         CHNEW=CHBIT(LNAM+1:LBIT)//' '
 184       ENDIF
 185
 186 C...Store new variable value.
 187       IF(IVAR.EQ.1) THEN
 188         N=INEW
 189       ELSEIF(IVAR.EQ.2) THEN
 190         K(I,J)=INEW
 191       ELSEIF(IVAR.EQ.3) THEN
 192         P(I,J)=RNEW
 193       ELSEIF(IVAR.EQ.4) THEN
 194         V(I,J)=RNEW
 195       ELSEIF(IVAR.EQ.5) THEN
 196         MSTU(I)=INEW
 197       ELSEIF(IVAR.EQ.6) THEN
 198         PARU(I)=RNEW
 199       ELSEIF(IVAR.EQ.7) THEN
 200         MSTJ(I)=INEW
 201       ELSEIF(IVAR.EQ.8) THEN
 202         PARJ(I)=RNEW
 203       ELSEIF(IVAR.EQ.9) THEN
 204         KCHG(I,J)=INEW
 205       ELSEIF(IVAR.EQ.10) THEN
 206         PMAS(I,J)=RNEW
 207       ELSEIF(IVAR.EQ.11) THEN
 208         PARF(I)=RNEW
 209       ELSEIF(IVAR.EQ.12) THEN
 210         VCKM(I,J)=RNEW
 211       ELSEIF(IVAR.EQ.13) THEN
 212         MDCY(I,J)=INEW
 213       ELSEIF(IVAR.EQ.14) THEN
 214         MDME(I,J)=INEW
 215       ELSEIF(IVAR.EQ.15) THEN
 216         BRAT(I)=RNEW
 217       ELSEIF(IVAR.EQ.16) THEN
 218         KFDP(I,J)=INEW
 219       ELSEIF(IVAR.EQ.17) THEN
 220         CHAF(I)=CHNEW
 221       ENDIF
 222
 223 C...Write old and new value. Loop back.
 224       CHBIT(LNAM:14)=' '
 225       CHBIT(15:60)=' changed from                to               '
 226       IF(IVAR.EQ.1.OR.IVAR.EQ.2.OR.IVAR.EQ.5.OR.IVAR.EQ.7.OR.
 227      &IVAR.EQ.9.OR.IVAR.EQ.13.OR.IVAR.EQ.14.OR.IVAR.EQ.16) THEN
 228         WRITE(CHBIT(33:42),'(I10)') IOLD
 229         WRITE(CHBIT(51:60),'(I10)') INEW
 230       ELSEIF(IVAR.NE.17) THEN
 231         WRITE(CHBIT(29:42),'(F14.5)') ROLD
 232         WRITE(CHBIT(47:60),'(F14.5)') RNEW
 233       ELSE
 234         CHBIT(35:42)=CHOLD
 235         CHBIT(53:60)=CHNEW
 236       ENDIF
 237       IF(MSTU(13).GE.1) WRITE(MSTU(11),1000) CHBIT(1:60)
 238       LLOW=LHIG
 239       IF(LLOW.LT.LTOT) GOTO 120
 240
 241 C...Format statement for output on unit MSTU(11) (by default 6).
 242  1000 FORMAT(5X,A60)
 243
 244       RETURN
 245       END