SUBROUTINE PEAK(ISW,IARRAY,IBSZ,ITHRSH,INIT,IPOS,IHIGHT,ISTAT,IZPS)
#
#
#	This routine will find a peak, provided that:
#	     a. The height of the peak exceeds a threshold that
#	        is given as a parameter. A threshold
#	        is the number of samples that consistantly produce
#	        a positive gradient after a THREE sample linear fit.
#
#
#
#	WARNING:
#
#	Do not attempt to overlay this routine.
#
#
#	PARAMETERS:
#
#	ISW	Input turn on diags
#	IARRAY	Input array of 256 real values of "Y".
#	IBSZ	Buffer size (multiple of 3 and .LE. 255)
#	ITHRSH	Input Number of +ve slopes before peak threshold.
#	INIT	Input Initialize all variables flag.
#	IPOS	Returned position of peak height.
#	IHIGHT	Returned Height of peak(integer).
#	ISTAT	0   = No peak start or end in block.
#		1   = Complete peak found (ipos,ihight returned)
#		2   = Peak rise encountered(latest ipos,ihight returned)
#		64+ = More than one peak in buffer. Call me
#		      again to receive next peak.
#		512+= Zero height peak, ipos and ihight refer
#		      to next peak found. "IZPS" is the number of
#		      zero height peaks estimated.
#              4096+= Peak height > full scale
#	IZPS	Number of zero height peaks (see ISTAT=512+).
#
#
	LOGICAL INIT,TOP,PSTART,ISW
	INTEGER THRESH,CI,FI,IARRAY(256),CIREJ,FIREJ
	DATA SLOPE/0./,IPS/0/
	DATA PSTART/.FALSE./,TOP/.FALSE./
#
#	Reset parameters
#
	IPOS=0
	IZPS=0
	IHIGHT=0
#
IC=ISTAT.AND.64
IF(IC.NE.64)
{
   IPT=0
   IREJ=ITHRSH/3
#
   IF (INIT)
{
      CI=0.
      FI=0.
      IPN=0
      GAP=0.
      GAPL=0
      IHL=0
      IH=0
      PSTART=.FALSE.
      IPSL=0
      TOP=.FALSE.
   }
}
ISTAT=ISTAT.AND.2   #Retain status of 2
#
#
# start of main processing loop
#
#
WHILE (IPT.LT.(IBSZ-2))
{
   IPT=IPT+1
   GAP=GAP+1.
   SLAST=SLOPE
   IF (PSTART)
   {
         IF (IARRAY(IPT).EQ."7777)ISTAT=ISTAT+4096
         IF (IARRAY(IPT).GT.IH)
         {
            IH=IARRAY(IPT)
            IP=IPT
         }
   }
#
#  Calculate the SLOPE of 3 points
#
   SLOPE=0.
   A1=0.;A2=0.;A3=0.;A4=0.
   DO I=1,3
   {
      AX=I
      A1=A1+AX*IARRAY(IPT+I-1)
      A2=A2+AX
      A3=A3+IARRAY(IPT+I-1)
      A4=A4+AX*AX
   }
   SLOPE=(3*A1-A2*A3)/(3*A4-A2*A2)
   IF(ISW)WRITE(5,(3I6,' SLOPE= ',F9.0))(IARRAY(I),I=IPT,IPT+2),SLOPE
#
   IF (SLOPE.GT.0.)
   {
      IF (SLAST.GT.0)
      {
         IF (.NOT.TOP)
         {
            CI=CI+1
            CIREJ=1+CI/IREJ
            IF(CIREJ.GT.3)CIREJ=3
            IF(ISW)WRITE(5,(' CI=',I3,' CIREJ=',I3))CI,CIREJ
            IF (CI.GE.ITHRSH)
            {
            ISTAT=ISTAT.OR.2
            }
         }             
         IF (CI.EQ.1) PSTART=.TRUE.
      }
      ELSE IF (CI.GE.ITHRSH)
           {
              IF (FI.GE.ITHRSH)
              {
                 ISTAT=1
                 PSTART=.FALSE.
                 IPN=IPN+1
                 CI=0
                 FI=0
                 CIREJ=0
                 FIREJ=0
                 TOP=.FALSE.
                 BREAK
              }
              ELSE
              {
              FIREJ=FIREJ-1
              IF (FIREJ.LE.0)FI=0
              ELSE SLOPE=0.-1.
              }
            }
            ELSE
            {
                 CI=0
                 IH=0
                 IHL=0
            }
   }
   ELSE 
        {
           IF (SLAST.LE.0)
           {
              IF (CI.GE.ITHRSH)
              {
                 FI=FI+1
                 FIREJ=1+FI/IREJ
                 IF(FIREJ.GT.3)FIREJ=3
                 IF(ISW)WRITE(5,(' FI=',I4,' FIREJ=',I4))FI,FIREJ
              }
           }
           ELSE IF (CI.LT.ITHRSH)
                {
                   CIREJ=CIREJ-1
                   IF (CIREJ.LE.0)
                   {
                      CI=0
                      IH=0
                      IHL=0
                      PSTART=.FALSE.
                   }
                   ELSE SLOPE=1.
                }
                ELSE TOP=.TRUE.
        }
}
#
#
# End of main processing loop
#
#
IC=ISTAT.AND.3
IF (IC.GT.0)
{
    IF (IH.GT.IHL)
    {
       GAPL=GAP
       IPOS=IP
       IHIGHT=IH
       IHL=IH
    }
}
IF (IC.EQ.1)
{
   IH=0
   IHL=0
   GAP=GAP-GAPL
   IF(IPN.EQ.2) GAP1=GAPL
   ELSE IF (IPN.GT.2)
        IF (GAPL.GT.(1.5*GAP1))
        {
           ISTAT=ISTAT.OR.512
           IZPS=GAPL/GAP1
           IF ((GAPL/GAP1-IZPS).LT..5)IZPS=IZPS-1
        }
}
#
IF (IPT.LT.(IBSZ-2))ISTAT=ISTAT.OR.64
ELSE GAP=GAP+2
#
#
RETURN
END