139 lines
5.4 KiB
Fortran
139 lines
5.4 KiB
Fortran
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 CCTIME (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 CCTIME (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 CCTIME (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 CCTIME (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 CCTIME(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 CCTIME (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
|