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