FTN SUBROUTINE OUTLN(IBUF,ILEN),92069-16001 REV. 1912 781120 C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WIOTH OUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18010 C RELOC: 92069-16001 C C C****************************************************************: C C ABSTRACT: C C OUTLN IS A GENERALIZED OUTPUT ROUTINE. IT OUTPUTS A RECORD C TO A DEVICE OR A FILE. WHEN THE VARIABLE LIST IS SET TO C A NEGITIVE ONE, THE RECORD IS WRITEN TO THE FILE DESIGNATED C IN THE LIST DCB (LDCB). OTHERWISE, THE RECORD IS LISTED C TO THE DEVICE SPECIFIED IN LIST. C C OUTLN IS USED WHENEVER RECORDS ARE TO BE WRITTEN TO THE C LISTING PARAMETER. C C CALLING SEQUENCE: C C CALL OUTLN(IBUF,ILEN) C C WHERE: C C IBUF IS THE BUFFER CONTAINING THE MESSAGE TO BE WRITTEN C ILEN IS THE LENGTH OF THE BUFFER IN WORDS C C C C C C C INTEGER INUM(2) INTEGER IOERR(10),ABORT(6),ISTAT(10) INTEGER DUMMY INTEGER BCLOS(3) C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ AUGUST 10,1978 $$$ INTEGER ERROR,P,PLEN,CARD,LOG,COL INTEGER ELECT,ITEM,LENTH,TYPE INTEGER IDCB,LDCB,LIST,INPUT,PRTLM,CHECK,LST INTEGER IBASE INTEGER SETERR INTEGER TRUE,FALSE,SEMI,COMMA INTEGER L,CHAR INTEGER SETNO INTEGER QTFLAG C COMMON ERROR,P(40),PLEN,CARD(256),LOG,COL COMMON ELECT(129),ITEM(129),LENTH(129),TYPE(129) COMMON IDCB(144),LDCB(144),LIST,INPUT,PRTLM,CHECK,LST COMMON IBASE(10) COMMON SETERR COMMON L,CHAR COMMON SETNO COMMON QTFLAG COMMON/CONST/TRUE,FALSE,SEMI,COMMA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ OCTOBER 16,1978 $$ DATA BCLOS/2HBC,2HLO,2H2 / DATA IOERR/2HDB,2HBL,2HD ,2HLI,2HST,2H I,2H/O,2H E,2HRR, &2HOR/ DATA ABORT/2HDB,2HBL,2HD ,2HEN,2HDE,2HD / DATA INUM/0,0/ C C OUT PUT OF A LINE SUBROUTINE C C IF(LIST .EQ. -1) GOTO 20 CALL EXEC(2+100000B,LIST+200B,IBUF,ILEN) GOTO 50 7000 GOTO 40 C C LIST IS A FILE C 20 CONTINUE CALL EWRIT(LDCB,IERR,IBUF,ILEN,INUM) IF(IERR .LT. 0) GOTO 50 40 CONTINUE RETURN C C I/O ERROR CLEAN UP AND TERMINATE C 50 CONTINUE CALL EXEC(2+100000B,1+200B,IOERR,10) GOTO 60 7001 CALL EXEC(2,1+200B,ABORT,6) 60 CONTINUE ERROR = -1 CALL SEGLD(BCLOS,IERR) STOP END