152 lines
5.1 KiB
Fortran
152 lines
5.1 KiB
Fortran
C-----------------------------------------------------------------------
|
|
C Subroutine to make a line profile using a theta/2theta or omega scan
|
|
C The reflection is assumed to be in the centre of the detector at the
|
|
C start of the procedure
|
|
C There can be a maximum of 100 steps
|
|
C-----------------------------------------------------------------------
|
|
SUBROUTINE LINPRF
|
|
INCLUDE 'COMDIF'
|
|
CHARACTER BEGIN*2
|
|
DATA ITYP,NPTS,NPTSA,CSTEP,TSTEP/0,10,10,0.05,1000./
|
|
IF (KI .EQ. 'DE') THEN
|
|
ISTAN = LPT
|
|
LPT = ITP
|
|
ENDIF
|
|
WRITE (COUT,10000)
|
|
CALL YESNO ('Y',ANS)
|
|
IF (ANS .EQ. 'N') THEN
|
|
KI = ' '
|
|
RETURN
|
|
ENDIF
|
|
WRITE (COUT,13000)
|
|
CALL FREEFM (ITR)
|
|
ITYP = IFREE(1)
|
|
120 WRITE (COUT,15000) NPTS,NPTSA
|
|
CALL FREEFM (ITR)
|
|
IF (IFREE(1) .NE. 0) NPTS = IFREE(1)
|
|
IF (IFREE(2) .NE. 0) NPTSA = IFREE(2)
|
|
WRITE (COUT,15100) CSTEP,TSTEP
|
|
CALL FREEFM (ITR)
|
|
IF (RFREE(1) .NE. 0.0) CSTEP = RFREE(1)
|
|
IF (RFREE(2) .NE. 0.0) TSTEP = RFREE(2)
|
|
IF(TSTEP .LE. 0)TSTEP = 1000.
|
|
IF (TSTEP .LT. 0.01 ) THEN
|
|
WRITE (COUT,11000)
|
|
CALL GWRITE (ITP,' ')
|
|
GO TO 120
|
|
ENDIF
|
|
C-----------------------------------------------------------------------
|
|
C Get current angle values
|
|
C-----------------------------------------------------------------------
|
|
CALL ANGET(THETA,OMEGA,CHI,PHI)
|
|
DEL = NPTS*CSTEP
|
|
NPTS = NPTS + NPTSA
|
|
IF (ITYP .EQ. 0) THEN
|
|
ANG1 = THETA - DEL
|
|
ANG2 = OMEGA
|
|
START = ANG1
|
|
ELSE
|
|
ANG1 = THETA
|
|
ANG2 = OMEGA - DEL
|
|
START = ANG2
|
|
ENDIF
|
|
NATT = 0
|
|
IF (KI .NE. 'DE' .AND. NATTEN .GT. 0) THEN
|
|
WRITE (COUT,17000)
|
|
CALL FREEFM (ITR)
|
|
NATT = IFREE(1)
|
|
IF (NATT .GT. NATTEN) NATT = NATTEN
|
|
ENDIF
|
|
C-----------------------------------------------------------------------
|
|
C Offset the scan from the peak centre
|
|
C-----------------------------------------------------------------------
|
|
CALL ANGSET (ANG1,ANG2,CHI,PHI,NATT,ICOL)
|
|
IF (ICOL .NE. 0) THEN
|
|
WRITE (COUT,26000)
|
|
CALL GWRITE (ITP,' ')
|
|
KI = ' '
|
|
RETURN
|
|
ENDIF
|
|
C-----------------------------------------------------------------------
|
|
C Loop to count and step through the reflection
|
|
C-----------------------------------------------------------------------
|
|
CALL SHUTTR (99)
|
|
DO 240 J = 1,NPTS
|
|
CALL CCTIME (TSTEP,COUNT)
|
|
ACOUNT(J) = COUNT
|
|
IF (ITYP .EQ. 0) ANG1 = ANG1 + CSTEP
|
|
IF (ITYP .NE. 0) ANG2 = ANG2 + CSTEP
|
|
CALL ANGSET (ANG1,ANG2,CHI,PHI,NATT,ICOL)
|
|
IF (ICOL .NE. 0) THEN
|
|
WRITE (COUT,26000)
|
|
CALL GWRITE (ITP,' ')
|
|
CALL SHUTTR (-99)
|
|
KI = ' '
|
|
RETURN
|
|
ENDIF
|
|
240 CONTINUE
|
|
CALL SHUTTR (-99)
|
|
END = ANG1 - CSTEP
|
|
IF (ITYP .NE. 0) END = ANG2 - CSTEP
|
|
C-----------------------------------------------------------------------
|
|
C Set the circles back to the peak
|
|
C-----------------------------------------------------------------------
|
|
NATT = 0
|
|
CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICOL)
|
|
IF (ICOL .NE. 0) THEN
|
|
WRITE (COUT,26000)
|
|
CALL GWRITE (ITP,' ')
|
|
KI = ' '
|
|
RETURN
|
|
ENDIF
|
|
SUM = 0.
|
|
DO 300 I = 1,NPTS
|
|
SUM = SUM + ACOUNT(I)
|
|
300 CONTINUE
|
|
IF (KI .EQ. 'DE') THEN
|
|
WRITE (COUT,19000)
|
|
CALL GWRITE (LPT,' ')
|
|
ENDIF
|
|
WRITE (COUT,20000) IH,IK,IL,THETA,OMEGA,CHI,PHI,SUM
|
|
CALL GWRITE (LPT,' ')
|
|
IF (ITYP .EQ. 0) THEN
|
|
WRITE (COUT,21000)
|
|
ELSE
|
|
WRITE (COUT,22000)
|
|
ENDIF
|
|
CALL GWRITE (LPT,' ')
|
|
IF (END .GE. 360.) END = END - 360.0
|
|
WRITE (COUT,23000) START,END,NPTS,TSTEP,CSTEP
|
|
CALL GWRITE (LPT,' ')
|
|
WRITE (COUT,24000) (ACOUNT(J),J = 1,NPTS)
|
|
CALL GWRITE (LPT,' ')
|
|
IF (KI .EQ. 'DE') THEN
|
|
WRITE (COUT,25000)
|
|
CALL GWRITE (ITP,' ')
|
|
ENDIF
|
|
C-----------------------------------------------------------------------
|
|
C Call PLTPRF to form a plot of the profile on LPT
|
|
C-----------------------------------------------------------------------
|
|
BEGIN = KI
|
|
CALL PLTPRF (ACOUNT,NPTS,BEGIN)
|
|
KI = ' '
|
|
RETURN
|
|
10000 FORMAT (' Plot a Line Profile on the Printer (Y) ? ',$)
|
|
11000 FORMAT (' There is something WRONG. Please try again.')
|
|
13000 FORMAT (' Scan type: Theta/2Theta or Omega, 0 or 1 ',$)
|
|
15000 FORMAT (' Type the no. of pts before & after the peak,'
|
|
$ ,'(',I2,',',I2,') ',$)
|
|
15100 FORMAT (' Type the step size in degs and the preset/step',
|
|
$ ' (',F4.2,',',F4.2,') ',$)
|
|
17000 FORMAT (' Which attenuator do you wish to use (0) ? ',$)
|
|
19000 FORMAT (//,4X,'Indices',21X,'2Theta Omega Chi Phi')
|
|
20000 FORMAT (//3I4,' Angle Settings: ',4F8.3,' Total Counts ',F8.0)
|
|
21000 FORMAT (' Theta/2Theta Scan')
|
|
22000 FORMAT (' Omega Scan')
|
|
23000 FORMAT (1H+,20X,' Begins at',F8.3,' Ends at',F8.3,I4,' Points,',
|
|
$ ' Time/point ',F8.3,' secs, Step Size ',F5.2)
|
|
24000 FORMAT (10F7.0)
|
|
25000 FORMAT (/' A normalized plot of these measurements looks like'/)
|
|
26000 FORMAT (' Collision')
|
|
END
|