Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-02 - 43,50250/tbldbg.f4
There are no other files named tbldbg.f4 in the archive.
      SUBROUTINE TBLDBG
C
C     ROUTINE TO PROVIDE TBLTRN DEBUG FEATURES
C
C     DONALD BARTH, CHEM. DEPT., HARVARD UNIVERSITY
C
C     IDBG   = UNIT NUMBER ON WHICH TO PRINT OUTPUT
C
C     KODE   = NEGATIVE IS NEGATIVE OF LOCATION OF ID
C              OF SINGLE CELL ABOUT WHICH INFORMATION
C              IS TO BE PRINTED.
C     KODE   = 17 LISTS TBLTRN SYMBOL DICTIONARY
C     KODE   = 18 LISTS DICTIONARY AND TABLE STORAGE
C     KODE   = 19 LISTS TBLTRN TABLE STORAGE ONLY
C     KODE   = 20 LIST ENTRIES ASSEMBLED BY PRESENT
C              STATEMENT
C     KODE   = GREATER THAN 100 IS 100 PLUS NUMBER OF
C              TABLE ENTRY ABOUT WHICH INFORMATION IS TO
C              BE PRINTED.
C
C     MOST   = NUMBER OF ENTRIES IN TABLE STORAGE
C
C     MAX    = NUMBER OF LOCATIONS IN MASTER ARRAY
C
C     MASTER = STORAGE ARRAY FOR TABLE AND DICTIONARY
C
      COMMON/TBLTRN/I,IADDRS,IADJST,IBASE,IBLANK,IDGT(16),
     1IERR,IFILL,IFKNT,IKODE,ILEFT,ILINE,ILPT,ILTR,IBYTE,
     2IMASK,LMAX,NMORE,IMOST,INSERT,IOCT(13),IOPRTR,IOUT,
     3IPAREN,IPNCTN(11),IPRCN,IRADIX,IREAD,IREPT,IRIGHT,
     4ISHIFT,ISIGN,ISTAR,ISTORE(478),ITEN,ITEST,ITITLE(6),
     5ITTY,IWIDE,IWRITE,J,JADJST,JBASE,JBLANK,JERR,KPAREN,
     6JFKNT,JKODE(37),JLEFT,JMASK,JMORE,JPAREN,JRADIX,LOOP,
     7JRIGHT,JSHIFT,JSIGN,K,KADJST,KBASE,KERR,KIND,KLINE,
     8KLM,KLTR,KMASK,KNT,KNTLTR,KNTWRD,KODE,KRADIX,IDBG,
     9KREAD,KSHIFT,L,LEAST,LETTER(160),LMASK,LOCK,LSTNEW,
     1LTTR(160),M,MASK,MASTER(5000),MAX,MLEFT,MORE,MOST,
     2MRIGHT,MULT,N,NEW,NEXT,NSIGN,NTITLE(6),NUMBER,LRADIX,
     3KMAX,INLINE,JPNCTN(50),KPNCTN(50),LPNCTN,JOPRTR,NLTR,
     4JBYTE,ILOOP,ISKIP,IVALUE,INSN(6),JNSN,IMAX,JMAX,
     5KNSN,MLTR,JLTR,JLOOP,IPFX,JPFX,LSIGN,IIARG,JJARG,
     6KKARG,LLARG,JVALUE,MIN,IAC,IARG,JARG,KARG,LARG,JSTFY,
     7LENGTH(20),LNGMIN,IORDER,IRMV,KSIGN
      IF(IDBG.EQ.ITTY)JBLANK=1
      IF(KODE.GT.100)GO TO 60
      IF(KODE.LT.0)GO TO 2
      IF(KODE.EQ.20)GO TO 57
      IF(IDBG.NE.ITTY)WRITE(IDBG,1)
    1 FORMAT(14H1DEBUG LISTING/1X)
      IF(KODE.EQ.19)GO TO 59
