]>
Commit | Line | Data |
---|---|---|
e74335a4 | 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 |