87 lines
2.9 KiB
Fortran
87 lines
2.9 KiB
Fortran
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
|