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 Transformed into a Subroutine for initialization for SICS by C Mark Koennecke, November 1999 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----------------------------------------------------------------------- SUBROUTINE DIFINI 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) CALL INIDATA 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 DFMODL = 'TRICS' DFTYPE = 'TRICS' WRITE (COUT,10000) DFMODL CALL GWRITE (ITP,' ') LPT = ITP 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 10000 FORMAT (/,10X,'Diffractometer Routine for TRICS ',A /) 11000 FORMAT (' There is no file ',A,'. It will be created.') RETURN END C---------------------------------------------------------------------- SUBROUTINE WNSET(I) INTEGER I RETURN END C---------------------------------------------------------------------- SUBROUTINE WNEND RETURN END C----------------------------------------------------------------------- C Block Data routine to initialize the COMMONs C----------------------------------------------------------------------- SUBROUTINE INIDATA 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/0.,0.,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/1000,1000,100000/, $ 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,0,0,0,0,0,1,0/ DATA STEP/0.02/,PRESET/15000./DPHI/0./ RETURN END