      SUBROUTINE LOUT(LMODE)
C   
C   
C     THIS SUBROUTINE IS USED TO OUTPUT THE ASSEMBLER LISTING
C   
C     ENTRY PARAMETERS
C        LMODE - OUTPUT MODE PARAMETER
C           1 = NORMAL LINE
C           2 = SPACE DIRECTIVE
C           3 = EJECT DIRECTIVE
C   
      INTEGER FTYPE
      REAL ITABV(249)
      COMMON ICRD,IPRT,MCFLE,IDFLE,MCREC,IDREC,IFORM,ITRUN,ILOUT,IXCOL
      COMMON MLAB,MOPC,IBIT,ICCNT,IWORD,IERRL,IERRI,IEND,IFRMC
      COMMON LSOR,LIF,LSYM,LREF,LDEF,LOCT,ITRMI,ITRMO
      COMMON ILEN,KLEN,LLEN,KWORD,IFLD(2400),IYFLD,IZFLD
      COMMON IFBIT,ZVAL,CVAL,JREAD,IN(80),INB(80),LINE,IPAGE,LISN
      COMMON IALPH(37),IAST,IDOLR,ISHRP
      COMMON ICOLN,IBLNK,ICTAB,ISEMI,ICOMM,IPLUS,IMIN,IMULT,IDIV
      COMMON IRPAR,ILPAR,IATT(9),JATT(5),LATT(9),IFPAR(16),NBASE,JBASE
      COMMON ICOL,IFCOL,MCOL,MLCOL,IOLIN,ICNT,LTITL(50),IADDR(4,12)
      COMMON ITYPE,JTYPE,FTYPE,IERR,IERRS,IOPVA,JCOL,IBUG
      COMMON ITAB(4,249),ITABS(249),ITABV,NAME(4),INDEX,INDET,ISYM,LTAB
      COMMON IXTAB(256),MXREF,IXT,IXPNT,IXCNT,IXPAG,MCORE(128)
C INCLUDE(:F1:METAD.COM)
C     SET LIST MODE,  1=ORDINARY LINE, 2,3=ERROR LINES
      MODE = 1
      LSCTL = 0
C     CHECK FOR TERMINAL ERROR LIST FLAG
      IF(ILOUT.EQ.0) GO TO 50
      IF(IERRI+IERRL) 40,50,40
40     LSCTL = 1
      ISAVE = IPRT
      IPRT = ITRMO
      GO TO 400
C     CHECK FOR AN ASSEMBLY ERROR, ALWAYS LIST LINE IF ERROR
50    IF(IERRL) 100,60,100
60    IF(IERRI) 100,70,100
C     CHECK TO SEE IF SOURCE IS TO BE LISTED
70    IF(LSOR) 100,900,100
C     CHECK OUTPUT LINE COUNT PER PAGE
100   IF(LSCTL.NE.0) GO TO 400
      LINE = LINE+1 
      IF(LINE-IOLIN) 400,400,200
C     EJECT TO NEXT PAGE AND PRINT TITLE
200   IF(IFORM.NE.0) GO TO 205
      WRITE(IPRT,1105)
1105  FORMAT(//////)
      GO TO 210 
205   WRITE(IPRT,1106) IFRMC
1106  FORMAT(A1) 
210   WRITE(IPRT,1001) LTITL,IPAGE
1001  FORMAT(5H LINE,4X,50A1,4X,5HPAGE ,I3,/) 
      IPAGE = IPAGE+1 
      LINE = 3
400   GO TO (410,600,900),LMODE 
410   GO TO (412,450,460),MODE
C     SCAN OFF TRAILING BLANKS
412   IJ = ITRUN
      DO 413 I=1,IJ 
      LINEL = IJ+1-I
      IF(IN(LINEL)-IBLNK) 414,413,414 
413   CONTINUE
414   WRITE(IPRT,1002) LISN,(IN(I),I=IXCOL,LINEL)
1002  FORMAT(1X,I4,3X,80A1) 
C     IF THERE IS AN ERROR, PRINT ERROR MESSAGE 
415   MODE = 2
      IF(IERRL) 100,420,100 
420   MODE = 3
      IF(IERRI) 100,900,100 
450   WRITE(IPRT,1004) IERRL,JCOL
      GO TO 465 
460   WRITE(IPRT,1004) IERRI,ICOL
1004  FORMAT(4X,8H***ERROR,I4,1X,1H(,I2,1H))
465   IF(LSCTL.EQ.0) IERRS = IERRS+1
      IF(MODE-3) 420,900,420
C     PROCESS SPACE DIRECTIVE 
600   IF(LINE-IOLIN) 610,610,200
610   WRITE(IPRT,1003)
1003  FORMAT(1X)
      ICNT = ICNT-1 
      IF(ICNT) 900,900,620
620   LINE = LINE+1 
      GO TO 600 
C     CLEAR ERROR FLAGS 
900   IF(LSCTL.EQ.0) GO TO 910
      MODE = 1
      IPRT = ISAVE
      LSCTL = 0 
      GO TO 50
910   IERRI = 0 
      IERRL = 0 
      RETURN
      END 
 LSCTL = 0 
      GO TO 50
910   IERRI = 0 
      IERRL = 0 
      RETURN
      END 
