PSI sics-cvs-psi_pre-ansto

difrac/cfind.f

@@ -0,0 +1,63 @@
+C-----------------------------------------------------------------------
+C  Subroutine to find the coarse centre for Chi
+C-----------------------------------------------------------------------
+      SUBROUTINE CFIND (TIM,MAXCOUNT)
+      INCLUDE 'COMDIF'
+      REAL MAXCOUNT, MCOUNT
+      DIMENSION TCOUNT(NSIZE)
+      EQUIVALENCE (ACOUNT(9*NSIZE+1),TCOUNT(1))
+      ICPSMX = 25000
+      STEPM  = 0.02
+      SENSE  = -1.0
+      CSTEP  = 1.5
+      NPTS   = 10
+      NRUN = 0
+  100 IF (CHI .LT.   0) CHI = CHI + 360
+      IF (CHI .GE. 360) CHI = CHI - 360
+      CHI = CHI + NPTS*CSTEP/2
+      CHISV = CHI
+  110 CALL ANGSET (THETA,OMEGA,CHISV,PHI,NATT,ICOL)
+      ICOUNT = 0
+      MCOUNT = 0
+      DO 120 I = 1,NPTS
+        CALL CCTIME (TIM,TCOUNT(I))
+        CALL KORQ (IFLAG1)
+        IF (IFLAG1 .NE. 1) THEN
+          KI = 'O4'
+          RETURN
+        ENDIF
+        IF (TCOUNT(I)/TIM .GT. ICPSMX .AND. NATT .LT. NATTEN) THEN
+          NATT = NATT + 1
+          GO TO 110
+        ENDIF
+        IF (TCOUNT(I) .GT. MCOUNT) THEN
+          MCOUNT = TCOUNT(I)
+          ICOUNT = I
+        ENDIF
+        CHI = CHI + SENSE*CSTEP
+        IF (CHI .LT.   0) CHI = CHI + 360
+        IF (CHI .GE. 360) CHI = CHI - 360
+        CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICOL)
+  120 CONTINUE
+      MAXCOUNT = REAL(MCOUNT)
+      IF (ICOUNT .EQ. 1) THEN
+C
+C try the other direction, but only once otherwise we get into an 
+C endless loop
+C
+        IF(NRUN .GT. 0) THEN
+           MAXCOUNT = 0.
+           RETURN
+        ENDIF
+        SENSE = -SENSE
+        CHI = CHISV + 9*SENSE*CSTEP
+        NRUN = NRUN + 1
+        GO TO 100
+      ELSE IF (ICOUNT .EQ. 20) THEN
+        CHI = CHISV - 3*SENSE*CSTEP
+        GO TO 100
+      ENDIF
+C      CHI = CHI + (ICOUNT - 12.25)*SENSE*CSTEP
+      CHI = CHISV + ICOUNT*SENSE*CSTEP
+      RETURN
+      END