PROGRAMRECEIV
     BYTERECORD(512),FNAME(29)
     LOGICAL*1IMAGE
     INTEGER*2IARRAY(18),NAMLEN,RECLEN
     BYTETSKNAM(6)
     COMMON/TASK/TSKNAM
data		idot	/3r.../
     DATAFNAME(29)/0/
     BYTERESPON(10)
     CALLASSIGN(2,'SY0:')
     CALLASSIGN(2)
     CALLASSIGN(1,'TI:')
     CALLTTATT(0,3,ISTAT)
     IF (.NOT.(ISTAT.NE.0))GOTO 20000
     WRITE(1,102)TSKNAM
     CALLEXST(4)
0000 CONTINUE
     CALLGETTSK(IARRAY,IDS)
     IF (.NOT.(IARRAY(1).EQ.IDOT))GOTO 20002
     IARRAY(1)=0
0002 CONTINUE
     IF (.NOT.(IARRAY(2).EQ.IDOT))GOTO 20004
     IARRAY(2)=0
0004 CONTINUE
     CALLR50ASC(6,IARRAY,TSKNAM)
     DO 20006I=1,6
     IF (.NOT.(TSKNAM(I).EQ.' '))GOTO 20008
     TSKNAM(I)=0
0008 CONTINUE
0006 CONTINUE
0007 CONTINUE
     RESPON(1)=0
     CALLWRITLN(RESPON,0)
0010 CONTINUE
     CALLRINIT(FNAME,NAMLEN,IMAGE,RECLEN)
     CONTINUE
0013 CONTINUE
     CALLRETLN(RECORD,LINLEN,IRETCD)
     IF (.NOT.(IRETCD.EQ.1))GOTO 20016
     GOTO 20015
0016 CONTINUE
     IF (.NOT.(LINLEN.EQ.0))GOTO 20018
     WRITE(2,100,ERR=9)
     GOTO 20019
0018 CONTINUE
     IF (.NOT.(LINLEN.GT.0))GOTO 20020
     WRITE(2,100,ERR=9)(RECORD(I),I=1,LINLEN)
0020 CONTINUE
0019 CONTINUE
0014 GOTO 20013
0015 CONTINUE
     CALLCLOSE(2)
     IF (.NOT.(.FALSE.))GOTO 20022
     WRITE(1,101)TSKNAM,(FNAME(I),I=1,NAMLEN)
     RESPON(1)=1
     CALLWRITLN(RESPON,1)
     CALLCLOSE(2)
0022 CONTINUE
0011 GOTO 20010
0012 CONTINUE
00   FORMAT(4(128a1))
01   FORMAT(X,6a1,' -- Unable to write to output file ',28a1)
02   FORMAT(X,6a1,' -- Unable to attach to remote. Aborting task.')
03   FORMAT(' ',A1)
     END

     SUBROUTINERINIT(FNAME,NAMLEN,IMAGE,RECLEN)
     BYTEFNAME(28)
     INTEGER*2NAMLEN
     LOGICAL*1IMAGE
     INTEGER*2RECLEN
     BYTETSKNAM(6)
     COMMON/TASK/TSKNAM
     INTEGER*2SEQL
     COMMON/SEQ/SEQNO,SEQUEN
     INTEGER*2SEQNO
     BYTESEQUEN(516)
     BYTETRHIGH,TRLOW
     BYTERESPON(10)
     DO 20024I=1,28
     FNAME(I)=0
0024 CONTINUE
0025 CONTINUE
0026 CONTINUE
     CALLREADLN(SEQL)
     IF (.NOT.((SEQL.LT.5).OR.(SEQUEN(1).NE.6)))GOTO 20029
     RESPON(1)=2
     CALLWRITLN(RESPON,1)
     GOTO 20027
0029 CONTINUE
     CALLDELEN(NAMLEN,SEQUEN(2),SEQUEN(3))
     IF (.NOT.(SEQL.NE.NAMLEN+5))GOTO 20031
     RESPON(1)=2
     CALLWRITLN(RESPON,1)
     GOTO 20027