C
C     ****************************
C     *  LIST SYMBOL DICTIONARY  *
C     ****************************
C
      LIMIT=MAX
      GO TO 4
    2 LIMIT=-KODE+1
      INDIC=LIMIT
      INDEX=LIMIT-3
      LIMIT=MASTER(LIMIT)
      KOUNT=LIMIT+1
      IF(INSERT.EQ.0)GO TO 5
      IF(IOPRTR.EQ.15)GO TO 53
      IF(IOPRTR.EQ.37)GO TO 53
      GO TO 5
    3 IF(KODE.LT.0)GO TO 109
    4 INDIC=LIMIT
      INDEX=LIMIT-3
      LIMIT=MASTER(LIMIT)
      IF(LIMIT.LE.0)GO TO 58
      KOUNT=LIMIT+1
      IF(MASTER(INDEX+2).LT.0)GO TO 3
    5 IF(MASTER(INDEX+2).EQ.0)GO TO 10
      IF(MASTER(INDEX+2).EQ.1)GO TO 87
      IF(MASTER(INDEX+2).GT.1000)GO TO 26
      IF(MASTER(INDEX+2).EQ.66)GO TO 25
      IF(MASTER(INDEX+2).EQ.29)GO TO 36
      IF(MASTER(INDEX+2).EQ.2)GO TO 12
      IF(MASTER(INDEX+2).EQ.8)GO TO 16
      IF(MASTER(INDEX+1).NE.0)GO TO 8
C
C     LIST OPERATOR WITHOUT NUMERIC VALUE
    6 WRITE(IDBG,7)INDIC,MASTER(INDEX+2),
     1(MASTER(I),I=KOUNT,INDEX)
    7 FORMAT(9H OPERATOR,1I6,4H OPR,1I3,32X,80A1)
      GO TO 3
C
C     LIST OPERATOR HAVING NUMERIC VALUE
    8 WRITE(IDBG,9)INDIC,MASTER(INDEX+2),
     1MASTER(INDEX+1),(MASTER(I),I=KOUNT,INDEX)
    9 FORMAT(9H OPERATOR,1I6,4H OPR,1I3,18X,1I13,1H ,80A1)
      GO TO 3
C
C     INDICATE VACANT CELL
   10 WRITE(IDBG,11)INDIC
   11 FORMAT(9H UNKNOWN ,1I6)
      GO TO 3
C
C     LIST KNOWN ADDRESS WHICH IS DUPLICATED
   12 J=-MASTER(INDEX+1)
      IF(J.LE.0)GO TO 14
      K=MASTER(J-1)
      L=MASTER(J-2)+1
      J=MASTER(J-3)
      WRITE(IDBG,13)INDIC,MASTER(INDEX+2),J,L,K,
     1(MASTER(I),I=KOUNT,INDEX)
   13 FORMAT(9H ADDRESS ,1I6,4H OPR,1I3,4X,7HENTRIES,
     11I3,4H DUP,1I3,4H LOC,1I6,1H ,80A1)
      GO TO 3
C
C     LIST KNOWN ADDRESS WITHOUT DUPLICATION COUNT
   14 WRITE(IDBG,15)INDIC,MASTER(INDEX+2),
     1MASTER(INDEX+1),(MASTER(I),I=KOUNT,INDEX)
   15 FORMAT(9H ADDRESS ,1I6,4H OPR,1I3,22X,3HLOC,
     11I6,1H ,80A1)
      GO TO 3
C
C     LIST TEXT STRING REPLACEMENT OPERATOR
   16 WRITE(IDBG,17)INDIC,MASTER(INDEX+2),
     1(MASTER(I),I=KOUNT,INDEX)
   17 FORMAT(9H TEXT    ,1I6,4H OPR,1I3,32X,80A1)
      J=-MASTER(INDEX+1)
      N=MASTER(J+1)
      IF(N.EQ.0)GO TO 3
      IF((J-1).LE.N)GO TO 3
   18 L=MASTER(J-1)
      IF(L.EQ.0)GO TO 24
      I=J-2
      J=J-L-1
      M=L
      IF(M.GT.40)M=40
      WRITE(IDBG,19)(ISTAR,K=1,M)
      WRITE(IDBG,19)(MASTER(K),K=J,I)
   19 FORMAT(9H  ''  '' ,4X,40A1)
      J=J-1
      IF(L.GT.40)GO TO 20
      IF(J.LE.N)GO TO 3
      GO TO 21
   20 L=L-40
      IF(L.GT.40)GO TO 20
   21 WRITE(IDBG,19)(ISTAR,K=1,L)
   22 IF(J.LE.N)GO TO 3
      WRITE(IDBG,23)MASTER(J)
   23 FORMAT(9H  ''  '' ,4X,16H* ARGUMENT COUNT,1I4)
      GO TO 18
   24 J=J-2
      GO TO 22
