Files
sics/difrac/sammes.f
cvs ff5e8cf0b2 - Improved centering in DIFRAC
- Fixed a bug in UserWait
- Improved scan message in scancom
- Added zero point correction in lin2ang
- fixed an issue with uuencoded messages
2000-04-06 12:18:53 +00:00

117 lines
4.1 KiB
Fortran

C-----------------------------------------------------------------------
C
C Subroutine to measure intensities to controlled precision.
C
C A sample scan is taken and from the results a decision is made
C on the further course of action to obtain a specified precision.
C A precision PA is defined as sigma(Inet)/Inet. Then :--
C 1. If Inet < 2sigma(Inet) no further measurement is done;
C 2. If precision PA has been acheived, no further measurement;
C 3. If PA has not been acheived, THEN
C a. if PA can be acheived in a time less than TMAX, then the
C necessary further scans are done,
C b. if PA cannot be acheived in TMAX, but a minimum precision PM
C can be if all of TMAX is used, then this is done,
C c. if PM cannot be acheived in TMAX, then no further measurement.
C The algorithm is described in D.F.Grant, Acta Cryst. 1973, A29, 217.
C
C On return :--
C the peak count is in COUNT, the backgrounds in BGRD1 & BGRD2,
C total number of scans in ITIME and attenuator number in NATT.
C
C-----------------------------------------------------------------------
SUBROUTINE SAMMES (ITIME,ICC)
COMMON/PREC/PCOUNT(500)
INCLUDE 'COMDIF'
C-----------------------------------------------------------------------
C Do the sample scan
C-----------------------------------------------------------------------
CALL MESINT (IROFL,ICC)
ITIME = 1
NPPTS = IDEL
TOTIME = PRESET
PK = COUNT
B1 = BGRD1
B2 = BGRD2
DO 100 N = 1,NPPTS + 10
PCOUNT(N) = ACOUNT(N)
100 CONTINUE
CALL PROFIL
TEMP = FRAC
IF (IPRFLG .EQ. 0) TEMP = FRAC1
C-----------------------------------------------------------------------
C Analysis of the sample counts.
C If the net count is < 2sigma(Inet) RETURN
C-----------------------------------------------------------------------
IF(TEMP .GT. 0) THEN
FACT = 1.0/(TEMP*2.0)
ELSE
FACT = 1.
ENDIF
ENQ = COUNT - (BGRD1 + BGRD2)*FACT
ENQD = ENQ - (2.0*SQRT(COUNT + (BGRD1 + BGRD2)*FACT*FACT))
IF (ENQD .LE. 0.0) RETURN
C-----------------------------------------------------------------------
C How many scans will be needed to attain precision PA ?
C-----------------------------------------------------------------------
NF = (COUNT + (BGRD1 + BGRD2)*FACT*FACT)/(ENQD*ENQD*PA*PA) + 0.5
IF (NF .LE. 1) THEN
RETURN
ELSE
TEMP = NF*PRESET
IF (TEMP .LE. TMAX) THEN
DO 120 I = 2,NF
CALL MESINT (IROFL,ICC)
DO 110 N = 1,NPPTS + 10
PCOUNT(N) = PCOUNT(N) + ACOUNT(N)
110 CONTINUE
TOTIME = TOTIME + PRESET
PK = PK + COUNT
B1 = B1 + BGRD1
B2 = B2 + BGRD2
CALL KORQ (KQFLAG)
IF (KQFLAG .EQ. 0) GO TO 200
120 CONTINUE
GO TO 200
ENDIF
ENDIF
C-----------------------------------------------------------------------
C PA cannot be acheived in TMAX.
C How many scans will be needed to attain precision PM ?
C-----------------------------------------------------------------------
NF = (COUNT + (BGRD1 + BGRD2)*FACT*FACT)/(ENQ*ENQ*PM*PM) + 0.5
IF (NF .LE. 1) THEN
RETURN
ELSE
TEMP = NF*PRESET
IF (TEMP .LE. TMAX) THEN
NF = TMAX/PRESET + 0.5
DO 140 I = 2,NF
CALL MESINT (IROFL,ICC)
DO 130 N = 1,NPPTS + 10
PCOUNT(N) = PCOUNT(N) + ACOUNT(N)
130 CONTINUE
TOTIME = TOTIME + PRESET
PK = PK + COUNT
B1 = B1 + BGRD1
B2 = B2 + BGRD2
CALL KORQ (KQFLAG)
IF (KQFLAG .EQ. 0) GO TO 200
140 CONTINUE
ENDIF
ENDIF
C-----------------------------------------------------------------------
C This is the end of all scans
C-----------------------------------------------------------------------
200 COUNT = PK
BGRD1 = B1
BGRD2 = B2
PRESET = TOTIME
ITIME = NF
DO 210 N = 1,NPPTS + 10
ACOUNT(N) = PCOUNT(N)
210 CONTINUE
RETURN
END