0031 CONTINUE
     CALLDELEN(RECLEN,SEQUEN(4),SEQUEN(5))
     IMAGE=RECLEN.GT.0
     DO 20033J=1,NAMLEN
     FNAME(J)=SEQUEN(J+6-1)
0033 CONTINUE
0034 CONTINUE
     CALLENLEN(SEQL,TRHIGH,TRLOW)
     RESPON(1)=TRHIGH
     RESPON(2)=TRLOW
     CALLWRITLN(RESPON,2)
     IF (.NOT.(IMAGE))GOTO 20035
     OPEN(UNIT=2,NAME=FNAME,TYPE='new',ERR=9,RECORDTYPE='fixed',
    $RECORDSIZE=RECLEN,ACCESS='sequential',FORM='formatted')
     GOTO 20036
0035 CONTINUE
     OPEN(UNIT=2,NAME=FNAME,TYPE='new',ERR=9,CARRIAGECONTROL='list')
0036 CONTINUE
     IF (.NOT.(.FALSE.))GOTO 20037
     WRITE(1,8)TSKNAM,(FNAME(I),I=1,NAMLEN)
     FORMAT(' ',6a1,' -- Unable to open output file ',28a1)
     RESPON(1)=1
     CALLWRITLN(RESPON,1)
0037 CONTINUE
     RETURN
0027 GOTO 20026
0028 CONTINUE
     END

     SUBROUTINERETLN(RECORD,LINLEN,IRETCD)
     BYTERECORD(512)
     INTEGER*2LINLEN,IRETCD
     INTEGER*2RECPTR
     INTEGER*2OFFSET,SEQL
     LOGICAL*1CONTIN
     COMMON/SEQ/SEQNO,SEQUEN
     INTEGER*2SEQNO
     BYTESEQUEN(516)
     BYTETRHIGH,TRLOW
     BYTERECHI,RECLOW
     BYTETSKNAM(6)
     COMMON/TASK/TSKNAM
     BYTERESPON(10)
     RECPTR=1
     IRETCD=0
     LINLEN=0
     OFFSET=0
0039 CONTINUE
     CALLREADLN(SEQL)
     IF (.NOT.(SEQUEN(SEQL).EQ.14))GOTO 20042
     CONTIN=.TRUE.
     SEQL=SEQL-1
     GOTO 20043
0042 CONTINUE
     IF (.NOT.(SEQUEN(SEQL).EQ.16))GOTO 20044
     CONTIN=.FALSE.
     SEQL=SEQL-1
     GOTO 20045
0044 CONTINUE
     IF (.NOT.(SEQUEN(1).EQ.2.AND.SEQL.EQ.1))GOTO 20046
     CONTIN=.FALSE.
     SEQL=SEQL-1
     GOTO 20041
0046 CONTINUE
     IF (.NOT.(SEQUEN(1).EQ.4.AND.SEQL.EQ.1))GOTO 20048
     IRETCD=1
     RESPON(1)=4
     CALLWRITLN(RESPON,1)
     RETURN
0048 CONTINUE
     TYPE*,'seqlength, sequence',SEQL,(SEQUEN(I),I=1,SEQL)
     WRITE(1,101)TSKNAM,2
     RESPON(1)=1
     CALLWRITLN(RESPON,1)
     IRETCD=1
     RETURN
0049 CONTINUE
0047 CONTINUE
0045 CONTINUE
0043 CONTINUE
     DO 20050J=1,SEQL
     IF (.NOT.(SEQUEN(J).LT.' '))GOTO 20052
     IF (.NOT.(SEQUEN(J).EQ.5))GOTO 20054
     OFFSET=1
     GOTO 20055
0054 CONTINUE
     IF (.NOT.(SEQUEN(J).EQ.7))GOTO 20056
     OFFSET=-1
     GOTO 20057
0056 CONTINUE
     IF (.NOT.(SEQUEN(J).EQ.8))GOTO 20058
     OFFSET=-2
     GOTO 20059
0058 CONTINUE
     IF (.NOT.(SEQUEN(J).EQ.20))GOTO 20060
     OFFSET=0
     RECORD(RECPTR)=127
     RECPTR=RECPTR+1
     GOTO 20061
