SUBROUTINE DIS2B(IHIS,IZMIN,IZMAX,IXMIN,IXMAX,IYMIN,IYMAX)
C
C	SUBROUTINE TO PLOT HISTOGRAMS ON THE ADM3A DUMB TERMINAL
C		IHIS	= HIST #
C
C			IHIS	=-100 RETRACE PLOT ONLY, DO NOT DO SCALES ETC.
C		IZMIN,IZMAX	= SCALE FOR 1 OR 2 DIM HISTS
C			0	= AUTO SCALE
C			1 - 12	= 32 MAX - 64K
C				= ANY CONTOUR # FOR 2 DIM PLOT
C
	BYTE IB(80)
	INTEGER*4 IN2,IXMIN,IXMAX,IYMIN,IYMAX,IZMIN,IZMAX,JZMIN,JZMAX
	REAL	YORG,XORG,XSC,YSC
	COMMON	/MSCAL/XORG,XSC,YORG,YSC
	COMMON	/D2SAVE/IHS,IXSIZ,IYSIZ,IXS,IX0,IYS,IY0,ITYPE,
	1	IJUMP,JXMIN,JXMAX,JYMIN,JYMAX,JZMIN,JZMAX,IX,IY,
	2	ITIME(5)
	COMMON /SCRAT/IA(30),IC(30)
	INTEGER*4	ISTPA(25)
	EQUIVALENCE (IB,IA)
	DATA ISTPA/2,5,10,20,50,100,200,200,500,1000,2000,5000,
	1 10000,20000,50000,50000,100000,200000,500000,
	2 1000000,2000000,5000000,10000000,20000000,50000000/
	DATA IBASE/32/,ITIC/16/,ITOP/754/
	IF(IHIS .ge. 0) IHS	= IHIS			! New value
	CALL	SCTEST(ISTAT)				! Istat = 0,no graphics
	IF(ISTAT .NE. 0) GO to 1			! Graphics scope ?
	CALL	DIS2BR(IHIS,IZMIN,IZMAX,IXMIN,IXMAX,IYMIN,IYMAX)
	RETURN
1	IF(IHIS .Lt. 0 .AND. IXSIZ .NE. 0) GO TO 60	! RETRACE, NO SEARCHES
	IHS	= IHIS
	CALL ERASE					! ERASE SCREEN
	CALL PLCHAR(0,ITOP,'HIST#',5)			! WRITE HIST#
	CALL NUMBER(-1,ITOP,IHS)
	DO 10 J	= 1,60
