Initial revision
This commit is contained in:
cvs
151
difrac/linprf.f
Normal file
151
difrac/linprf.f
Normal file
@@ -0,0 +1,151 @@
|
||||
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 CTIME (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
|
||||
Reference in New Issue
Block a user