*
* $Id: histey.F,v 1.1.1.1 1996/03/22 16:42:47 mclareni Exp $
*
* $Log: histey.F,v $
* Revision 1.1.1.1  1996/03/22 16:42:47  mclareni
* Phtools
*
*
      SUBROUTINE HISTEY(XLO1, MXBIN1, XINT1, BINOUT, ERROUT)
C--  CALLED FROM - FOWLPR
C --  PURPOSE - PRINTS THE PRETTY HISTOGRAMS
      COMMON/ TAPES / NTPNCH   ,NTPBIN   ,NTPCSL
      DIMENSION BINOUT(125), ERROUT(125), XOUT(81)
      DATA CROSS, BLANK, ZERO, AXIS / 1HX , 1H  , 1H0 , 1HI /
      BMAX = 0.0
      NL2 = MXBIN1 + 2
      MXBIN2 = MXBIN1 + 1
      BMIN = 0.0
      DO 100 IK= 2, MXBIN2
      BMIN = MIN (BMIN,BINOUT(IK))
  100 BMAX = MAX (BMAX, BINOUT(IK))
      IF(BMAX.EQ.BMIN) BMAX = 1.0
      BMAMI = 1.0/(BMAX-BMIN)
      IZERO = INT(80.0*ABS(BMIN)*BMAMI) + 1
      WRITE(6,5001)
      NQUIT = 0
      XUP2 = XLO1
      IF(BINOUT(1).NE.0.) WRITE(6,5002)XLO1,BINOUT(1),ERROUT(1)
      WRITE(6,5003)
      DO 180 IBIN= 2, MXBIN2
      DO 150  IK= 1, 81
  150 XOUT(IK) = BLANK
      Y = BINOUT(IBIN)
      NCROSS= INT(80.0*ABS(Y-BMIN)*BMAMI) + 1
      IF(NCROSS.EQ.IZERO) GOTO 165
      NX1 = MIN(NCROSS,IZERO)
      NX2 = MAX(NCROSS,IZERO)
C*UL  155 DO 157  IK= NX1,NX2
      DO 157  IK= NX1,NX2
      XOUT(IK) = CROSS
      NDIFF = ABS(IK-IZERO)
      IF(MOD(NDIFF,10).EQ.0) XOUT(IK) = ZERO
  157 CONTINUE
  165 CONTINUE
      XOUT(IZERO) = AXIS
      XLO2 = XUP2
      XUP2 = XLO2 + XINT1
      IF(XLO2) 167,168,167
  167 CONTINUE
      IF(ABS(XUP2/XLO2).LT.0.0001) XUP2 = 0.0
  168 CONTINUE
      IF(Y) 175,169,175
  169 CONTINUE
      IF(NQUIT.LE.0) GOTO 180
      DO 170 IQ= IBIN, MXBIN2
      IF(BINOUT(IQ)) 175,170,175
  170 CONTINUE
      GOTO 190
  175 NQUIT = 1
      ERRST = ERROUT(IBIN)
      WRITE(6,5003)XLO2,XUP2,Y,ERRST,XOUT
      XLO2 = XUP2
  180 CONTINUE
  190 CONTINUE
      M = NL2
      XLO2 = XLO1 + MXBIN1*XINT1
      IF(BINOUT(M).NE.0.) WRITE(6,5004)XLO2,BINOUT(M),ERROUT(M)
      WRITE(6,5003)
      RETURN
 5001 FORMAT('+',8X,'INTERVAL',8X,'EVENTS',5X,'ERROR'/' S',20('-'),
     + 2(3X,7(1H-)))
 5002 FORMAT('      BELOW',E11.3, 2F10.6)
5003  FORMAT(1X,E10.3,E11.3,2F10.6,5X,81A1)
 5004 FORMAT(1X/11X,'ABOVE',E11.3,2F10.6//)
      END