10	IB(J)	= '  '
	CALL GTITL(IHS,IB,5)				! GET 5 WORD TITLE
	CALL GTITL(0,IB(15),5)
	CALL DATE(IB(30))				! GET DATE INTO ARRAY
	CALL TIME(IB(40))				! GET TIME
	CALL PLCHAR(140,ITOP,%DESCR(IB),48)		! WRITE DATE+ TIME
	CALL HSTAT(IHS,IXSIZ,IYSIZ,IXS,IX0,IYS,IY0,ITYPE)	! GET SIZES,SCALES
	ITYPE	= IAND("3,ITYPE)
	IJUMP	= 1
	IF(ITYPE .EQ. 2) IJUMP	= 2
	IF(IXSIZ .GT. 0) GO TO 20			! HIST EXISTS PLOT IT
	CALL HTITL(IHIS,IZMIN)				! HIST TITLES ON SCREEN
	GO TO 900					! EXIT

C
C	SECTION TO DETERMINE SCALES + RANGES
C
20	CONTINUE
	JXMIN	= (IXMIN-IX0)/IXS
	JXMAX	= (IXMAX-IX0)/IXS
	JYMIN	= (IYMIN-IY0)/IYS
	JYMAX	= (IYMAX-IY0)/IYS
	IF(IYMIN .EQ. 0 .AND. IYMAX .EQ. 0) JYMIN = IYSIZ
	IF(JXMIN .LT. 0)JXMIN	= 0
	IF(JYMIN .LT. 0)JYMIN	= 0
	IF(JXMAX .GE. IXSIZ)JXMAX	= IXSIZ-1
	IF(JYMAX .GE. IYSIZ)JYMAX	= IYSIZ-1
	IF(JXMIN+5 .LT. JXMAX) GO TO 25
	JXMIN	= 0
	JXMAX	= IXSIZ-1
25	IF(JYMAX .GE. JYMIN) GO TO 30
	JYMIN	= 0
	JYMAX	= IYSIZ-1
30	CONTINUE
	IF(JXMAX .GT. JXMIN+1023) JXMAX	= JXMIN+1023
	IY	= JYMAX-JYMIN			!NUMBER OF SWEEPS
	IX	= JXMAX-JXMIN
	JZMIN	= IZMIN
	JZMAX	= IZMAX
	IF(JZMIN .LT. JZMAX) GO TO 60		! If max,min are ok do not calc
	IF(IY .le. 3) go to 35			! If not 1 dim calculate
	IF(JZMIN .eq. 0) go to 35		! If min is zero calculate
	JZMAX	= 100000			! Set max
	GO TO 400				! Do 2 dim hist
35	JZMIN	= 100000
	JZMAX	= 0
	IN2	= 0
	K	= 1				!IF 2 D IGNORE OVERFLOW
	IF(IY .LE. 3) K	= 0			!1D SO NO 2D OVERFLOW
	DO 40 I	= JYMIN+K,JYMAX-K
	DO 40 J	= JXMIN+1,JXMAX-1
	CALL HGET(IHS,IN2,IJUMP*(I*IXSIZ+J)+1,IJUMP,ISZ)
	IF(IN2 .LT. JZMIN) JZMIN	= IN2
	IF(IN2 .GT. JZMAX) JZMAX	= IN2
40	CONTINUE
	IF(IY .GT. 3) JZMIN	= JZMAX/2
60	IF(IY .GT. 3) GO TO 400				!DO 2 DIM HIST

C
C	DO 1 DIMENSIONAL HIST
C
	IN2	= 0					!START WITH ZERO
	IMULT	= IY + 1				!NUMBER OF SWEEPS
	IBSTP	= 740/IMULT
	DO 90 I	= 1,2
	TEMP	= IMULT * (JZMAX - JZMIN)
	IF(TEMP .LT. 20.)TEMP	= 20.			!LIMIT MAX SCALE
	IS	= ALOG(TEMP)/.69314718 - 2.4512111	!(ALOG(TEMP)-ALOG(700))/ALOG(2) + 7
	IF(IS .GT. 25)IS	= 25
	JZMIN	= JZMIN/ISTPA(IS)
90	JZMIN	= JZMIN*ISTPA(IS)
	ISF	= 6 - IS				!NOW IS SHIFT FACTOR
	XSTEP	= 940/(IX+1)				!STEPS/BIN
	IF(XSTEP .LT. 3) XSTEP	= 1024/(IX+1)
	IXM	= XSTEP*(IX+1)
	DO  120  II	= JYMIN,JYMAX
	IF(IHIS .GT. 0 .AND. IYSIZ .GT. 1)
	1	CALL NUMBER(ITOP,IBASE+26,IY0+IYS*II)	!Y SCALE
	IXP	= 0					!X POSITION
	CALL PTPL(IXM,IBASE)				!START PLOT AT RH MARGIN
	IA(1)	= 0					!NEXT TO L HAND MARGIN
	IA(2)	= 0					!L HAND MARGIN
	IC(1)	= IBASE					!BOTTOM MARGIN
	IC(2)	= IBASE					!DRAWS A BASE LINE
	IPOINT	= 2
	ICHAN	= IJUMP * (JXMIN + II*IXSIZ) + 1
	DO 100 I	= JXMIN,JXMAX
	CALL HGET(IHS,IN2,ICHAN,IJUMP,ISZ)		!GET VALUES DESIRED
	ICHAN	= ICHAN + IJUMP
	IN2	= IN2 - JZMIN
	IF(IN2 .LT. 0)IN2	= 0
	IN2	= ISHFT(IN2,ISF) + IBASE		!Y VALUE
	IF(IN2 .GT. 800) IN2	= 800
	IF(IN2 .EQ. IC(IPOINT))GO TO 95
	IPOINT	= IPOINT + 1
	IA(IPOINT)	= IXP
	IC(IPOINT)	= IN2
	IPOINT	= IPOINT + 1
	IC(IPOINT)	= IN2
95	IXP	= IXP + XSTEP				!NEXT X LOCATION
	IA(IPOINT)	= IXP
	IF(IPOINT .LT.18) GO TO 100
	IPOINT	= IPOINT - 1
	CALL VECT(IA,IC,IPOINT)
	IA(1)	= IXP
	IC(1)	= IN2
	IPOINT	= 1
100	CONTINUE
	IPOINT	= IPOINT+1
	IA(IPOINT)	= IXP
	IC(IPOINT)	= IBASE
	CALL VECT(IA,IC,IPOINT)
120	IBASE	= IBASE + IBSTP
C
C	SET UP DATA FOR X,Y SCALES
C
	IBASE	= 32					!Y OFFSET
	IYM	= 690/IMULT
	YSTEP	= ISTPA(IS)				!STEP
	IYSTEP	= YSTEP/2.**(IS-6)
	IMULT	= IMULT - 1
	YORG	= JZMIN
	GO TO 600

C
C	DO 2 DIMENSIONAL HISTS HERE
C
400	CONTINUE
	IF(IHIS .LE. 0) GO TO 401
	CALL PLCHAR(800,ITOP,'CONTOUR ',0)
	IF(JZMIN .EQ. 0) JZMIN	= 1
	CALL NUMBER(-1,ITOP,JZMIN)
	CALL PLCHAR(-1,ITOP,',',1)
	CALL NUMBER(-1,ITOP,JZMAX)
401	IYSTEP	= 10
	IF(IX .GT. 64) IX	= 64
	IF(IY .GT. 50) IY	= 50
D	WRITE(5,*) IX,IY,IJUMP
	IF(JZMAX .lt. JZMIN) GO TO 505			! No hist to plot
	DO 500 IYP	= 0,IY
	MAX	= -1
	DO 490 IXP	= 0,IX
	I	= JXMIN + IXP + (JYMIN + IYP)*IXSIZ
	I	= IJUMP*I + 1
	CALL HGET(IHS,IN2,I,IJUMP,ISZ)
D	WRITE(5,*) I,IXP,IYP,IN2
	IB(IXP+1)	= ' '				! DEFALUT PLOT BLANK
	IF(IN2 .LT. JZMIN .OR. IN2 .GT. JZMAX) GO TO 490! outside contour ?
	IB(IXP+1)	= '*'				! POINT TO DISPLAY
	MAX	= IXP					! MAX POINT TO DISPLAY
490	CONTINUE
	IF(MAX .LT. 0)GO TO 500				! IF, NO POINTS TO PLOT
	I	= IYP*14 + IBASE
	CALL PLCHAR(0,I,%DESCR(IB),MAX+1)		! PLOT 1 LINE
500	CONTINUE
505	MAX	= IX + 1
	DO 510 J = 1,MAX
510	IB(J)	= ' '					! Get array of blanks
	CALL PLCHAR(0,0,%DESCR(IB),MAX)			! Plot it
	CALL	SCTEST(IS,IXM,IYP)
	IXM	= IXM + 1
	XSTEP	= FLOAT(IXM)/(MAX)
	IYM	= 14 * (IY + 1)
	IYP	= IBASE + IYM				! TOP OF FRAME
	IA(1)	= 0					! SET UP TO DRAW
	IA(2)	= IXM					! A FRAME AROUND
	IA(3)	= IXM					! THE 2 DIM HIST.
	IA(4)	= 0
	IA(5)	= 0
	IC(1)	= IBASE
	IC(2)	= IBASE
	IC(3)	= IYP
	IC(4)	= IYP
	IC(5)	= IBASE
	CALL VECT(IA,IC,-5)				! DRAW FRAME
	IYSTEP	= 70
	YORG	= IY0 + JYMIN*IXS
	YSTEP	= IYS * 5
	IMULT	= 0

C
C	NOW PUT UP THE X SCALE
C
600	CONTINUE
	XORG	= IX0 + JXMIN*IXS
	XSC	= IXS/XSTEP
	YSC	= YSTEP/FLOAT(IYSTEP)
	IF(IHIS .LT. 0) GO TO 900			!NO SCALES IF SIMPLE RETRACE
	IF(IX .GT. 200)GO TO 605
	XP	= 0
	DO 604 I	= 0,IX,20
	MAX	= IX - I + 1
	IF(MAX .GT. 20)MAX	= 20
	DO 603 J	= 1,MAX
	IC(J)	= IBASE - 4
	IA(J)	= XP + .5
603	XP	= XP + XSTEP
	CALL PTPL(IA,IC,MAX)
604	CONTINUE
605	DO 610 J	= 1,10
	ISTP	= ISTPA(J)				!TRY THIS FACTOR
	IF(ISTP*XSTEP .GT. 100) GO TO 630		!IT IS CORRECT
610	CONTINUE
630	CONTINUE
	DO 650 I	= 0,IX+1,ISTP
	IXP	= I*XSTEP + .5				!POSITION OF VERT LINE
	CALL PTPL(IXP,ITIC)
	CALL VECT(IXP,IBASE)
	IF(IXP .GT. 940) GO TO 650
	IN2	= I
	IN2	= XORG + IN2*IXS
	CALL NUMBR2(IXP+6,0,IN2)			!OUTPUT THE VALUE
650	CONTINUE
651	CONTINUE
C
C	PUT UP Y SCALES
C
	IF(IXM .GT. 1000) IXM	= 1000			!STARTING PT. OF TICS
	DO 700 II	= 0,IMULT
	IN2	= YORG
	DO 700 J	= 0,IYM,IYSTEP
	IYP	= J + IBASE + II*IBSTP
	CALL PTPL(IXM,IYP)
	CALL VECT(IXM+ITIC,IYP)				!HORIZ TIC
	CALL NUMBR2(IXM+ITIC+6,IYP+6,IN2)		!WRITE VALUE ON SCREEN
700	IN2	= IN2 + YSTEP				!NEXT VALUE TO WRITE

C
C	PUT UP MARKERS FOR CUTS
C
	YORG	= YORG - YSC*IBASE
	CALL	MGETA(0,MMAX,AX)		! Get the number of markers
	DO 800 I	= 1,MMAX		! Do all markers
	CALL	MGETA(I,J,AX)			!GET MARKER
	IF(ABS(J) .NE. IHS) GO TO 800		!IF NOT FOR THIS HIS 800
	CALL	MARKPL(I)
800	CONTINUE
C
C	HERE THE PLOTTING IS TERMINATED
C
900	CONTINUE
C	CALL	ENACKP				!ENABLE CHECKPOINT
	END					!EXIT FROM PROGRAM

	SUBROUTINE MARKPL(I)
C
C	SUBROUTINE TO PLOT MARKERS ON SCREEN
C
	COMMON	/MSCAL/XORG,XSC,YORG,YSC
	DATA IBASE/32/,ITIC/16/,ITOP/950/
	CALL	MGETA(I,J,VALUE)
	VAL	= VALUE
	IF(J .GT. 0) VALUE	= (VALUE - XORG)/XSC	! LOCATION ON SCREEN OF CURSOR
	IF(J .LE. 0) VALUE	= (VALUE - YORG)/YSC
	VALUE	= VALUE + .01
	IF(VALUE .LT. 0.)VALUE	= 0		! LIMIT POSITION TO SCREN SIZE
	IF(VALUE .GT. ITOP)VALUE	= ITOP	! RIGHT HAND LIMIT
	IF(J .LT. 0) GO TO 780
	IXP	= VALUE				! X POSITION OF VERT. TIC
	IYP	= 730
	CALL	PTPL(IXP,32)			! BOTTOM OF VERTICAL LINE
	GO TO 790
780	IYP	= VALUE				! DRAW A HORIZ MARKER
	IXP	= ITOP
	CALL	PTPL(0,IYP)			! START HORIZ MARKER
790	CALL	VECT(IXP,IYP)			! TOP
	CALL	NUMBER(IXP,IYP+4,I)		! WRITE MARKER NUMBER
	END

	SUBROUTINE HTITL(IHIS,IZMIN)
C
C	WRITE THE LIST OF HISTOGRAMS ON THE PLOT SCOPE
C
	CHARACTER	IB(80)
	INTEGER*2	IA(24)
	COMMON /SCRAT/IA,IB
	DATA	IROW/25/, ICOL/4/
	IMAX	= IROW*ICOL
	CALL	HSTAT(0,IXN,IHMAX)
	IYP	= 700
	IHMIN	= IHIS-IROW
	IF(IHIS .eq. 0) IHMIN	= IZMIN
	IF(IHMIN .GT. IHMAX) IHMIN	= IHMAX - IMAX
	IF(IHMIN .le. 0) IHMIN	= 1		! Min hist number
	IF(IHMAX-IHMIN .GE. IMAX) IHMAX	= IHMIN+IMAX-1
	IF(IHMAX .LE. 0) RETURN
	IMAX	= IHMIN + IROW-1
	IF(IMAX .gt. IHMAX) IMAX	= IHMAX
	DO 100 I	= IHMIN,IMAX		! DO IROW ROWS
	DO 10 J	= 1,24
10	IA(J)	= '_'				! FILL IN WITH DASHES
	DO 90 J	= 0,ICOL-1			! BY 4 COLUMNS
	IH	= I + IROW*J			! Hist number
	IF(IH .GT. IHMAX) GO TO 91		!  No more labels this line
	MAX	= 18 * J + 15
	CALL HSTAT(IH,IX)			! FIND OUT IF IT EXISTS
	IF(IX .NE. 0)CALL GTITL(IH,IA(6*J+2),5)	! GET REAL TITLE IF IT EXISTS
90	IA(6*J+1)	= IH
91	ENCODE(72,1000,IB) IA			! SET UP FOR OUTPUT
	CALL PLCHAR(28,IYP,%DESCR(IB),MAX)	! AND TITLE
	IYP	= IYP - 28
100	CONTINUE
1000	FORMAT( 4(I4,1X,5A2,3X) )
	END