C
C     LIST CONSTANT
   25 K=-MASTER(INDEX+1)-2
      J=MASTER(K+1)
      GO TO 27
   26 J=MASTER(INDEX+2)-1000
      K=INDEX+1
   27 IF(MASTER(K).LT.0)GO TO 29
      I=0
      CALL DANUMB(1,MASTER(K),8,IOCT,I,13,13)
      WRITE(IDBG,28)INDIC,J,(IOCT(I),I=1,13),
     1MASTER(K),(MASTER(I),I=KOUNT,INDEX)
   28 FORMAT(9H CONSTANT,1I6,4H WRD,1I3,5H OCT ,13A1,
     11I13,1X,80A1)
      GO TO 31
   29 WRITE(IDBG,30)INDIC,J,MASTER(K),
     1MASTER(K),(MASTER(I),I=KOUNT,INDEX)
   30 FORMAT(9H CONSTANT,1I6,4H WRD,1I3,5H OCT ,1O13,
     11I13,1X,80A1)
   31 IF(MASTER(INDEX+2).NE.66)GO TO 3
      L=MASTER(K+3)
   32 K=K-2
      IF(K.LT.L)GO TO 3
      IF(MASTER(K).LT.0)GO TO 34
      I=0
      CALL DANUMB(1,MASTER(K),8,IOCT,I,13,13)
      WRITE(IDBG,33)MASTER(K+1),(IOCT(I),I=1,13),
     1MASTER(K),(MASTER(I),I=KOUNT,INDEX)
   33 FORMAT(9H  ''  '' ,6X,4H WRD,1I3,5H OCT ,13A1,
     11I13,1X,80A1)
      GO TO 32
   34 WRITE(IDBG,35)MASTER(K+1),MASTER(K),MASTER(K),
     1(MASTER(I),I=KOUNT,INDEX)
   35 FORMAT(9H  ''  '' ,6X,4H WRD,1I3,5H OCT ,1O13,
     11I13,1X,80A1)
      GO TO 32
C
C     LIST BYTE MASK
   36 IF(MASTER(INDIC-2).EQ.0)GO TO 6
      I=-MASTER(INDIC-2)+1
      NUMBER=0
   37 I=I-2
      IF(I.EQ.NUMBER)GO TO 3
      IF(MASTER(I).EQ.0)GO TO 41
      L=MASTER(I-1)
      K=L/101
      L=L-(101*K)-49
      M=K/5
      K=K-(5*M)
      M=M+2
      IF(MASTER(I).LT.0)GO TO 45
      IF(NUMBER.EQ.0)GO TO 39
      WRITE(IDBG,38)K,M,L,MASTER(I),
     1(MASTER(J),J=KOUNT,INDEX)
   38 FORMAT(9H  ''  '' ,14X,3HSIN,1I3,4H SIZ,1I3,
     14H BYT,1I3,4H WRD,1I6,1H ,80A1)
      GO TO 37
   39 WRITE(IDBG,40)INDIC,MASTER(INDIC-1),K,M,L,
     1MASTER(I),(MASTER(J),J=KOUNT,INDEX)
   40 FORMAT(9H BYTEMASK,1I6,4H OPR,1I3,4H SIN,1I3,
     14H SIZ,1I3,4H BYT,1I3,4H WRD,1I6,1H ,80A1)
      NUMBER=MASTER(I+2)
      GO TO 37
C     PRINT ORIGIN INCREMENT
   41 IF(NUMBER.EQ.0)GO TO 43
      WRITE(IDBG,42)MASTER(I-1),(MASTER(N),N=KOUNT,INDEX)
   42 FORMAT(9H  ''  '' ,14X,16HORIGIN INCREMENT,5X,3HWRD,
     11I6,1X,80A1)
      GO TO 37
   43 WRITE(IDBG,44)INDIC,MASTER(INDIC-1),MASTER(I-1),
     1(MASTER(N),N=KOUNT,INDEX)
   44 FORMAT(9H BYTEMASK,1I6,4H OPR,1I3,
     117H ORIGIN INCREMENT,5X,3HWRD,1I6,1X,80A1)
      NUMBER=MASTER(I+2)
      GO TO 37