0060 CONTINUE
     IF (.NOT.(SEQUEN(J).EQ.22))GOTO 20062
     OFFSET=0
     RECORD(RECPTR)=127.OR.128
     RECPTR=RECPTR+1
     GOTO 20063
0062 CONTINUE
     WRITE(1,101)TSKNAM,3
     RESPON(1)=1
     CALLWRITLN(RESPON,1)
     IRETCD=1
     RETURN
0063 CONTINUE
0061 CONTINUE
0059 CONTINUE
0057 CONTINUE
0055 CONTINUE
     GOTO 20053
0052 CONTINUE
     IF (.NOT.(OFFSET.EQ.1))GOTO 20064
     RECORD(RECPTR)=SEQUEN(J).AND.63
     GOTO 20065
0064 CONTINUE
     IF (.NOT.(OFFSET.EQ.-1))GOTO 20066
     RECORD(RECPTR)=SEQUEN(J).OR.128
     GOTO 20067
0066 CONTINUE
     IF (.NOT.(OFFSET.EQ.-2))GOTO 20068
     RECORD(RECPTR)=(SEQUEN(J).AND.63).OR.128
     GOTO 20069
0068 CONTINUE
     IF (.NOT.(OFFSET.EQ.0))GOTO 20070
     RECORD(RECPTR)=SEQUEN(J)
0070 CONTINUE
0069 CONTINUE
0067 CONTINUE
0065 CONTINUE
     OFFSET=0
     RECPTR=RECPTR+1
0053 CONTINUE
0050 CONTINUE
0051 CONTINUE
     IF (.NOT.(CONTIN))GOTO 20072
     CALLENLEN(SEQL+1,TRHIGH,TRLOW)
     RESPON(1)=TRHIGH
     RESPON(2)=TRLOW
     CALLWRITLN(RESPON,2)
0072 CONTINUE
0040 IF (.NOT.(.NOT.CONTIN))GOTO 20039
0041 CONTINUE
     CALLENLEN(SEQL+1,TRHIGH,TRLOW)
     LINLEN=RECPTR-1
     CALLENLEN(LINLEN,RECHI,RECLOW)
     RESPON(1)=TRHIGH
     RESPON(2)=TRLOW
     RESPON(3)=RECHI
     RESPON(4)=RECLOW
     CALLWRITLN(RESPON,4)
     RETURN
