     	SUBROUTINE BARPLT_PLOT
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY
C
C	THIS ROUTINE CARRIES OUT THE PLOTTING FOR HISTOGRAM PLOT.
C
     	INCLUDE 'BARPLT.CBS'

     	IF( YINC.EQ.0.0 ) THEN
     	    IF( IF_DCL_HARDCOPY() ) THEN
     		STOP '%BARPLT_PLOT: data scaling failure.'
     	    ELSE
     		CALL IFANSI_VIDEO(70)
     		WRITE(6,1000)
 1000		FORMAT(' oops: data scaling failure.')
     		RETURN
     	    ENDIF
     	ENDIF
C
C  INITIALIZE THE CRT...
C
     	CALL IFANSI_VIDEO(47)
     	CALL IFINIT_LINE( 3 )
     	IF( INIT ) THEN
     	    CALL IFINIT_PLOT( XORG, YORG, DATNAM )
     	ELSE
     	    CALL IFINIT_PLOT( XORG, YORG, '$OVERLAY' )
     	ENDIF
     	IF( IFCTRL_C() ) GOTO 999
C
C  OPEN A GRAPHICS SEGMENT TO SAVE THE PLOT...
C
     	IF( .NOT.IFINIT_SAVE() ) RETURN
     	IF( .NOT.IF_DCL_HARDCOPY() ) WRITE(6,1)
  1	FORMAT('$Press CTRL/C to cancel plotting...')
     	CALL IFINIT_DIF(0)
     	CALL IFSCAL( XSCL, YSCL )
     	CALL IFINIT_DIF(1)
C
C  DRAW GRAPH TITLE IF ANY...
C
     	IF( TITL(1).NE.' ' ) THEN
     	    CALL IFSPEN(1)
     	    CALL IFTEXT_CENT(0.,ABS(XLNS),-1.,-1.,TITL(1),.15,.15)
     	ENDIF
C
C  DRAW THE Y-AXIS ...
C
     	IF( YLNS.GT.0.0 ) THEN
     	    CALL IFSPEN( IAXS ) 
     	    CALL IFAXIS( LAXS+3, ABS(XLNS), YLNS, TITL(3),
     +      YLOW, YINC, OFFS, NTKS, MTKS, NDGS, IGDS )
     	ENDIF
C
C  PUT ON THE BARS ...
C
     	IF( IFCTRL_C() ) GOTO 999
    	CALL BARPLT_DRAW
C
C  DRAW THE X-AXIS ...
C
     	IF( IFCTRL_C() ) GOTO 999
     	CALL BARPLT_XAXIS
C
C  CLOSE THE PLOT SESSION...
C
  555	CALL IFSTYL( 1, 1 )			!RESET PLOTTING STYLUS
     	IF( CRT.EQ.2 ) CALL IFSEG_OPEN( 0 ) 	!CLOSE THE SEGMENT
C
C  OVERLAY THE LAYOUT IF LAYOUT FILE EXISTS...
C
     	IF( IFCTRL_C() ) GOTO 999
    	IF( DESNAM.NE.' ' ) CALL LAYOUT_MAIN(0,XORG,YORG,DESNAM)
  999	CALL IFINIT_PLOT_END
     	RETURN
    	END

     	SUBROUTINE BARPLT_XAXIS
C
C	THIS ROUTINE DRAWS THE X-AXIS FOR HISTOGRAM PLOT,
C	WHICH IS POSITIONED AT Y=0.0 IF Y-AXIS SCALE ALLOWS.
C
     	INCLUDE 'BARPLT.CBS'
