Initial revision
This commit is contained in:
cvs
248
difrac/difini.f
Normal file
248
difrac/difini.f
Normal file
@@ -0,0 +1,248 @@
|
||||
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,7*0/
|
||||
DATA STEP/0.02/,PRESET/15000./DPHI/0./
|
||||
RETURN
|
||||
END
|
||||
|
||||
|
||||
Reference in New Issue
Block a user