714b8ae84d
- Fixed many things in DIFRAC subsystem:
* Recoded tcentr.f etc so that the course centering will work and will not
go into an endless loop.
* fixed boundary overwrites which occurred when yesno or alfnum where
uset to get a single character and several were given.
* Addeded documentation for DIFRAC
- Added tcl-files which support the WWW status system
64 lines
1.8 KiB
Fortran
64 lines
1.8 KiB
Fortran
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
|