FORTRAN IV-PLUS V02-51D		02:35:58    22-AUG-78		PAGE 1   

BAROUT.FTN   	/TR:BLOCKS/WR


        C

        C

        C	BAROUT -- OUTPUT A LINE OF CHANGE-BAR DATA

        C

        C

        C

        C	COPYRIGHT (C) 1976

        C	DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

        C

        C	THIS SOFTWARE IS FURNISHED UNDER  A LICENSE FOR USE ONLY  ON  A

        C	SINGLE COMPUTER SYSTEM AND MAY BE  COPIED ONLY WITH  THE INCLU-

        C	SION OF  THE  ABOVE  COPYRIGHT NOTICE.  THIS SOFTWARE,  OR  ANY

        C	OTHER COPIES THEREOF, MAY NOT BE  PROVIDED  OR  OTHERWISE  MADE

        C	AVAILABLE TO ANY OTHER PERSON EXCEPT  FOR  USE  ON  SUCH SYSTEM

        C	AND TO  ONE WHO AGREES  TO  THESE LICENSE  TERMS.  TITLE TO AND

        C	OWNERSHIP OF THE SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.

        C

        C	THE INFORMATION IN THIS SOFTWARE  IS  SUBJECT TO CHANGE WITHOUT

        C	NOTICE AND SHOULD NOT BE CONSTRUED  AS  A COMMITMENT BY DIGITAL

        C	EQUIPMENT CORPORATION.

        C

        C	DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS

        C	SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.

        C

        C

        C	K.D. MORSE	23-NOV-76

        C

        C

        C

        C	THIS ROUTINE WRITES ONE LINE OF OUTPUT TO THE DIF OUTPUT FILE.

        C	BAROUT DECIDES WHICH TYPE OF OUTPUT LINE TO WRITE BASED ON

        C	THE VARIABLE IKIND.

        C

        C

        C

        C  MODIFICATIONS:

        C

        C  NO.		DATE		PROGRAMMER		PURPOSE

        C  --		----		----------		-------

        C

        C

FORTRAN IV-PLUS V02-51D		02:35:58    22-AUG-78		PAGE 2   

BAROUT.FTN   	/TR:BLOCKS/WR


         

        C

        C

        C

        C  VARIABLES:

        C

        C	BLANK--ASCII CHARACTER FOR A SPACE

        C	IERR1--ERROR INDICATOR FROM FORTRAN ROUTINE

        C	IERR2--ERROR INDICATOR FROM MACRO ROUTINE

        C	IKIND--INDICATOR OF CHARACTERISTICS OF LINE TO BE PRINTED, I.E.,

        C		WITH OR WITHOUT LINE NUMBERS AND CHANGE-BAR CHARACTER

        C	INMLNG--LENGTH OF FILE NAME

        C	INPNAM--NAME OF FILE TO GET RECORD FROM

        C	IRECNM--SEQUENTIAL LINE NUMBER OF RECORD TO BE PRINTED

        C	ISTAT--INDICATOR OF TYPE OF CLOSE TO PERFORM ON FILE

        C	ITYPE--INDICATOR OF TYPE OF OPEN TO PERFORM ON FILE

        C	LENINP--LENGTH OF LINE TO OUTPUT

        C	LINSIZ--WIDTH OF OUTPUT LINE

        C	LINWID--ARRAY OF TWO INTEGER VALUES:  THE FIRST BEING THE

        C		NUMBER OF HEXADECIMAL VALUES TO PRINT PER LINE, AND

        C		THE SECOND BEING THE NUMBER OF SPACES TO SKIP BEFORE

        C		TYPING SEQUENTIAL LINES OF HEXADECIMAL DATA

        C	OLUN--OUTPUT FILE LUN

        C	OUTCHR--OUTPUT CHARACTER TO BE WRITTEN TO OUTPUT FILE

        C	OUTMOD--INDICATOR FOR TYPE OF OUTPUT MODE, E.G., ASCII, OCTAL,

        C		OR HEXADECIMAL

        C	RECORD--BUFFER TO HOLD ONE RECORD

        C	TAB--ASCII CHARACTER FOR A HORIZONTAL TAB

