Initial revision

2000-02-07 10:38:55 +00:00
commit fdc6b051c9
846 changed files with 230218 additions and 0 deletions
--- a/difrac/pscan.f
+++ b/difrac/pscan.f
@@ -0,0 +1,86 @@
+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