C
C  DRAW THE STRAIGHT LINE...
C
     	CALL IFSPEN( IAXS )
     	IF( LAXS.EQ.1 .AND. YLOW*YHIG.LT.0.0 ) THEN
     	    YPS = (YHIG-YLOW) / (ABS(YLNS)-2.0*OFFS)
     	    YPS = ABS(YLOW/YPS) + OFFS
     	    CALL IFPLOT(       0.0, YPS, 3 )
     	    CALL IFPLOT( ABS(XLNS), YPS, 2 )
     	    CALL IFPLOT(       0.0, YPS, 2 )
     	ENDIF
     	IF( XLNS.GT.0.0 ) THEN
     	    YPS = 0.0
     	    IF( ABS(YHIG).LT.ABS(YLOW) ) YPS = ABS(YLNS)
     	    CALL IFPLOT(  0.0, YPS, 3 )
     	    CALL IFPLOT( XLNS, YPS, 2 )
     	    CALL IFPLOT(  0.0, YPS, 2 )
     	    IF( YPS.EQ.0.0 ) THEN
     		YPS = -0.55
     	    ELSE
     		IF( PBAR.EQ.1 ) THEN
     		    YPS = YPS + 0.45
     		ELSE
     		    YPS = YPS + 0.25
     		ENDIF
     	    ENDIF
     	    IF( TITL(2).NE.' ' ) CALL IFTEXT_CENT(0.,XLNS,YPS,YPS,
     +      TITL(2),.12,.12)
     	ENDIF

     	RETURN
     	END

    	SUBROUTINE BARPLT_DRAW
C
C	THIS ROUTINE DRAWS THE BARS...
C
     	INCLUDE 'BARPLT.CBS'
     	COMMON/BARPLT_DRAW_ID/ XXX,YYY, LMX
     	COMMON/GRAFIT_SCRATCH/ XPS(MNP), YPS(MNP), YSP(MNP), YMX(MNP)
C
C  GET Y-AXIS SCALE WINDOW...
C
     	YDL = BARPLT_LIMIT( YLO, YHI )
     	IF( LAXS.EQ.2 ) THEN
     	    YLOL = 10.0**YLO
     	    YHIL = 10.0**YHI
     	ENDIF
     	YRL = 0.0			!BAR REFERENCE LINE
     	IF( YLO*YHI.GT.0.0 ) THEN
     	    YRL = YLO
     	    IF( ABS(YHI).LT.ABS(YLO) ) YRL = YHI
     	ENDIF
C
C  OFFSET FROM ORIGIN IF SPECIFIED...
C
     	IF( BARD.GT.0.0 ) CALL IFPLOT( BARD, 0.0, -9 )
C
C  INITIALIZE CUMMULATIVE BAR POSITION RECORDS...
C
     	WBAR = BARW(1) + SPAC
     	IF( SIDE.EQ.1 ) THEN
     	    DO  I=2, NSET
     		WBAR = WBAR + BARW(I)
     	    ENDDO
     	ENDIF
     	BASE = (YRL-YLO)/YDL
     	IF( YDL.LT.0.0 ) BASE = ABS(YLNS)+BASE
     	DO  I=1, NBAR
     	    XPS(I) = (I-1)*WBAR
     	    YPS(I) = BASE
     	    YSP(I) = BASE
     	    YMX(I) = BASE
     	ENDDO
C
C  START THE DATA SET LOOP...
C
     	XXX = XLPS + 0.40 - BARD
     	YYY = YLPS + 0.15
     	LMX = 0
     	DO 888  IB=1, NSET
C
C  GET THE ACTUAL PLOT SEQUENCE OF THE DATA SET...
C
     	DO  IK=1, NSET
     	    IF( ISEQ(IK).EQ.IB ) GOTO 111
     	ENDDO
     	GOTO 888
 111	IF( IPEN(IK).EQ.0 ) GOTO 888
