hijing/src/lugive.f

0001
0002 C*********************************************************************
0003
0004       SUBROUTINE LUGIVE(CHIN)
0005
0006 C...Purpose: to set values of commonblock variables.
0007       COMMON/LUJETS/N,K(9000,5),P(9000,5),V(9000,5)
0008       SAVE /LUJETS/
0009       COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0010       SAVE /LUDAT1/
0011       COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
0012       SAVE /LUDAT2/
0013       COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5)
0014       SAVE /LUDAT3/
0015       COMMON/LUDAT4/CHAF(500)
0016       CHARACTER CHAF*8
0017       SAVE /LUDAT4/
0018       CHARACTER CHIN*(*),CHFIX*104,CHBIT*104,CHOLD*8,CHNEW*8,
0019      &CHNAM*4,CHVAR(17)*4,CHALP(2)*26,CHIND*8,CHINI*10,CHINR*16
0020       DATA CHVAR/'N','K','P','V','MSTU','PARU','MSTJ','PARJ','KCHG',
0021      &'PMAS','PARF','VCKM','MDCY','MDME','BRAT','KFDP','CHAF'/
0022       DATA CHALP/'abcdefghijklmnopqrstuvwxyz',
0023      &'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
0024
0025 C...Length of character variable. Subdivide it into instructions.
0026       IF(MSTU(12).GE.1) CALL LULIST(0)
0027       CHBIT=CHIN//' '
0028       LBIT=101
0029   100 LBIT=LBIT-1
0030       IF(CHBIT(LBIT:LBIT).EQ.' ') GOTO 100
0031       LTOT=0
0032       DO 110 LCOM=1,LBIT
0033       IF(CHBIT(LCOM:LCOM).EQ.' ') GOTO 110
0034       LTOT=LTOT+1
0035       CHFIX(LTOT:LTOT)=CHBIT(LCOM:LCOM)
0036   110 CONTINUE
0037       LLOW=0
0038   120 LHIG=LLOW+1
0039   130 LHIG=LHIG+1
0040       IF(LHIG.LE.LTOT.AND.CHFIX(LHIG:LHIG).NE.';') GOTO 130
0041       LBIT=LHIG-LLOW-1
0042       CHBIT(1:LBIT)=CHFIX(LLOW+1:LHIG-1)
0043
0044 C...Identify commonblock variable.
0045       LNAM=1
0046   140 LNAM=LNAM+1
0047       IF(CHBIT(LNAM:LNAM).NE.'('.AND.CHBIT(LNAM:LNAM).NE.'='.AND.
0048      &LNAM.LE.4) GOTO 140
0049       CHNAM=CHBIT(1:LNAM-1)//' '
0050       DO 150 LCOM=1,LNAM-1
0051       DO 150 LALP=1,26
0052   150 IF(CHNAM(LCOM:LCOM).EQ.CHALP(1)(LALP:LALP)) CHNAM(LCOM:LCOM)=
0053      &CHALP(2)(LALP:LALP)
0054       IVAR=0
0055       DO 160 IV=1,17
0056   160 IF(CHNAM.EQ.CHVAR(IV)) IVAR=IV
0057       IF(IVAR.EQ.0) THEN
0058         CALL LUERRM(18,'(LUGIVE:) do not recognize variable '//CHNAM)
0059         LLOW=LHIG
0060         IF(LLOW.LT.LTOT) GOTO 120
0061         RETURN
0062       ENDIF
0063
0064 C...Identify any indices.
0065       I=0
0066       J=0
0067       IF(CHBIT(LNAM:LNAM).EQ.'(') THEN
0068         LIND=LNAM
0069   170   LIND=LIND+1
0070         IF(CHBIT(LIND:LIND).NE.')'.AND.CHBIT(LIND:LIND).NE.',') GOTO 170
0071         CHIND=' '
0072         IF((CHBIT(LNAM+1:LNAM+1).EQ.'C'.OR.CHBIT(LNAM+1:LNAM+1).EQ.'c').
0073      &  AND.(IVAR.EQ.9.OR.IVAR.EQ.10.OR.IVAR.EQ.13.OR.IVAR.EQ.17)) THEN
0074           CHIND(LNAM-LIND+11:8)=CHBIT(LNAM+2:LIND-1)
0075           READ(CHIND,'(I8)') I1
0076           I=LUCOMP(I1)
0077         ELSE
0078           CHIND(LNAM-LIND+10:8)=CHBIT(LNAM+1:LIND-1)
0079           READ(CHIND,'(I8)') I
0080         ENDIF
0081         LNAM=LIND
0082         IF(CHBIT(LNAM:LNAM).EQ.')') LNAM=LNAM+1
0083       ENDIF
0084       IF(CHBIT(LNAM:LNAM).EQ.',') THEN
0085         LIND=LNAM
0086   180   LIND=LIND+1
0087         IF(CHBIT(LIND:LIND).NE.')'.AND.CHBIT(LIND:LIND).NE.',') GOTO 180
0088         CHIND=' '
0089         CHIND(LNAM-LIND+10:8)=CHBIT(LNAM+1:LIND-1)
0090         READ(CHIND,'(I8)') J
0091         LNAM=LIND+1
0092       ENDIF
0093
0094 C...Check that indices allowed and save old value.
0095       IERR=1
0096       IF(CHBIT(LNAM:LNAM).NE.'=') GOTO 190
0097       IF(IVAR.EQ.1) THEN
0098         IF(I.NE.0.OR.J.NE.0) GOTO 190
0099         IOLD=N
0100       ELSEIF(IVAR.EQ.2) THEN
0101         IF(I.LT.1.OR.I.GT.MSTU(4).OR.J.LT.1.OR.J.GT.5) GOTO 190
0102         IOLD=K(I,J)
0103       ELSEIF(IVAR.EQ.3) THEN
0104         IF(I.LT.1.OR.I.GT.MSTU(4).OR.J.LT.1.OR.J.GT.5) GOTO 190
0105         ROLD=P(I,J)
0106       ELSEIF(IVAR.EQ.4) THEN
0107         IF(I.LT.1.OR.I.GT.MSTU(4).OR.J.LT.1.OR.J.GT.5) GOTO 190
0108         ROLD=V(I,J)
0109       ELSEIF(IVAR.EQ.5) THEN
0110         IF(I.LT.1.OR.I.GT.200.OR.J.NE.0) GOTO 190
0111         IOLD=MSTU(I)
0112       ELSEIF(IVAR.EQ.6) THEN
0113         IF(I.LT.1.OR.I.GT.200.OR.J.NE.0) GOTO 190
0114         ROLD=PARU(I)
0115       ELSEIF(IVAR.EQ.7) THEN
0116         IF(I.LT.1.OR.I.GT.200.OR.J.NE.0) GOTO 190
0117         IOLD=MSTJ(I)
0118       ELSEIF(IVAR.EQ.8) THEN
0119         IF(I.LT.1.OR.I.GT.200.OR.J.NE.0) GOTO 190
0120         ROLD=PARJ(I)
0121       ELSEIF(IVAR.EQ.9) THEN
0122         IF(I.LT.1.OR.I.GT.MSTU(6).OR.J.LT.1.OR.J.GT.3) GOTO 190
0123         IOLD=KCHG(I,J)
0124       ELSEIF(IVAR.EQ.10) THEN
0125         IF(I.LT.1.OR.I.GT.MSTU(6).OR.J.LT.1.OR.J.GT.4) GOTO 190
0126         ROLD=PMAS(I,J)
0127       ELSEIF(IVAR.EQ.11) THEN
0128         IF(I.LT.1.OR.I.GT.2000.OR.J.NE.0) GOTO 190
0129         ROLD=PARF(I)
0130       ELSEIF(IVAR.EQ.12) THEN
0131         IF(I.LT.1.OR.I.GT.4.OR.J.LT.1.OR.J.GT.4) GOTO 190
0132         ROLD=VCKM(I,J)
0133       ELSEIF(IVAR.EQ.13) THEN
0134         IF(I.LT.1.OR.I.GT.MSTU(6).OR.J.LT.1.OR.J.GT.3) GOTO 190
0135         IOLD=MDCY(I,J)
0136       ELSEIF(IVAR.EQ.14) THEN
0137         IF(I.LT.1.OR.I.GT.MSTU(7).OR.J.LT.1.OR.J.GT.2) GOTO 190
0138         IOLD=MDME(I,J)
0139       ELSEIF(IVAR.EQ.15) THEN
0140         IF(I.LT.1.OR.I.GT.MSTU(7).OR.J.NE.0) GOTO 190
0141         ROLD=BRAT(I)
0142       ELSEIF(IVAR.EQ.16) THEN
0143         IF(I.LT.1.OR.I.GT.MSTU(7).OR.J.LT.1.OR.J.GT.5) GOTO 190
0144         IOLD=KFDP(I,J)
0145       ELSEIF(IVAR.EQ.17) THEN
0146         IF(I.LT.1.OR.I.GT.MSTU(6).OR.J.NE.0) GOTO 190
0147         CHOLD=CHAF(I)
0148       ENDIF
0149       IERR=0
0150   190 IF(IERR.EQ.1) THEN
0151         CALL LUERRM(18,'(LUGIVE:) unallowed indices for '//
0152      &  CHBIT(1:LNAM-1))
0153         LLOW=LHIG
0154         IF(LLOW.LT.LTOT) GOTO 120
0155         RETURN
0156       ENDIF
0157
0158 C...Print current value of variable. Loop back.
0159       IF(LNAM.GE.LBIT) THEN
0160         CHBIT(LNAM:14)=' '
0161         CHBIT(15:60)=' has the value                                '
0162         IF(IVAR.EQ.1.OR.IVAR.EQ.2.OR.IVAR.EQ.5.OR.IVAR.EQ.7.OR.
0163      &  IVAR.EQ.9.OR.IVAR.EQ.13.OR.IVAR.EQ.14.OR.IVAR.EQ.16) THEN
0164           WRITE(CHBIT(51:60),'(I10)') IOLD
0165         ELSEIF(IVAR.NE.17) THEN
0166           WRITE(CHBIT(47:60),'(F14.5)') ROLD
0167         ELSE
0168           CHBIT(53:60)=CHOLD
0169         ENDIF
0170         IF(MSTU(13).GE.1) WRITE(MSTU(11),1000) CHBIT(1:60)
0171         LLOW=LHIG
0172         IF(LLOW.LT.LTOT) GOTO 120
0173         RETURN
0174       ENDIF
0175
0176 C...Read in new variable value.
0177       IF(IVAR.EQ.1.OR.IVAR.EQ.2.OR.IVAR.EQ.5.OR.IVAR.EQ.7.OR.
0178      &IVAR.EQ.9.OR.IVAR.EQ.13.OR.IVAR.EQ.14.OR.IVAR.EQ.16) THEN
0179         CHINI=' '
0180         CHINI(LNAM-LBIT+11:10)=CHBIT(LNAM+1:LBIT)
0181         READ(CHINI,'(I10)') INEW
0182       ELSEIF(IVAR.NE.17) THEN
0183         CHINR=' '
0184         CHINR(LNAM-LBIT+17:16)=CHBIT(LNAM+1:LBIT)
0185         READ(CHINR,'(F16.2)') RNEW
0186       ELSE
0187         CHNEW=CHBIT(LNAM+1:LBIT)//' '
0188       ENDIF
0189
0190 C...Store new variable value.
0191       IF(IVAR.EQ.1) THEN
0192         N=INEW
0193       ELSEIF(IVAR.EQ.2) THEN
0194         K(I,J)=INEW
0195       ELSEIF(IVAR.EQ.3) THEN
0196         P(I,J)=RNEW
0197       ELSEIF(IVAR.EQ.4) THEN
0198         V(I,J)=RNEW
0199       ELSEIF(IVAR.EQ.5) THEN
0200         MSTU(I)=INEW
0201       ELSEIF(IVAR.EQ.6) THEN
0202         PARU(I)=RNEW
0203       ELSEIF(IVAR.EQ.7) THEN
0204         MSTJ(I)=INEW
0205       ELSEIF(IVAR.EQ.8) THEN
0206         PARJ(I)=RNEW
0207       ELSEIF(IVAR.EQ.9) THEN
0208         KCHG(I,J)=INEW
0209       ELSEIF(IVAR.EQ.10) THEN
0210         PMAS(I,J)=RNEW
0211       ELSEIF(IVAR.EQ.11) THEN
0212         PARF(I)=RNEW
0213       ELSEIF(IVAR.EQ.12) THEN
0214         VCKM(I,J)=RNEW
0215       ELSEIF(IVAR.EQ.13) THEN
0216         MDCY(I,J)=INEW
0217       ELSEIF(IVAR.EQ.14) THEN
0218         MDME(I,J)=INEW
0219       ELSEIF(IVAR.EQ.15) THEN
0220         BRAT(I)=RNEW
0221       ELSEIF(IVAR.EQ.16) THEN
0222         KFDP(I,J)=INEW
0223       ELSEIF(IVAR.EQ.17) THEN
0224         CHAF(I)=CHNEW
0225       ENDIF
0226
0227 C...Write old and new value. Loop back.
0228       CHBIT(LNAM:14)=' '
0229       CHBIT(15:60)=' changed from                to               '
0230       IF(IVAR.EQ.1.OR.IVAR.EQ.2.OR.IVAR.EQ.5.OR.IVAR.EQ.7.OR.
0231      &IVAR.EQ.9.OR.IVAR.EQ.13.OR.IVAR.EQ.14.OR.IVAR.EQ.16) THEN
0232         WRITE(CHBIT(33:42),'(I10)') IOLD
0233         WRITE(CHBIT(51:60),'(I10)') INEW
0234       ELSEIF(IVAR.NE.17) THEN
0235         WRITE(CHBIT(29:42),'(F14.5)') ROLD
0236         WRITE(CHBIT(47:60),'(F14.5)') RNEW
0237       ELSE
0238         CHBIT(35:42)=CHOLD
0239         CHBIT(53:60)=CHNEW
0240       ENDIF
0241       IF(MSTU(13).GE.1) WRITE(MSTU(11),1000) CHBIT(1:60)
0242       LLOW=LHIG
0243       IF(LLOW.LT.LTOT) GOTO 120
0244
0245 C...Format statement for output on unit MSTU(11) (by default 6).
0246  1000 FORMAT(5X,A60)
0247
0248       RETURN
0249       END