SUBROUTINE MAIN LOGICAL*1 BUF(512), NAME(16,1000), VALSTR(7) LOGICAL*1 ARG(128), BARSTR(134), C INTEGER FD INTEGER OPEN INTEGER MAXCOL, MEAN, SUM, VALUE(1000) INTEGER I, J, JUNK, MAXVAL, MAXNDX, MINVAL, NDX, PERCEN, RANGE INTEGER CTOI, GETARG, GETLIN, GETWRD COMMON / CBAR / DOHDR, DOMEAN, DOSUM, DOWIDE, HIRULE, LORULE, BARC *HR, HIFILL, LOFILL, MEACHR, RULCHR INTEGER DOHDR INTEGER DOMEAN INTEGER DOSUM INTEGER DOWIDE INTEGER HIRULE INTEGER LORULE LOGICAL*1 BARCHR LOGICAL*1 HIFILL LOGICAL*1 LOFILL LOGICAL*1 MEACHR LOGICAL*1 RULCHR DATA BARCHR /124/ DATA HIFILL /32/ DATA LOFILL /124/ DATA MEACHR /46/ DATA RULCHR /58/ DATA DOHDR /0/ DATA DOSUM /0/ DATA DOWIDE /0/ DATA HIRULE /0/ DATA LORULE /0/ DATA MAXCOL /51/ DATA MAXVAL /0/ DATA MINVAL /0/ DATA RANGE /0/ DATA SUM /0/ CALL QUERY(40Husage: bargraph [-cfFhmrRsw] [file] ...) CALL BARARG IF (.NOT.( DOWIDE .EQ. 1 ))GOTO 23000 MAXCOL = MAXCOL + 50 23000 CONTINUE IF (.NOT.( DOHDR .EQ. 1 ))GOTO 23002 CALL BARHDR(DOWIDE) 23002 CONTINUE NDX = 1 J = 1 23004 CONTINUE IF (.NOT.( GETARG( J, ARG, 128) .EQ. -1 ))GOTO 23007 IF (.NOT.( J .NE. 1 ))GOTO 23009 GOTO 23006 23009 CONTINUE FD = 1 23010 CONTINUE GOTO 23008 23007 CONTINUE IF (.NOT.( ARG(1) .EQ. 45 ))GOTO 23011 FD = 1 GOTO 23012 23011 CONTINUE FD = OPEN( ARG, 1) IF (.NOT.( FD .EQ. -3 ))GOTO 23013 CALL CANT(ARG) 23013 CONTINUE 23012 CONTINUE 23008 CONTINUE 23015 IF (.NOT.(GETLIN( BUF, FD) .NE. -1 ))GOTO 23017 MAXNDX = NDX IF (.NOT.( NDX .GT. 1000 ))GOTO 23018 CALL REMARK( 38H? Too much data: increase TABLE_SIZE. ) GOTO 23017 23018 CONTINUE I = 1 JUNK = GETWRD( BUF, I, NAME( 1, NDX)) JUNK = GETWRD( BUF, I, VALSTR) I = 1 VALUE(NDX) = CTOI( VALSTR, I) IF (.NOT.( DOSUM .EQ. 0 ))GOTO 23020 IF (.NOT.( VALUE(NDX) .GT. MAXVAL ))GOTO 23022 MAXVAL = VALUE(NDX) 23022 CONTINUE IF (.NOT.( VALUE(NDX) .LT. MINVAL ))GOTO 23024 MINVAL = VALUE(NDX) 23024 CONTINUE 23020 CONTINUE RANGE = RANGE + VALUE(NDX) 23016 NDX = NDX + 1 GOTO 23015 23017 CONTINUE IF (.NOT.( FD .NE. 1 ))GOTO 23026 CALL CLOSE(FD) 23026 CONTINUE 23005 J = J + 1 GOTO 23004 23006 CONTINUE IF (.NOT.( NDX .GT. 1 .AND. DOSUM .EQ. 0 ))GOTO 23028 MEAN = RANGE / (NDX - 1) GOTO 23029 23028 CONTINUE MEAN = 0 23029 CONTINUE IF (.NOT.( DOSUM .EQ. 0 ))GOTO 23030 RANGE = MAXVAL - MINVAL IF (.NOT.( RANGE .EQ. 0 ))GOTO 23032 CALL ERROR( 28H? Range of data values is 0. ) 23032 CONTINUE 23030 CONTINUE NDX = 1 23034 IF (.NOT.(NDX .LE. MAXNDX ))GOTO 23036 CALL PUTSTR( NAME( 1, NDX), -16, 2) CALL PUTINT( VALUE(NDX), 7, 2) CALL PUTCH( 32, 2) IF (.NOT.( DOSUM .EQ. 1 ))GOTO 23037 SUM = SUM + VALUE(NDX) PERCEN = ( SUM * 100 ) / RANGE GOTO 23038 23037 CONTINUE PERCEN = ( VALUE(NDX) * 100 ) / RANGE 23038 CONTINUE CALL PUTCH( 124, 2) IF (.NOT.( DOWIDE .EQ. 0 ))GOTO 23039 PERCEN = PERCEN / 2 23039 CONTINUE I = 1 23041 IF (.NOT.(I .LT. PERCEN ))GOTO 23043 BARSTR(I) = LOFILL IF (.NOT.( LORULE .EQ. 1 ))GOTO 23044 IF (.NOT.( DOWIDE .EQ. 1 ))GOTO 23046 IF (.NOT.( MOD( I, 10) .EQ. 0 ))GOTO 23048 BARSTR(I) = RULCHR 23048 CONTINUE GOTO 23047 23046 CONTINUE IF (.NOT.( MOD( I, 5) .EQ. 0 ))GOTO 23050 BARSTR(I) = RULCHR 23050 CONTINUE 23047 CONTINUE 23044 CONTINUE 23042 I = I + 1 GOTO 23041 23043 CONTINUE CALL CHCOPY( BARCHR, BARSTR, I) 23052 IF (.NOT.(I .LT. MAXCOL ))GOTO 23054 BARSTR(I) = HIFILL IF (.NOT.( HIRULE .EQ. 1 ))GOTO 23055 IF (.NOT.( DOWIDE .EQ. 1 ))GOTO 23057 IF (.NOT.( MOD( I, 10) .EQ. 0 ))GOTO 23059 BARSTR(I) = RULCHR 23059 CONTINUE GOTO 23058 23057 CONTINUE IF (.NOT.( MOD( I, 5) .EQ. 0 ))GOTO 23061 BARSTR(I) = RULCHR 23061 CONTINUE 23058 CONTINUE 23055 CONTINUE 23053 I = I + 1 GOTO 23052 23054 CONTINUE IF (.NOT.( DOMEAN .EQ. 1 .AND. MEAN .GT. 0 ))GOTO 23063 IF (.NOT.( DOWIDE .EQ. 1 ))GOTO 23065 BARSTR( MEAN * 100 / RANGE ) = MEACHR GOTO 23066 23065 CONTINUE BARSTR( MEAN * 50 / RANGE ) = MEACHR 23066 CONTINUE 23063 CONTINUE BARSTR(I) = 124 BARSTR(I+1) = 0 CALL PUTLIN( BARSTR, 2) CALL PUTCH( 10, 2) 23035 NDX = NDX + 1 GOTO 23034 23036 CONTINUE RETURN END SUBROUTINE BARARG COMMON / CBAR / DOHDR, DOMEAN, DOSUM, DOWIDE, HIRULE, LORULE, BARC *HR, HIFILL, LOFILL, MEACHR, RULCHR INTEGER DOHDR INTEGER DOMEAN INTEGER DOSUM INTEGER DOWIDE INTEGER HIRULE INTEGER LORULE LOGICAL*1 BARCHR LOGICAL*1 HIFILL LOGICAL*1 LOFILL LOGICAL*1 MEACHR LOGICAL*1 RULCHR LOGICAL*1 ARG(128), C INTEGER I INTEGER GETARG I = 1 23067 IF (.NOT.(GETARG( I, ARG, 128) .NE. -1 ))GOTO 23069 IF (.NOT.( ARG(1) .EQ. 45 ))GOTO 23070 C = ARG(2) IF (.NOT.( C .EQ. 0 ))GOTO 23072 GOTO 23068 23072 CONTINUE IF (.NOT.( C .EQ. 99 ))GOTO 23074 IF (.NOT.( ARG(3) .GT. 32 ))GOTO 23076 BARCHR = ARG(3) 23076 CONTINUE GOTO 23075 23074 CONTINUE IF (.NOT.( C .EQ. 102 ))GOTO 23078 IF (.NOT.( ARG(3) .GE. 32 ))GOTO 23080 LOFILL = ARG(3) 23080 CONTINUE GOTO 23079 23078 CONTINUE IF (.NOT.( C .EQ. 70 ))GOTO 23082 IF (.NOT.( ARG(3) .GT. 32 ))GOTO 23084 HIFILL = ARG(3) 23084 CONTINUE GOTO 23083 23082 CONTINUE IF (.NOT.( C .EQ. 104 ))GOTO 23086 DOHDR = 1 GOTO 23087 23086 CONTINUE IF (.NOT.( C .EQ. 109 ))GOTO 23088 DOMEAN = 1 IF (.NOT.( ARG(3) .GE. 32 ))GOTO 23090 MEACHR = ARG(3) 23090 CONTINUE GOTO 23089 23088 CONTINUE IF (.NOT.( C .EQ. 114 ))GOTO 23092 LORULE = 1 IF (.NOT.( ARG(3) .GT. 32 ))GOTO 23094 RULCHR = ARG(3) 23094 CONTINUE GOTO 23093 23092 CONTINUE IF (.NOT.( C .EQ. 82 ))GOTO 23096 HIRULE = 1 IF (.NOT.( ARG(3) .GT. 32 ))GOTO 23098 RULCHR = ARG(3) 23098 CONTINUE GOTO 23097 23096 CONTINUE IF (.NOT.( C .EQ. 115 ))GOTO 23100 DOSUM = 1 GOTO 23101 23100 CONTINUE IF (.NOT.( C .EQ. 119 ))GOTO 23102 DOWIDE = 1 23102 CONTINUE 23101 CONTINUE 23097 CONTINUE 23093 CONTINUE 23089 CONTINUE 23087 CONTINUE 23083 CONTINUE 23079 CONTINUE 23075 CONTINUE CALL DELARG(I) I = I - 1 23070 CONTINUE 23068 I = I + 1 GOTO 23067 23069 CONTINUE RETURN END SUBROUTINE BARHDR(DOWIDE) INTEGER DOWIDE, I LOGICAL*1 HDRSTR(25) LOGICAL*1 BLANKS(9) LOGICAL*1 HUNDRD(4) DATA HDRSTR(1)/78/,HDRSTR(2)/97/,HDRSTR(3)/109/,HDRSTR(4)/101/,HDR *STR(5)/32/,HDRSTR(6)/32/,HDRSTR(7)/32/,HDRSTR(8)/32/,HDRSTR(9)/32/ *,HDRSTR(10)/32/,HDRSTR(11)/32/,HDRSTR(12)/32/,HDRSTR(13)/32/,HDRST *R(14)/32/,HDRSTR(15)/32/,HDRSTR(16)/32/,HDRSTR(17)/32/,HDRSTR(18)/ *32/,HDRSTR(19)/32/,HDRSTR(20)/83/,HDRSTR(21)/105/,HDRSTR(22)/122/, *HDRSTR(23)/101/,HDRSTR(24)/32/,HDRSTR(25)/0/ DATA BLANKS(1)/32/,BLANKS(2)/32/,BLANKS(3)/32/,BLANKS(4)/32/,BLANK *S(5)/32/,BLANKS(6)/32/,BLANKS(7)/32/,BLANKS(8)/32/,BLANKS(9)/0/ DATA HUNDRD(1)/49/,HUNDRD(2)/48/,HUNDRD(3)/48/,HUNDRD(4)/0/ IF (.NOT.( DOWIDE .EQ. 0 ))GOTO 23104 BLANKS(4) = 0 23104 CONTINUE CALL PUTLIN( HDRSTR, 2) I = 0 23106 IF (.NOT.(I .LT. 100 ))GOTO 23108 CALL PUTINT( I, 1, 2) CALL PUTLIN( BLANKS, 2) 23107 I = I + 10 GOTO 23106 23108 CONTINUE CALL PUTLIN( HUNDRD, 2) CALL PUTCH( 10, 2) CALL PUTCH( 10, 2) RETURN END