C     PRINT AUTOMATIC ARGUMENT
   45 N=I+MASTER(I)
   46 I=I-2
      IF(NUMBER.NE.0)GO TO 47
      NUMBER=MASTER(I+4)
      WRITE(IDBG,40)INDIC,MASTER(INDIC-1),K,M,L,
     1MASTER(I),(MASTER(J),J=KOUNT,INDEX)
      GO TO 48
   47 WRITE(IDBG,38)K,M,L,MASTER(I),
     1(MASTER(J),J=KOUNT,INDEX)
   48 IF(MASTER(I-1).LT.0)GO TO 50
      J=0
      CALL DANUMB(1,MASTER(I-1),8,IOCT,J,13,13)
      WRITE(IDBG,49)(IOCT(J),J=1,13),MASTER(I-1),
     1(MASTER(J),J=KOUNT,INDEX)
   49 FORMAT(9H  ''  '' ,2X,8HAUTO ARG,3X,5H OCT ,
     113A1,1I13,1X,80A1)
      GO TO 52
   50 WRITE(IDBG,51)MASTER(I-1),MASTER(I-1),
     1(MASTER(J),J=KOUNT,INDEX)
   51 FORMAT(9H  ''  '' ,2X,8HAUTO ARG,3X,5H OCT ,
     11O13,1I13,1X,80A1)
   52 IF(I.EQ.N)GO TO 37
      GO TO 46
C
C     *************************************
C     *  LIST TABLE ENTRIES ASSEMBLED BY  *
C     *  PRESENT STATEMENT AS A CONSTANT  *
C     *************************************
C
   53 K=MOST-MULT+INSERT
      J=INSERT
      INDIC=IKODE+1
      IF(MASTER(K).LT.0)GO TO 54
      I=0
      CALL DANUMB(1,MASTER(K),8,IOCT,I,13,13)
      WRITE(IDBG,28)INDIC,J,(IOCT(I),I=1,13),
     1MASTER(K),(MASTER(I),I=KOUNT,INDEX)
      GO TO 55
   54 WRITE(IDBG,30)INDIC,J,MASTER(K),
     1MASTER(K),(MASTER(I),I=KOUNT,INDEX)
   55 K=K-1
      J=J-1
      IF(J.LE.0)GO TO 109
      IF(MASTER(K).EQ.0)GO TO 55
      IF(MASTER(K).LT.0)GO TO 56
      I=0
      CALL DANUMB(1,MASTER(K),8,IOCT,I,13,13)
      WRITE(IDBG,33)J,(IOCT(I),I=1,13),
     1MASTER(K),(MASTER(I),I=KOUNT,INDEX)
      GO TO 55
   56 WRITE(IDBG,35)J,MASTER(K),MASTER(K),
     1(MASTER(I),I=KOUNT,INDEX)
      GO TO 55
C
C     *****************************************
C     *  LIST ENTIRE TABLE OR SPECIFIC ENTRY  *
C     *****************************************
C
   57 KOUNT=MOST-MULT+1
      GO TO 61
   58 IF(KODE.NE.18)GO TO 109
      IF(IDBG.NE.ITTY)WRITE(IDBG,1)
   59 KOUNT=1
      GO TO 61
   60 KOUNT=KODE-100
   61 II=MOST+NEXT+1
      IF(KOUNT.GE.II)GO TO 109
      J=LNGMIN
   62 I=0
      LIMIT=LNGMIN
   63 INDEX=LIMIT
      LIMIT=MASTER(LIMIT)
      IF(LIMIT.EQ.0)GO TO 70
      IF(MASTER(INDEX-1).NE.1)GO TO 63
C
C     TEST FOR ADDRESS REFERENCE IN TABLE ENTRY
      K=INDEX-2
   64 L=K
      K=MASTER(K)
      IF(K.EQ.0)GO TO 63
      IF(K.LT.0)GO TO 67
      K=K/8080
      IF(K.EQ.KOUNT)GO TO 65
      IF(K.LT.KOUNT)GO TO 64
      IF(K.LT.II)II=K
      GO TO 64
   65 IF(L.LT.I)GO TO 66
      IF(L.GT.J)GO TO 66
      I=L
      NUMBER=INDEX
      INDIC=I
      IF(INDIC.GT.LEAST)INDIC=INDEX
   66 IF(KOUNT.LT.I)GO TO 64
      IF(KOUNT.GT.J)GO TO 64
      I=KOUNT
      NUMBER=INDEX
      INDIC=KOUNT
      GO TO 64
