Trailing-Edge
-
PDP-10 Archives
-
decus_20tap5_198111
-
decus/20-0141/daturn.for
There are 2 other files named daturn.for in the archive. Click here to see a list.
00100 SUBROUTINE DATURN(INTRVL,MOVE ,ISPACE,LTTR ,LTRBGN,
00200 1 LTREND,LFTCOL,MAXBFR,IBUFFR,MAXUSD,MAGNFY,INISTR,
00300 2 MAXSTR,KIND ,ISTORE)
00400 C RENBR(/CONSTRUCT LARGE LETTERING TURNED 90 DEGREES)
00500 C
00600 C DONALD BARTH, HARVARD BUSINESS SCHOOL
00700 C
00800 C ROUTINE TO PRODUCE LARGE LETTERING EXTENDING ACROSS
00900 C FANFOLDS. EACH CALL TO DATURN CONSTRUCTS A SINGLE
01000 C LINE IN THE REPRESENTATION OF A SINGLE CHARACTER.
01100 C DATURN SIGNALS TO THE CALLING PROGRAM WHEN THE FINAL
01200 C CHARACTER HAS BEEN COMPLETELY REPRESENTATED. THIS
01300 C ROUTINE MUST BE USED WITH A BLOCK DATA FONT CREATED
01400 C BY THE PROGRAM DAFONT.
01500 C
01600 C INTRVL, MOVE, ISPACE, LTTR, LTRBGN, LTREND, LFTCOL,
01700 C MAXBFR, MAGNFY, INISTR AND MAXSTR ARE USED ONLY FOR
01800 C INPUT AND ARE RETURNED UNCHANGED. KIND AND ISTORE
01900 C ARE USED BOTH FOR INPUT AND FOR RETURNING INFORMATION
02000 C TO CALLING PROGRAM AND TO SUBSEQUENT CALLS TO THIS
02100 C ROUTINE. IBUFFR AND MAXUSD ARE USED ONLY FOR OUTPUT.
02200 C
02300 C INTRVL = NUMBER OF BLANK LINES TO BE INSERTED BETWEEN
02400 C REPRESENTED CHARACTERS
02500 C MOVE = -2, CHARACTERS WHICH ARE NARROWER THAN THE
02600 C WIDEST CHARACTER ARE CENTERED WITHIN WIDTH
02700 C OF WIDEST CHARACTER. NO WHITE SPACE ADJUST-
02800 C MENT OF POSITIONS IS TO BE MADE. SPACES
02900 C WILL ALSO BE WIDTH OF WIDEST CHARACTER.
03000 C = -1, CHARACTERS WHICH ARE NARROWER THAN MOST
03100 C COMMON WIDTH WILL BE CENTERED WITHIN MOST
03200 C COMMON WIDTH. NO WHITE SPACE ADJUSTMENT OF
03300 C POSITIONS IS TO BE MADE. SPACES WILL ALSO
03400 C BE WIDTH WHICH IS MOST COMMON.
03500 C = 0, NORMAL INTER-CHARACTER SPACING IS ACCEPT-
03600 C ABLE WITHOUT WHITE SPACE ADJUSTMENT.
03700 C = 1, ADJUST SPACE BETWEEN CHARACTERS TO EQUAL-
03800 C IZE WHITE SPACES.
03900 C ISPACE = -1 OR 0, REPRESENT INITIAL SPACES IN LTTR
04000 C ARRAY. SUPPRESS FINAL SPACES IN LTTR ARRAY.
04100 C = 1, SUPPRESS BOTH INITIAL AND FINAL SPACES IN
04200 C LTTR ARRAY.
04300 C LTTR = ARRAY CONTAINING LETTERS TO BE REPRESENTED,
04400 C 1 LETTER PER WORD, AS READ BY MULTIPLE OF A1
04500 C FORMAT. SINCE LETTERING PRODUCED BY THIS
04600 C ROUTINE IS LARGE, TERMINAL SPACES ARE
04700 C IGNORED BUT BLANK LINES WILL BE GENERATED IF
04800 C DATURN IS CALLED TO CONTINUE THE LETTERING
04900 C REPRESENTATION ONCE ALL PRINTING CHARACTERS
05000 C IN LTTR HAVE BEEN REPRESENTED.
05100 C LTRBGN = SEQUENCE NUMBER WITHIN LTTR ARRAY OF FIRST
05200 C LETTER TO BE REPRESENTED (THIS IS THE
05300 C SUBSCRIPT OF LTTR ARRAY AT WHICH THE FIRST
05400 C LETTER IS TO BE FOUND)
05500 C LTREND = SEQUENCE NUMBER WITHIN LTTR ARRAY OF FINAL
05600 C LETTER TO BE REPRESENTED (THIS IS THE
05700 C SUBSCRIPT OF LTTR ARRAY AT WHICH THE FINAL
05800 C LETTER IS TO BE FOUND)
05900 C LFTCOL = SUBSCRIPT OF OUTPUT BUFFER ARRAY LOCATION TO
06000 C LEFT OF 1ST LOCATION INTO WHICH THIS ROUTINE
06100 C CAN PLACE REPRESENTATION OF CONTENTS OF LTTR
06200 C ARRAY.
06300 C MAXBFR = MAXIMUM SUBSCRIPT OF IBUFFR ARRAY LOCATION
06400 C INTO WHICH CAN BE PLACED REPRESENTATION OF
06500 C CONTENTS OF LTTR ARRAY.
06600 C IBUFFR = ARRAY INTO WHICH IS TO BE PLACED THE
06700 C REPRESENTATION OF LETTERS IN LTTR.
06800 C MAXUSD = RETURNED BY DATURN CONTAINING NEW NUMBER OF
06900 C LOCATIONS IN USE AFTER NEXT SECTION OF
07000 C CHARACTER IN LTTR ARRAY HAS BEEN
07100 C REPRESENTED.
07200 C MAGNFY = INPUT CONTAINING MAGNIFICATION FACTOR WHICH
07300 C IS APPLIED TO HEIGHT OF LETTERING. IF
07400 C MAGNFY HAS VALUE 2, THEN EACH CHARACTER
07500 C WHICH WOULD BE GENERATED TO FORM SHAPE IS
07600 C REPEATED TWICE. SINCE FONTS ARE DESIGNED
07700 C FOR 6 LINES PER INCH AND 10 CHARACTERS PER
07800 C INCH FORMAT, LETTERING, WHEN TURNED 90
07900 C DEGREES, WILL APPEAR EXTREMELY ELONGATED
08000 C UNLESS HEIGHT IS MAGNIFIED. MAGNFY VALUE OF
08100 C 3 WOULD PRODUCE APPROXIMATELY NORMALLY
08200 C PROPORTIONED LETTERING. IF EACH LINE
08300 C RETURNED BY DATURN IS PRINTED TWICE, THEN
08400 C EXTREMELY LARGE LETTERING CAN BE PRODUCED BY
08500 C SETTING MAGNFY TO 5. IT IS OF COURSE
08600 C NECESSARY THAT IBUFFR ARRAY BE LARGE ENOUGH
08700 C TO CONTAIN MAGNIFIED IMAGE OF LETTERING.
08800 C INISTR = INPUT CONTAINING SUBSCRIPT OF FIRST LOCATION
08900 C IN ISTORE ARRAY WHICH CAN BE USED TO
09000 C TRANSFER INFORMATION ABOUT CURRENT STATE OF
09100 C LETTERING PROCESS TO SUBSEQUENT CALL OF THIS
09200 C ROUTINE WHICH IS TO CONTINUE REPRESENTATION
09300 C OF SAME LINE OF TEXT.
09400 C MAXSTR = INPUT CONTAINING SUBSCRIPT OF FINAL LOCATION
09500 C IN ISTORE ARRAY WHICH CAN BE USED TO
09600 C TRANSFER INFORMATION ABOUT CURRENT STATE OF
09700 C LETTERING PROCESS TO SUBSEQUENT CALL OF THIS
09800 C ROUTINE WHICH IS TO CONTINUE REPRESENTATION
09900 C OF SAME LINE OF TEXT. AT LEAST 18 LOCATIONS
10000 C IN ISTORE ARRAY ARE NEEDED FOR THIS PURPOSE,
10100 C BUT IT IS REQUESTED THAT AT LEAST 24
10200 C LOCATIONS BE RESERVED TO ALLOW FOR FUTURE
10300 C ENHANCEMENT OF ROUTINE.
10400 C KIND = MUST BE INPUT CONTAINING ZERO WHEN THIS
10500 C ROUTINE IS FIRST CALLED TO REPRESENT
10600 C PARTICULAR LINE OF TEXT. THEREAFTER, VALUE
10700 C OF KIND RETURNED BY THIS ROUTINE SHOULD BE
10800 C SUPPLIED TO SUBSEQUENT CALL WHICH IS
10900 C CONTINUING REPRESENTATION OF SAME LINE OF
11000 C TEXT. KIND IS RETURNED CONTAINING ONE OF
11100 C FOLLOWING VALUES.
11200 C = 1, RETURNED IF LINE OF TEXT HAS BEEN
11300 C COMPLETELY REPRESENTED. IBUFFR(LFTCOL+1)
11400 C THROUGH AND INCLUDING IBUFFR(MAXUSD) IS
11500 C RETURNED CONTAINING SPACES. THIS PORTION OF
11600 C IBUFFR ARRAY WILL AGAIN BE RETURNED
11700 C CONTAINING SPACES IF DATURN IS SUBSEQUENTLY
11800 C CALLED WITH VALUE OF KIND BEING UNCHANGED.
11900 C = 2, RETURNED IF IBUFFR(LFTCOL+1) THROUGH AND
12000 C INCLUDING IBUFFR(MAXUSD) IS RETURNED
12100 C CONTAINING PORTION OF REPRESENTATION OF
12200 C SINGLE CHARACTER.
12300 C = 3, RETURNED IF AVAILABLE PORTION OF IBUFFR
12400 C ARRAY WAS INSUFFICIENT TO CONTAIN
12500 C REPRESENTATION OF LETTERING. MAXBFR-LFTCOL
12600 C IS LESS THAN MAGNFY TIMES CHARACTER HEIGHT.
12700 C = 4, RETURNED IF AVAILABLE PORTION OF ISTORE
12800 C ARRAY WAS INSUFFICIENT TO CONTAIN
12900 C DESCRIPTION OF CURRENT STATE OF LETTERING
13000 C PROCESS FOR TRANSFER TO SUBSEQUENT CALL TO
13100 C THIS ROUTINE WHICH IS TO CONTINUE LETTERING
13200 C OF SAME LINE OF TEXT.
13300 C = 5, RETURNED IF FONT WAS NOT LOADED.
13400 C ISTORE = ARRAY USED TO TRANSFER DESCRIPTION OF
13500 C CURRENT STATE OF LETTERING PROCESS TO
13600 C SUBSEQUENT CALL OF THIS ROUTINE WHICH IS TO
13700 C CONTINUE REPRESENTATION OF SAME LINE OF
13800 C TEXT. THE ORIGINAL CONTENTS OF ISTORE ARRAY
13900 C ARE IGNORED AND ARE DESTROYED.
14000 C
14100 COMMON/FASPG/KNTLTR,IHIGH,IWIDE,JWIDE,LOCK,
14200 1LETTER(96),LENGTH(96),IPACKD(1020)
14300 C
14400 DIMENSION LTTR(LTREND),IBUFFR(MAXBFR),ISTORE(MAXSTR),
14500 1IDIGIT(10)
14600 DATA IDIGIT/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/
14700 DATA KOMAND,IVRTCL,IHRZNT,IEQUAL,IEND,IUPPER,
14800 1LOWER,NARROW,IFIXED,IADJST,NWIDE,IBLANK/
14900 21H$,1HV,1HH,1H=,1HE,1HU,1HL,1HN,1HF,1HA,1HW,1H /
15000 C
15100 MAXUSD=LFTCOL
15200 IF(LOCK.NE.999)GO TO 56
15300 IF((MAXSTR-INISTR).LT.17)GO TO 55
15400 MULTPL=MAGNFY
15500 IF(MULTPL.LE.0)MULTPL=1
15600 IF((LFTCOL+(MULTPL*IHIGH)).GT.MAXBFR)GO TO 54
15700 JSPACE=INTRVL
15800 IF(JSPACE.LT.0)JSPACE=0
15900 KWIDE=IWIDE
16000 IF(MOVE.LE.-2)KWIDE=JWIDE
16100 IF(KIND.GT.0)GO TO 44
16200 KIND=2
16300 LTRNXT=LTRBGN
16400 IWHITE=MOVE
16500 LAST=0
16600 KSPACE=0
16700 NEED=0
16800 IFCASE=1
16900 NOWVRT=1
17000 NOWHRZ=1
17100 KASATO=0
17200 LWIDE=KWIDE
17300 NOWTST=0
17400 GO TO 3
17500 C
17600 C FIND OUT IF CAN REPRESENT THE LETTER
17700 1 KSPACE=JSPACE+NEED
17800 NEED=0
17900 LAST=MATCH
18000 LSTVRT=NOWVRT
18100 LSTHRZ=NOWHRZ
18200 LSTLNG=NOWLNG
18300 2 LTRNXT=LTRNXT+1
18400 3 IF(LTRNXT.GT.LTREND)GO TO 50
18500 NOWLTR=LTTR(LTRNXT)
18600 IF(NOWLTR.EQ.IBLANK)GO TO 7
18700 IF(NOWLTR.EQ.KOMAND)GO TO 10
18800 4 MATCH=0
18900 KNTKAS=0
19000 5 MATCH=MATCH+1
19100 IF(MATCH.GT.KNTLTR)GO TO 6
19200 IF(NOWLTR.NE.LETTER(MATCH))GO TO 5
19300 KNTKAS=KNTKAS+1
19400 IF(KNTKAS.GE.IFCASE)GO TO 23
19500 LSTKAS=MATCH
19600 GO TO 5
19700 6 IF(KNTKAS.GT.0)GO TO 22
19800 GO TO 8
19900 C
20000 C REPRESENT SPACE OR UNKNOWN CHARACTER
20100 7 IF(KASATO.GE.0)GO TO 8
20200 KASATO=-KASATO
20300 IFCASE=KASATO-IFCASE
20400 8 IF(ISPACE.LE.0)GO TO 9
20500 IF(LAST.EQ.0)GO TO 2
20600 9 KSPACE=KSPACE+LWIDE
20700 IF(IWHITE.LE.0)KSPACE=KSPACE+JSPACE
20800 GO TO 2
20900 C
21000 C DOLLAR CONTROL CHARACTER FOUND
21100 10 LTRNXT=LTRNXT+1
21200 IF(LTRNXT.GT.LTREND)GO TO 57
21300 NOWLTR=LTTR(LTRNXT)
21400 IF(NOWLTR.EQ.KOMAND)GO TO 4
21500 IF(NOWLTR.EQ.IVRTCL)GO TO 13
21600 IF(NOWLTR.EQ.IHRZNT)GO TO 14
21700 IF(NOWLTR.EQ.IEQUAL)GO TO 12
21800 IF(NOWLTR.EQ.IFIXED)GO TO 15
21900 IF(NOWLTR.EQ.IADJST)GO TO 16
22000 IF(NOWLTR.EQ.NARROW)GO TO 17
22100 IF(NOWLTR.EQ.NWIDE)GO TO 18
22200 IF(NOWLTR.EQ.IEND)GO TO 19
22300 IF(NOWLTR.EQ.IUPPER)GO TO 20
22400 IF(NOWLTR.EQ.LOWER)GO TO 21
22500 DO 11 I=2,10
22600 IF(NOWLTR.NE.IDIGIT(I))GO TO 11
22700 IFCASE=I-1
22800 KASATO=0
22900 GO TO 2
23000 11 CONTINUE
23100 GO TO 2
23200 12 NOWVRT=1
23300 NOWHRZ=1
23400 IFCASE=1
23500 KASATO=0
23600 LWIDE=KWIDE
23700 IWHITE=MOVE
23800 GO TO 2
23900 13 NOWVRT=-1
24000 GO TO 2
24100 14 NOWHRZ=-1
24200 GO TO 2
24300 15 IF(IWHITE.GT.0)IWHITE=0
24400 GO TO 2
24500 16 IF(IWHITE.EQ.0)IWHITE=1
24600 GO TO 2
24700 17 LWIDE=KWIDE/2
24800 GO TO 2
24900 18 LWIDE=(3*KWIDE)/2
25000 GO TO 2
25100 19 IF(KASATO.LT.0)IFCASE=-KASATO-IFCASE
25200 KASATO=0
25300 GO TO 2
25400 20 IF(KASATO.EQ.0)KASATO=(4*((IFCASE+1)/2))-1
25500 IF(KASATO.GT.0)GO TO 2
25600 KASATO=-KASATO
25700 IFCASE=KASATO-IFCASE
25800 GO TO 2
25900 21 IF(KASATO.LT.0)GO TO 2
26000 IF(KASATO.EQ.0)KASATO=(4*((IFCASE+1)/2))-1
26100 IFCASE=KASATO-IFCASE
26200 KASATO=-KASATO
26300 GO TO 2
26400 C
26500 C PREPARE TO PLOT CHARACTER
26600 22 MATCH=LSTKAS
26700 23 IF(KASATO.LE.0)GO TO 24
26800 IFCASE=KASATO-IFCASE
26900 KASATO=-KASATO
27000 24 NOWLNG=LENGTH(MATCH)
27100 LSTTST=NOWTST
27200 NOWTST=2**(NOWLNG-1)
27300 C
27400 C DETERMINE OPTIMUM SPACING
27500 C
27600 C SKIP AROUND THIS CODE IF NORMAL
27700 C INTER-CHARACTER SPACING IS ACCEPTABLE
27800 C WITHOUT WHITE AREA ADJUSTMENT.
27900 C THE CALCULATIONS ARE DESIGNED TO PRODUCE
28000 C DISTANCES OF THE SORT
28100 C
28200 C 4
28300 C 34
28400 C 234
28500 C 1234
28600 C 01234
28700 C X01234
28800 C 01234
28900 C 1234
29000 C 234
29100 C 34
29200 C 4
29300 C
29400 C THE FIRST LOOP CATCHES THE MOST COMMON CASE OF
29500 C 2 CHARACTERS TOUCHING ON THE SAME LINE. THE
29600 C SECOND LONGER LOOP CATCHES THIS CASE AND ALL
29700 C OTHERS AND COULD BE USED BY ITSELF.
29800 IF(IWHITE.LT.0)GO TO 43
29900 IF(JSPACE.EQ.0)GO TO 45
30000 IF(LAST.EQ.0)GO TO 45
30100 IF(IWHITE.EQ.0)GO TO 45
30200 MIN=JSPACE
30300 ISTART=IHIGH*(LAST-1)
30400 JSTART=IHIGH*(MATCH-1)
30500 IF(LSTVRT.EQ.NOWVRT)GO TO 25
30600 LSTVRT=-1
30700 ISTART=ISTART+IHIGH+1
30800 GO TO 26
30900 25 LSTVRT=1
31000 26 IINDEX=ISTART
31100 JINDEX=JSTART
31200 DO 30 I=1,IHIGH
31300 IINDEX=IINDEX+LSTVRT
31400 JINDEX=JINDEX+1
31500 K=IPACKD(IINDEX)
31600 IF(LSTHRZ.LT.0)GO TO 27
31700 IF(K.EQ.(2*(K/2)))GO TO 30
31800 GO TO 28
31900 27 IF(K.LT.LSTTST)GO TO 30
32000 28 K=IPACKD(JINDEX)
32100 IF(NOWHRZ.GT.0)GO TO 29
32200 IF(K.EQ.(2*(K/2)))GO TO 30
32300 GO TO 45
32400 29 IF(K.GE.NOWTST)GO TO 45
32500 30 CONTINUE
32600 DO 42 I=1,IHIGH
32700 ISTART=ISTART+LSTVRT
32800 K=IPACKD(ISTART)
32900 IF(K.EQ.0)GO TO 42
33000 IF(LSTHRZ.GT.0)GO TO 32
33100 IDIST=LSTLNG
33200 31 K=K/2
33300 IDIST=IDIST-1
33400 IF(K.NE.0)GO TO 31
33500 GO TO 34
33600 32 IDIST=0
33700 33 L=K/2
33800 IF((L+L).NE.K)GO TO 34
33900 K=L
34000 IDIST=IDIST+1
34100 GO TO 33
34200 34 N=JSTART
34300 DO 41 J=1,IHIGH
34400 N=N+1
34500 K=IPACKD(N)
34600 IF(K.EQ.0)GO TO 41
34700 IF(NOWHRZ.GT.0)GO TO 36
34800 JDIST=IDIST
34900 35 L=K/2
35000 IF((L+L).NE.K)GO TO 38
35100 K=L
35200 JDIST=JDIST+1
35300 GO TO 35
35400 36 JDIST=IDIST+NOWLNG
35500 37 K=K/2
35600 JDIST=JDIST-1
35700 IF(K.NE.0)GO TO 37
35800 38 IF(I.GT.J)GO TO 39
35900 IF(I.EQ.J)GO TO 40
36000 JDIST=JDIST+J-I-1
36100 GO TO 40
36200 39 JDIST=JDIST+I-J-1
36300 40 IF(MIN.LE.JDIST)GO TO 41
36400 IF(JDIST.LE.0)GO TO 45
36500 MIN=JDIST
36600 41 CONTINUE
36700 42 CONTINUE
36800 KSPACE=KSPACE-MIN
36900 GO TO 45
37000 C
37100 C ADJUST CENTERING OF NARROW CHARACTERS IF NEEDED
37200 43 IF(NOWLNG.GE.KWIDE)GO TO 45
37300 NEED=(KWIDE-NOWLNG)/2
37400 KSPACE=KSPACE+NEED
37500 NEED=KWIDE-NEED-NOWLNG
37600 GO TO 45
37700 C
37800 C SECOND OR SUBSEQUENT LINE
37900 44 IF(KIND.NE.2)GO TO 50
38000 IFCASE=ISTORE(INISTR)
38100 IWHITE=ISTORE(INISTR+1)
38200 KASATO=ISTORE(INISTR+2)
38300 KSPACE=ISTORE(INISTR+3)
38400 LAST =ISTORE(INISTR+4)
38500 LSTHRZ=ISTORE(INISTR+5)
38600 LSTKAS=ISTORE(INISTR+6)
38700 LSTLNG=ISTORE(INISTR+7)
38800 LSTTST=ISTORE(INISTR+8)
38900 LSTVRT=ISTORE(INISTR+9)
39000 LTRNXT=ISTORE(INISTR+10)
39100 LWIDE =ISTORE(INISTR+11)
39200 MATCH =ISTORE(INISTR+12)
39300 NEED =ISTORE(INISTR+13)
39400 NOWHRZ=ISTORE(INISTR+14)
39500 NOWLNG=ISTORE(INISTR+15)
39600 NOWTST=ISTORE(INISTR+16)
39700 NOWVRT=ISTORE(INISTR+17)
39800 IF(KSPACE.LE.0)GO TO 46
39900 KSPACE=KSPACE-1
40000 C
40100 C CONSTRUCT LETTER
40200 45 IF(KSPACE.GT.0)GO TO 51
40300 LSTTST=1
40400 IF(NOWHRZ.GT.0)LSTTST=NOWTST
40500 LSTLNG=NOWLNG
40600 46 IF(LSTLNG.LE.0)GO TO 1
40700 INITAL=IHIGH*(MATCH-1)
40800 IF(NOWVRT.GT.0)INITAL=INITAL+IHIGH+1
40900 NOWLTR=LTTR(LTRNXT)
41000 DO 48 I=1,IHIGH
41100 INITAL=INITAL-NOWVRT
41200 K=IPACKD(INITAL)/LSTTST
41300 K=K-(2*(K/2))
41400 DO 47 J=1,MULTPL
41500 MAXUSD=MAXUSD+1
41600 IBUFFR(MAXUSD)=IBLANK
41700 IF(K.NE.0)IBUFFR(MAXUSD)=NOWLTR
41800 47 CONTINUE
41900 48 CONTINUE
42000 LSTLNG=LSTLNG-1
42100 IF(NOWHRZ.LT.0)GO TO 49
42200 LSTTST=LSTTST/2
42300 GO TO 53
42400 49 LSTTST=2*LSTTST
42500 GO TO 53
42600 C
42700 C CONSTRUCT LINE OF BLANKS
42800 50 KIND=1
42900 51 I=LFTCOL+(MULTPL*IHIGH)
43000 52 MAXUSD=MAXUSD+1
43100 IBUFFR(MAXUSD)=IBLANK
43200 IF(MAXUSD.LT.I)GO TO 52
43300 IF(KIND.NE.2)GO TO 57
43400 C
43500 C STORE VARIABLES NEEDED TO PRODUCE NEXT LINE
43600 53 ISTORE(INISTR)=IFCASE
43700 ISTORE(INISTR+1)=IWHITE
43800 ISTORE(INISTR+2)=KASATO
43900 ISTORE(INISTR+3)=KSPACE
44000 ISTORE(INISTR+4)=LAST
44100 ISTORE(INISTR+5)=LSTHRZ
44200 ISTORE(INISTR+6)=LSTKAS
44300 ISTORE(INISTR+7)=LSTLNG
44400 ISTORE(INISTR+8)=LSTTST
44500 ISTORE(INISTR+9)=LSTVRT
44600 ISTORE(INISTR+10)=LTRNXT
44700 ISTORE(INISTR+11)=LWIDE
44800 ISTORE(INISTR+12)=MATCH
44900 ISTORE(INISTR+13)=NEED
45000 ISTORE(INISTR+14)=NOWHRZ
45100 ISTORE(INISTR+15)=NOWLNG
45200 ISTORE(INISTR+16)=NOWTST
45300 ISTORE(INISTR+17)=NOWVRT
45400 GO TO 57
45500 C
45600 C RETURN TO CALLING PROGRAM
45700 54 KIND=3
45800 GO TO 57
45900 55 KIND=4
46000 GO TO 57
46100 56 KIND=5
46200 57 RETURN
46300 C736047020160$
46400 END