PSI sics-cvs-psi_pre-ansto

difrac/sammes.f

@@ -0,0 +1,116 @@
+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
+