C
C     TEST FOR ADDRESS REFERENCE IN BYTE INFO CELL
   67 K=-K+1
      M=K
      L=MASTER(M)
   68 K=K-2
      IF(K.EQ.L)GO TO 63
      IF(MASTER(K).EQ.KOUNT)GO TO 69
      IF(MASTER(K).LT.KOUNT)GO TO 68
      IF(MASTER(K).LT.II)II=MASTER(K)
      GO TO 68
   69 IF(K.LT.I)GO TO 68
      IF(K.GT.J)GO TO 68
      I=K
      NUMBER=INDEX
      INDIC=M
      GO TO 68
C
C     PRINT INFORMATION CONCERNING TABLE ENTRY
   70 IF(I.GE.KOUNT)GO TO 75
      IF(J.LE.KOUNT)GO TO 75
   71 IF(MASTER(KOUNT).LT.0)GO TO 73
      J=0
      CALL DANUMB(1,MASTER(KOUNT),8,IOCT,J,13,13)
      WRITE(IDBG,72)KOUNT,(IOCT(J),J=1,13),MASTER(KOUNT)
   72 FORMAT(9H ENTRY   ,1I6,7X,5H OCT ,13A1,1I13)
      GO TO 75
   73 WRITE(IDBG,74)KOUNT,MASTER(KOUNT),MASTER(KOUNT)
   74 FORMAT(9H ENTRY   ,1I6,7X,5H OCT ,1O13,1I13)
   75 IF(I.EQ.0)GO TO 84
      INDEX=MASTER(NUMBER)+1
      NUMBER=NUMBER-3
      K=MASTER(I)
      IF(K.GT.0)GO TO 79
      IF(K.EQ.0)GO TO 77
      K=-K+1
      WRITE(IDBG,76)I,K,(MASTER(N),N=INDEX,NUMBER)
   76 FORMAT(9H POINTER ,1I6,32X,1I6,1H ,80A1)
      GO TO 83
   77 WRITE(IDBG,78)I,(MASTER(N),N=INDEX,NUMBER)
   78 FORMAT(9H LIST END,1I6,39X,80A1)
      GO TO 83
   79 IF(I.GT.NUMBER)GO TO 80
      IF(I.LT.LEAST)GO TO 80
      J=K
      L=MASTER(I-1)
      GO TO 81
   80 J=K/8080
      L=K-(8080*J)
   81 K=L/101
      L=L-(101*K)-49
      M=K/5
      K=K-(5*M)
      M=M+2
      WRITE(IDBG,82)INDIC,K,M,L,J,
     1(MASTER(N),N=INDEX,NUMBER)
   82 FORMAT(9H BYTEINFO,1I6,7X,4H SIN,1I3,4H SIZ,1I3,
     14H BYT,1I3,4H LOC,1I6,1H ,80A1)
   83 J=I-1
      IF(J.NE.0)GO TO 62
   84 IF(JSIGN.LT.0)GO TO 86
      IF(KOUNT.NE.(MOST+JMORE))GO TO 86
      L=MASTER(IADDRS+1)+1
      J=IADDRS-2
      K=JSHIFT+1
      WRITE(IDBG,85)JSIGN,JBASE,K,KOUNT,(MASTER(M),M=L,J)
   85 FORMAT(1X,8HRESERVED,14X,3HSIN,1I3,4H SIZ,1I3,
     14H BYT,1I3,4H LOC,1I6,1H ,80A1)
   86 IF(KODE.GT.100)GO TO 109
      I=0
      KOUNT=KOUNT+1
      IF(KOUNT.EQ.II)GO TO 61
      IF(KOUNT.EQ.(MOST+NEXT))GO TO 71
      IF(MASTER(KOUNT).NE.0)GO TO 71
      GO TO 84
