Commit | Line | Data |
---|---|---|
8b22683c KB |
1 | C RESIDENT SUBROUTINES FOR DUNGEON |
2 | C | |
3 | C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142 | |
4 | C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED | |
5 | C WRITTEN BY R. M. SUPNIK | |
6 | C | |
7 | C RSPEAK-- OUTPUT RANDOM MESSAGE ROUTINE | |
8 | C | |
9 | C CALLED BY-- | |
10 | C | |
11 | C CALL RSPEAK(MSGNUM) | |
12 | C | |
13 | SUBROUTINE RSPEAK(N) | |
14 | IMPLICIT INTEGER(A-Z) | |
15 | C | |
16 | CALL RSPSB2(N,0,0) | |
17 | RETURN | |
18 | END | |
19 | C RSPSUB-- OUTPUT RANDOM MESSAGE WITH SUBSTITUTABLE ARGUMENT | |
20 | C | |
21 | C CALLED BY-- | |
22 | C | |
23 | C CALL RSPSUB(MSGNUM,SUBNUM) | |
24 | C | |
25 | SUBROUTINE RSPSUB(N,S1) | |
26 | IMPLICIT INTEGER(A-Z) | |
27 | C | |
28 | CALL RSPSB2(N,S1,0) | |
29 | RETURN | |
30 | END | |
31 | C RSPSB2-- OUTPUT RANDOM MESSAGE WITH UP TO TWO SUBSTITUTABLE ARGUMENTS | |
32 | C | |
33 | C CALLED BY-- | |
34 | C | |
35 | C CALL RSPSB2(MSGNUM,SUBNUM1,SUBNUM2) | |
36 | C | |
37 | SUBROUTINE RSPSB2(N,S1,S2) | |
38 | IMPLICIT INTEGER(A-Z) | |
39 | #ifndef PDP | |
40 | CHARACTER*74 B1,B2,B3 | |
41 | INTEGER*2 OLDREC,NEWREC,JREC | |
42 | #endif PDP | |
43 | C | |
44 | C DECLARATIONS | |
45 | C | |
46 | #include "gamestate.h" | |
47 | C | |
48 | #ifdef PDP | |
49 | TELFLG=.TRUE. | |
50 | C | |
51 | C use C routine to access data base | |
52 | C | |
53 | call rspsb3(N,S1,S2) | |
54 | return | |
55 | #else | |
56 | #include "mindex.h" | |
57 | #include "io.h" | |
58 | C | |
59 | C CONVERT ALL ARGUMENTS FROM DICTIONARY NUMBERS (IF POSITIVE) | |
60 | C TO ABSOLUTE RECORD NUMBERS. | |
61 | C | |
62 | X=N | |
63 | C !SET UP WORK VARIABLES. | |
64 | Y=S1 | |
65 | Z=S2 | |
66 | IF(X.GT.0) X=RTEXT(X) | |
67 | C !IF >0, LOOK UP IN RTEXT. | |
68 | IF(Y.GT.0) Y=RTEXT(Y) | |
69 | IF(Z.GT.0) Z=RTEXT(Z) | |
70 | X=IABS(X) | |
71 | C !TAKE ABS VALUE. | |
72 | Y=IABS(Y) | |
73 | Z=IABS(Z) | |
74 | IF(X.EQ.0) RETURN | |
75 | C !ANYTHING TO DO? | |
76 | TELFLG=.TRUE. | |
77 | C !SAID SOMETHING. | |
78 | C | |
79 | READ(UNIT=DBCH,REC=X) OLDREC,B1 | |
80 | C | |
81 | 100 DO 150 I=1,74 | |
82 | X1=and(X,31)+I | |
83 | B1(I:I)=char(xor(ichar(B1(I:I)),X1)) | |
84 | 150 CONTINUE | |
85 | C | |
86 | 200 IF(Y.EQ.0) GO TO 400 | |
87 | C !ANY SUBSTITUTABLE? | |
88 | DO 300 I=1,74 | |
89 | C !YES, LOOK FOR #. | |
90 | IF(B1(I:I).EQ.'#') GO TO 1000 | |
91 | 300 CONTINUE | |
92 | C | |
93 | 400 DO 500 I=74,1,-1 | |
94 | C !BACKSCAN FOR BLANKS. | |
95 | IF(B1(I:I).NE.' ') GO TO 600 | |
96 | 500 CONTINUE | |
97 | C | |
98 | 600 WRITE(OUTCH,650) (B1(J:J),J=1,I) | |
99 | #ifdef NOCC | |
100 | 650 FORMAT(74A1) | |
101 | #else NOCC | |
102 | 650 FORMAT(1X,74A1) | |
103 | #endif NOCC | |
104 | X=X+1 | |
105 | C !ON TO NEXT RECORD. | |
106 | READ(UNIT=DBCH,REC=X) NEWREC,B1 | |
107 | IF(OLDREC.EQ.NEWREC) GO TO 100 | |
108 | C !CONTINUATION? | |
109 | RETURN | |
110 | C !NO, EXIT. | |
111 | C | |
112 | C SUBSTITUTION WITH SUBSTITUTABLE AVAILABLE. | |
113 | C I IS INDEX OF # IN B1. | |
114 | C Y IS NUMBER OF RECORD TO SUBSTITUTE. | |
115 | C | |
116 | C PROCEDURE: | |
117 | C 1) COPY REST OF B1 TO B2 | |
118 | C 2) READ SUBSTITUTABLE OVER B1 | |
119 | C 3) RESTORE TAIL OF ORIGINAL B1 | |
120 | C | |
121 | C THE IMPLICIT ASSUMPTION HERE IS THAT THE SUBSTITUTABLE STRING | |
122 | C IS VERY SHORT (i.e. MUCH LESS THAN ONE RECORD). | |
123 | C | |
124 | 1000 K2=1 | |
125 | C !TO | |
126 | DO 1100 K1=I+1,74 | |
127 | C !COPY REST OF B1. | |
128 | B2(K2:K2)=B1(K1:K1) | |
129 | K2=K2+1 | |
130 | 1100 CONTINUE | |
131 | C | |
132 | C READ SUBSTITUTE STRING INTO B3, AND DECRYPT IT: | |
133 | C | |
134 | READ(UNIT=DBCH,REC=Y) JREC,B3 | |
135 | DO 1150 K1=1,74 | |
136 | X1=and(Y,31)+K1 | |
137 | B3(K1:K1)=char(xor(ICHAR(B3(K1:K1)),X1)) | |
138 | 1150 CONTINUE | |
139 | C | |
140 | C FILL REMAINDER OF B1 WITH CHARACTERS FROM B3: | |
141 | C | |
142 | K2=1 | |
143 | DO 1180 K1=I,74 | |
144 | B1(K1:K1)=B3(K2:K2) | |
145 | K2=K2+1 | |
146 | 1180 CONTINUE | |
147 | C | |
148 | C FIND END OF SUBSTITUTE STRING IN B1: | |
149 | C | |
150 | DO 1200 J=74,1,-1 | |
151 | C !ELIM TRAILING BLANKS. | |
152 | IF(B1(J:J).NE.' ') GO TO 1300 | |
153 | 1200 CONTINUE | |
154 | C | |
155 | C PUT TAIL END OF B1 (NOW IN B2) BACK INTO B1 AFTER SUBSTITUTE STRING: | |
156 | C | |
157 | 1300 K1=1 | |
158 | C !FROM | |
159 | DO 1400 K2=J+1,74 | |
160 | C !COPY REST OF B1 BACK. | |
161 | B1(K2:K2)=B2(K1:K1) | |
162 | K1=K1+1 | |
163 | 1400 CONTINUE | |
164 | C | |
165 | Y=Z | |
166 | C !SET UP FOR NEXT | |
167 | Z=0 | |
168 | C !SUBSTITUTION AND | |
169 | GO TO 200 | |
170 | C !RECHECK LINE. | |
171 | #endif PDP | |
172 | C | |
173 | END | |
174 | C OBJACT-- APPLY OBJECTS FROM PARSE VECTOR | |
175 | C | |
176 | C DECLARATIONS | |
177 | C | |
178 | LOGICAL FUNCTION OBJACT(X) | |
179 | IMPLICIT INTEGER (A-Z) | |
180 | LOGICAL OAPPLI | |
181 | #include "parser.h" | |
182 | #include "objects.h" | |
183 | C | |
184 | OBJACT=.TRUE. | |
185 | C !ASSUME WINS. | |
186 | IF(PRSI.EQ.0) GO TO 100 | |
187 | C !IND OBJECT? | |
188 | IF(OAPPLI(OACTIO(PRSI),0)) RETURN | |
189 | C !YES, LET IT HANDLE. | |
190 | C | |
191 | 100 IF(PRSO.EQ.0) GO TO 200 | |
192 | C !DIR OBJECT? | |
193 | IF(OAPPLI(OACTIO(PRSO),0)) RETURN | |
194 | C !YES, LET IT HANDLE. | |
195 | C | |
196 | 200 OBJACT=.FALSE. | |
197 | C !LOSES. | |
198 | RETURN | |
199 | END | |
200 | #ifndef PDP | |
201 | C BUG-- REPORT FATAL SYSTEM ERROR | |
202 | C | |
203 | C CALLED BY-- | |
204 | C | |
205 | C CALL BUG(NO,PAR) | |
206 | C | |
207 | SUBROUTINE BUG(A,B) | |
208 | IMPLICIT INTEGER(A-Z) | |
209 | #include "debug.h" | |
210 | C | |
211 | PRINT 100,A,B | |
212 | IF(DBGFLG.NE.0) RETURN | |
213 | CALL EXIT | |
214 | C | |
215 | #ifdef NOCC | |
216 | 100 FORMAT('PROGRAM ERROR ',I2,', PARAMETER=',I6) | |
217 | #else NOCC | |
218 | 100 FORMAT(' PROGRAM ERROR ',I2,', PARAMETER=',I6) | |
219 | #endif NOCC | |
220 | END | |
221 | #endif PDP | |
222 | C NEWSTA-- SET NEW STATUS FOR OBJECT | |
223 | C | |
224 | C CALLED BY-- | |
225 | C | |
226 | C CALL NEWSTA(OBJECT,STRING,NEWROOM,NEWCON,NEWADV) | |
227 | C | |
228 | SUBROUTINE NEWSTA(O,R,RM,CN,AD) | |
229 | IMPLICIT INTEGER(A-Z) | |
230 | #include "objects.h" | |
231 | C | |
232 | CALL RSPEAK(R) | |
233 | OROOM(O)=RM | |
234 | OCAN(O)=CN | |
235 | OADV(O)=AD | |
236 | RETURN | |
237 | END | |
238 | C QHERE-- TEST FOR OBJECT IN ROOM | |
239 | C | |
240 | C DECLARATIONS | |
241 | C | |
242 | LOGICAL FUNCTION QHERE(OBJ,RM) | |
243 | IMPLICIT INTEGER (A-Z) | |
244 | #include "objects.h" | |
245 | C | |
246 | QHERE=.TRUE. | |
247 | IF(OROOM(OBJ).EQ.RM) RETURN | |
248 | C !IN ROOM? | |
249 | DO 100 I=1,R2LNT | |
250 | C !NO, SCH ROOM2. | |
251 | IF((OROOM2(I).EQ.OBJ).AND.(RROOM2(I).EQ.RM)) RETURN | |
252 | 100 CONTINUE | |
253 | QHERE=.FALSE. | |
254 | C !NOT PRESENT. | |
255 | RETURN | |
256 | END | |
257 | C QEMPTY-- TEST FOR OBJECT EMPTY | |
258 | C | |
259 | C DECLARATIONS | |
260 | C | |
261 | LOGICAL FUNCTION QEMPTY(OBJ) | |
262 | IMPLICIT INTEGER (A-Z) | |
263 | #include "objects.h" | |
264 | C | |
265 | QEMPTY=.FALSE. | |
266 | C !ASSUME LOSE. | |
267 | DO 100 I=1,OLNT | |
268 | IF(OCAN(I).EQ.OBJ) RETURN | |
269 | C !INSIDE TARGET? | |
270 | 100 CONTINUE | |
271 | QEMPTY=.TRUE. | |
272 | RETURN | |
273 | END | |
274 | C JIGSUP- YOU ARE DEAD | |
275 | C | |
276 | C DECLARATIONS | |
277 | C | |
278 | SUBROUTINE JIGSUP(DESC) | |
279 | IMPLICIT INTEGER (A-Z) | |
280 | LOGICAL YESNO,MOVETO,QHERE,F | |
281 | INTEGER RLIST(9) | |
282 | #include "parser.h" | |
283 | #include "gamestate.h" | |
284 | #include "state.h" | |
285 | #include "io.h" | |
286 | #include "debug.h" | |
287 | #include "rooms.h" | |
288 | #include "rflag.h" | |
289 | #include "rindex.h" | |
290 | #include "objects.h" | |
291 | #include "oflags.h" | |
292 | #include "oindex.h" | |
293 | #include "advers.h" | |
294 | #include "flags.h" | |
295 | C | |
296 | C FUNCTIONS AND DATA | |
297 | C | |
298 | DATA RLIST/8,6,36,35,34,4,34,6,5/ | |
299 | C JIGSUP, PAGE 2 | |
300 | C | |
301 | CALL RSPEAK(DESC) | |
302 | C !DESCRIBE SAD STATE. | |
303 | PRSCON=1 | |
304 | C !STOP PARSER. | |
305 | IF(DBGFLG.NE.0) RETURN | |
306 | C !IF DBG, EXIT. | |
307 | AVEHIC(WINNER)=0 | |
308 | C !GET RID OF VEHICLE. | |
309 | IF(WINNER.EQ.PLAYER) GO TO 100 | |
310 | C !HIMSELF? | |
311 | CALL RSPSUB(432,ODESC2(AOBJ(WINNER))) | |
312 | C !NO, SAY WHO DIED. | |
313 | CALL NEWSTA(AOBJ(WINNER),0,0,0,0) | |
314 | C !SEND TO HYPER SPACE. | |
315 | RETURN | |
316 | C | |
317 | 100 IF(ENDGMF) GO TO 900 | |
318 | C !NO RECOVERY IN END GAME. | |
319 | IF(DEATHS.GE.2) GO TO 1000 | |
320 | C !DEAD TWICE? KICK HIM OFF. | |
321 | IF(.NOT.YESNO(10,9,8)) GO TO 1100 | |
322 | C !CONTINUE? | |
323 | C | |
324 | DO 50 J=1,OLNT | |
325 | C !TURN OFF FIGHTING. | |
326 | IF(QHERE(J,HERE)) OFLAG2(J)=and(OFLAG2(J),not(FITEBT)) | |
327 | 50 CONTINUE | |
328 | C | |
329 | DEATHS=DEATHS+1 | |
330 | CALL SCRUPD(-10) | |
331 | C !CHARGE TEN POINTS. | |
332 | F=MOVETO(FORE1,WINNER) | |
333 | C !REPOSITION HIM. | |
334 | EGYPTF=.TRUE. | |
335 | C !RESTORE COFFIN. | |
336 | IF(OADV(COFFI).EQ.WINNER) CALL NEWSTA(COFFI,0,EGYPT,0,0) | |
337 | OFLAG2(DOOR)=and(OFLAG2(DOOR),not(TCHBT)) | |
338 | OFLAG1(ROBOT)=and(or(OFLAG1(ROBOT),VISIBT),not(NDSCBT)) | |
339 | IF((OROOM(LAMP).NE.0).OR.(OADV(LAMP).EQ.WINNER)) | |
340 | & CALL NEWSTA(LAMP,0,LROOM,0,0) | |
341 | C | |
342 | C NOW REDISTRIBUTE HIS VALUABLES AND OTHER BELONGINGS. | |
343 | C | |
344 | C THE LAMP HAS BEEN PLACED IN THE LIVING ROOM. | |
345 | C THE FIRST 8 NON-VALUABLES ARE PLACED IN LOCATIONS AROUND THE HOUSE. | |
346 | C HIS VALUABLES ARE PLACED AT THE END OF THE MAZE. | |
347 | C REMAINING NON-VALUABLES ARE PLACED AT THE END OF THE MAZE. | |
348 | C | |
349 | I=1 | |
350 | DO 200 J=1,OLNT | |
351 | C !LOOP THRU OBJECTS. | |
352 | IF((OADV(J).NE.WINNER).OR.(OTVAL(J).NE.0)) | |
353 | & GO TO 200 | |
354 | I=I+1 | |
355 | IF(I.GT.9) GO TO 400 | |
356 | C !MOVE TO RANDOM LOCATIONS. | |
357 | CALL NEWSTA(J,0,RLIST(I),0,0) | |
358 | 200 CONTINUE | |
359 | C | |
360 | 400 I=RLNT+1 | |
361 | C !NOW MOVE VALUABLES. | |
362 | NONOFL=RAIR+RWATER+RSACRD+REND | |
363 | C !DONT MOVE HERE. | |
364 | DO 300 J=1,OLNT | |
365 | IF((OADV(J).NE.WINNER).OR.(OTVAL(J).EQ.0)) | |
366 | & GO TO 300 | |
367 | 250 I=I-1 | |
368 | C !FIND NEXT ROOM. | |
369 | IF(and(RFLAG(I),NONOFL).NE.0) GO TO 250 | |
370 | CALL NEWSTA(J,0,I,0,0) | |
371 | C !YES, MOVE. | |
372 | 300 CONTINUE | |
373 | C | |
374 | DO 500 J=1,OLNT | |
375 | C !NOW GET RID OF REMAINDER. | |
376 | IF(OADV(J).NE.WINNER) GO TO 500 | |
377 | 450 I=I-1 | |
378 | C !FIND NEXT ROOM. | |
379 | IF(and(RFLAG(I),NONOFL).NE.0) GO TO 450 | |
380 | CALL NEWSTA(J,0,I,0,0) | |
381 | 500 CONTINUE | |
382 | RETURN | |
383 | C | |
384 | C CAN'T OR WON'T CONTINUE, CLEAN UP AND EXIT. | |
385 | C | |
386 | 900 CALL RSPEAK(625) | |
387 | C !IN ENDGAME, LOSE. | |
388 | GO TO 1100 | |
389 | C | |
390 | 1000 CALL RSPEAK(7) | |
391 | C !INVOLUNTARY EXIT. | |
392 | 1100 CALL SCORE(.FALSE.) | |
393 | C !TELL SCORE. | |
394 | #ifdef PDP | |
395 | C file closed in exit routine | |
396 | #else | |
397 | CLOSE(DBCH) | |
398 | #endif PDP | |
399 | CALL EXIT | |
400 | C | |
401 | END | |
402 | C OACTOR- GET ACTOR ASSOCIATED WITH OBJECT | |
403 | C | |
404 | C DECLARATIONS | |
405 | C | |
406 | INTEGER FUNCTION OACTOR(OBJ) | |
407 | IMPLICIT INTEGER(A-Z) | |
408 | #include "advers.h" | |
409 | C | |
410 | DO 100 I=1,ALNT | |
411 | C !LOOP THRU ACTORS. | |
412 | OACTOR=I | |
413 | C !ASSUME FOUND. | |
414 | IF(AOBJ(I).EQ.OBJ) RETURN | |
415 | C !FOUND IT? | |
416 | 100 CONTINUE | |
417 | CALL BUG(40,OBJ) | |
418 | C !NO, DIE. | |
419 | RETURN | |
420 | END | |
421 | C PROB- COMPUTE PROBABILITY | |
422 | C | |
423 | C DECLARATIONS | |
424 | C | |
425 | LOGICAL FUNCTION PROB(G,B) | |
426 | IMPLICIT INTEGER(A-Z) | |
427 | #include "flags.h" | |
428 | C | |
429 | I=G | |
430 | C !ASSUME GOOD LUCK. | |
431 | IF(BADLKF) I=B | |
432 | C !IF BAD, TOO BAD. | |
433 | PROB=RND(100).LT.I | |
434 | C !COMPUTE. | |
435 | RETURN | |
436 | END | |
437 | C RMDESC-- PRINT ROOM DESCRIPTION | |
438 | C | |
439 | C RMDESC PRINTS A DESCRIPTION OF THE CURRENT ROOM. | |
440 | C IT IS ALSO THE PROCESSOR FOR VERBS 'LOOK' AND 'EXAMINE'. | |
441 | C | |
442 | LOGICAL FUNCTION RMDESC(FULL) | |
443 | C | |
444 | C FULL= 0/1/2/3= SHORT/OBJ/ROOM/FULL | |
445 | C | |
446 | C DECLARATIONS | |
447 | C | |
448 | IMPLICIT INTEGER (A-Z) | |
449 | LOGICAL LIT,RAPPLI | |
450 | C LOGICAL PROB | |
451 | #include "parser.h" | |
452 | #include "gamestate.h" | |
453 | #include "screen.h" | |
454 | #include "rooms.h" | |
455 | #include "rflag.h" | |
456 | #include "xsrch.h" | |
457 | #include "objects.h" | |
458 | #include "advers.h" | |
459 | #include "verbs.h" | |
460 | #include "flags.h" | |
461 | C RMDESC, PAGE 2 | |
462 | C | |
463 | RMDESC=.TRUE. | |
464 | C !ASSUME WINS. | |
465 | IF(PRSO.LT.XMIN) GO TO 50 | |
466 | C !IF DIRECTION, | |
467 | FROMDR=PRSO | |
468 | C !SAVE AND | |
469 | PRSO=0 | |
470 | C !CLEAR. | |
471 | 50 IF(HERE.EQ.AROOM(PLAYER)) GO TO 100 | |
472 | C !PLAYER JUST MOVE? | |
473 | CALL RSPEAK(2) | |
474 | C !NO, JUST SAY DONE. | |
475 | PRSA=WALKIW | |
476 | C !SET UP WALK IN ACTION. | |
477 | RETURN | |
478 | C | |
479 | 100 IF(LIT(HERE)) GO TO 300 | |
480 | C !LIT? | |
481 | CALL RSPEAK(430) | |
482 | C !WARN OF GRUE. | |
483 | RMDESC=.FALSE. | |
484 | RETURN | |
485 | C | |
486 | 300 RA=RACTIO(HERE) | |
487 | C !GET ROOM ACTION. | |
488 | IF(FULL.EQ.1) GO TO 600 | |
489 | C !OBJ ONLY? | |
490 | I=RDESC2-HERE | |
491 | C !ASSUME SHORT DESC. | |
492 | IF((FULL.EQ.0) | |
493 | & .AND.(SUPERF.OR.(((and(RFLAG(HERE),RSEEN)).NE.0) | |
494 | C | |
495 | C The next line means that when you request VERBOSE mode, you | |
496 | C only get long room descriptions 20% of the time. I don't either | |
497 | C like or understand this, so the mod. ensures VERBOSE works | |
498 | C all the time. jmh@ukc.ac.uk 22/10/87 | |
499 | C | |
500 | C& .AND.(BRIEFF.OR.PROB(80,80))))) GO TO 400 | |
501 | & .AND.BRIEFF))) GO TO 400 | |
502 | I=RDESC1(HERE) | |
503 | C !USE LONG. | |
504 | IF((I.NE.0).OR.(RA.EQ.0)) GO TO 400 | |
505 | C !IF GOT DESC, SKIP. | |
506 | PRSA=LOOKW | |
507 | C !PRETEND LOOK AROUND. | |
508 | IF(.NOT.RAPPLI(RA)) GO TO 100 | |
509 | C !ROOM HANDLES, NEW DESC? | |
510 | PRSA=FOOW | |
511 | C !NOP PARSER. | |
512 | GO TO 500 | |
513 | C | |
514 | 400 CALL RSPEAK(I) | |
515 | C !OUTPUT DESCRIPTION. | |
516 | 500 IF(AVEHIC(WINNER).NE.0) CALL RSPSUB(431,ODESC2(AVEHIC(WINNER))) | |
517 | C | |
518 | 600 IF(FULL.NE.2) CALL PRINCR(FULL.NE.0,HERE) | |
519 | RFLAG(HERE)=or(RFLAG(HERE),RSEEN) | |
520 | IF((FULL.NE.0).OR.(RA.EQ.0)) RETURN | |
521 | C !ANYTHING MORE? | |
522 | PRSA=WALKIW | |
523 | C !GIVE HIM A SURPISE. | |
524 | IF(.NOT.RAPPLI(RA)) GO TO 100 | |
525 | C !ROOM HANDLES, NEW DESC? | |
526 | PRSA=FOOW | |
527 | RETURN | |
528 | C | |
529 | END | |
530 | C RAPPLI- ROUTING ROUTINE FOR ROOM APPLICABLES | |
531 | C | |
532 | C DECLARATIONS | |
533 | C | |
534 | LOGICAL FUNCTION RAPPLI(RI) | |
535 | IMPLICIT INTEGER(A-Z) | |
536 | LOGICAL RAPPL1,RAPPL2 | |
537 | DATA NEWRMS/38/ | |
538 | C | |
539 | RAPPLI=.TRUE. | |
540 | C !ASSUME WINS. | |
541 | IF(RI.EQ.0) RETURN | |
542 | C !IF ZERO, WIN. | |
543 | IF(RI.LT.NEWRMS) RAPPLI=RAPPL1(RI) | |
544 | C !IF OLD, PROCESSOR 1. | |
545 | IF(RI.GE.NEWRMS) RAPPLI=RAPPL2(RI) | |
546 | C !IF NEW, PROCESSOR 2. | |
547 | RETURN | |
548 | END |