FORTRAN IV-PLUS V02-51D		02:35:58    22-AUG-78		PAGE 3   

BAROUT.FTN   	/TR:BLOCKS/WR


         

0001    	SUBROUTINE BAROUT(ILUN,RECORD,LENINP,ISTAT,INPNAM,INMLNG,ITYPE,

        	1IRECNM,OUTMOD)

0002    	COMMON MAP(100,2),NUMLIN,MAPTOP(2),LSTMAP(2),MLUN,

        	1IHOLD(30,2),NINCOR,IFREE(2),IFIRST(2),LAST(2),MAXBUF,

        	2BUFR,ISWTCH,COMCHR,NSWVAL(10),LSTMAT(2),IRECSZ,

        	3MRKPNT(2,4),INOUT,MAPEND(2),LINSIZ,MAPNAM,MNMLNG,MTYPE,MSTAT

        	4,IERR1,IERR2,IKIND,OLUN,MAPMRK(3,2),MPRINT,BARCHR

         

0003    	BYTE BUFR(7680,2),COMCHR(16),OUTMOD,BARCHR

0004    	BYTE OUTCHR,BLANK,TAB,INPNAM(1),RECORD(1),MAPNAM(12)

0005    	INTEGER LINWID(2),OLUN

0006    	DATA BLANK/32/,TAB/9/

         

0007    111	FORMAT(' ',2A1,<N>(<LINSIZ-8>A1/' ',T10))

0008    121	FORMAT(' ',2A1,<N>(<(LINSIZ-8)/5>O5/' ',T10))

0009    131	FORMAT(' ',2A1,$)

0010    211	FORMAT(' ',A1,I5,A1,<N>(<LINSIZ-8>A1/' ',T10))

0011    221	FORMAT(' ',A1,I5,A1,<N>(<(LINSIZ-8)/5>O5/' ',T10))

0012    231	FORMAT(' ',A1,I5,A1,$)

         

        C

        C	DECIDE WHICH FILE IS REQUESTED.

        C

0013    	ISUB=1

0014    	IF (ILUN .EQ. 3) ISUB=2

        C

        C	GET THE OUTPUT LINE.

        C

0015    	CALL GETLIN(ILUN,RECORD,LENINP,ISTAT,INPNAM,INMLNG,

        	1ITYPE,IRECNM)

0016    	IF (IERR2 .EQ. 0) GOTO 700

0017    	IF (IERR1 .LT. 0) GOTO 1000

        C

        C	BRANCH ON KIND OF OUTPUT TO WRITE.

        C		100 = CHANGE BAR WITHOUT THE BAR-CHARACTER

        C		200 = CHANGE BAR WITHOUT THE BAR-CHARACTER WITH A RECORD NUMBER

        C		500 = CHANGE BAR WITH A BAR-CHARACTER

        C		600 = CHANGE BAR WITH A BAR-CHARACTER AND A RECORD NUMBER

        C

0018    	GOTO (100,200,1000,1000,500,600),IKIND

        C

        C

        C	CHANGE BAR OUTPUT

        C

        C

0019    100	OUTCHR=BLANK

        C

        C	BRANCH ON TYPE OF OUTPUT:  ASCII, OCTAL OR HEXADECIMAL.

        C

0020    105	GOTO (110,120,130),OUTMOD

        C

        C	ASCII.

        C

0021    110	N=512 / (LINSIZ-8) + 1

0022    	IF (LENINP .GT. 0) WRITE(OLUN,111,ERR=991)OUTCHR,TAB,

FORTRAN IV-PLUS V02-51D		02:35:58    22-AUG-78		PAGE 4   

BAROUT.FTN   	/TR:BLOCKS/WR


        	1(RECORD(I),I=1,LENINP)

0023    	IF (LENINP .EQ. 0) WRITE(OLUN,111,ERR=991)OUTCHR

0024    	GOTO 1000

        C

        C	OCTAL CHANGE-BAR.

        C

0025    120	N=512 / ((LINSIZ-8)/5) + 1