C
C     ***********************************
C     *  LIST SPECIFIC UNKNOWN ADDRESS  *
C     ***********************************
C
   87 K=MASTER(INDEX+1)
      IF(K.LT.0)GO TO 91
      J=K/8080
      L=K-(8080*J)
      K=L/101
      L=L-(101*K)-49
      M=K/5
      K=K-(5*M)
      M=M+2
      WRITE(IDBG,88)INDIC,MASTER(INDEX+2),
     1 K,M,L,J,(MASTER(I),I=KOUNT,INDEX)
   88 FORMAT(9H ADDRESS ,1I6,4H OPR,1I3,4H SIN,1I3,
     14H SIZ,1I3,4H BYT,1I3,4H LOC,1I6,1H ,80A1)
   89 J=MASTER(J)
      IF(J.LT.0)GO TO 90
      IF(J.EQ.0)GO TO 101
      J=J/8080
      GO TO 89
   90 K=-J+1
      GO TO 92
   91 K=-K+1
      WRITE(IDBG,15)INDIC,MASTER(INDEX+2),
     1  K,(MASTER(I),I=KOUNT,INDEX)
C
C     PRINT BYTE INFORMATION STORAGE CELL
   92 INDIC=K
      I=K
   93 I=I-2
      IF(I.EQ.MASTER(INDIC))GO TO 101
      L=MASTER(I-1)
      K=L/101
      L=L-(101*K)-49
      M=K/5
      K=K-(5*M)
      M=M+2
      IF(I.EQ.(INDIC-2))GO TO 97
      IF(MASTER(I).LT.0)GO TO 95
      WRITE(IDBG,94)K,M,L,MASTER(I),
     1(MASTER(N),N=KOUNT,INDEX)
   94 FORMAT(9H  ''  '' ,14X,3HSIN,1I3,4H SIZ,1I3,
     14H BYT,1I3,4H LOC,1I6,1H ,80A1)
      GO TO 93
   95 NUMBER=-MASTER(I)
      WRITE(IDBG,96)K,M,L,NUMBER,(MASTER(N),N=KOUNT,INDEX)
   96 FORMAT(9H  ''  '' ,14X,3HSIN,1I3,4H SIZ,1I3,
     14H BYT,1I3,4H WRD,1I6,1H ,80A1)
      GO TO 93
   97 J=-MASTER(I+1)
      IF(J.GT.LEAST)J=J+2
      IF(MASTER(I).LT.0)GO TO 99
      WRITE(IDBG,98)INDIC,J,K,M,L,MASTER(I),
     1 (MASTER(N),N=KOUNT,INDEX)
   98 FORMAT(9H  ''  '' ,1I6,1I7,4H SIN,1I3,4H SIZ,1I3,
     14H BYT,1I3,4H LOC,1I6,1H ,80A1)
      GO TO 93
   99 NUMBER=-MASTER(I)
      WRITE(IDBG,100)INDIC,J,K,M,L,NUMBER,
     1 (MASTER(N),N=KOUNT,INDEX)
  100 FORMAT(9H  ''  '' ,1I6,1I7,4H SIN,1I3,4H SIZ,1I3,
     14H BYT,1I3,4H WRD,1I6,1H ,80A1)
      GO TO 93
C
C     PRINT TABLE ENTRIES CONTAINING BYTE INFORMATION
  101 IF(KODE.GT.0)GO TO 3
      J=KOUNT
  102 I=0
      LIMIT=INDEX+1
  103 IF(LIMIT.LT.I)GO TO 104
      IF(LIMIT.GT.J)GO TO 104
      I=LIMIT
  104 LIMIT=MASTER(LIMIT)
      IF(LIMIT.LE.0)GO TO 105
      LIMIT=LIMIT/8080
      GO TO 103
  105 IF(I.EQ.0)GO TO 109
      K=MASTER(I)
      IF(K.LT.0)GO TO 106
      IF(K.EQ.0)GO TO 107
      J=K/8080
      L=K-(8080*J)
      K=L/101
      L=L-(101*K)-49
      M=K/5
      K=K-(5*M)
      M=M+2
      WRITE(IDBG,82)I,K,M,L,J,(MASTER(N),N=KOUNT,INDEX)
      GO TO 108
  106 K=-K+1
      WRITE(IDBG,76)I,K,(MASTER(N),N=KOUNT,INDEX)
      GO TO 108
  107 WRITE(IDBG,78)I,(MASTER(N),N=KOUNT,INDEX)
  108 J=I-1
      GO TO 102
C
C     RETURN TO CALLING PROGRAM
  109 RETURN
      END