Initial revision
This commit is contained in:
cvs
138
difrac/demo1e.f
Normal file
138
difrac/demo1e.f
Normal file
@@ -0,0 +1,138 @@
|
||||
C-----------------------------------------------------------------------
|
||||
C Subroutine to demonstrate the operations of the diffractometer.
|
||||
C-----------------------------------------------------------------------
|
||||
SUBROUTINE DEMO1E
|
||||
INCLUDE 'COMDIF'
|
||||
C-----------------------------------------------------------------------
|
||||
C Print the header and wait 3 seconds
|
||||
C-----------------------------------------------------------------------
|
||||
WRITE (COUT,10000)
|
||||
CALL GWRITE (ITP,' ')
|
||||
DELAY = 3.0
|
||||
C-----------------------------------------------------------------------
|
||||
C Move 2Theta
|
||||
C-----------------------------------------------------------------------
|
||||
CALL CTIME (DELAY,COUNT)
|
||||
CALL ANGET (THETA,OMEGA,CHI,PHI)
|
||||
THETA = THETA + 20.0
|
||||
CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICOL)
|
||||
C-----------------------------------------------------------------------
|
||||
C Move Omega
|
||||
C-----------------------------------------------------------------------
|
||||
WRITE (COUT,11000)
|
||||
CALL GWRITE (ITP,' ')
|
||||
CALL CTIME (DELAY,COUNT)
|
||||
OMEGA = OMEGA - 20.0
|
||||
CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICOL)
|
||||
C-----------------------------------------------------------------------
|
||||
C Move Chi
|
||||
C-----------------------------------------------------------------------
|
||||
WRITE (COUT,12000)
|
||||
CALL GWRITE (ITP,' ')
|
||||
CALL CTIME (DELAY,COUNT)
|
||||
CHI = CHI + 20.0
|
||||
IF (CHI .GE. 360.0) CHI = CHI - 360.0
|
||||
CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICOL)
|
||||
C-----------------------------------------------------------------------
|
||||
C Move Phi
|
||||
C-----------------------------------------------------------------------
|
||||
WRITE (COUT,13000)
|
||||
CALL GWRITE (ITP,' ')
|
||||
CALL CTIME (DELAY,COUNT)
|
||||
PHI = PHI + 30.0
|
||||
IF (PHI .GE. 360.0) PHI = PHI - 360.0
|
||||
CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICOL)
|
||||
C-----------------------------------------------------------------------
|
||||
C Move all circles
|
||||
C-----------------------------------------------------------------------
|
||||
WRITE (COUT,14000)
|
||||
CALL GWRITE (ITP,' ')
|
||||
CALL CTIME(DELAY,COUNT)
|
||||
THETA = THETA - 20.0
|
||||
OMEGA = OMEGA + 20.0
|
||||
CHI = CHI - 20.0
|
||||
PHI = PHI - 30.0
|
||||
CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICOL)
|
||||
C-----------------------------------------------------------------------
|
||||
C Operate the shutter
|
||||
C-----------------------------------------------------------------------
|
||||
WRITE (COUT,15000)
|
||||
CALL GWRITE (ITP,' ')
|
||||
DO 110 I = 1,10
|
||||
DO 100 J = 1,100
|
||||
DJUNK = SQRT(1.0)
|
||||
100 CONTINUE
|
||||
110 CALL SHUTTR (1)
|
||||
C-----------------------------------------------------------------------
|
||||
C Operate the attenuator
|
||||
C-----------------------------------------------------------------------
|
||||
WRITE (COUT,16000)
|
||||
CALL GWRITE (ITP,' ')
|
||||
DO 120 NAT = 1,6
|
||||
IAT = MOD(NAT,6)
|
||||
CALL ANGSET (THETA,OMEGA,CHI,PHI,IAT,ICOL)
|
||||
120 CONTINUE
|
||||
C-----------------------------------------------------------------------
|
||||
C Count for 5 seconds
|
||||
C-----------------------------------------------------------------------
|
||||
WRITE (COUT,17000)
|
||||
CALL GWRITE (ITP,' ')
|
||||
DELAY = 5.0
|
||||
DO 140 I = 1,5
|
||||
DO 130 J = 1,100
|
||||
DJUNK = SQRT(1.0)
|
||||
130 CONTINUE
|
||||
CALL CTIME (DELAY,COUNT)
|
||||
140 CONTINUE
|
||||
CALL SHUTTR (-1)
|
||||
C-----------------------------------------------------------------------
|
||||
C Header for line profile done by LINPRF
|
||||
C-----------------------------------------------------------------------
|
||||
WRITE (COUT,18000)
|
||||
CALL GWRITE (ITP,' ')
|
||||
DO 150 I = 1,300
|
||||
DJUNK = SQRT(1.0)
|
||||
150 CONTINUE
|
||||
CALL LINPRF
|
||||
WRITE (COUT,20000)
|
||||
CALL GWRITE (ITP,' ')
|
||||
CALL INDMES
|
||||
WRITE (COUT,21000)
|
||||
CALL GWRITE (ITP,' ')
|
||||
LPT = ISTAN
|
||||
WRITE (COUT,22000)
|
||||
CALL GWRITE (ITP,' ')
|
||||
KI = ' '
|
||||
RETURN
|
||||
10000 FORMAT (///,10X,'Demonstration of the National Research Council',
|
||||
$ ' Diffractometer',///,
|
||||
$ 6X,'An automatic diffractometer measures the X-ray',
|
||||
$ ' diffraction intensities',/,
|
||||
$ ' of crystals using a scintillation counter.',/,
|
||||
$ ' Its computer controls 4 angles.',/,
|
||||
$ ' Please watch the instrument, it will operate',/,
|
||||
$ 3X,'-- The 2-Theta Circle')
|
||||
11000 FORMAT (3X,'-- The Omega Circle')
|
||||
12000 FORMAT (3X,'-- The Chi Circle')
|
||||
13000 FORMAT (3X,'-- The Phi Circle')
|
||||
14000 FORMAT (' One at a time or all together.')
|
||||
15000 FORMAT (' It also controls a shutter')
|
||||
16000 FORMAT (' and an attenuator to protect the counter from',
|
||||
$ ' excessive radiation.')
|
||||
17000 FORMAT (' It can also count the x-ray quanta entering the',
|
||||
$ ' scintillation counter.',/,
|
||||
$ ' If you now watch the oscilloscope display on the',
|
||||
$ ' top of the cabinet,',/,
|
||||
$ ' it will count for 5 seconds.')
|
||||
18000 FORMAT (//' These elementary operations (angles, shutter,',
|
||||
$ ' attenuator, timed count)',/,
|
||||
$ ' are now combined to make a line-profile analysis:')
|
||||
20000 FORMAT (///,' It is now going to scan through the peak while',
|
||||
$ ' counting, then subtract',/,
|
||||
$ ' two background measurements to derive the integrated',
|
||||
$ ' intensity under the peak.')
|
||||
21000 FORMAT (//,' An actual experiment involves the measurement',
|
||||
$ ' of thousands of intensities.',/,
|
||||
$ ' Typically, it lasts for 1-2 weeks, day and night.')
|
||||
22000 FORMAT (//////////////////)
|
||||
END
|
||||
Reference in New Issue
Block a user