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
60 lines
1.6 KiB
Fortran
60 lines
1.6 KiB
Fortran
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
|