Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-05 - 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