01   FORMAT(' ',6a1,' - Transmit error',I3,'. Aborting communication.'
    $)
     END

     SUBROUTINEWRITLN(RESPON,RSPLEN)
     BYTERESPON(10)
     INTEGER*2RSPLEN
     COMMON/SEQ/SEQNO,SEQUEN
     INTEGER*2SEQNO
     BYTESEQUEN(516)
     INTEGER*2OUTLEN
     BYTETSKNAM(6)
     COMMON/TASK/TSKNAM
     INTEGER*2ISTAT,ADDR
     COMMON/TTCOM/TTEFN,TTPAR(6),TTDSW,TTIOS(2),TTWAIT,TTATAF,TTATCF,
    $TTDETF,TTGMCF,TTGTSF,TTSMCF,TTKILF,TTRTTF,TTATTF,TTRPRF,TTWVBF,
    $TTRVBF,TFESQF,TFBINF,TFRALF,TFRNEF,TFRSTF,TFCCOF,TFRCUF,TFWALF,
    $TTATTV,TTRPRV,TTWVBV,TTRVBV,TTSUCS,TTPNDS,TTCLRS,TTSETS,TTDNRS,
    $TTEOFS,TTFHES,TTPRIS,TTVERS,TTSUCL,TTPNDL,TTEOFL,TTDSEL,TTIOEL,
    $TTERRL,TCACR,TCBIN,TCCTS,TCDLU,TCESQ,TCFDX,TCHFF,TCHFL,TCHHT,
    $TCHLD,TCISL,TCLPP,TCNEC,TCPRI,TCRAT,TCRSP,TCSCP,TCSLV,TCSMR,TCTBF
    $,TCTTP,TCVFL,TCWID,TCXSP,TC8BC
     BYTETTBYT
     INTEGER*2TTEFN,TTPAR,TTDSW,TTIOS
     INTEGER*2TTATAF,TTATCF,TTDETF,TTGMCF,TTGTSF,TTSMCF
     INTEGER*2TTKILF,TTRTTF,TTATTF,TTRPRF,TTWVBF,TTRVBF
     INTEGER*2TFESQF,TFBINF,TFRALF,TFRNEF,TFRSTF,TFCCOF
     INTEGER*2TFRCUF,TFWALF,TTATTV,TTRPRV,TTWVBV,TTRVBV
     INTEGER*2TTSUCS,TTPNDS,TTCLRS,TTSETS,TTDNRS,TTEOFS
     INTEGER*2TTFHES,TTPRIS,TTVERS
     LOGICALTTWAIT
     LOGICALTTSUCL,TTPNDL,TTEOFL
     LOGICALTTDSEL,TTIOEL,TTERRL
     EQUIVALENCE(TTBYT,TTIOS(1))
     BYTETCACR,TCBIN,TCCTS,TCDLU,TCESQ,TCFDX,TCHFF
     BYTETCHFL,TCHHT,TCHLD,TCISL,TCLPP,TCNEC,TCPRI
     BYTETCRAT,TCRSP,TCSCP,TCSLV,TCSMR,TCTBF,TCTTP
     BYTETCVFL,TCWID,TCXSP,TC8BC
     RESPON(RSPLEN+1)=13
     OUTLEN=RSPLEN+1
     CALLGETADR(ADDR,SEQUEN)
     TTPAR(1)=ADDR
     TTPAR(2)=516
     TTPAR(3)=0
     CALLGETADR(ADDR,RESPON)
     TTPAR(4)=ADDR
     TTPAR(5)=OUTLEN
     TTPAR(6)=0
     TTIOS(1)=1
     IF (.NOT.(RSPLEN.GT.0))GOTO 20074
     CALLQIO(TTRPRF.OR.TFRNEF,3,3,,TTIOS,TTPAR,TTDSW)
     GOTO 20075
0074 CONTINUE
     CALLQIO(512.OR.TFRNEF,3,3,,TTIOS,TTPAR,TTDSW)
0075 CONTINUE
     IF (.NOT.(TTDSW.NE.1))GOTO 20076
     WRITE(1,1)TSKNAM,TTDSW
     WRITE(3,3)1
     CALLEXST(4)
