PSI sics-cvs-psi_pre-ansto

2003-06-13 00:00:00 +00:00
parent 2e3ddfb6c6
commit 3ffd0d8af4
1099 changed files with 318432 additions and 0 deletions
--- a/difrac/tfind.f
+++ b/difrac/tfind.f
@@ -0,0 +1,59 @@
+C-----------------------------------------------------------------------
+C  Find the Coarse setting for 2-Theta
+C-----------------------------------------------------------------------
+      SUBROUTINE TFIND (TIM, MAXCOUNT)
+      INCLUDE 'COMDIF'
+      REAL MAXCOUNT, MCOUNT
+      DIMENSION TCOUNT(NSIZE)
+      EQUIVALENCE (ACOUNT(9*NSIZE+1),TCOUNT(1))
+      STEPM = 0.01
+      SENSE = -1.0
+      TSTEP = 0.25
+      NATT = 0
+      NPTS = 10
+      NRUN = 0
+100   THEOFF = THETA
+      OMEOFF = OMEGA
+      CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICOL)
+      ICOUNT = 0
+      MCOUNT = 0
+      DO 110 I = 1,NPTS
+        CALL CCTIME (TIM,TCOUNT(I))
+        CALL KORQ (IFLAG1)
+        IF (IFLAG1 .NE. 1) THEN
+          KI = 'O4'
+          RETURN
+        ENDIF
+        IF (TCOUNT(I) .GT. MCOUNT) THEN
+          MCOUNT = TCOUNT(I)
+          ICOUNT = I
+        ENDIF
+        THETA = THETA + SENSE*TSTEP
+        OMEGA = OMEGA - SENSE*TSTEP*0.5
+        CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICOL)
+  110 CONTINUE
+      MAXCOUNT = MCOUNT
+      IF (ICOUNT .EQ. 1) THEN
+C 
+C try, the other direction. But only once as checked by NRUN
+C otherwise we end in an endless loop.
+C
+        IF (NRUN .GT. 0) THEN
+           MAXCOUNT = 0.
+           RETURN
+        ENDIF
+        SENSE = -SENSE
+        THETA = THEOFF + 9.0*SENSE*TSTEP
+        OMEGA = OMEOFF - 9.0*SENSE*TSTEP/2
+        NRUN = NRUN + 1
+        GO TO 100
+      ENDIF
+      IF (ICOUNT .EQ. 10) THEN
+        THETA = THEOFF - 3.0*SENSE*TSTEP
+        OMEGA = OMEOFF + 3.0*SENSE*TSTEP/2
+        GO TO 100
+      ENDIF
+      THETA = THEOFF + ICOUNT*SENSE*TSTEP
+      OMEGA = OMEOFF - ICOUNT*SENSE*TSTEP/2
+      RETURN
+      END