246 lines
10 KiB
Fortran
246 lines
10 KiB
Fortran
C-----------------------------------------------------------------------
|
|
C
|
|
C Diffractometer Control Routine for NRC Picker or Rigaku AFC6
|
|
C E.J.Gabe and P.S White
|
|
C Chemistry Department , UNC, Chapel Hill, NC, USA
|
|
C
|
|
C This routine is based on the original NRC Picker routine for the PDP8
|
|
C E.J. Gabe, Y. Le Page & D.F. Grant
|
|
C Chemistry Division, N.R.C., Ottawa, Canada.
|
|
C
|
|
C The original code has been cleaned up and brought to F77 standard.
|
|
C
|
|
C Key Function
|
|
C
|
|
C *** Terminal Data Input Commands ***
|
|
C
|
|
C AD Attenuator Data: number and values.
|
|
C BD all Basic Data (CZ DH FR LA OM OR PS RR SD SE TM TP)
|
|
C CZ Correct angle Zero values.
|
|
C FR First Reflection to be measured.
|
|
C LA LAmbda for the wavelength in use, usually alpha1.
|
|
C LN Liquid Nitrogen option - specific to cryosystem.
|
|
C OM Orientation Matrix.
|
|
C PS PSi rotation data.
|
|
C RO re-Orientation Reflections: frequency and h,k,ls.
|
|
C RR Reference Reflections: frequency and h,k,ls.
|
|
C SD Scan Data: type, width, speed, profile control.
|
|
C SE Systematic Extinctions.
|
|
C SG Space-Group symbol.
|
|
C TM 2Theta Min and max values.
|
|
C TP Time and Precision parameters for intensity measurement.
|
|
C
|
|
C *** Crystal Alignment Commands ***
|
|
C
|
|
C AL ALign reflections and their symmetry equivalents for MM.
|
|
C AR Align Resumption after interruption.
|
|
C A8 Align the 8 alternate settings of one reflection.
|
|
C CH CHoose reflections from the PK list for use with M2/M3.
|
|
C CR Centre the Reflection which is already in the detector.
|
|
C LC 2theta Least-squares Cell with symmetry constrained cell.
|
|
C MM Matrix from Many reflections by least-squares on AL data.
|
|
C M2 Matrix from 2 indexed reflections and a unit cell.
|
|
C M3 Matrix from 3 indexed reflections.
|
|
C OC Orient a Crystal, i.e. index the peaks from PK.
|
|
C PK PeaK search in 2Theta, Chi, Phi for use with OC.
|
|
C RC Reduce a unit Cell.
|
|
C RP Rotate Phi 360degs, centre and save any peaks found.
|
|
C RS ReSet the cell and matrix with the results from RC.
|
|
C
|
|
C *** Intensity Data Collection ***
|
|
C
|
|
C GO Start of intensity data collection.
|
|
C K Kill operation at the end of the current reflection.
|
|
C Q Quit after the next set of reference reflections.
|
|
C
|
|
C *** Angle Setting and Intensity Measurement ***
|
|
C
|
|
C GS Grid Search measurement in 2theta, omega or chi.
|
|
C IE Intensity measurement for Equivalent reflections.
|
|
C IM Intensity Measurement of the reflection in the detector.
|
|
C IP Intensity measurement in Psi for empirical absorption.
|
|
C IR Intensity measurement for specified Reflections.
|
|
C LP Line Profile plot on the printer.
|
|
C SA Set All angles to specified values.
|
|
C SC Set Chi to the specified value.
|
|
C SH SHutter open or close as a flip/flop.
|
|
C SO Set Omega to the specified value.
|
|
C SP Set Phi to the specified value.
|
|
C SR Set Reflection: h,k,l,psi.
|
|
C ST Set 2Theta to the specified value.
|
|
C TC Timed Counts.
|
|
C ZE ZEro the instrument Angles.
|
|
C
|
|
C *** Photograph Setup Commands ***
|
|
C
|
|
C PL Photograph in the Laue mode.
|
|
C PO Photograph in the Oscillation mode (same as OS).
|
|
C PR Photograph in the Rotation mode.
|
|
C
|
|
C *** General System Commands ***
|
|
C AH Angles to H,k,l (same as IX).
|
|
C AI Ascii Intensity data file conversion.
|
|
C AP Ascii Profile data file conversion.
|
|
C BC Big Chi search for psi rotation.
|
|
C BI Big Intensity search in the IDATA.DA file.
|
|
C EX EXit the program saving the basic data on IDATA.DA.
|
|
C HA H,k,l to Angles (same as RA).
|
|
C PA Print Angle settings.
|
|
C PD Print Data of all forms.
|
|
C Q Quit the program directly.
|
|
C RB Read the Basic data from the IDATA.DA file.
|
|
C SW SWitch register flags setting.
|
|
C UM (UMpty) Count unique reflections within theta limits.
|
|
C WB Write the Basic data to the IDATA.DA file.
|
|
C
|
|
C The program uses 2 main files:--
|
|
C 1. On unit IID the file IDATA.DA contains all the permanent
|
|
C information for a data collection:
|
|
C 2. ON unit ISD the file ORIENT.DA is really a scratch file for
|
|
C use with the crystal orientation routines
|
|
C
|
|
C Both files are 'direct-access' with records of length 85 4-byte
|
|
C variables.
|
|
C
|
|
C The file IDATA.DA contains the following information:--
|
|
C Record # Information
|
|
C 1,2,3 All the basic info for a particular data collection;
|
|
C 4 to 8 All symmetry info from SGROUP;
|
|
C 9 Automatic restart info for use after interruption;
|
|
C 16 to 19 Alignment data for ALIGN;
|
|
C 20 and up Intensity data, 10 reflns per record.
|
|
C
|
|
C There is a 9-bit switch register which can be changed with the SW
|
|
C command or during operation by typing any digit from 1 to 9.
|
|
C The switches control the following :--
|
|
C
|
|
C 1. 0 normal screen display; 1 profile display.
|
|
C 2. 0 display raw profile data; 1 display smoothed data.
|
|
C 3. 0 dont print profiles; 1 print profiles on printer.
|
|
C 4. 0 print intensity data; 1 do not print intensity data.
|
|
C 5. 0 print standards data; 1 do not print standards.
|
|
C 6. 0 no action; 1 add 20 points to profile tolerance.
|
|
C 7. 0 no action; 1 add 10 points to profile tolerance.
|
|
C 8. 0 no action; 1 add 5 points to profile tolerance.
|
|
C 9. 0 no action; 1 write profiles to unit 7.
|
|
C
|
|
C Common to match the CREDUC Common /GEOM/
|
|
C-----------------------------------------------------------------------
|
|
INCLUDE 'COMDIF'
|
|
COMMON /CADCON/ ALPHA,APMIN,APMAX,MAXVAR,MINVAR,
|
|
$ IHOLE,IVSLIT,IHSLIT,INEG45,IPOS45,IUPHAF,ILOHAF,
|
|
$ VUTHT,VUOME,VUCHI,VUPHI,IPORT,IBAUD
|
|
COMMON /GEOM/ GJUNK(370)
|
|
IDH(1,1,1) = 1
|
|
IDH(1,2,2) = 1
|
|
IDH(1,3,3) = 1
|
|
NOTEND = 0
|
|
IKO(5) = -777
|
|
ALPHA = 50.0
|
|
C-----------------------------------------------------------------------
|
|
C Get the I/O unit numbers with SETIOU
|
|
C-----------------------------------------------------------------------
|
|
CALL SETIOU (IID,ISD,LPT,ITR,ITP,IBYLEN)
|
|
CALL WNSET (3)
|
|
C-----------------------------------------------------------------------
|
|
C Check that the angles did not change since the last time the
|
|
C program was stopped.
|
|
C-----------------------------------------------------------------------
|
|
CALL ANGVAL
|
|
WRITE (COUT,10000) DFMODL
|
|
CALL GWRITE (ITP,' ')
|
|
WRITE (COUT,12000)
|
|
CALL ALFNUM (ANS)
|
|
IF (ANS .EQ. 'F' .OR. ANS .EQ. 'f') THEN
|
|
OPEN (LPT, FILE = 'printer.out', STATUS = 'UNKNOWN')
|
|
WRITE (COUT,13000)
|
|
CALL GWRITE (ITP,' ')
|
|
ELSE IF (ANS .EQ. 'S' .OR. ANS .EQ. 's') THEN
|
|
LPT = ITP
|
|
ELSE
|
|
OPEN (LPT, FILE = 'LPT1', STATUS = 'UNKNOWN')
|
|
ENDIF
|
|
C-----------------------------------------------------------------------
|
|
C Open the Idata file (IID) and the scratch file (ISD)
|
|
C If either file does not exist, create it.
|
|
C-----------------------------------------------------------------------
|
|
DO 100 I = 1,85
|
|
ACOUNT(I) = 0.0
|
|
100 CONTINUE
|
|
IDREC = 85*IBYLEN
|
|
STATUS = 'OD'
|
|
IDNAME = 'IDATA.DA'
|
|
LENID = 700
|
|
CALL IBMFIL (IDNAME,IID,IDREC,STATUS,IERR)
|
|
IF (IERR .NE. 0) THEN
|
|
STATUS = 'DN'
|
|
CALL IBMFIL (IDNAME,IID,IDREC,STATUS,IERR)
|
|
KI = 'W2'
|
|
CALL WRBAS
|
|
KI = ' '
|
|
DO 110 I = 4,20
|
|
WRITE (IID,REC=I) (NOTEND,J = 1,85)
|
|
110 CONTINUE
|
|
STATUS = 'DO'
|
|
CALL IBMFIL (IDNAME,-IID,IDREC,STATUS,IERR)
|
|
CALL IBMFIL (IDNAME, IID,IDREC,STATUS,IERR)
|
|
ELSE
|
|
KI = 'AN'
|
|
CALL WRBAS
|
|
ENDIF
|
|
STATUS = 'OD'
|
|
DSNAME = 'ORIENT.DA'
|
|
LENSD = 300
|
|
CALL IBMFIL (DSNAME,ISD,IDREC,STATUS,IERR)
|
|
IF (IERR .NE. 0) THEN
|
|
WRITE (COUT,11000) DSNAME(1:9)
|
|
CALL GWRITE (ITP,' ')
|
|
STATUS = 'DN'
|
|
CALL IBMFIL (DSNAME,ISD,IDREC,STATUS,IERR)
|
|
DO 120 I = 1,300
|
|
WRITE (ISD,REC=I) (NOTEND,J = 1,85)
|
|
120 CONTINUE
|
|
STATUS = 'OD'
|
|
CALL IBMFIL (DSNAME,-ISD,IDREC,STATUS,IERR)
|
|
CALL IBMFIL (DSNAME, ISD,IDREC,STATUS,IERR)
|
|
ENDIF
|
|
C-----------------------------------------------------------------------
|
|
C All commands are read and interpreted in the routine SETOP using
|
|
C 2-letter codes only.
|
|
C-----------------------------------------------------------------------
|
|
200 CALL SETOP
|
|
GO TO 200
|
|
10000 FORMAT (/,10X,'Diffractometer Routine for Enraf-Nonius ',A /)
|
|
11000 FORMAT (' There is no file ',A,'. It will be created.')
|
|
12000 FORMAT (' Send output to Printer or File (P) ')
|
|
13000 FORMAT (' Printer output will be sent to the file PRINTER.OUT')
|
|
END
|
|
C-----------------------------------------------------------------------
|
|
C Block Data routine to initialize the COMMONs
|
|
C-----------------------------------------------------------------------
|
|
BLOCK DATA
|
|
INCLUDE 'COMDIF'
|
|
DATA ISCDEF,ICDDEF/150,250/,IDTDEF,IDODEF,IDCDEF/4,2,10/,
|
|
$ IFRDEF/100/,NRC/-1/,STEPDG/100.0/,ICADSL/60/,NATTEN/0/,
|
|
$ ATTEN/1.0,1.88,3.54,6.66,12.52,170.4/
|
|
DATA KQFLG2/0/,IUPDWN/1/,IUMPTY/0/,IAUTO,NSET/0,1/,SGSYMB/10*0.0/,
|
|
$ DEG/57.2958/
|
|
DATA R/0.070932,0,0, 0,0.070932,0, 0,0,0.070932/,
|
|
$ DTHETA,DOMEGA,DCHI/3*0/,NAXIS/2/,
|
|
$ THEMIN,THEMAX/2.0,100.0/, AS,BS,CS/1.0,0.7,1.0/,
|
|
$ DPSI,PSIMIN,PSIMAX/3*0.0/, TIME,QTIME,TMAX/10,0.5,10/,
|
|
$ PA,PM/2*1.0/, IHMAX,IKMAX,ILMAX/3*22/, WAVE/0.70932/,
|
|
$ NCOND/0/,ICOND,IHS,IKS,ILS,IR,IS/30*0/,
|
|
$ SPEED/4.0/, STEPOF/0.5/, IORNT/0/,NINTOR/0/
|
|
DATA NSTAN/1/,NINTRR/100/,IHSTAN,IKSTAN,ILSTAN/4,17*0/,ISTAN/0/,
|
|
$ NSEG/1/,NMSEG/1/,NMSTAN/1/, NREF/0/, NBLOCK/20/,
|
|
$ IHO,IKO,ILO/24*0/, IND/3*0/, ITYPE/0/, JMIN,JMAX/16*0/,
|
|
$ AP/3*10.0/,APS/3*0.1/,
|
|
$ CANGS/3*0.0/,SANGS/3*1.0/,CANG/3*0.0/,SANG/3*1.0/,
|
|
$ RTHETA,ROMEGA,RCHI,RPHI/4*0.0/, IH,IK,IL/1,2,3/
|
|
DATA IDH/72*0/, IBSECT,ISCAN/2*0/, FRAC/0.1/, IPRFLG/0/,
|
|
$ ISYS/1/, SINABS/3*0.00503135,3*0.0/, ILN/0/, DELAY/100/
|
|
DATA COUT/20*' '/,IWNCUR/0/,ISREG/1,1,1,7*0/
|
|
END
|
|
|