0076 CONTINUE
     FORMAT(' ',6a1,' - Directive error',2i5,
    $' - writln. Aborting receive.')
     FORMAT(X,A1)
     RETURN
     END

     SUBROUTINEREADLN(SEQL)
     INTEGER*2SEQL
     COMMON/SEQ/SEQNO,SEQUEN
     INTEGER*2SEQNO
     BYTESEQUEN(516)
     INTEGER*2ISTAT,ADDR,IOFCN
     COMMON/TTCOM/TTEFN,TTPAR(6),TTDSW,TTIOS(2),TTWAIT,TTATAF,TTATCF,
    $TTDETF,TTGMCF,TTGTSF,TTSMCF,TTKILF,TTRTTF,TTATTF,TTRPRF,TTWVBF,
    $TTRVBF,TFESQF,TFBINF,TFRALF,TFRNEF,TFRSTF,TFCCOF,TFRCUF,TFWALF,
    $TTATTV,TTRPRV,TTWVBV,TTRVBV,TTSUCS,TTPNDS,TTCLRS,TTSETS,TTDNRS,
    $TTEOFS,TTFHES,TTPRIS,TTVERS,TTSUCL,TTPNDL,TTEOFL,TTDSEL,TTIOEL,
    $TTERRL,TCACR,TCBIN,TCCTS,TCDLU,TCESQ,TCFDX,TCHFF,TCHFL,TCHHT,
    $TCHLD,TCISL,TCLPP,TCNEC,TCPRI,TCRAT,TCRSP,TCSCP,TCSLV,TCSMR,TCTBF
    $,TCTTP,TCVFL,TCWID,TCXSP,TC8BC
     BYTETTBYT
     INTEGER*2TTEFN,TTPAR,TTDSW,TTIOS
     INTEGER*2TTATAF,TTATCF,TTDETF,TTGMCF,TTGTSF,TTSMCF
     INTEGER*2TTKILF,TTRTTF,TTATTF,TTRPRF,TTWVBF,TTRVBF
     INTEGER*2TFESQF,TFBINF,TFRALF,TFRNEF,TFRSTF,TFCCOF
     INTEGER*2TFRCUF,TFWALF,TTATTV,TTRPRV,TTWVBV,TTRVBV
     INTEGER*2TTSUCS,TTPNDS,TTCLRS,TTSETS,TTDNRS,TTEOFS
     INTEGER*2TTFHES,TTPRIS,TTVERS
     LOGICALTTWAIT
     LOGICALTTSUCL,TTPNDL,TTEOFL
     LOGICALTTDSEL,TTIOEL,TTERRL
     EQUIVALENCE(TTBYT,TTIOS(1))
     BYTETCACR,TCBIN,TCCTS,TCDLU,TCESQ,TCFDX,TCHFF
     BYTETCHFL,TCHHT,TCHLD,TCISL,TCLPP,TCNEC,TCPRI
     BYTETCRAT,TCRSP,TCSCP,TCSLV,TCSMR,TCTBF,TCTTP
     BYTETCVFL,TCWID,TCXSP,TC8BC
     BYTETSKNAM(6)
     COMMON/TASK/TSKNAM
     CALLWAITFR(3,IDSW)
     IF (.NOT.(IDSW.NE.1))GOTO 20078
     WRITE(1,1)IDSW
     CALLWRITLN(1,1)
     CALLEXST(4)
0078 CONTINUE
     IF (.NOT.(TTBYT.EQ.1))GOTO 20080
     SEQL=TTIOS(2)
     CONTINUE
0082 IF (.NOT.(SEQUEN(1).EQ.0))GOTO 20083
     DO 20084I=1,SEQL-1
     SEQUEN(I)=SEQUEN(I+1)
0084 CONTINUE
0085 CONTINUE
     SEQL=SEQL-1
     GOTO 20082
0083 CONTINUE
     RETURN
0080 CONTINUE
     WRITE(1,2)TTBYT,TTIOS
     CALLWRITLN(1,1)
     CALLEXST(4)
0081 CONTINUE
     FORMAT(' Directive error ',I5,' in waitfr (in readln). Aborting.'
    $)
     FORMAT(' I/O error ',I5,' in readln. Status block: ',2o8,
    $'. Aborting.')
     END

     SUBROUTINEENLEN(I,HIBYTE,LOBYTE)
     INTEGER*2I
     BYTEHIBYTE,LOBYTE
     IF (.NOT.((I.LT.0).OR.(I.GT.4095)))GOTO 20086
     WRITE(1,1)I
     CALLWRITLN(1,1)
     CALLEXST(4)
0086 CONTINUE
     HIBYTE=(I/64)+32
     LOBYTE=(I.AND.63)+32
     RETURN
     FORMAT(' Logic error in Encodenumeric: i = ',I12,'. Aborting.')
     END

     SUBROUTINEDELEN(I,HIBYTE,LOBYTE)
     INTEGER*2I
     BYTEHIBYTE,LOBYTE
     INTEGER*2J,K
     IF (.NOT.((HIBYTE.LT.32).OR.(HIBYTE.GT.95).OR.(LOBYTE.LT.32).OR.(
    $LOBYTE.GT.95)))GOTO 20088
     WRITE(1,1)HIBYTE,LOBYTE
     CALLWRITLN(1,1)
     CALLEXST(4)
0088 CONTINUE
     J=HIBYTE-32
     K=LOBYTE-32
     I=J*64+K
     FORMAT(' Logic error in Decodenumeric: bytes = ',2i5,
    $'. Aborting.')
     RETURN
     END