Initial revision

2000-02-07 10:38:55 +00:00
commit fdc6b051c9
846 changed files with 230218 additions and 0 deletions
--- a/difrac/cfind.f
+++ b/difrac/cfind.f
@@ -0,0 +1,56 @@
+C-----------------------------------------------------------------------
+C  Subroutine to find the coarse centre for Chi
+C-----------------------------------------------------------------------
+      SUBROUTINE CFIND (TIM)
+      INCLUDE 'COMDIF'
+      DIMENSION TCOUNT(NSIZE)
+      EQUIVALENCE (ACOUNT(9*NSIZE+1),TCOUNT(1))
+      ICPSMX = 25000
+      STEPM  = 0.02
+      SENSE  = -1.0
+      CSTEP  = 0.25
+      NPTS   = 10
+      CHI = CHI + NPTS*CSTEP/2
+  100 IF (CHI .LT.   0) CHI = CHI + 360
+      IF (CHI .GE. 360) CHI = CHI - 360
+      CHISV = CHI
+  110 CALL ANGSET (THETA,OMEGA,CHISV,PHI,NATT,ICOL)
+      ICOUNT = 0
+      MCOUNT = 0
+      DO 120 I = 1,NPTS
+        CALL CTIME (TIM,TCOUNT(I))
+        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
+      IF (ICOUNT .EQ. 1) THEN
+        SENSE = -SENSE
+        CHI = CHI + 9*SENSE*CSTEP
+        GO TO 100
+      ELSE IF (ICOUNT .EQ. 10) THEN
+        CHI = CHI - 3*SENSE*CSTEP
+        GO TO 100
+      ENDIF
+      CHI = CHI + (ICOUNT - 12.25)*SENSE*CSTEP
+      IF(TCOUNT(ICOUNT) .GT. 0)THEN
+         TIM = 500.*TIM/TCOUNT(ICOUNT)
+      ELSE
+         TIM = 500 * TIM
+      ENDIF
+      IF (TIM .LT. 10000.0) THEN
+        IF (TIM .LT. 1000.) TIM =1000. 
+        CSTEP = CSTEP/4
+        IF (CSTEP .GT. STEPM) GO TO 100
+      ENDIF
+      CHI = CHI + 5*SENSE*CSTEP
+      RETURN
+      END