0026    	IF (LENINP .GT. 0) WRITE(OLUN,121,ERR=991)OUTCHR,TAB,

        	1(RECORD(I),I=1,LENINP)

0027    	IF (LENINP .EQ. 0) WRITE(OLUN,121,ERR=991)OUTCHR

0028    	GOTO 1000

        C

        C	HEXADECIMAL CHANGE-BAR.

        C

0029    130	LINWID(1)=(LINSIZ-8)/4

0030    	LINWID(2)=8

0031    	IF (LENINP .GT. 0) WRITE(OLUN,131,ERR=991)OUTCHR,TAB

0032    	IF (LENINP .GT. 0) CALL HEXDMP(RECORD,1,LENINP,LINWID(1),OLUN)

0033    	IF (LENINP .EQ. 0) WRITE(OLUN,131,ERR=991)OUTCHR

0034    	GOTO 1000

        C

        C

        C	CHANGE-BAR OUTPUT WITH LINE NUMBERS.

        C

        C

0035    200	OUTCHR=BLANK

0036    205	GOTO (210,220,230),OUTMOD

        C

        C	ASCII WITH LINE NUMBER.

        C

0037    210	N=512 / (LINSIZ-8) +1

0038    	IF (LENINP .GT. 0) WRITE(OLUN,211,ERR=991)OUTCHR,IRECNM,TAB,

        	1(RECORD(I),I=1,LENINP)

0039    	IF (LENINP .EQ. 0) WRITE(OLUN,211,ERR=991)OUTCHR,IRECNM

0040    	GOTO 1000

        C

        C	OCTAL CHANGE-BAR.

        C

0041    220	N=512 / ((LINSIZ-8)/5) + 1

0042    	IF (LENINP .GT. 0) WRITE(OLUN,221,ERR=991)OUTCHR,IRECNM,TAB,

        	1(RECORD(I),I=1,LENINP)

0043    	IF (LENINP .EQ. 0) WRITE(OLUN,221,ERR=991)OUTCHR,IRECNM

0044    	GOTO 1000

        C

        C	HEXADECIMAL CHANGE-BAR.

        C

0045    230	LINWID(1)=(LINSIZ-8)/4

0046    	LINWID(2)=8

0047    	IF (LENINP .GT. 0) WRITE(OLUN,231,ERR=991)OUTCHR,IRECNM,TAB

0048    	IF (LENINP .GT. 0) CALL HEXDMP(RECORD,1,LENINP,LINWID(1),OLUN)

0049    	IF (LENINP .EQ. 0) WRITE(OLUN,231,ERR=991)OUTCHR,IRECNM

0050    	GOTO 1000

        C

        C

        C	CHANGE-BAR OUTPUT WITH CHANGE-BAR.

        C

FORTRAN IV-PLUS V02-51D		02:35:58    22-AUG-78		PAGE 5   

BAROUT.FTN   	/TR:BLOCKS/WR


        C

0051    500	OUTCHR=BARCHR

0052    	GOTO 105

        C

        C

        C	CHANGE-BAR OUTPUT WITH CHANGE-BAR AND LINE NUMBER.

        C

        C

0053    600	OUTCHR=BARCHR

0054    	GOTO 205

        C

        C	DISREGARD EOF AS AN ERROR.

        C

0055    700	IERR1=1

0056    	GOTO 1000

        C

        C

        C	ERROR CODES

        C

        C

        C

        C	OLUN WRITE ERROR.

        C

0057    991	IERR1=-18

0058    1000	RETURN

0059    		END

FORTRAN IV-PLUS V02-51D		02:35:58    22-AUG-78		PAGE 6   

BAROUT.FTN   	/TR:BLOCKS/WR


PROGRAM SECTIONS



NUMBER	 NAME	    SIZE		ATTRIBUTES



  1	$CODE1	002456   663		RW,I,CON,LCL

  2	$PDATA	000042    17		RW,D,CON,LCL

  3	$IDATA	000244    82		RW,D,CON,LCL

  4	$VARS	000016     7		RW,D,CON,LCL

  5	$TEMPS	000002     1		RW,D,CON,LCL

  6	.$$$$.	037222  8009		RW,D,OVR,GBL





