C-----------------------------------------------------------------------
C  This subroutine scans Phi from 0 to 360 and extracts possible peaks
C-----------------------------------------------------------------------
      SUBROUTINE PSCAN (NMAX,NTOT,SPRESET)
      INCLUDE 'COMDIF'
      DIMENSION PHIP(40),PCOUNT(40)
      EQUIVALENCE (BCOUNT(1),PHIP(1))
      NMAX = 0
      KI = ' '
      N5= 5*NSIZE
C-----------------------------------------------------------------------
C  Start Phi, high speed, + sense
C-----------------------------------------------------------------------
      ACOUNT(N5) = 0
      CALL ANGET (RTHETA,ROMEGA,RCHI,RPHI)
      CALL RPSCAN (NPTS,ICOL,SPRESET)
      IF (ICOL .NE. 0) THEN
         WRITE (COUT,10000)
         CALL GWRITE (ITP,' ')
         IF (KI .EQ. 'RP') KI = ' '
         RETURN
      ENDIF 
C-----------------------------------------------------------------------
C  Look for peaks in the profile: if a given count is more than 4 sigmas
C  above the average of the 3 counts before and the 3 counts after it,
C  it is a probably a peak.  This may be a little weak -- try 8 sigmas
C  for now.
C-----------------------------------------------------------------------
      I = NPTS 
      DO 110 J = 1,I 
        INDZ = MOD((J + I - 4),I) + 1
        SUM = 0
        DO 100 KA = 1,7
          IF (KA .NE. 4) SUM = SUM + ACOUNT(INDZ)
          INDZ = INDZ + 1
          IF (INDZ .GT. I) INDZ = 1
  100   CONTINUE
        AVECT = SUM/6.0
        THRESH = AVECT + 4.0*SQRT(AVECT/6.0 + ACOUNT(J))
        IF (ACOUNT(J) .GT. THRESH) THEN
          NMAX = NMAX + 1
          PHIP(NMAX) = ACOUNT(J+N5)
          PCOUNT(NMAX) = ACOUNT(J)
        ENDIF
  110 CONTINUE
C-----------------------------------------------------------------------
C  Eliminate duplicate peaks
C-----------------------------------------------------------------------
      IPFLAG = 0
      IF (NMAX .GT. 1) THEN
        DO 120 I = 1,NMAX-1
          IF (ABS(PHIP(I) - PHIP(I+1)) .LT. 2.5) THEN
            IPFLAG = 1
            IF (PCOUNT(I) .LT. PCOUNT(I+1)) THEN
              PCOUNT(I) = - PCOUNT(I)
            ELSE
              PCOUNT(I+1) = - PCOUNT(I+1)
            ENDIF
          ENDIF
  120   CONTINUE
        IF (IPFLAG .NE. 0) THEN
          J = 0
          DO 130 I = 1,NMAX
            IF (PCOUNT(I) .GT. 0) THEN
              J = J + 1
              PCOUNT(J) = PCOUNT(I)
              PHIP(J) = PHIP(I)
            ENDIF
  130     CONTINUE
          NMAX = J
        ENDIF
      ENDIF
      IF (NMAX .GT. 0) THEN
        NPEAK = NTOT
        DO 140 I = 1,NMAX
         NPEAK = NPEAK + 1
          WRITE (COUT,11000) NPEAK,RTHETA,ROMEGA,RCHI,PHIP(I),PCOUNT(I)
          CALL GWRITE (ITP,' ')
          WRITE (LPT,11000) NPEAK,RTHETA,ROMEGA,RCHI,PHIP(I),PCOUNT(I)
  140   CONTINUE
      ENDIF
      IF (KI .EQ. 'RP') KI = ' '
      RETURN
10000 FORMAT (1X,' Scan error in PSCAN')
11000 FORMAT (10X,I4,4F10.2,F10.0)
      END