C
C  DRAW THIS SET OF BARS...
C
     	CALL IFSPEN( IPEN(IK) )
     	CALL IFSTYL( ILIN(IK), IBOL(IK) )
     	JPAT = IPAT(IK)
     	WBAR = BARW(IK)
     	OFFX = XOFF(IK)
     	OFFY = YOFF(IK)
     	SBAR = BARS(IK)
     	DO  IC=1, NBAR
     	IF( IFCTRL_C() ) RETURN
     	    BARH = Y(IC,IK)*SBAR
     	    IF( BARH.EQ.0.0 ) GOTO 777
     	    IF( LAXS.EQ.2 ) THEN
     		IF( BARH.LT.YLOL ) BARH = YLOL
     		IF( BARH.GT.YHIL ) BARH = YHIL
     		BARH = LOG10(BARH)
     	    ENDIF
     	    IF( BARH.LT.YLO ) BARH = YLO
     	    IF( BARH.GT.YHI ) BARH = YHI
     	    BARH = (BARH-YRL)/YDL
     	    HBAR = ABS(BARH)
     	    IF( HBAR.LT.0.02 ) GOTO 777
     		XPOS = OFFX + XPS(IC) + 0.5*WBAR
     	    IF( SIDE.EQ.1 ) THEN
     		YPOS = OFFY + YPS(IC) + 0.5*BARH
     	    ELSE
     		IF( BARH.GT.0.0 ) THEN
     		    YPOS = OFFY + YPS(IC) + 0.5*BARH
     		ELSE
     		    YPOS = OFFY + YSP(IC) + 0.5*BARH
     		ENDIF
     	    ENDIF
     	    IF( JPAT.NE.0 ) CALL IFFILL( JPAT )
     	    CALL IFBARS( XPOS, YPOS, WBAR, HBAR, 0.0, 0.0 )
     	    IF( JPAT.NE.0 ) CALL IFFILL( 0 )
  777	    IF( SIDE.EQ.1 ) THEN
     		XPS(IC) = XPS(IC)+WBAR
     		IF( PBAR.EQ.2 ) THEN
     		    HBAR = YPS(IC) + BARH
     		    IF(BARH.GT.0..AND.HBAR.GT.YMX(IC)) YMX(IC) = HBAR
     		    IF(BARH.LT.0..AND.HBAR.LT.YSP(IC)) YSP(IC) = HBAR
     		ENDIF
     	    ELSE
     		IF( BARH.GT.0.0 ) THEN
     		    YPS(IC) = YPS(IC) + BARH
     		ELSE
     		    YSP(IC) = YSP(IC) + BARH
     		ENDIF
     	    ENDIF
     	ENDDO
C
C  DRAW DATA SET LABEL...
C
     	IF( DRAW.GT.0 .AND. LABL(IK).NE.' ' ) CALL BARPLT_DRAW_ID(IK)
888	CONTINUE
C
C  DRAW GROUP BAR LABEL "X(I)"...
C
     	IF( PBAR.GT.0 ) CALL BARPLT_DRAW_LABEL( BASE )
     	IF( BARD.GT.0.) CALL IFPLOT( -BARD, 0.0, -9 )
C
C  BOX THE DATA SET LABEL IF REQUIRED...
C
     	IF( DRAW.EQ.2 ) THEN
     	    WBAR = XLPS + LMX*0.1 + 0.9
     	    YYY  = YYY + 0.05
     	    CALL IFSPEN( IAXS )
     	    CALL IFPLOT( XLPS, YLPS, 3 )
     	    CALL IFPLOT( XLPS,  YYY, 2 )
     	    CALL IFPLOT( WBAR,  YYY, 2 )
     	    CALL IFPLOT( WBAR, YLPS, 2 )
     	    CALL IFPLOT( XLPS, YLPS, 2 )
     	ENDIF
     	
     	RETURN
     	END

     	SUBROUTINE BARPLT_DRAW_ID( IK )
C
C	THIS ROUTINE DRAWS DATA SET ID LABEL.
C
     	COMMON/BARPLT_DRAW_ID/ XXX,YYY, LMX
     	INCLUDE 'BARPLT.CBS'

     	JK  = IK
     	NCH = IFMISC_LENG( LABL(JK) )
     	IF( NCH.GT.LMX ) LMX = NCH
     	BARH = BARW(JK)
     	IF( BARH.GT.0.15 ) BARH = 0.15
     	JPAT = IPAT(JK)
     	IF( JPAT.NE.0 ) CALL IFFILL( JPAT )
     	CALL IFBARS( XXX, YYY+0.5*BARH, 0.5, BARH, 0.0, 0.0 )
     	IF( JPAT.NE.0 ) CALL IFFILL( 0 )
     	CALL IFTEXT_EXT(XXX+.4,YYY+.5*BARH-.05,LABL(JK),.1,.1,0.0)
     	YYY = YYY + 0.25

     	RETURN
     	END

     	SUBROUTINE BARPLT_DRAW_LABEL( BS )