ENTRY POINTS



 NAME   TYPE  ADDRESS    NAME   TYPE  ADDRESS    NAME   TYPE  ADDRESS    NAME   TYPE  ADDRESS    NAME   TYPE  ADDRESS   



 BAROUT	      1-000000





VARIABLES



 NAME   TYPE  ADDRESS    NAME   TYPE  ADDRESS    NAME   TYPE  ADDRESS    NAME   TYPE  ADDRESS    NAME   TYPE  ADDRESS   



 BARCHR	L*1   6-037220	 BLANK	L*1   4-000001	 I	I*2   4-000014	 IERR1	I*2   6-037172	 IERR2	I*2   6-037174

 IKIND	I*2   6-037176	 ILUN	I*2   F-000002*	 INMLNG	I*2   F-000014*	 INOUT	I*2   6-037140	 IRECNM	I*2   F-000020*

 IRECSZ	I*2   6-037116	 ISTAT	I*2   F-000010*	 ISUB	I*2   4-000012	 ISWTCH	I*2   6-037044	 ITYPE	I*2   F-000016*

 LENINP	I*2   F-000006*	 LINSIZ	I*2   6-037146	 MAXBUF	I*2   6-001042	 MLUN	I*2   6-000632	 MNMLNG	I*2   6-037164

 MPRINT	I*2   6-037216	 MSTAT	I*2   6-037170	 MTYPE	I*2   6-037166	 N	I*2   4-000010	 NINCOR	I*2   6-001024

 NUMLIN	I*2   6-000620	 OLUN	I*2   6-037200	 OUTCHR	L*1   4-000000	 OUTMOD	L*1   F-000022*	 TAB	L*1   4-000002





ARRAYS



 NAME   TYPE  ADDRESS	    SIZE 	DIMENSIONS



 BUFR	L*1   6-001044	036000  7680	(7680,2)

 COMCHR	L*1   6-037046	000020     8	(16)

 IFIRST	I*2   6-001032	000004     2	(2)

 IFREE	I*2   6-001026	000004     2	(2)

 IHOLD	I*2   6-000634	000170    60	(30,2)

 INPNAM	L*1   F-000012*	000001     0	(1)

 LAST	I*2   6-001036	000004     2	(2)

 LINWID	I*2   4-000004	000004     2	(2)

 LSTMAP	I*2   6-000626	000004     2	(2)

 LSTMAT	I*2   6-037112	000004     2	(2)

 MAP	I*2   6-000000	000620   200	(100,2)

 MAPEND	I*2   6-037142	000004     2	(2)

 MAPMRK	I*2   6-037202	000014     6	(3,2)

 MAPNAM	L*1   6-037150	000014     6	(12)

 MAPTOP	I*2   6-000622	000004     2	(2)

 MRKPNT	I*2   6-037120	000020     8	(2,4)

 NSWVAL	I*2   6-037066	000024    10	(10)

 RECORD	L*1   F-000004*	000001     0	(1)





LABELS

FORTRAN IV-PLUS V02-51D		02:35:58    22-AUG-78		PAGE 7   

BAROUT.FTN   	/TR:BLOCKS/WR




 LABEL   ADDRESS 	 LABEL   ADDRESS 	 LABEL   ADDRESS 	 LABEL   ADDRESS 	 LABEL   ADDRESS 	



 100	 1-000236	 105	 1-000252	 110	 1-000276	 111'	 3-000000	 120	 1-000532

 121'	 3-000026	 130	 1-000774	 131'	 3-000054	 200	 1-001214	 205	 1-001230

 210	 1-001254	 211'	 3-000064	 220	 1-001530	 221'	 3-000116	 230	 1-002010

 231'	 3-000150	 500	 1-002246	 600	 1-002266	 700	 1-002306	 991	 1-002324

 1000	 1-002340





FUNCTIONS AND SUBROUTINES REFERENCED



 GETLIN	 HEXDMP





TOTAL SPACE ALLOCATED = 042226  8779



NO FPP INSTRUCTIONS GENERATED



OBJ$:BAROUT,LIS$:BAROUT/-SP=SRC$:BAROUT