C
C	THIS ROUTINE DRAWS BAR GROUP LABEL "X(I)".
C
     	INCLUDE 'BARPLT.CBS'
     	COMMON/GRAFIT_SCRATCH/ XPS(MNP), YPS(MNP), YSP(MNP), YMX(MNP)

     	BASE = BS
     	IF( PBAR.EQ.2 ) THEN
     	    IF( SIDE.EQ.2 ) THEN
     		DO  I=1, NBAR
     		    IF( YSP(I).NE.BASE ) YMX(I) = YSP(I)
     		    IF( YPS(I).NE.BASE ) YMX(I) = YPS(I)
     		ENDDO
     	    ELSE
     		DO  I=1, NBAR
     		    IF( YMX(I).EQ.BASE ) YMX(I) = YSP(I)
     		ENDDO
     	    ENDIF
     	ENDIF
     	WBAR = BARW(1)
     	IF( SIDE.EQ.1 ) THEN
     	    DO  I=2, NSET
     		WBAR = WBAR + BARW(I)
     	    ENDDO
     	ENDIF
     	IF( PBAR.EQ.1 ) THEN
     	    IF( BASE.LT.ABS(YLNS)-0.1 ) THEN
     		BARH = -0.25
     	    ELSE
     		BARH = ABS(YLNS)+0.1
     	    ENDIF
     	ENDIF
     	CALL IFSPEN( IAXS )
     	DO  I=1, NBAR
     	    IF( X(I).NE.' ' ) THEN
     		IF( PBAR.EQ.2 ) THEN
     		    BARH = YMX(I)
     		    IF( BASE.LT.BARH ) THEN
     			BARH = BARH + 0.05
     		    ELSE
     			BARH = BARH - 0.15
     		    ENDIF
     		ENDIF
     		IF( SIDE.EQ.1 ) THEN
     		    XL = XPS(I) - WBAR - SPAC
     		    XR = XPS(I) + SPAC
     		ELSE
     		    XL = XPS(I) - SPAC
     		    XR = XPS(I) + WBAR + SPAC
     		ENDIF
     		CALL IFTEXT_CENT( XL, XR, BARH, BARH, X(I), 0.1, 0.1 )
     	    ENDIF
     	ENDDO
     	RETURN
     	END

    	FUNCTION BARPLT_LIMIT( YLO, YHI )
C
C	THIS ROUTINE CALCULATES SCALE WINDOW OF A HISTOGRAM PLOT
C	BECAUSE OF POSSIBLE OFFSETS OF THE 1ST MAJOR TICKMARKS.
C
C	YLO,YHI: WINDOW LIMIT ON Y-AXIS.
C	RETURN WITH AXIS SCALE INCREMENT PER INCH.
C
     	INCLUDE 'BARPLT.CBS'

     	IF( LAXS.EQ.1 ) THEN
     	    YDL = (YHIG-YLOW) / (ABS(YLNS)-2.0*OFFS)
     	    YLO = YLOW - YDL*OFFS
     	    YHI = YHIG + YDL*OFFS
     	ELSE
    	    YDL = LOG10(YHIG/YLOW) / (ABS(YLNS)-2.0*OFFS)
    	    YLO = LOG10(YLOW) - YDL*OFFS
    	    YHI = LOG10(YHIG) + YDL*OFFS
     	ENDIF
     	BARPLT_LIMIT = YDL
    	IF( YLO.GT.YHI ) THEN
    	    YDL = YLO
    	    YLO = YHI
    	    YHI = YDL
    	ENDIF

     	RETURN
    	END

